Сериализация взаимно-рекурсивных данных

[lomeo]

На RSDN Tonal- задаёт вопрос о сериализации взаимно-рекурсивных данных.

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

Поэтому в голову приходит замечательный пакет data-reify от Andy Gill. О его применении можно прочитать в статье Type-Safe Observable Sharing in Haskell.

Смысл в том, что мы можем разложить рекурсивные данные на нерекурсивные данные со ссылками - то, что нам и нужно.

Т.е. для типов из примера Tonal-

data A = A {a_unuqId :: Int, a_refs :: [B]}
data B = B {b_unuqId :: Int, b_refs :: [A]}

это будет

data N u = AN { an_uniqId :: Int, an_refs :: [u] }
         | BN { bn_uniqId :: Int, bn_refs :: [u] }

Обратите внимание на дырки `u', оставленные для рекурсии - по сути A ~ N B и наоборот.
Пишем instance для MuRef

instance MuRef A where
    type DeRef A = N
    mapDeRef f (A i rs) = AN i <$> sequenceA (map f rs)

instance MuRef B where
    type DeRef B = N
    mapDeRef f (B i rs) = BN i <$> sequenceA (map f rs)

и получаем нужный граф, например

> let { a = A 1 [b] ; b = B 2 [a] }
> reifyGraph a
let [(1,AN {an_uniqId = 1, an_refs = [2]}),(2,BN {bn_uniqId = 2, bn_refs = [1]})] in 1

или

> let { a1 = A 1 [b1, b2] ; a2 = A 2 [b2] ; b1 = B 3 [a1] ; b2 = B 4 [a1, a2] }
> reifyGraph a1
let [(1,AN {an_uniqId = 1, an_refs = [2,3]}),
     (3,BN {bn_uniqId = 4, bn_refs = [1,4]}),
     (4,AN {an_uniqId = 2, an_refs = [3]}),
     (2,BN {bn_uniqId = 3, bn_refs = [1]})] in 1

Меня здесь смущает тип [(Unique, g Unique)], всё таки хочется IntMap (g Unique) - быстрее и десериализация будет проще. Впрочем, переписать библиотеку должно быть несложно.

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

graphToA :: Graph (DeRef A) -> A
graphToA (Graph gs i) = ma ! i
    where
        ma = fromList [ (i, A ai $ map (mb!) rs) | (i, AN ai rs) <- gs ]
        mb = fromList [ (i, B bi $ map (ma!) rs) | (i, BN bi rs) <- gs ]

Покритикуйте.

Comments

[lomeo.livejournal.com]

Да, понял, спасибо за код.

Версия, которая не зависит от Id (пользую StableName)
http://hpaste.org/fastcgi/hpaste.fcgi/view?id=17329#a17329

В uniplate, чтобы поддерживал рекурсивные данные, это красиво не засунешь :-( Потому что IO.

[permea-kra.livejournal.com]

Ошибка базы. Может, в pre-теге в коммент кинете ?

[lomeo.livejournal.com]

А я уже убил. Но вот uniplate-like с unsafePerformIO

{-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-}
module Ser
where
import Data.Generics
import Control.Monad.State
import Control.Monad.Writer
import qualified Data.Set as Set
import Data.Maybe
import System.Mem.StableName
import System.IO.Unsafe
import Debug.Trace

type LinkSet = Set.Set Int

presents :: (Monad m, MonadState LinkSet m) => Int -> m Bool
presents iD = gets (Set.member iD)

type SerM r a = StateT LinkSet (WriterT [r] IO) a

goRec :: (Data v, Data r) => v -> SerM r ()
goRec v = do
    iD <- v `seq` (hashStableName `fmap` liftIO (makeStableName v))
    p <- presents iD
    unless p $ do
        modify $ Set.insert iD
        case cast v of
            Just v0 -> serRi v0 iD
            Nothing -> continue
    where
        serRi v iD = tell [v] >> continue
        continue = sequence_ $ gmapQ goRec v

recUniplate :: (Data v, Data r) => v -> [r]
recUniplate v = unsafePerformIO $ execWriterT $ evalStateT (goRec v) Set.empty

data Rose = Rose { roseId :: Int, roses :: [Rose] }
    deriving (Data,Typeable)

testRose = let
        a = Rose 1 [b,c]
        b = Rose 2 [a,c]
        c = Rose 3 [a,b]
    in a

Работаем...

> [id | Rose id _ <- recUniplate testRose]
[1,2,3]

[permea-kra.livejournal.com]

Ага. Спасибо, симпатичненько.

[permea-kra.livejournal.com]

Хм. Это вы ручками код выправили или какой-то тульзой ?

[lomeo.livejournal.com]

Ручками, пока разбирался с вашим :)

[permea-kra.livejournal.com]

Бгы. Надо бы какие-то гайдлайны по форматированию хаскельного кода что ли поискать...

[lomeo.livejournal.com]

http://www.haskell.org/haskellwiki/Programming_guidelines
http://haskell.org/haskellwiki/Things_to_avoid - тут не форматирование

Ещё есть соглашения для GHC sources, оттуда тоже можно взять что-нибудь полезное.

Поиск haskell beautifier не дал ничего полезного :(

[permea-kra.livejournal.com]

Спасибо, почитаем.