module LambdaCube.SystemFw.TH
  ( qTerm
  , qType
  , qKind
  ) where

import           Data.Data                  (Data)
import           Data.Generics              (extQ)
import           LambdaCube.Common.TH
import           LambdaCube.SystemFw.Ast
import           LambdaCube.SystemFw.Parser
import           Language.Haskell.TH.Lib    (ExpQ, varE)
import           Language.Haskell.TH.Quote  (QuasiQuoter (..))
import           Language.Haskell.TH.Syntax (mkName)

qTerm :: QuasiQuoter
qTerm :: QuasiQuoter
qTerm =
  QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
qExpTerm
    , quotePat :: String -> Q Pat
quotePat = String -> Q Pat
forall a. HasCallStack => a
undefined
    , quoteType :: String -> Q Type
quoteType = String -> Q Type
forall a. HasCallStack => a
undefined
    , quoteDec :: String -> Q [Dec]
quoteDec = String -> Q [Dec]
forall a. HasCallStack => a
undefined
    }

qExpTerm :: String -> ExpQ
qExpTerm :: String -> Q Exp
qExpTerm = Parser ExtLCTerm
-> (forall b. Data b => b -> Maybe (Q Exp)) -> String -> Q Exp
forall a.
Data a =>
Parser a
-> (forall b. Data b => b -> Maybe (Q Exp)) -> String -> Q Exp
qExpBase Parser ExtLCTerm
pTopTerm forall b. Data b => b -> Maybe (Q Exp)
converter
  where
    converter :: Data b => b -> Maybe ExpQ
    converter :: b -> Maybe (Q Exp)
converter =
      b -> Maybe (Q Exp)
forall b. Data b => b -> Maybe (Q Exp)
converterBase
      (b -> Maybe (Q Exp))
-> (ExtLCTerm -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ExtLCTerm -> Maybe (Q Exp)
quotedMVar
      (b -> Maybe (Q Exp))
-> (ExtLCType -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ExtLCType -> Maybe (Q Exp)
quotedMTVar
      (b -> Maybe (Q Exp))
-> (ExtLCKind -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ExtLCKind -> Maybe (Q Exp)
quotedMKVar

    quotedMVar :: ExtLCTerm -> Maybe (Q Exp)
quotedMVar (ExtLCMVar String
x) = Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp))
-> (Name -> Q Exp) -> Name -> Maybe (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Q Exp
varE (Name -> Maybe (Q Exp)) -> Name -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
x
    quotedMVar ExtLCTerm
_             = Maybe (Q Exp)
forall a. Maybe a
Nothing

    quotedMTVar :: ExtLCType -> Maybe (Q Exp)
quotedMTVar (ExtLCMTVar String
x) = Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp))
-> (Name -> Q Exp) -> Name -> Maybe (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Q Exp
varE (Name -> Maybe (Q Exp)) -> Name -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
x
    quotedMTVar ExtLCType
_              = Maybe (Q Exp)
forall a. Maybe a
Nothing

    quotedMKVar :: ExtLCKind -> Maybe (Q Exp)
quotedMKVar (ExtLCMKVar String
x) = Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp))
-> (Name -> Q Exp) -> Name -> Maybe (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Q Exp
varE (Name -> Maybe (Q Exp)) -> Name -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
x
    quotedMKVar ExtLCKind
_              = Maybe (Q Exp)
forall a. Maybe a
Nothing

qType :: QuasiQuoter
qType :: QuasiQuoter
qType =
  QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
qExpType
    , quotePat :: String -> Q Pat
quotePat = String -> Q Pat
forall a. HasCallStack => a
undefined
    , quoteType :: String -> Q Type
quoteType = String -> Q Type
forall a. HasCallStack => a
undefined
    , quoteDec :: String -> Q [Dec]
quoteDec = String -> Q [Dec]
forall a. HasCallStack => a
undefined
    }

qExpType :: String -> ExpQ
qExpType :: String -> Q Exp
qExpType = Parser ExtLCType
-> (forall b. Data b => b -> Maybe (Q Exp)) -> String -> Q Exp
forall a.
Data a =>
Parser a
-> (forall b. Data b => b -> Maybe (Q Exp)) -> String -> Q Exp
qExpBase Parser ExtLCType
pTopType forall b. Data b => b -> Maybe (Q Exp)
converter
  where
    converter :: Data b => b -> Maybe ExpQ
    converter :: b -> Maybe (Q Exp)
converter =
      b -> Maybe (Q Exp)
forall b. Data b => b -> Maybe (Q Exp)
converterBase
      (b -> Maybe (Q Exp))
-> (ExtLCType -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ExtLCType -> Maybe (Q Exp)
quotedMTVar
      (b -> Maybe (Q Exp))
-> (ExtLCKind -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ExtLCKind -> Maybe (Q Exp)
quotedMKVar

    quotedMTVar :: ExtLCType -> Maybe (Q Exp)
quotedMTVar (ExtLCMTVar String
x) = Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp))
-> (Name -> Q Exp) -> Name -> Maybe (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Q Exp
varE (Name -> Maybe (Q Exp)) -> Name -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
x
    quotedMTVar ExtLCType
_              = Maybe (Q Exp)
forall a. Maybe a
Nothing

    quotedMKVar :: ExtLCKind -> Maybe (Q Exp)
quotedMKVar (ExtLCMKVar String
x) = Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp))
-> (Name -> Q Exp) -> Name -> Maybe (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Q Exp
varE (Name -> Maybe (Q Exp)) -> Name -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
x
    quotedMKVar ExtLCKind
_              = Maybe (Q Exp)
forall a. Maybe a
Nothing

qKind :: QuasiQuoter
qKind :: QuasiQuoter
qKind =
  QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
qExpKind
    , quotePat :: String -> Q Pat
quotePat = String -> Q Pat
forall a. HasCallStack => a
undefined
    , quoteType :: String -> Q Type
quoteType = String -> Q Type
forall a. HasCallStack => a
undefined
    , quoteDec :: String -> Q [Dec]
quoteDec = String -> Q [Dec]
forall a. HasCallStack => a
undefined
    }

qExpKind :: String -> ExpQ
qExpKind :: String -> Q Exp
qExpKind = Parser ExtLCKind
-> (forall b. Data b => b -> Maybe (Q Exp)) -> String -> Q Exp
forall a.
Data a =>
Parser a
-> (forall b. Data b => b -> Maybe (Q Exp)) -> String -> Q Exp
qExpBase Parser ExtLCKind
pTopKind forall b. Data b => b -> Maybe (Q Exp)
converter
  where
    converter :: Data b => b -> Maybe ExpQ
    converter :: b -> Maybe (Q Exp)
converter =
      b -> Maybe (Q Exp)
forall b. Data b => b -> Maybe (Q Exp)
converterBase
      (b -> Maybe (Q Exp))
-> (ExtLCKind -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ExtLCKind -> Maybe (Q Exp)
quotedMKVar

    quotedMKVar :: ExtLCKind -> Maybe (Q Exp)
quotedMKVar (ExtLCMKVar String
x) = Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp))
-> (Name -> Q Exp) -> Name -> Maybe (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Q Exp
varE (Name -> Maybe (Q Exp)) -> Name -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
x
    quotedMKVar ExtLCKind
_              = Maybe (Q Exp)
forall a. Maybe a
Nothing