datatype/Serialise.hs

   1 {-# LANGUAGE DefaultSignatures, FlexibleContexts, TypeOperators #-}
   2 module Serialise where
   3
   4 import Data.Char
   5
   6 import GHC.Generics
   7
   8 class Serialise a where
   9     serialise :: a -> [Int] -> [Int]
  10     default serialise :: (Generic a, GSerialise (Rep a)) => a -> [Int] -> [Int]
  11     serialise = gserialise . from
  12
  13 class GSerialise f where
  14     gserialise :: f a -> [Int] -> [Int]
  15
  16 --Void
  17 instance GSerialise V1 where
  18     gserialise _ = id
  19 --Unit
  20 instance GSerialise U1 where
  21     gserialise _ = id
  22 --Pair
  23 instance (GSerialise a, GSerialise b) => GSerialise (a :*: b) where
  24     gserialise (l :*: r) = gserialise l . gserialise r
  25 --Constants, additional parameters and recursion of kind *
  26 instance Serialise a => GSerialise (K1 i a) where
  27     gserialise (K1 a) = serialise a
  28 --Either not supported because we don't support sumtypes in our stack machine
  29 instance (GSerialise a, GSerialise b) => GSerialise (a :+: b) where
  30     gserialise (L1 l) = (0:) . gserialise l
  31     gserialise (R1 r) = (1:) . gserialise r
  32 --Datatype, Constructor or Selector
  33 instance (GSerialise a) => GSerialise (M1 i c a) where
  34     gserialise (M1 l) = gserialise l
  35
  36 instance Serialise Int where
  37     serialise i = (i:)
  38 instance Serialise Bool where
  39     serialise b = ((if b then 1 else 0):)
  40 instance Serialise Char where
  41     serialise c = (ord c:)