Октябрь 6, 2009, 05:05
Для бинарной сериализации в 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. Скачать тут.
Заранее пожалуйста! :)