{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
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)
import Language.Haskell.TH.TestUtils.QMode (MockedMode (..), QMode (..))
data QState (mode :: MockedMode) = QState
{ forall (mode :: MockedMode). QState mode -> QMode mode
mode :: QMode mode
, forall (mode :: MockedMode). QState mode -> [(String, Name)]
knownNames :: [(String, Name)]
, forall (mode :: MockedMode). 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
$cshowsPrec :: forall (mode :: MockedMode). Int -> QState mode -> ShowS
showsPrec :: Int -> QState mode -> ShowS
$cshow :: forall (mode :: MockedMode). QState mode -> String
show :: QState mode -> String
$cshowList :: forall (mode :: MockedMode). [QState mode] -> ShowS
showList :: [QState mode] -> ShowS
Show, (forall (m :: * -> *). Quote m => QState mode -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
QState mode -> Code m (QState mode))
-> Lift (QState mode)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (mode :: MockedMode) (m :: * -> *).
Quote m =>
QState mode -> m Exp
forall (mode :: MockedMode) (m :: * -> *).
Quote m =>
QState mode -> Code m (QState mode)
forall (m :: * -> *). Quote m => QState mode -> m Exp
forall (m :: * -> *).
Quote m =>
QState mode -> Code m (QState mode)
$clift :: forall (mode :: MockedMode) (m :: * -> *).
Quote m =>
QState mode -> m Exp
lift :: forall (m :: * -> *). Quote m => QState mode -> m Exp
$cliftTyped :: forall (mode :: MockedMode) (m :: * -> *).
Quote m =>
QState mode -> Code m (QState mode)
liftTyped :: forall (m :: * -> *).
Quote m =>
QState mode -> Code m (QState mode)
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
$cshowsPrec :: Int -> ReifyInfo -> ShowS
showsPrec :: Int -> ReifyInfo -> ShowS
$cshow :: ReifyInfo -> String
show :: ReifyInfo -> String
$cshowList :: [ReifyInfo] -> ShowS
showList :: [ReifyInfo] -> ShowS
Show, (forall (m :: * -> *). Quote m => ReifyInfo -> m Exp)
-> (forall (m :: * -> *). Quote m => ReifyInfo -> Code m ReifyInfo)
-> Lift ReifyInfo
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ReifyInfo -> m Exp
forall (m :: * -> *). Quote m => ReifyInfo -> Code m ReifyInfo
$clift :: forall (m :: * -> *). Quote m => ReifyInfo -> m Exp
lift :: forall (m :: * -> *). Quote m => ReifyInfo -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => ReifyInfo -> Code m ReifyInfo
liftTyped :: forall (m :: * -> *). Quote m => ReifyInfo -> Code m ReifyInfo
Lift)
loadNames :: [Name] -> ExpQ
loadNames :: [Name] -> ExpQ
loadNames [Name]
names = [ExpQ] -> ExpQ
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE ([ExpQ] -> ExpQ) -> [ExpQ] -> ExpQ
forall a b. (a -> b) -> a -> b
$ ((Name -> ExpQ) -> [Name] -> [ExpQ])
-> [Name] -> (Name -> ExpQ) -> [ExpQ]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name -> ExpQ) -> [Name] -> [ExpQ]
forall a b. (a -> b) -> [a] -> [b]
map [Name]
names ((Name -> ExpQ) -> [ExpQ]) -> (Name -> ExpQ) -> [ExpQ]
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 a. a -> Q a
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
Type
infoType <- Name -> Q Type
reifyType Name
name
[|(name, ReifyInfo info fixity roles infoType)|]
unmockedState :: QState 'NotMocked
unmockedState :: QState 'NotMocked
unmockedState =
QState
{ mode :: QMode 'NotMocked
mode = QMode 'NotMocked
AllowQ
, knownNames :: [(String, Name)]
knownNames = []
, reifyInfo :: [(Name, ReifyInfo)]
reifyInfo = []
}