{-# LANGUAGE TemplateHaskell #-} module Language.Parser.Ptera.TH.Class.LiftType ( T, LiftType (..), typeOf, ) where import Language.Parser.Ptera.Prelude import qualified Language.Haskell.TH as TH import Data.Sequence import GHC.Real type T = LiftType class LiftType a where liftType :: proxy a -> TH.Q TH.Type typeOf :: LiftType a => a -> TH.Q TH.Type typeOf :: forall a. LiftType a => a -> Q Type typeOf a x = forall {k} (a :: k) (proxy :: k -> *). LiftType a => proxy a -> Q Type liftType do forall a. a -> Identity a Identity a x instance LiftType () where liftType :: forall (proxy :: * -> *). proxy () -> Q Type liftType proxy () _ = [t|()|] instance LiftType Int where liftType :: forall (proxy :: * -> *). proxy Int -> Q Type liftType proxy Int _ = [t|Int|] instance LiftType Char where liftType :: forall (proxy :: * -> *). proxy Char -> Q Type liftType proxy Char _ = [t|Char|] instance LiftType Integer where liftType :: forall (proxy :: * -> *). proxy Integer -> Q Type liftType proxy Integer _ = [t|Integer|] instance LiftType a => LiftType (Ratio a) where liftType :: forall (proxy :: * -> *). proxy (Ratio a) -> Q Type liftType proxy (Ratio a) _ = [t|Ratio $(liftType do Proxy @a)|] instance LiftType a => LiftType [a] where liftType :: forall (proxy :: * -> *). proxy [a] -> Q Type liftType proxy [a] _ = [t|[] $(liftType do Proxy @a)|] instance LiftType a => LiftType (Maybe a) where liftType :: forall (proxy :: * -> *). proxy (Maybe a) -> Q Type liftType proxy (Maybe a) _ = [t|Maybe $(liftType do Proxy @a)|] instance (LiftType a, LiftType b) => LiftType (a, b) where liftType :: forall (proxy :: * -> *). proxy (a, b) -> Q Type liftType proxy (a, b) _ = [t|(,) $(liftType do Proxy @a) $(liftType do Proxy @b)|] instance (LiftType a, LiftType b, LiftType c) => LiftType (a, b, c) where liftType :: forall (proxy :: * -> *). proxy (a, b, c) -> Q Type liftType proxy (a, b, c) _ = [t|(,,) $(liftType do Proxy @a) $(liftType do Proxy @b) $(liftType do Proxy @c)|] instance LiftType a => LiftType (Seq a) where liftType :: forall (proxy :: * -> *). proxy (Seq a) -> Q Type liftType proxy (Seq a) _ = [t|Seq $(liftType do Proxy @a)|]