ersatz-0.2: src/Ersatz/Encoding.hs

{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
--------------------------------------------------------------------
-- |
-- Copyright :  (c) Edward Kmett 2010-2013, Johan Kiviniemi 2013
-- License   :  BSD3
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
--------------------------------------------------------------------
module Ersatz.Encoding
  ( Encoding(..)
  ) where

import Data.Array
import Data.HashMap.Lazy (HashMap)
import Data.IntMap (IntMap)
import Data.Map (Map)
import Data.Sequence (Seq)
import Data.Tree (Tree)
import Ersatz.Internal.Literal

class Encoding a where
  type Encoded a :: *
  -- | A counterpart to 'Ersatz.Decoding.decode'. Can encode e.g. a 'Bool' as a
  -- 'Ersatz.Bit.Bit', a 'Data.Word.Word8' as a 'Ersatz.Bits.Bit8', or a
  -- @[Word8]@ as a @[Bit8]@.
  encode :: Encoded a -> a

instance Encoding Literal where
  type Encoded Literal = Bool
  encode False = literalFalse
  encode True  = literalTrue

instance Encoding () where
  type Encoded () = ()
  encode () = ()

instance (Encoding a, Encoding b) => Encoding (a,b) where
  type Encoded (a,b) = (Encoded a, Encoded b)
  encode (a,b) = (encode a, encode b)

instance (Encoding a, Encoding b, Encoding c) => Encoding (a,b,c) where
  type Encoded (a,b,c) = (Encoded a, Encoded b, Encoded c)
  encode (a,b,c) = (encode a, encode b, encode c)

instance (Encoding a, Encoding b, Encoding c, Encoding d) => Encoding (a,b,c,d) where
  type Encoded (a,b,c,d) = (Encoded a, Encoded b, Encoded c, Encoded d)
  encode (a,b,c,d) = (encode a, encode b, encode c, encode d)

instance (Encoding a, Encoding b, Encoding c, Encoding d, Encoding e) => Encoding (a,b,c,d,e) where
  type Encoded (a,b,c,d,e) = (Encoded a, Encoded b, Encoded c, Encoded d, Encoded e)
  encode (a,b,c,d,e) = (encode a, encode b, encode c, encode d, encode e)

instance (Encoding a, Encoding b, Encoding c, Encoding d, Encoding e, Encoding f) => Encoding (a,b,c,d,e,f) where
  type Encoded (a,b,c,d,e,f) = (Encoded a, Encoded b, Encoded c, Encoded d, Encoded e, Encoded f)
  encode (a,b,c,d,e,f) = (encode a, encode b, encode c, encode d, encode e, encode f)

instance (Encoding a, Encoding b, Encoding c, Encoding d, Encoding e, Encoding f, Encoding g) => Encoding (a,b,c,d,e,f,g) where
  type Encoded (a,b,c,d,e,f,g) = (Encoded a, Encoded b, Encoded c, Encoded d, Encoded e, Encoded f, Encoded g)
  encode (a,b,c,d,e,f,g) = (encode a, encode b, encode c, encode d, encode e, encode f, encode g)

instance (Encoding a, Encoding b, Encoding c, Encoding d, Encoding e, Encoding f, Encoding g, Encoding h) => Encoding (a,b,c,d,e,f,g,h) where
  type Encoded (a,b,c,d,e,f,g,h) = (Encoded a, Encoded b, Encoded c, Encoded d, Encoded e, Encoded f, Encoded g, Encoded h)
  encode (a,b,c,d,e,f,g,h) = (encode a, encode b, encode c, encode d, encode e, encode f, encode g, encode h)

instance Encoding a => Encoding [a] where
  type Encoded [a] = [Encoded a]
  encode = fmap encode

instance (Ix i, Encoding e) => Encoding (Array i e) where
  type Encoded (Array i e) = Array i (Encoded e)
  encode = fmap encode

instance (Encoding a, Encoding b) => Encoding (Either a b) where
  type Encoded (Either a b) = Either (Encoded a) (Encoded b)
  encode (Left  a) = Left  (encode a)
  encode (Right b) = Right (encode b)

instance Encoding a => Encoding (HashMap k a) where
  type Encoded (HashMap k a) = HashMap k (Encoded a)
  encode = fmap encode

instance Encoding a => Encoding (IntMap a) where
  type Encoded (IntMap a) = IntMap (Encoded a)
  encode = fmap encode

instance Encoding a => Encoding (Map k a) where
  type Encoded (Map k a) = Map k (Encoded a)
  encode = fmap encode

instance Encoding a => Encoding (Maybe a) where
  type Encoded (Maybe a) = Maybe (Encoded a)
  encode = fmap encode

instance Encoding a => Encoding (Seq a) where
  type Encoded (Seq a) = Seq (Encoded a)
  encode = fmap encode

instance Encoding a => Encoding (Tree a) where
  type Encoded (Tree a) = Tree (Encoded a)
  encode = fmap encode