Священный грааль динамической диспетчеризации

Большой бедой Узким местом статической типизации являются гетерогенные коллекции и [поли]вариадические функции. Поэтому в RPC-библиотеках часто встречается подход, когда входящие данные так и лежат одним ADT-куском, а для методов один такой же плоский тип [Foo] -> IO Foo, реализации которого копипастят десериализацию/сериализацию, что неудобно и плодит ошибки, в т.ч. рантаймовые.

Решение этой задачи меня беспокоило практически с самого начала практического применения мной хаскеля и, наконец, вчера ночью на меня снизошло вдохновение аж в 6.5 миллиолега и после сеанса гадания на ошибках и беседы с ghci у меня всё получилось.

Допустим мы хотим сделать список/словарь вида “Текст -> Метод”. И сразу же облом:

methods :: [(String, ????)]
methods = [ ("add", \x y -> return (x + y))
          , ("reverse", \s -> return (reverse s))
          ]

Все методы имеют разный тип. Это можно решить, положив их в непрозрачную коробку.

data BaconBox = forall a. a

methods :: [(String, BaconBox)]

Но такую коробку нельзя распаковать т.к. непонятно что вообще с ними можно делать, распаковав. Это значит, что нужен класс типов, которые могут в ней находиться и описывающий как привести функцию к нормальному виду т.е. функции готовой к десериализации входных данных и сериализации результата.

В этом примере будет использоваться “протокол” Read/Show. Не самый лучший, но для остальных всё тоже самое. Типом данных, соответственно будет String.

class Tossable t where
    toss :: [String] -> t -> IO String

data BaconBox = forall a. (Tossable a) => BaconBox a

С таким определением уже понятно даже компилятору, что внутрь коробки можно положить любой тип, для которого определена функция toss, которая…. Бах! Тут мы плавно переходим ко второй проблеме. Ведь хочется, чтобы вызываемые методы могли иметь любые аргументы и в любом количестве. Т.е. чтобы в коробку можно было просто взять и положить любой обработчик RPC, для которого определены процедуры маршалинга. У Олега и на хаскельной вики есть пример кое-чего похожего - printf с любым количеством аргументов любого типа: http://www.haskell.org/haskellwiki/Varargs. Но это не совсем то. Но и не совсем не то!

Трюк основывается на двух инстансах - базовая форма и свёртывание аргументов. Базовая форма определяет что же всё-таки делать, когда данные собраны. В ней же опредляется класс выходного типа метода.

instance (Show a) => Tossable (IO a) where
    toss [] f = fmap show f
    toss _ _ = fail "Избыточное количество аргументов"

Если все аргументы использованы и у нас на руках есть готовое значние (в данном случае это действие, которое надо выполнить), т.е. к функции применены все аргументы - мы его выполняем и сразу же сериализуем результат. Оставшиеся аргументы можно выбросить, а можно и ругнуться - я предпочитаю кинуть ошибку, чем гадать о корректности.

Для свёртывания аргументов используется весьма интересный инстанс, демонстрирующий во всей красе мощщъ функционального подхода в целом и правильной системы типов в частности. Тут фиксируется класс входных аргументов, гарантирующий успешность наличие десерилизатора для типа, используемого в вызове RPC метода.

instance (Read a, Tossable t) => Tossable (a -> t) where
    toss [] _ = fail "Недостаточно аргументов"
    toss (a:as) f = toss as (f (read a))

Не смотря на магичность определения, происходящее довольно тривиально. Если наш тип это функция (a -> t), а у нас есть ещё для неё аргументы, то мы десериализуем следующий аргумент в соответствии с типом, который ожидает функция и применяем его к ней.

Если результат получился в виде базовой формы - хорошо, если после применения аргумента к функции, снова получилась функция - повторяем процедуру.

doAnd :: Bool -> Bool -> IO Bool
doAnd a b = return (a && b)

doSum3 :: Double -> Double -> Double -> IO Bool
doSum3 x y z = return (x + y + z)

main = do
    toss [] (doAnd True True) >>= print
    toss ["True"] (doAnd True) >>= print
    toss ["True", "True"] doAnd >>= print

    toss ["42", "2.71828", "3.14159"] doSum3 >>= print 

Et voila! Функция спокойно распаковывает и скармливает аргументы и упаковывает результат.

Остался последний штрих - динамическая диспетчеризация методов из коробок. Добавим в нашу коробку немного метаданных и функцию поиска по ним.

data BaconBox = forall a. (Tossable a) => BaconBox String a

tossBacon :: (Show a) => [BaconBox] -> String -> [String] -> IO a
tossBacon [] _ _ = fail "Метод не найден"
tossBacon (BaconBox bn bf : bs) name args
    | bn == name = toss args bf
    | otherwise = tossBacon bs name args

Специальная функция нужна для того, чтобы у компилятора не взорвался мозг(sic!) при раскрытии экзистенциального контейнера любым способом кроме паттерн-матчинга. FP-world problems…

-- класс, инстансы, функции как раньше

bacon :: [BaconBox]
bacon = [ BaconBox "bool.and" doAnd
        , BaconBox "num.sum3" doSum3
        ]

main :: IO ()
main = do
    (method:args) <- getArgs
    tossBacon bacon method args >>= print

Итак, у нас получился контейнер, позволяющий совать внутрь функции с произвольным (но строго ограниченым по вводу и выводу) типом и вызывать их по имени, автоматически выполняя рутинную работу по маршалингу. Меньше кода - меньше багов. Ура!