{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE RoleAnnotations #-}
#endif
module Language.Haskell.TH.Syntax.Compat (
Quote(..)
, unsafeQToQuote
#if MIN_VERSION_template_haskell(2,9,0)
, unTypeQQuote
, unsafeTExpCoerceQuote
#endif
, liftQuote
#if MIN_VERSION_template_haskell(2,9,0)
, liftTypedQuote
#endif
, liftStringQuote
#if MIN_VERSION_template_haskell(2,9,0)
, Code(..), CodeQ
, IsCode(..)
, unsafeCodeCoerce
, liftCode
, unTypeCode
, hoistCode
, bindCode
, bindCode_
, joinCode
, Splice
, SpliceQ
, bindSplice
, bindSplice_
, examineSplice
, hoistSplice
, joinSplice
, liftSplice
, liftTypedFromUntypedSplice
, unsafeSpliceCoerce
, unTypeSplice
, expToSplice
#endif
, getPackageRoot
, makeRelativeToProject
) where
import qualified Control.Monad.Fail as Fail
import Control.Monad.IO.Class (MonadIO(..))
import Language.Haskell.TH (Exp)
import qualified Language.Haskell.TH.Lib as Lib ()
import Language.Haskell.TH.Syntax (Q, runQ, Quasi(..))
import qualified Language.Haskell.TH.Syntax as Syntax
#if !(MIN_VERSION_base(4,8,0))
import Control.Applicative
#endif
#if MIN_VERSION_template_haskell(2,16,0)
import GHC.Exts (RuntimeRep, TYPE)
#endif
#if MIN_VERSION_template_haskell(2,17,0)
import Language.Haskell.TH.Lib (CodeQ)
import Language.Haskell.TH.Syntax
( Code(..), Quote(..)
, bindCode, bindCode_, hoistCode, joinCode, liftCode, unsafeCodeCoerce, unTypeCode
, unsafeTExpCoerce, unTypeQ )
#else
import Language.Haskell.TH (Name)
#endif
#if MIN_VERSION_template_haskell(2,19,0)
import Language.Haskell.TH.Syntax (getPackageRoot, makeRelativeToProject)
#else
import System.FilePath (isRelative, takeExtension, takeDirectory, (</>))
import System.Directory (getDirectoryContents, canonicalizePath)
#endif
#if !(MIN_VERSION_template_haskell(2,17,0))
class ( Monad m
# if !(MIN_VERSION_template_haskell(2,7,0))
, Functor m
# elif !(MIN_VERSION_template_haskell(2,10,0))
, Applicative m
# endif
) => Quote m where
newName :: String -> m Name
instance Quote Q where
newName = qNewName
#endif
#if MIN_VERSION_template_haskell(2,9,0)
unTypeQQuote ::
# if MIN_VERSION_template_haskell(2,16,0)
forall (r :: RuntimeRep) (a :: TYPE r) m .
# else
forall a m .
# endif
Quote m => m (Syntax.TExp a) -> m Exp
# if MIN_VERSION_template_haskell(2,17,0)
unTypeQQuote :: forall a (m :: * -> *). Quote m => m (TExp a) -> m Exp
unTypeQQuote = m (TExp a) -> m Exp
forall a (m :: * -> *). Quote m => m (TExp a) -> m Exp
unTypeQ
# else
unTypeQQuote m = do { Syntax.TExp e <- m
; return e }
# endif
unsafeTExpCoerceQuote ::
# if MIN_VERSION_template_haskell(2,16,0)
forall (r :: RuntimeRep) (a :: TYPE r) m .
# else
forall a m .
# endif
Quote m => m Exp -> m (Syntax.TExp a)
# if MIN_VERSION_template_haskell(2,17,0)
unsafeTExpCoerceQuote :: forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
unsafeTExpCoerceQuote = m Exp -> m (TExp a)
forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
unsafeTExpCoerce
# else
unsafeTExpCoerceQuote m = do { e <- m
; return (Syntax.TExp e) }
# endif
#endif
liftQuote ::
#if MIN_VERSION_template_haskell(2,17,0)
forall (r :: RuntimeRep) (t :: TYPE r) m .
#else
forall t m .
#endif
(Syntax.Lift t, Quote m) => t -> m Exp
#if MIN_VERSION_template_haskell(2,17,0)
liftQuote :: forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
liftQuote = t -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
Syntax.lift
#else
liftQuote = unsafeQToQuote . Syntax.lift
#endif
#if MIN_VERSION_template_haskell(2,9,0)
liftTypedQuote ::
# if MIN_VERSION_template_haskell(2,17,0)
forall (r :: RuntimeRep) (t :: TYPE r) m .
# else
forall t m .
# endif
(Syntax.Lift t, Quote m) => t -> Code m t
# if MIN_VERSION_template_haskell(2,17,0)
liftTypedQuote :: forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
liftTypedQuote = t -> Code m t
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
Syntax.liftTyped
# elif MIN_VERSION_template_haskell(2,16,0)
liftTypedQuote = liftCode . unsafeQToQuote . Syntax.liftTyped
# else
liftTypedQuote = unsafeCodeCoerce . liftQuote
# endif
#endif
liftStringQuote :: Quote m => String -> m Exp
#if MIN_VERSION_template_haskell(2,17,0)
liftStringQuote :: forall (m :: * -> *). Quote m => FilePath -> m Exp
liftStringQuote = FilePath -> m Exp
forall (m :: * -> *). Quote m => FilePath -> m Exp
Syntax.liftString
#else
liftStringQuote = unsafeQToQuote . Syntax.liftString
#endif
unsafeQToQuote :: Quote m => Q a -> m a
unsafeQToQuote :: forall (m :: * -> *) a. Quote m => Q a -> m a
unsafeQToQuote = QuoteToQuasi m a -> m a
forall (m :: * -> *) a. QuoteToQuasi m a -> m a
unQTQ (QuoteToQuasi m a -> m a)
-> (Q a -> QuoteToQuasi m a) -> Q a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q a -> QuoteToQuasi m a
forall (m :: * -> *) a. Quasi m => Q a -> m a
runQ
newtype QuoteToQuasi (m :: * -> *) a = QTQ { forall (m :: * -> *) a. QuoteToQuasi m a -> m a
unQTQ :: m a }
deriving ((forall a b. (a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b)
-> (forall a b. a -> QuoteToQuasi m b -> QuoteToQuasi m a)
-> Functor (QuoteToQuasi m)
forall a b. a -> QuoteToQuasi m b -> QuoteToQuasi m a
forall a b. (a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
forall (m :: * -> *) a b.
Functor m =>
a -> QuoteToQuasi m b -> QuoteToQuasi m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> QuoteToQuasi m b -> QuoteToQuasi m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> QuoteToQuasi m b -> QuoteToQuasi m a
fmap :: forall a b. (a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
Functor, Functor (QuoteToQuasi m)
Functor (QuoteToQuasi m)
-> (forall a. a -> QuoteToQuasi m a)
-> (forall a b.
QuoteToQuasi m (a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b)
-> (forall a b c.
(a -> b -> c)
-> QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m c)
-> (forall a b.
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b)
-> (forall a b.
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m a)
-> Applicative (QuoteToQuasi m)
forall a. a -> QuoteToQuasi m a
forall a b.
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m a
forall a b.
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
forall a b.
QuoteToQuasi m (a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
forall a b c.
(a -> b -> c)
-> QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (QuoteToQuasi m)
forall (m :: * -> *) a. Applicative m => a -> QuoteToQuasi m a
forall (m :: * -> *) a b.
Applicative m =>
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m a
forall (m :: * -> *) a b.
Applicative m =>
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
forall (m :: * -> *) a b.
Applicative m =>
QuoteToQuasi m (a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m c
<* :: forall a b.
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m a
*> :: forall a b.
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
liftA2 :: forall a b c.
(a -> b -> c)
-> QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m c
<*> :: forall a b.
QuoteToQuasi m (a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
QuoteToQuasi m (a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
pure :: forall a. a -> QuoteToQuasi m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> QuoteToQuasi m a
Applicative, Applicative (QuoteToQuasi m)
Applicative (QuoteToQuasi m)
-> (forall a b.
QuoteToQuasi m a -> (a -> QuoteToQuasi m b) -> QuoteToQuasi m b)
-> (forall a b.
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b)
-> (forall a. a -> QuoteToQuasi m a)
-> Monad (QuoteToQuasi m)
forall a. a -> QuoteToQuasi m a
forall a b.
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
forall a b.
QuoteToQuasi m a -> (a -> QuoteToQuasi m b) -> QuoteToQuasi m b
forall {m :: * -> *}. Monad m => Applicative (QuoteToQuasi m)
forall (m :: * -> *) a. Monad m => a -> QuoteToQuasi m a
forall (m :: * -> *) a b.
Monad m =>
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
forall (m :: * -> *) a b.
Monad m =>
QuoteToQuasi m a -> (a -> QuoteToQuasi m b) -> QuoteToQuasi m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> QuoteToQuasi m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> QuoteToQuasi m a
>> :: forall a b.
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
>>= :: forall a b.
QuoteToQuasi m a -> (a -> QuoteToQuasi m b) -> QuoteToQuasi m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
QuoteToQuasi m a -> (a -> QuoteToQuasi m b) -> QuoteToQuasi m b
Monad)
qtqError :: String -> a
qtqError :: forall a. FilePath -> a
qtqError FilePath
name = FilePath -> a
forall a. HasCallStack => FilePath -> a
error (FilePath -> a) -> FilePath -> a
forall a b. (a -> b) -> a -> b
$ FilePath
"`unsafeQToQuote` does not support code that uses " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name
instance Monad m => Fail.MonadFail (QuoteToQuasi m) where
fail :: forall a. FilePath -> QuoteToQuasi m a
fail = FilePath -> FilePath -> QuoteToQuasi m a
forall a. FilePath -> a
qtqError FilePath
"MonadFail.fail"
instance Monad m => MonadIO (QuoteToQuasi m) where
liftIO :: forall a. IO a -> QuoteToQuasi m a
liftIO = FilePath -> IO a -> QuoteToQuasi m a
forall a. FilePath -> a
qtqError FilePath
"liftIO"
instance Quote m => Quasi (QuoteToQuasi m) where
qNewName :: FilePath -> QuoteToQuasi m Name
qNewName FilePath
s = m Name -> QuoteToQuasi m Name
forall (m :: * -> *) a. m a -> QuoteToQuasi m a
QTQ (FilePath -> m Name
forall (m :: * -> *). Quote m => FilePath -> m Name
newName FilePath
s)
qRecover :: forall a. QuoteToQuasi m a -> QuoteToQuasi m a -> QuoteToQuasi m a
qRecover = FilePath
-> QuoteToQuasi m a -> QuoteToQuasi m a -> QuoteToQuasi m a
forall a. FilePath -> a
qtqError FilePath
"qRecover"
qReport :: Bool -> FilePath -> QuoteToQuasi m ()
qReport = FilePath -> Bool -> FilePath -> QuoteToQuasi m ()
forall a. FilePath -> a
qtqError FilePath
"qReport"
qReify :: Name -> QuoteToQuasi m Info
qReify = FilePath -> Name -> QuoteToQuasi m Info
forall a. FilePath -> a
qtqError FilePath
"qReify"
qLocation :: QuoteToQuasi m Loc
qLocation = FilePath -> QuoteToQuasi m Loc
forall a. FilePath -> a
qtqError FilePath
"qLocation"
qRunIO :: forall a. IO a -> QuoteToQuasi m a
qRunIO = FilePath -> IO a -> QuoteToQuasi m a
forall a. FilePath -> a
qtqError FilePath
"qRunIO"
#if MIN_VERSION_template_haskell(2,7,0)
qReifyInstances :: Name -> [Type] -> QuoteToQuasi m [Dec]
qReifyInstances = FilePath -> Name -> [Type] -> QuoteToQuasi m [Dec]
forall a. FilePath -> a
qtqError FilePath
"qReifyInstances"
qLookupName :: Bool -> FilePath -> QuoteToQuasi m (Maybe Name)
qLookupName = FilePath -> Bool -> FilePath -> QuoteToQuasi m (Maybe Name)
forall a. FilePath -> a
qtqError FilePath
"qLookupName"
qAddDependentFile :: FilePath -> QuoteToQuasi m ()
qAddDependentFile = FilePath -> FilePath -> QuoteToQuasi m ()
forall a. FilePath -> a
qtqError FilePath
"qAddDependentFile"
# if MIN_VERSION_template_haskell(2,9,0)
qReifyRoles :: Name -> QuoteToQuasi m [Role]
qReifyRoles = FilePath -> Name -> QuoteToQuasi m [Role]
forall a. FilePath -> a
qtqError FilePath
"qReifyRoles"
qReifyAnnotations :: forall a. Data a => AnnLookup -> QuoteToQuasi m [a]
qReifyAnnotations = FilePath -> AnnLookup -> QuoteToQuasi m [a]
forall a. FilePath -> a
qtqError FilePath
"qReifyAnnotations"
qReifyModule :: Module -> QuoteToQuasi m ModuleInfo
qReifyModule = FilePath -> Module -> QuoteToQuasi m ModuleInfo
forall a. FilePath -> a
qtqError FilePath
"qReifyModule"
qAddTopDecls :: [Dec] -> QuoteToQuasi m ()
qAddTopDecls = FilePath -> [Dec] -> QuoteToQuasi m ()
forall a. FilePath -> a
qtqError FilePath
"qAddTopDecls"
qAddModFinalizer :: Q () -> QuoteToQuasi m ()
qAddModFinalizer = FilePath -> Q () -> QuoteToQuasi m ()
forall a. FilePath -> a
qtqError FilePath
"qAddModFinalizer"
qGetQ :: forall a. Typeable a => QuoteToQuasi m (Maybe a)
qGetQ = FilePath -> QuoteToQuasi m (Maybe a)
forall a. FilePath -> a
qtqError FilePath
"qGetQ"
qPutQ :: forall a. Typeable a => a -> QuoteToQuasi m ()
qPutQ = FilePath -> a -> QuoteToQuasi m ()
forall a. FilePath -> a
qtqError FilePath
"qPutQ"
# endif
# if MIN_VERSION_template_haskell(2,11,0)
qReifyFixity :: Name -> QuoteToQuasi m (Maybe Fixity)
qReifyFixity = FilePath -> Name -> QuoteToQuasi m (Maybe Fixity)
forall a. FilePath -> a
qtqError FilePath
"qReifyFixity"
qReifyConStrictness :: Name -> QuoteToQuasi m [DecidedStrictness]
qReifyConStrictness = FilePath -> Name -> QuoteToQuasi m [DecidedStrictness]
forall a. FilePath -> a
qtqError FilePath
"qReifyConStrictness"
qIsExtEnabled :: Extension -> QuoteToQuasi m Bool
qIsExtEnabled = FilePath -> Extension -> QuoteToQuasi m Bool
forall a. FilePath -> a
qtqError FilePath
"qIsExtEnabled"
qExtsEnabled :: QuoteToQuasi m [Extension]
qExtsEnabled = FilePath -> QuoteToQuasi m [Extension]
forall a. FilePath -> a
qtqError FilePath
"qExtsEnabled"
# endif
#elif MIN_VERSION_template_haskell(2,5,0)
qClassInstances = qtqError "qClassInstances"
#endif
#if MIN_VERSION_template_haskell(2,13,0)
qAddCorePlugin :: FilePath -> QuoteToQuasi m ()
qAddCorePlugin = FilePath -> FilePath -> QuoteToQuasi m ()
forall a. FilePath -> a
qtqError FilePath
"qAddCorePlugin"
#endif
#if MIN_VERSION_template_haskell(2,14,0)
qAddForeignFilePath :: ForeignSrcLang -> FilePath -> QuoteToQuasi m ()
qAddForeignFilePath = FilePath -> ForeignSrcLang -> FilePath -> QuoteToQuasi m ()
forall a. FilePath -> a
qtqError FilePath
"qAddForeignFilePath"
qAddTempFile :: FilePath -> QuoteToQuasi m FilePath
qAddTempFile = FilePath -> FilePath -> QuoteToQuasi m FilePath
forall a. FilePath -> a
qtqError FilePath
"qAddTempFile"
#elif MIN_VERSION_template_haskell(2,12,0)
qAddForeignFile = qtqError "qAddForeignFile"
#endif
#if MIN_VERSION_template_haskell(2,16,0)
qReifyType :: Name -> QuoteToQuasi m Type
qReifyType = FilePath -> Name -> QuoteToQuasi m Type
forall a. FilePath -> a
qtqError FilePath
"qReifyType"
#endif
#if MIN_VERSION_template_haskell(2,18,0)
qGetDoc = qtqError "qGetDoc"
qPutDoc = qtqError "qPutDoc"
#endif
#if MIN_VERSION_template_haskell(2,19,0)
qGetPackageRoot = qtqError "qGetPackageRoot"
#endif
#if MIN_VERSION_template_haskell(2,9,0)
class IsCode q
# if MIN_VERSION_template_haskell(2,16,0)
(a :: TYPE r)
# else
a
# endif
c | c -> a q where
toCode :: c -> Code q a
fromCode :: Code q a -> c
instance Quote q => IsCode q
# if MIN_VERSION_template_haskell(2,16,0)
(a :: TYPE r)
# else
a
# endif
(Code q a) where
toCode :: Code q a -> Code q a
toCode = Code q a -> Code q a
forall a. a -> a
id
fromCode :: Code q a -> Code q a
fromCode = Code q a -> Code q a
forall a. a -> a
id
instance texp ~ Syntax.TExp a => IsCode Q
# if MIN_VERSION_template_haskell(2,16,0)
(a :: TYPE r)
# else
a
# endif
(Q texp) where
toCode :: Q texp -> Code Q a
toCode = Q texp -> Code Q a
forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode
fromCode :: Code Q a -> Q texp
fromCode = Code Q a -> Q texp
forall (m :: * -> *) a. Code m a -> m (TExp a)
examineCode
# if !(MIN_VERSION_template_haskell(2,17,0))
type role Code representational nominal
newtype Code m
# if MIN_VERSION_template_haskell(2,16,0)
(a :: TYPE (r :: RuntimeRep))
# else
a
# endif
= Code
{ examineCode :: m (Syntax.TExp a)
}
type CodeQ = Code Q
# if MIN_VERSION_template_haskell(2,16,0)
:: (TYPE r -> *)
# endif
unsafeCodeCoerce ::
# if MIN_VERSION_template_haskell(2,16,0)
forall (r :: RuntimeRep) (a :: TYPE r) m .
# else
forall a m .
# endif
Quote m => m Exp -> Code m a
unsafeCodeCoerce m = Code (unsafeTExpCoerceQuote m)
liftCode ::
# if MIN_VERSION_template_haskell(2,16,0)
forall (r :: RuntimeRep) (a :: TYPE r) m .
# else
forall a m .
# endif
m (Syntax.TExp a) -> Code m a
liftCode = Code
unTypeCode ::
# if MIN_VERSION_template_haskell(2,16,0)
forall (r :: RuntimeRep) (a :: TYPE r) m .
# else
forall a m .
# endif
Quote m => Code m a -> m Exp
unTypeCode = unTypeQQuote . examineCode
hoistCode ::
# if MIN_VERSION_template_haskell(2,16,0)
forall m n (r :: RuntimeRep) (a :: TYPE r) .
# else
forall m n a .
# endif
Monad m => (forall x . m x -> n x) -> Code m a -> Code n a
hoistCode f (Code a) = Code (f a)
bindCode ::
# if MIN_VERSION_template_haskell(2,16,0)
forall m a (r :: RuntimeRep) (b :: TYPE r) .
# else
forall m a b .
# endif
Monad m => m a -> (a -> Code m b) -> Code m b
bindCode q k = liftCode (q >>= examineCode . k)
bindCode_ ::
# if MIN_VERSION_template_haskell(2,16,0)
forall m a (r :: RuntimeRep) (b :: TYPE r) .
# else
forall m a b .
# endif
Monad m => m a -> Code m b -> Code m b
bindCode_ q c = liftCode ( q >> examineCode c)
joinCode ::
# if MIN_VERSION_template_haskell(2,16,0)
forall m (r :: RuntimeRep) (a :: TYPE r) .
# else
forall m a .
# endif
Monad m => m (Code m a) -> Code m a
joinCode = flip bindCode id
# endif
# if MIN_VERSION_template_haskell(2,17,0)
type Splice = Code :: (forall r. (* -> *) -> TYPE r -> *)
# elif MIN_VERSION_template_haskell(2,16,0)
type Splice m (a :: TYPE r) = m (Syntax.TExp a)
# else
type Splice m a = m (Syntax.TExp a)
# endif
# if MIN_VERSION_template_haskell(2,17,0)
type SpliceQ = Splice Q :: (TYPE r -> *)
# elif MIN_VERSION_template_haskell(2,16,0)
type SpliceQ (a :: TYPE r) = Splice Q a
# else
type SpliceQ a = Splice Q a
# endif
bindSplice ::
# if MIN_VERSION_template_haskell(2,16,0)
forall m a (r :: RuntimeRep) (b :: TYPE r) .
# else
forall m a b .
# endif
Monad m => m a -> (a -> Splice m b) -> Splice m b
# if MIN_VERSION_template_haskell(2,17,0)
bindSplice :: forall (m :: * -> *) a b.
Monad m =>
m a -> (a -> Splice m b) -> Splice m b
bindSplice = m a -> (a -> Code m b) -> Code m b
forall (m :: * -> *) a b.
Monad m =>
m a -> (a -> Splice m b) -> Splice m b
bindCode
# else
bindSplice q k = liftSplice (q >>= examineSplice . k)
# endif
bindSplice_ ::
# if MIN_VERSION_template_haskell(2,16,0)
forall m a (r :: RuntimeRep) (b :: TYPE r) .
# else
forall m a b .
# endif
Monad m => m a -> Splice m b -> Splice m b
# if MIN_VERSION_template_haskell(2,17,0)
bindSplice_ :: forall (m :: * -> *) a b.
Monad m =>
m a -> Splice m b -> Splice m b
bindSplice_ = m a -> Code m b -> Code m b
forall (m :: * -> *) a b.
Monad m =>
m a -> Splice m b -> Splice m b
bindCode_
# else
bindSplice_ q c = liftSplice ( q >> examineSplice c)
# endif
expToSplice :: Applicative m => Syntax.TExp a -> Splice m a
expToSplice :: forall (m :: * -> *) a. Applicative m => TExp a -> Splice m a
expToSplice TExp a
a = m (TExp a) -> Splice m a
forall a (m :: * -> *). m (TExp a) -> Code m a
liftSplice (m (TExp a) -> Splice m a) -> m (TExp a) -> Splice m a
forall a b. (a -> b) -> a -> b
$ TExp a -> m (TExp a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TExp a
a
examineSplice ::
# if MIN_VERSION_template_haskell(2,16,0)
forall (r :: RuntimeRep) m (a :: TYPE r) .
# else
forall m a .
# endif
Splice m a -> m (Syntax.TExp a)
# if MIN_VERSION_template_haskell(2,17,0)
examineSplice :: forall (m :: * -> *) a. Code m a -> m (TExp a)
examineSplice = Code m a -> m (TExp a)
forall (m :: * -> *) a. Code m a -> m (TExp a)
examineCode
# else
examineSplice = id
# endif
hoistSplice ::
# if MIN_VERSION_template_haskell(2,16,0)
forall m n (r :: RuntimeRep) (a :: TYPE r) .
# else
forall m n a .
# endif
Monad m => (forall x . m x -> n x) -> Splice m a -> Splice n a
# if MIN_VERSION_template_haskell(2,17,0)
hoistSplice :: forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(forall x. m x -> n x) -> Splice m a -> Splice n a
hoistSplice = (forall x. m x -> n x) -> Code m a -> Code n a
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(forall x. m x -> n x) -> Splice m a -> Splice n a
hoistCode
# else
hoistSplice f a = f a
# endif
joinSplice ::
# if MIN_VERSION_template_haskell(2,16,0)
forall m (r :: RuntimeRep) (a :: TYPE r) .
# else
forall m a .
# endif
Monad m => m (Splice m a) -> Splice m a
# if MIN_VERSION_template_haskell(2,17,0)
joinSplice :: forall (m :: * -> *) a. Monad m => m (Splice m a) -> Splice m a
joinSplice = m (Code m a) -> Code m a
forall (m :: * -> *) a. Monad m => m (Splice m a) -> Splice m a
joinCode
# else
joinSplice = flip bindSplice id
# endif
liftSplice ::
# if MIN_VERSION_template_haskell(2,16,0)
forall (r :: RuntimeRep) (a :: TYPE r) m .
# else
forall a m .
# endif
m (Syntax.TExp a) -> Splice m a
# if MIN_VERSION_template_haskell(2,17,0)
liftSplice :: forall a (m :: * -> *). m (TExp a) -> Code m a
liftSplice = m (TExp a) -> Code m a
forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode
# else
liftSplice = id
# endif
liftTypedFromUntypedSplice :: (Syntax.Lift t, Quote m) => t -> Splice m t
liftTypedFromUntypedSplice :: forall t (m :: * -> *). (Lift t, Quote m) => t -> Splice m t
liftTypedFromUntypedSplice = m Exp -> Splice m t
forall a (m :: * -> *). Quote m => m Exp -> Splice m a
unsafeSpliceCoerce (m Exp -> Splice m t) -> (t -> m Exp) -> t -> Splice m t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
liftQuote
unsafeSpliceCoerce ::
# if MIN_VERSION_template_haskell(2,16,0)
forall (r :: RuntimeRep) (a :: TYPE r) m .
# else
forall a m .
# endif
Quote m => m Exp -> Splice m a
# if MIN_VERSION_template_haskell(2,17,0)
unsafeSpliceCoerce :: forall a (m :: * -> *). Quote m => m Exp -> Splice m a
unsafeSpliceCoerce = m Exp -> Code m a
forall a (m :: * -> *). Quote m => m Exp -> Splice m a
unsafeCodeCoerce
# else
unsafeSpliceCoerce = unsafeTExpCoerceQuote
# endif
unTypeSplice ::
# if MIN_VERSION_template_haskell(2,16,0)
forall (r :: RuntimeRep) (a :: TYPE r) m .
# else
forall a m .
# endif
Quote m => Splice m a -> m Exp
# if MIN_VERSION_template_haskell(2,17,0)
unTypeSplice :: forall a (m :: * -> *). Quote m => Splice m a -> m Exp
unTypeSplice = Code m a -> m Exp
forall a (m :: * -> *). Quote m => Splice m a -> m Exp
unTypeCode
# else
unTypeSplice = unTypeQQuote
# endif
#endif
#if !MIN_VERSION_template_haskell(2,19,0)
getPackageRoot :: Q FilePath
getPackageRoot :: Q FilePath
getPackageRoot = (FilePath -> Bool) -> Q FilePath
getPackageRootPredicate ((FilePath -> Bool) -> Q FilePath)
-> (FilePath -> Bool) -> Q FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
(==) FilePath
".cabal" (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension
getPackageRootPredicate :: (FilePath -> Bool) -> Q FilePath
getPackageRootPredicate :: (FilePath -> Bool) -> Q FilePath
getPackageRootPredicate FilePath -> Bool
isTargetFile = do
Loc
loc <- Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation
(FilePath
srcFP, Maybe FilePath
mdir) <- IO (FilePath, Maybe FilePath) -> Q (FilePath, Maybe FilePath)
forall a. IO a -> Q a
Syntax.runIO (IO (FilePath, Maybe FilePath) -> Q (FilePath, Maybe FilePath))
-> IO (FilePath, Maybe FilePath) -> Q (FilePath, Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ do
FilePath
srcFP <- FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Loc -> FilePath
Syntax.loc_filename Loc
loc
Maybe FilePath
mdir <- FilePath -> IO (Maybe FilePath)
findProjectDir FilePath
srcFP
(FilePath, Maybe FilePath) -> IO (FilePath, Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
srcFP, Maybe FilePath
mdir)
case Maybe FilePath
mdir of
Maybe FilePath
Nothing -> FilePath -> Q FilePath
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Q FilePath) -> FilePath -> Q FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Could not find .cabal file for path: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
srcFP
Just FilePath
dir -> FilePath -> Q FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
dir
where
findProjectDir :: FilePath -> IO (Maybe FilePath)
findProjectDir FilePath
x = do
let dir :: FilePath
dir = FilePath -> FilePath
takeDirectory FilePath
x
if FilePath
dir FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
x
then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
else do
[FilePath]
contents <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
if (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any FilePath -> Bool
isTargetFile [FilePath]
contents
then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
dir)
else FilePath -> IO (Maybe FilePath)
findProjectDir FilePath
dir
makeRelativeToProject :: FilePath -> Q FilePath
makeRelativeToProject :: FilePath -> Q FilePath
makeRelativeToProject FilePath
fp | FilePath -> Bool
isRelative FilePath
fp = do
FilePath
root <- Q FilePath
getPackageRoot
FilePath -> Q FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
root FilePath -> FilePath -> FilePath
</> FilePath
fp)
makeRelativeToProject FilePath
fp = FilePath -> Q FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fp
#endif