[Haskell-cafe] Pickling HList
Cale Gibbard
cgibbard at gmail.com
Thu Nov 10 10:45:47 EST 2005
On 10/11/05, Joel Reymont <joelr1 at gmail.com> wrote:
> 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/
>
We came to this solution on IRC:
{-# OPTIONS_GHC -fglasgow-exts #-}
module Bar where
--...
class (HList l, HList p) => HLPU p l | p -> l, l -> p where
puHList :: p -> PU l
instance HLPU HNil HNil where
puHList HNil = lift HNil
instance (HList l, HLPU p l) => HLPU (HCons (PU e) p) (HCons e l) where
puHList (HCons pe l) =
wrap (\(a, b) -> HCons a b,
\(HCons a b) -> (a, b))
(pair pe (puHList l))
--...
The trick is to get the types to assert that not just the first
element of the HList is a pickler/unpickler, but that the whole input
HList is composed of them.
- Cale
More information about the Haskell-Cafe
mailing list