module Type.Spine.Base where
import Language.Haskell.TH
import Type.Spine.TH (tyConSignature)
type family Spine (t :: k)
data Atom (t :: k) :: *
infixl 9 :@
data (tc :: k) :@ (t :: l) :: *
spineType_d :: Name -> Q [Dec]
spineType_d n = tyConSignature n >>= spineType_d_ n . fst
spineType_d_ :: Name -> [Kind] -> Q [Dec]
spineType_d_ = spineType_gen_ . ConT
spineType_pro :: Name -> Q [Dec]
spineType_pro n = tyConSignature n >>= spineType_d_ n . fst
spineType_pro_ :: Name -> [Kind] -> Q [Dec]
spineType_pro_ = spineType_gen_ . PromotedT
spineType_gen_ :: Type -> [Kind] -> Q [Dec]
spineType_gen_ t ks = do
let rhs = ConT ''Atom `AppT` t
vars = [VarT $ mkName $ "t" ++ show i | i <- [0..]]
return $ TySynInstD ''Spine [t] rhs :
[ case take n vars of
vars -> TySynInstD ''Spine [foldl AppT t vars] $
ConT ''(:@) `AppT` foldl AppT t (init vars) `AppT` last vars
| n <- [1..length ks] ]