Для бинарной сериализации в Haskell существует модуль Data.Binary. Без побочных эффектов (де)сериализует в/из Data.ByteString.Lazy. Он пока не идет в поставке с GHC и его нужно руками ставить из hackage. Использовать его не просто, а очень просто:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
| module Main where
import Control.Monad import Data.Binary
data SomeData = ConstrA | ConstrB Int | ConstrC String Int deriving(Show)
instance Binary SomeData where put ConstrA = sequence_ [put (0 :: Word8)] put (ConstrB a) = sequence_ [put (1 :: Word8), put a] put (ConstrC a b) = sequence_ [put (2 :: Word8), put a, put b] get = do tag <- getWord8 case tag of 0 -> do return ConstrA 1 -> do a <- get return $ ConstrB a 2 -> do a <- get b <- get return $ ConstrC a b
|
Ну и поиграться:
| > encode $ ConstrC "asdf" 1 Chunk "\STX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\EOTasdf\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH" Empty
> decode (encode $ ConstrC "asdf" 1) :: SomeData ConstrC "asdf" 1
|
Всё понятно. Но вот только если у ваших типов много конструкторов и самих типов много, написание этих бесконечных инстансов превращается в абсолютно тупую работу, а мы, гордые хаскеллисты, не любим делать тупую работу! Да и ручное написание такого кода чревата деланием большого количества ошибок — тут вам умный вывод типов ничем не поможет. Собственно в документации Data.Binary есть рекомендация использовать для создания инстансов скрипт генерации хаскельного кода по декларации типа. Метод, прямо скажем, никуда не годный: для каждого изменения типа придется ручками заново генерировать инстанс, можно конечно доточить этот скрипт до автоматической генерации, но это чревато ковырянием с вашими билдовыми скриптами и т.п. безобразиями. Короче — неудобно.
В эту задачу прямо таки проситься метапрограммирование. А что у нас в Хаскелле используется для метапрограммирования? Правильно — Template Haskell.
UPD: Указанный далее способ использовать не рекомендую, читайте как надо.
Судя по кешу гугла и по хаскеллевской вики, нечто похожее было написано в библиотеке SerTH, однако ссылка на неё ведет в 403 Forbidden и выковырянные мною его исходники из кеша гугла под GHC 6.10.4 не собирались, и за пол-часа я это не победил. Из факта отсутствия других реализаций генерации Binary на Template Haskell можно сделать ряд выводов:
- Я самый гордый из всех гордых хаскелистов — все остальные обожают делать тупую работу
- Все пишут этот несчастный автогенератор на TH и не выкладывают его в Интернет (засранцы!)
- Хаскель — никому не нужный язык, на нем никто ничего не пишет сложнее вычисления факториала
- Этот генератор лежит на самом видном месте и я его не заметил
Я засучил рукава и пошел писать генератор сам. Получилось конечно страшненько, зато работает! Для учебных целей этот код использовать бессмысленно, так что особо я про него писать не буду:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
| module DeriveBinary(derive_binary) where
import Language.Haskell.TH import Language.Haskell.TH.Syntax
derive_binary :: Name -> Q [Dec] derive_binary t = do TyConI (DataD _ _ _ cnst _) <- reify t return [InstanceD [] (AppT (ConT $ mkName "Data.Binary.Binary") (ConT t)) [ FunD (mkName "put") $ make_clause_list cnst, ValD (VarP $ mkName "get") ( NormalB ( DoE [ BindS (VarP $ mkName "tag") (VarE $ mkName "Data.Binary.Get.getWord8"), NoBindS (CaseE (VarE $ mkName "tag") (make_match_list cnst))])) []]] where make_clause_list cnst = map make_clause $ zip cnst [0..] make_clause (c,cidx) = Clause [ConP (name c) (map VarP $ make_var_names c)] (NormalB (AppE (VarE $ mkName "Control.Monad.sequence_") ( ListE $ (++) [AppE (VarE $ mkName "Data.Binary.put") ( SigE (LitE (IntegerL cidx)) (ConT $ mkName "Word8"))] $ map make_put_var $ make_var_names c))) [] make_var_names c = map (\i -> mkName $ (++) "a_" $ show i) [1..(len_of_args c)] make_put_var v = AppE (VarE $ mkName "Data.Binary.put") (VarE v) make_match_list cnst = map make_match $ zip cnst [0..] make_match (c,cidx) = Match (LitP (IntegerL cidx)) ( NormalB ( DoE ((make_binds c) ++ [NoBindS ( InfixE (Just (VarE $ mkName "return")) (VarE $ mkName "$") (Just ( make_constr c )))]))) [] make_binds c = map (\n -> BindS (VarP $ mkName $ (++) "a_" $ show n) (VarE $ mkName "Data.Binary.get")) [1..(len_of_args c)] make_constr c = foldl (\p n -> AppE p (VarE $ mkName $ (++) "a_" $ show n)) (ConE $ name c) [1..(len_of_args c)] name (NormalC n _) = n len_of_args (NormalC _ l) = length l
|
Используем:
1 2 3 4 5 6 7 8 9 10 11 12 13
| {-# LANGUAGE TemplateHaskell #-}
module Main where
import DeriveBinary import qualified Control.Monad import Data.Binary import qualified Data.Binary.Get
data SomeData = ConstA | ConstrB Int | ConstrC String Int deriving(Show)
$(derive_binary ''SomeData)
|
Красота! Тестируем:
| > encode $ ConstrC "asdf" 1 Chunk "\STX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\EOTasdf\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH" Empty
> decode (encode $ ConstrC "asdf" 1) :: SomeData ConstrC "asdf" 1
|
Кому надо — пользуйтесь. Лицензия: Public Domain. Скачать тут.
Заранее пожалуйста! :)