[Haskell-cafe] Pickling HList
Joel Reymont
joelr1 at gmail.com
Thu Nov 10 09:04:03 EST 2005
Folks,
I'm having trouble creating a pickler for HLists and would appreciate
a solution.
The code for (HCons e HNil) works fine but I get an error trying to
implement puHList for (HCons e l) where l is supposed to be (HCons
e ...), i.e. another HList.
Bar.hs:21:37:
Couldn't match the rigid variable e' against PU e'
`e' is bound by the instance declaration at Bar.hs:17:0
Expected type: HCons (PU e) l Inferred type: HCons e l
In the first argument of puHList', namely l'
In the second argument of pair', namely (puHList l)'
Failed, modules loaded: none.
----
module Bar where
import Data.Word
import OOHaskell
main = print "We are here!"
class HList l => HLPU l where
puHList :: HCons (PU e) l -> PU (HCons e l)
instance HLPU HNil where
puHList (HCons pe HNil) =
wrap (\e -> HCons e HNil,
\(HCons e HNil) -> e)
pe
instance HList l => HLPU (HCons e l) where
puHList (HCons pe l) =
wrap (\(a, b) -> HCons a b,
\(HCons a b) -> (a, b))
(pair pe (puHList l))
newtype TourType = TourType TourType_ deriving (Show{-, Typeable-})
newtype AvgPot = AvgPot Word64 deriving (Show{-, Typeable-})
data TourType_
= TourNone
| TourSingle
| TourMulti
| TourHeadsUpMulti
deriving (Enum, Show{-, Typeable-})
--- Pickling
data PU a = PU { appP :: (a, [Word8]) -> [Word8],
appU :: [Word8] -> (a, [Word8]) }
pickle :: PU a -> a -> [Word8]
pickle p value = appP p (value, [])
unpickle :: PU a -> [Word8] -> a
unpickle p stream = fst (appU p stream)
lift :: a -> PU a
lift x = PU snd (\s -> (x, s))
sequ :: (b -> a) -> PU a -> (a -> PU b) -> PU b
sequ f pa k = PU (\ (b, s) -> let a = f b
pb = k a
in appP pb (b, appP pa (a, s)))
(\ s -> let (a, s') = appU pa s
pb = k a
in appU pb s')
pair :: PU a -> PU b -> PU (a,b)
pair pa pb = sequ fst pa (\ a -> sequ snd pb
(\ b -> lift (a,b)))
wrap :: (a -> b, b -> a) -> PU a -> PU b
wrap (i, j) pa = sequ j pa (lift . i)
Thanks, Joel
--
http://wagerlabs.com/
More information about the Haskell-Cafe
mailing list