Data.Comp.Trans

GHC has a phase restriction which prevents code generated by Template Haskell being referred to by Template Haskell in the same file. Thus, when using this library, you will need to spread invocations out over several files.

We will refer to the following example in the documentation:

module Foo where
data Arith = Add Atom Atom
data Atom = Var String | Const Lit
data Lit = Lit Int

Documentation

deriveMultiComp :: Name -> Q [Dec]

Declares a multi-sorted compositional datatype isomorphic to the given ADT.

e.g.

import qualified Foo as F
deriveMultiComp ''F.Arith

will create

data ArithL
data AtomL
data LitL

data Arith e l where
  Add :: e AtomL -> e AtomL -> Arith e ArithL

data Atom e l where
  Var :: String -> Atom e AtomL
  Const :: e LitL -> Atom e AtomL

data Lit (e :: * -> *) l where
  Lit :: Int -> Lit e LitL

generateNameLists :: Name -> Q [Dec]

e.g.

generateNameLists ''Arith

will create

origASTTypes = [mkName Foo.Arith, mkName Foo.Atom, mkName Foo.Lit]
newASTTypes  = [mkName Arith, mkName Atom, mkName Lit]
newASTLabels = map ConT [mkName ArithL, mkName "AtomL', mkName LitL]

makeSumType :: String -> [Name] -> Q [Dec]

Folds together names with (:+:).

e.g.

import qualified Foo as F
deriveMult ''F.Arith
makeSumType "ArithSig" [''Arith, ''Atom, ''Lit]

will create

type ArithSig = Arith :+: Atom :+: Lit

You can use generateNameLists to avoid spelling out the names manually

getLabels :: [Name] -> Q [Type]

deriveTrans :: Name -> [Name] -> Type -> Q [Dec]

Creates a functions translating from an ADT to its isomorphic multi-sorted compositional data type

import qualified Foo as F
...
type ArithTerm = Term Arith
deriveTrans ''Arith [''Arith, ''Atom, ''Lit] ArithTerm

will create

translate :: F.Arith -> ArithTerm ArithL
translate = trans


class Trans a l where
  trans a -> ArithTerm l

instance Trans F.Arith ArithL where
  trans (F.Add x y) = iAdd (trans x) (trans y)

instance Trans F.Atom AtomL where
  trans (F.Var s)   = iVar s
  trans (F.Const x) = iConst (trans x)

instance Trans F.Lit LitL where
  trans (F.Lit n) = iLit n

deriveUntrans :: [Name] -> Type -> Q [Dec]

Creates an untranslate function inverting the translate function created by deriveTrans.

import qualified Foo as F
type ArithTerm = Term (Arith :+: Atom :+: Lit)
deriveUntrans [''F.Arith, ''F.Atom, ''F.Lit] (TH.ConT ''ArithTerm)

will create

type family Targ l
newtype T l = T {t :: Targ l}

class Untrans f where
  untrans :: Alg f t

untranslate :: ArithTerm l -> Targ l
untranslate = t . cata untrans

type instance Targ ArithL = F.Arith
instance Untrans Arith where
  untrans (Add x y) = T $ F.Add (t x) (t y)

type instance Targ AtomL = F.Atom
instance Untrans Atom where
  untrans (Var s)   = T $ F.Var s
  untrans (Const x) = T $ F.Const (t x)

type instance Targ LitL = F.Lit
instance Untrans Lit where
  untrans (Lit n) = T $ F.Lit n

Note that you will need to manually provide an instance (Untrans f, Untrans g) => Untrans (f :+: g) due to phase issues.