Recycled Bin

 
module Ser
where
import Data.Generics
import Control.Monad.State
import Control.Monad.Writer
import Control.Monad.Identity
import qualified Data.Set as Set
import Data.Maybe

ifIsId :: (Monad m, MonadState (Set.Set Id) m ) => Id -> m () -> m () -> m ()
ifIsId iD onS onF =	do
			s <- get
			let is = Set.member iD s
			if is then onS else onF

newtype Id = Id { unId :: Int} deriving (Data,Typeable,Show,Read,Ord,Eq)

getIdMaybe :: (Data a, Typeable a) => a -> Maybe Id 
-- ^ get Id for this node. 
-- Limitation : no more then one id per node or undefined behaivor
getIdMaybe = listToMaybe . catMaybes . (gmapQ (mkQ Nothing (Just :: Id -> Maybe Id)))

type SerM a = StateT (Set.Set Id) (WriterT String Identity) a

serV :: (Data v, Typeable v) => v -> SerM ()
serV v =	do
		tell "{ " 
		case (getIdMaybe v) of -- brunch if value has identifier
			Just iD	-> ifIsId iD ( tell $ "linkTo " ++ (show $ unId iD) ) (serRi v iD)
			Nothing -> (serRs v)
		tell " }"
		where 	serRi v iD = 	(modify $ Set.insert iD) >>
					tell (showConstr $ toConstr v) >>
		                     	tell (" id = " ++ (show $ unId iD) ) >>
					(sequence_ $ gmapQ serV v)  
			serRs v = tell (showConstr $ toConstr v) >> (sequence_ $ gmapQ serV v)
		
runSer :: (Data v, Typeable v) => v -> String
runSer v = runIdentity $ execWriterT $ evalStateT (serV v) Set.empty

data A = A { id_A :: Id , ref_B :: Maybe B } 			deriving (Data,Typeable)
data B = B { id_B :: Id , ref_A :: Maybe A, ref_C :: Maybe C } 	deriving (Data,Typeable)
data C = C { ind_ref_A :: Maybe A }				deriving (Data,Typeable)

test :: A
test = 	let 	top = A (Id 1) (Just sb)
		sb  = B (Id 2) (Just top) (Just sc)
		sc  = C (Just top)
	in top

*Ser> runSer test
"{ A id = 1{ Id{ 1 } }{ Just{ B id = 2{ Id{ 2 } }{ Just{ linkTo 1 } }{ Just{ C{ Just{ linkTo 1 } } } } } } }"