RefSerialize-0.2.6: Data/RefSerialize.hs
{-# OPTIONS -fglasgow-exts -XOverlappingInstances #-}
-----------------------------------------------------------------------------
--
-- Module : Data.RefSerialize
-- Copyright : Alberto Gómez Corona
-- License : see LICENSE
--
-- Maintainer : agocorona@gmail.com
-- Stability : experimental
-- | Read, Show and Data.Binary do not check for repeated references to the same address.
-- As a result, the data is duplicated when seri<alized. This is a waste of space in the filesystem
-- and also a waste of serialization time. but the worst consequence is that, when the serialized data is read,
-- it allocates multiple copies for the same object when referenced multiple times. Because multiple referenced
-- data is very typical in a pure language such is Haskell, this means that the resulting data loose the beatiful
-- economy of space and processing time that referential transparency permits.
--
-- Here comes a brief tutorial:
--
-- @runW applies showp, the serialization parser of the instance Int for the RefSerialize class
--
-- Data.RefSerialize>let x= 5 :: Int
-- Data.RefSerialize>runW $ showp x
-- "5"
--
-- every instance of Read and Show is an instance of RefSerialize. for how to construct showp and readp parsers, see the demo.hs
--
-- rshowp is derived from showp, it labels the serialized data with a variable name
--
-- Data.RefSerialize>runW $ rshowp x
-- " v8 where {v8= 5; }"
--
-- Data.RefSerialize>runW $ rshowp [2::Int,3::Int]
-- " v6 where {v6= [ v9, v10]; v9= 2; v10= 3; }"
--
-- while showp does a normal show serialization
--
-- Data.RefSerialize>runW $ showp [x,x]
-- "[5, 5]"
--
-- rshowp variables are serialized memory references: no piece of data that point to the same addrees is serialized but one time
--
-- Data.RefSerialize>runW $ rshowp [x,x]
-- " v9 where {v6= 5; v9= [ v6, v6]; }"
--
--
--
-- "this happens recursively"
--
-- Data.RefSerialize>let xs= [x,x] in str = runW $ rshowp [xs,xs]
-- Data.RefSerialize>str
-- " v8 where {v8= [ v10, v10]; v9= 5; v10= [ v9, v9]; }"
--
-- the rshowp serialized data is read with rreadp. The showp serialized data is read by readp
--
-- Data.RefSerialize>let xss= runR rreadp str :: [[Int]]
-- Data.RefSerialize>print xss
-- [[5,5],[5,5]]
--
-- this is the deserialized data
--
-- the deserialized data keep the references!! pointers are restored! That is the whole point!
--
-- Data.RefSerialize>varName xss !! 0 == varName xss !! 1
-- True
--
--
-- rShow= runW rshowp
-- rRead= runR rreadp
--
-- Data.RefSerialize>rShow x
-- " v11 where {v11= 5; }"
--
--
-- In the definition of a referencing parser non referencing parsers can be used and viceversa. Use a referencing parser
-- when the piece of data is being referenced many times inside the serialized data.
--
-- by default the referencing parser is constructed by:
--
--
-- rshowp= insertVar showp
-- rreadp= readVar readp
-- but this can be redefined. See for example the instance of [] in RefSerialize.hs
--
-- This is an example of a showp parser for a simple data structure.
--
-- data S= S Int Int deriving ( Show, Eq)
--
-- instance Serialize S where
-- showp (S x y)= do
-- xs <- rshowp x -- rshowp parsers can be inside showp parser
-- ys <- rshowp y
-- return $ "S "++xs++" "++ys
--
--
--
-- readp = do
-- symbol "S" -- I included a (almost) complete Parsec for deserialization
-- x <- rreadp
-- y <- rreadp
-- return $ S x y
--
-- there is a mix between referencing and no referencing parser here:
--
-- Data.RefSerialize>putStrLn $ runW $ showp $ S x x
-- S v23 v23 where {v23= 5; }@
module Data.RefSerialize
(
module Data.Parser
,Serialize(
showp
,readp
,rshowp
,rreadp
)
,showSR
,readSR
,rShow
,rRead
,insertVar
,readVar
,varName
,runR
,runW
,readHexp
,showHexp
)
where
import qualified Data.Map as M
import Data.Serialize
import Data.Parser
import Unsafe.Coerce
import Data.Char(isAlpha, isSpace, isAlphaNum)
import Numeric(readHex,showHex)
import Data.Map
class Serialize c where
showp :: c -> ST String -- ^ shows the content of a expression, must be defined bu the user
readp :: ST c -- ^ read the content of a expression, must be user defined
rshowp :: c -> ST String -- ^ insert a reference (a variable in the where section). @rshowp = insertVar showp @ -- default definition
rshowp = insertVar showp
rreadp :: ST c -- ^ read a variable in the where section (to use for deserializing rshowp output). @rreadp = readVar readp@ -- default definition
rreadp = readVar readp
{-
#ifdef Axioms
serializeAxioms: Axioms c
serializeAxioms= axioms{
unary= [Axiom "reverse"
(\x -> let str= rShow x
y = rRead xtr
in y== x)
AxioM "pointer equality"
(\x -> let str= rShow[x,x]
[y,z] = rRead str
in varName y== varName z)
]
}
#endif
-}
-- | use the rshowp parser to serialize the object
-- @ rShow c= runW $ rshowp c@
rShow :: Serialize c => c -> String
rShow c= runW $ rshowp c
-- | deserialize trough the rreadp parser
-- @ rRead str= runR rreadp $ str@
rRead :: Serialize c => String -> c
rRead str= runR rreadp $ str
readHexp :: (Num a, Integral a) => ST a
readHexp = ST(\(Stat(c,s,v)) ->
let l= readHex s
in if Prelude.null l then Left . Error $ "not readable: " ++ s
else let ((x,str2):_)= l
in Right(Stat(c,dropWhile isSpace str2,v),x) )
<?> "readHexp "
-- |if a is an instance of Read, readSR can be used as the readp method
-- the drawback is that the data inside is not inspected for common references
-- so it is recommended to create your own readp method for your complex data structures
readSR :: Read a => ST a
readSR = ST(\(Stat(c,s,v)) ->
let l= readsPrec 1 s
in if Prelude.null l then Left . Error $ "not readable: " ++ s
else let ((x,str2):_)= l
in Right(Stat(c,dropWhile isSpace str2,v),x) )
<?> "readp: readsPrec "
--readSR = ST(\(Stat(c,s,v)) -> let ((x,str2):_)= readsPrec 1 s in Right(Stat(c,str2,v),x) )
-- | deserialize the string with the parser
runR:: ST a -> String -> a
runR (ST f) str=
let (struct, vars)= readContext "where " str
in case f (Stat(M.empty,struct,vars) ) of
Right (Stat _, a) -> a
Left (Error s) -> error s
showHexp :: (Num a,Integral a) => a -> ST String
showHexp var= ST(\(Stat(c,s,v)) -> Right(Stat(c,s,v),showHex var "")) <?> "showHexp "
-- |if a is an instance of Show, showSR can be used as the showp method
-- the drawback is that the data inside is not inspected for common references
-- so it is recommended to create your own readp method for your complex data structures
showSR :: Show a => a -> ST String
showSR var= ST(\(Stat(c,s,v)) -> Right(Stat(c,s,v),show var)) <?> "showp: show "
-- | serialize x with the parser
runW :: ST String -> String
runW (ST f) = case f (Stat(M.empty,"","")) of
Right (Stat (c,_,_), str) ->
let scontext= M.assocs c
show1 c= concatMap (\(n,(_,v))->"v"++ show n++"= "++v++"; ") scontext
vars= show1 c
strContext= if Prelude.null vars then "" else " where {"++vars ++ "}"
in str ++ strContext
Left (Error s) -> error s
-- | insert a variable at this position. The expression value is inserted in the "where" section if it is not already
-- created. If the address of this object being parsed correspond with an address already parsed and
-- it is in the where section, then the same variable name is used
-- @runW showp (1::Int) -> "1"
-- runW (insertVar showp) (1::Int) -> v1 where { v1=1}
-- runW (insertVar showp) [(1::Int) ,1] -> [v1.v1] where { v1=1}@
-- This is useful when the object is referenced many times
insertVar :: (a -> ST String) -> a -> ST String
insertVar parser x= ST(\(Stat(c,s,v))->
let mf = trytofindEntireObject x c in
case mf of
Just var -> Right(Stat(c,s,v),var)
Nothing ->
let
ST f= parser x
Right (Stat (c',_,_), str) = f (Stat(c,s,v))
in Right(Stat(addc str c',s,v), ' ':varname))
where
addc str c= M.insert ( hash) (unsafeCoerce x, str) c
hash = hasht x
varname= "v" ++ show hash
trytofindEntireObject x c=
case M.lookup hash c of
Nothing -> Nothing
Just _ -> Just varname
-- | deserialize a variable serialized with insertVar. Memory references are restored
readVar :: Serialize c => ST c -> ST c
readVar parser= ST(\(Stat(c,s,v))->
let
s1= dropWhile isSpace s
(var, str2) = span isAlphaNum s1
in case trytofindEntireObject (numVar var) c of
Just (x,_) -> Right(Stat(c,str2,v),unsafeCoerce x)
Nothing ->
let
(_, rest)= readContext (var++"= ") v
ST f= parser
in case f (Stat(c,rest,v)) --`debug` ("s="++s++"var="++var++"rest="++rest )
of
Right (Stat(c',s',v'),x) ->
let c''= M.insert (numVar var) (unsafeCoerce x, "") c'
in Right (Stat(c'',str2,v),x)
err -> err)
where
trytofindEntireObject x c=
case M.lookup x c of
Nothing -> Nothing
justx -> justx
-- -------------Instances
instance Serialize String where
showp = showSR
readp = readSR
instance Serialize a => Serialize [a] where
showp []= return "[]"
showp (x:xs)= do
s1<- rshowp x
sn<- mapM f xs
return $ "["++ s1++ concat sn ++"]"
where
f x= do str <- rshowp (x:: a)
return $ ", "++str
readp = (readVar $ brackets $ commaSep $ rreadp) <?> "rreadp:: [] "
instance (Serialize a, Serialize b) => Serialize (a, b) where
showp (x, y)= do
sx <- rshowp x
sy <- rshowp y
return $ "("++ sx ++ ", " ++ sy ++ ")"
readp = parens $ do
x <- rreadp
comma
y <- rreadp
return (x,y)
instance (Serialize a, Ord a, Serialize b) => Serialize (Map a b) where
showp m= showp $ M.toList m
readp= do
list <- readp :: ST [(a,b)]
return $ M.fromList list
instance Serialize a => Serialize (Maybe a) where
showp Nothing = return "Nothing"
showp (Just x) = showp x >>= \sx -> return $ "Just " ++ sx
readp = choice [rNothing, rJust] where
rNothing = symbol "Nothing" >> return Nothing
rJust = symbol "Just" >> readp >>= \x -> return $ Just x
instance (Serialize a, Serialize b) => Serialize (Either a b) where
showp (Left x) = rshowp x >>= \sx -> return $ "Left " ++ sx
showp (Right x) = rshowp x >>= \sx -> return $ "Right " ++ sx
readp = choice [rLeft, rRight] where
rLeft = symbol "Left" >> rreadp >>= \x -> return $ Left x
rRight = symbol "Right" >> rreadp >>= \x -> return $ Right x
instance Serialize Bool where
showp = showSR
readp = readSR
instance Serialize Char where
showp = showSR
readp = readSR
instance Serialize Double where
showp = showSR
readp = readSR
instance Serialize Float where
showp = showSR
readp = readSR
instance Serialize Int where
showp = showSR
readp = readSR
instance Serialize Integer where
showp = showSR
readp = readSR
instance Serialize Ordering where
showp = showSR
readp = readSR
instance Serialize () where
showp = showSR
readp = readSR