{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
module Language.Haskell.TH.TestUtils.QState
( QState(..)
, ReifyInfo(..)
, loadNames
, unmockedState
) where
import Language.Haskell.TH
import Language.Haskell.TH.Instances ()
import Language.Haskell.TH.Syntax (Lift)
#if MIN_VERSION_template_haskell(2,16,0)
import qualified Language.Haskell.TH.Syntax as TH
#endif
import Language.Haskell.TH.TestUtils.QMode (MockedMode(..), QMode(..))
data QState (mode :: MockedMode) = QState
{ QState mode -> QMode mode
mode :: QMode mode
, QState mode -> [(String, Name)]
knownNames :: [(String, Name)]
, QState mode -> [(Name, ReifyInfo)]
reifyInfo :: [(Name, ReifyInfo)]
} deriving (Int -> QState mode -> ShowS
[QState mode] -> ShowS
QState mode -> String
(Int -> QState mode -> ShowS)
-> (QState mode -> String)
-> ([QState mode] -> ShowS)
-> Show (QState mode)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (mode :: MockedMode). Int -> QState mode -> ShowS
forall (mode :: MockedMode). [QState mode] -> ShowS
forall (mode :: MockedMode). QState mode -> String
showList :: [QState mode] -> ShowS
$cshowList :: forall (mode :: MockedMode). [QState mode] -> ShowS
show :: QState mode -> String
$cshow :: forall (mode :: MockedMode). QState mode -> String
showsPrec :: Int -> QState mode -> ShowS
$cshowsPrec :: forall (mode :: MockedMode). Int -> QState mode -> ShowS
Show, QState mode -> Q Exp
QState mode -> Q (TExp (QState mode))
(QState mode -> Q Exp)
-> (QState mode -> Q (TExp (QState mode))) -> Lift (QState mode)
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
forall (mode :: MockedMode). QState mode -> Q Exp
forall (mode :: MockedMode). QState mode -> Q (TExp (QState mode))
liftTyped :: QState mode -> Q (TExp (QState mode))
$cliftTyped :: forall (mode :: MockedMode). QState mode -> Q (TExp (QState mode))
lift :: QState mode -> Q Exp
$clift :: forall (mode :: MockedMode). QState mode -> Q Exp
Lift)
data ReifyInfo = ReifyInfo
{ ReifyInfo -> Info
reifyInfoInfo :: Info
, ReifyInfo -> Maybe Fixity
reifyInfoFixity :: Maybe Fixity
, ReifyInfo -> Maybe [Role]
reifyInfoRoles :: Maybe [Role]
, ReifyInfo -> Type
reifyInfoType :: Type
} deriving (Int -> ReifyInfo -> ShowS
[ReifyInfo] -> ShowS
ReifyInfo -> String
(Int -> ReifyInfo -> ShowS)
-> (ReifyInfo -> String)
-> ([ReifyInfo] -> ShowS)
-> Show ReifyInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReifyInfo] -> ShowS
$cshowList :: [ReifyInfo] -> ShowS
show :: ReifyInfo -> String
$cshow :: ReifyInfo -> String
showsPrec :: Int -> ReifyInfo -> ShowS
$cshowsPrec :: Int -> ReifyInfo -> ShowS
Show, ReifyInfo -> Q Exp
ReifyInfo -> Q (TExp ReifyInfo)
(ReifyInfo -> Q Exp)
-> (ReifyInfo -> Q (TExp ReifyInfo)) -> Lift ReifyInfo
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: ReifyInfo -> Q (TExp ReifyInfo)
$cliftTyped :: ReifyInfo -> Q (TExp ReifyInfo)
lift :: ReifyInfo -> Q Exp
$clift :: ReifyInfo -> Q Exp
Lift)
loadNames :: [Name] -> ExpQ
loadNames :: [Name] -> Q Exp
loadNames [Name]
names = [Q Exp] -> Q Exp
listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ ((Name -> Q Exp) -> [Name] -> [Q Exp])
-> [Name] -> (Name -> Q Exp) -> [Q Exp]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name -> Q Exp) -> [Name] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map [Name]
names ((Name -> Q Exp) -> [Q Exp]) -> (Name -> Q Exp) -> [Q Exp]
forall a b. (a -> b) -> a -> b
$ \Name
name -> do
Info
info <- Name -> Q Info
reify Name
name
Maybe Fixity
fixity <- Name -> Q (Maybe Fixity)
reifyFixity Name
name
Maybe [Role]
roles <- Q (Maybe [Role]) -> Q (Maybe [Role]) -> Q (Maybe [Role])
forall a. Q a -> Q a -> Q a
recover (Maybe [Role] -> Q (Maybe [Role])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Role]
forall a. Maybe a
Nothing) (Q (Maybe [Role]) -> Q (Maybe [Role]))
-> Q (Maybe [Role]) -> Q (Maybe [Role])
forall a b. (a -> b) -> a -> b
$ [Role] -> Maybe [Role]
forall a. a -> Maybe a
Just ([Role] -> Maybe [Role]) -> Q [Role] -> Q (Maybe [Role])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Q [Role]
reifyRoles Name
name
#if MIN_VERSION_template_haskell(2,16,0)
let infoType :: Q Exp
infoType = Name -> Q Type
reifyType Name
name Q Type -> (Type -> Q Exp) -> Q Exp
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift
#else
let infoType = [| error "Your version of template-haskell does not have 'reifyType'" |]
#endif
[| (name, ReifyInfo info fixity roles $infoType) |]
unmockedState :: QState 'NotMocked
unmockedState :: QState 'NotMocked
unmockedState = QState :: forall (mode :: MockedMode).
QMode mode
-> [(String, Name)] -> [(Name, ReifyInfo)] -> QState mode
QState
{ mode :: QMode 'NotMocked
mode = QMode 'NotMocked
AllowQ
, knownNames :: [(String, Name)]
knownNames = []
, reifyInfo :: [(Name, ReifyInfo)]
reifyInfo = []
}