{-# OPTIONS -fglasgow-exts #-}

-- A bit more test code for the 2nd boilerplate paper.
-- These are downscaled versions of library functionality or real test cases.
-- We just wanted to typecheck the fragments as shown in the paper.

module Encode () where

import Data.Generics

data Bit = Zero | One

------------------------------------------------------------------------------
-- Sec. 3.2

data2bits :: Data a => a -> [Bit]
data2bits t = encodeCon (dataTypeOf t) (toConstr t)
                ++ concat (gmapQ data2bits t)

-- The encoder for constructors
encodeCon :: DataType -> Constr -> [Bit]
encodeCon ty con = natToBin (max-1) (idx-1)
                  where
                    max = maxConstrIndex ty
                    idx = constrIndex con


natToBin :: Int -> Int -> [Bit]
natToBin = undefined

------------------------------------------------------------------------------
-- Sec. 3.3

data State   -- Abstract
initState  :: State
encodeCon' :: DataType -> Constr
           -> State -> (State, [Bit])

initState  = undefined
encodeCon' = undefined

data2bits' :: Data a => a -> [Bit]
data2bits' t = snd (show_bin t initState)

show_bin :: Data a => a -> State -> (State, [Bit])
show_bin t st = (st2, con_bits ++ args_bits)
   where
    (st1, con_bits)  = encodeCon' (dataTypeOf t)
                                  (toConstr t) st
    (st2, args_bits) = foldr do_arg (st1,[])
                             enc_args

    enc_args :: [State -> (State,[Bit])]
    enc_args = gmapQ show_bin t

    do_arg fn (st,bits) = (st', bits' ++ bits)
      where
        (st', bits') = fn st


------------------------------------------------------------------------------
-- Sec. 3.3 cont'd

data EncM a   -- The encoder monad
instance Monad EncM
 where
  return  = undefined
  c >>= f = undefined

runEnc  :: EncM () -> [Bit]
emitCon :: DataType -> Constr -> EncM ()

runEnc  = undefined
emitCon = undefined

data2bits'' :: Data a => a -> [Bit]
data2bits'' t = runEnc (emit t)

emit :: Data a => a -> EncM ()
emit t = do { emitCon (dataTypeOf t) (toConstr t) 
            ; sequence_ (gmapQ emit t) }