module Language.Haskell.TypeTree.Leaf where
import Data.Data
import Data.List.Compat
import Language.Haskell.TH.Lib
import Language.Haskell.TH.Syntax
import Language.Haskell.TypeTree.CheatingLift
import Prelude.Compat
liftType :: Type -> ExpQ
liftType (VarT x) = [|VarT $(liftName x)|]
liftType (ConT x) = [|ConT $(liftName x)|]
liftType (AppT x y) = [|AppT $(liftType x) $(liftType y)|]
liftType (TupleT n) = [|TupleT n|]
liftType ListT = [|ListT|]
liftType (SigT t k) = [|SigT $(liftType t) $(liftType k)|]
liftType (UnboxedTupleT n) = [|UnboxedTupleT n|]
liftType x = error $ show x
data Leaf
= TypeL Name
Arity
| Recursive Leaf
deriving (Eq, Data, Ord, Typeable)
leafName (TypeL n _) = n
leafName (Recursive l) = leafName l
instance Show Leaf where
showsPrec p (TypeL n rs) =
showParen (p > 10) $
showString (nameBase n) .
showString " :: " . showString (intercalate " -> " (replicate (rs + 1) "*"))
showsPrec p (Recursive r) = showString "..." . showsPrec p r
unRec (Recursive t) = unRec t
unRec x = x
instance Lift Leaf where
lift (TypeL n x) = [|TypeL $(liftName n) x|]
lift (Recursive r) = [|Recursive $(lift r)|]