{-# 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]