{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE OverloadedStrings     #-}

module Language.Haskell.Liquid.UX.QuasiQuoter
-- (
--     -- * LiquidHaskell Specification QuasiQuoter
--     lq

--     -- * QuasiQuoter Annotations
--   , LiquidQuote(..)
--   ) 
  where

import Data.Data
import Data.List

import qualified Data.Text as T

import Language.Haskell.TH.Lib
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Quote

import Language.Fixpoint.Types hiding (Error, Loc, SrcSpan)
import qualified Language.Fixpoint.Types as F

import Language.Haskell.Liquid.GHC.Misc (fSrcSpan)
import Liquid.GHC.API  (SrcSpan)
import Language.Haskell.Liquid.Parse
import Language.Haskell.Liquid.Types

import System.IO
import Text.Megaparsec.Error

--------------------------------------------------------------------------------
-- LiquidHaskell Specification QuasiQuoter -------------------------------------
--------------------------------------------------------------------------------

lq :: QuasiQuoter
lq :: QuasiQuoter
lq = QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp  = forall {a}. a
bad
  , quotePat :: String -> Q Pat
quotePat  = forall {a}. a
bad
  , quoteType :: String -> Q Type
quoteType = forall {a}. a
bad
  , quoteDec :: String -> Q [Dec]
quoteDec  = String -> Q [Dec]
lqDec
  }
  where
    -- FIME(adinapoli) Should we preserve 'fail' here?
    bad :: a
bad = forall a. HasCallStack => String -> a
error String
"`lq` quasiquoter can only be used as a top-level declaration"

lqDec :: String -> Q [Dec]
lqDec :: String -> Q [Dec]
lqDec String
src = do
  SourcePos
pos <- Loc -> SourcePos
locSourcePos forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Loc
location
  case SourcePos -> String -> Either (ParseErrorBundle String Void) BPspec
singleSpecP SourcePos
pos String
src of
    Left ParseErrorBundle String Void
peb -> do
      forall a. IO a -> Q a
runIO (Handle -> String -> IO ()
hPutStrLn Handle
stderr (forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle String Void
peb))
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"LH quasiquoter parse error"
    Right BPspec
spec -> do
      Dec
prg <- forall (m :: * -> *). Quote m => AnnTarget -> m Exp -> m Dec
pragAnnD AnnTarget
ModuleAnnotation forall a b. (a -> b) -> a -> b
$
               forall (m :: * -> *). Quote m => Name -> m Exp
conE 'LiquidQuote forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` forall a. Data a => a -> Q Exp
dataToExpQ' BPspec
spec
      case BPspec -> Either UserError [Dec]
mkSpecDecs BPspec
spec of
        Left UserError
uerr ->
          forall a. UserError -> Q a
throwErrorInQ UserError
uerr
        Right [Dec]
decs ->
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Dec
prg forall a. a -> [a] -> [a]
: [Dec]
decs

throwErrorInQ :: UserError -> Q a
throwErrorInQ :: forall a. UserError -> Q a
throwErrorInQ UserError
uerr =
  forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PPrint a => a -> String
showpp forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IO a -> Q a
runIO ([UserError] -> IO [CtxError Doc]
errorsWithContext [UserError
uerr])

--------------------------------------------------------------------------------
-- Liquid Haskell to Template Haskell ------------------------------------------
--------------------------------------------------------------------------------

-- Spec to Dec -----------------------------------------------------------------

mkSpecDecs :: BPspec -> Either UserError [Dec]
mkSpecDecs :: BPspec -> Either UserError [Dec]
mkSpecDecs (Asrt (LocSymbol
name, Located BareType
ty)) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Type -> Dec
SigD (forall s. Symbolic s => s -> Name
symbolName LocSymbol
name)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocSymbol -> BareType -> Either UserError Type
simplifyBareType LocSymbol
name (forall r tv c. (Monoid r, Eq tv) => RType c tv r -> RType c tv r
quantifyFreeRTy forall a b. (a -> b) -> a -> b
$ forall a. Located a -> a
val Located BareType
ty)
mkSpecDecs (LAsrt (LocSymbol
name, Located BareType
ty)) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Type -> Dec
SigD (forall s. Symbolic s => s -> Name
symbolName LocSymbol
name)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocSymbol -> BareType -> Either UserError Type
simplifyBareType LocSymbol
name (forall r tv c. (Monoid r, Eq tv) => RType c tv r -> RType c tv r
quantifyFreeRTy forall a b. (a -> b) -> a -> b
$ forall a. Located a -> a
val Located BareType
ty)
mkSpecDecs (Asrts ([LocSymbol]
names, (Located BareType
ty, Maybe [Located Expr]
_))) =
  (\Type
t -> (Name -> Type -> Dec
`SigD` Type
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Symbolic s => s -> Name
symbolName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LocSymbol]
names)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocSymbol -> BareType -> Either UserError Type
simplifyBareType (forall a. [a] -> a
head [LocSymbol]
names) (forall r tv c. (Monoid r, Eq tv) => RType c tv r -> RType c tv r
quantifyFreeRTy forall a b. (a -> b) -> a -> b
$ forall a. Located a -> a
val Located BareType
ty)
mkSpecDecs (Alias Located (RTAlias Symbol BareType)
rta) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [TyVarBndr ()] -> Type -> Dec
TySynD Name
name [TyVarBndr ()]
tvs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocSymbol -> BareType -> Either UserError Type
simplifyBareType LocSymbol
lsym (forall x a. RTAlias x a -> a
rtBody (forall a. Located a -> a
val Located (RTAlias Symbol BareType)
rta))
  where
    lsym :: LocSymbol
lsym = forall l b. Loc l => l -> b -> Located b
F.atLoc Located (RTAlias Symbol BareType)
rta Symbol
n
    name :: Name
name = forall s. Symbolic s => s -> Name
symbolName Symbol
n
    n :: Symbol
n    = forall x a. RTAlias x a -> Symbol
rtName (forall a. Located a -> a
val Located (RTAlias Symbol BareType)
rta)
    tvs :: [TyVarBndr ()]
tvs  = (\Symbol
a -> forall flag. Name -> flag -> TyVarBndr flag
PlainTV (forall s. Symbolic s => s -> Name
symbolName Symbol
a) ()) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x a. RTAlias x a -> [x]
rtTArgs (forall a. Located a -> a
val Located (RTAlias Symbol BareType)
rta)
mkSpecDecs BPspec
_ =
  forall a b. b -> Either a b
Right []

-- Symbol to TH Name -----------------------------------------------------------

symbolName :: Symbolic s => s -> Name
symbolName :: forall s. Symbolic s => s -> Name
symbolName = String -> Name
mkName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> String
symbolString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Symbolic a => a -> Symbol
symbol

-- BareType to TH Type ---------------------------------------------------------

simplifyBareType :: LocSymbol -> BareType -> Either UserError Type
simplifyBareType :: LocSymbol -> BareType -> Either UserError Type
simplifyBareType LocSymbol
s BareType
t = case BareType -> Simpl Type
simplifyBareType' BareType
t of
  Simplified Type
t' ->
    forall a b. b -> Either a b
Right Type
t'
  FoundExprArg SrcSpan
l ->
    forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall t. SrcSpan -> Maybe Doc -> Doc -> t -> Doc -> TError t
ErrTySpec SrcSpan
l forall a. Maybe a
Nothing (forall a. PPrint a => a -> Doc
pprint forall a b. (a -> b) -> a -> b
$ forall a. Located a -> a
val LocSymbol
s) (forall a. PPrint a => a -> Doc
pprint BareType
t)
      Doc
"Found expression argument in bad location in type"
  Simpl Type
FoundHole ->
    forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall t. SrcSpan -> Maybe Doc -> Doc -> t -> Doc -> TError t
ErrTySpec (forall a. Loc a => a -> SrcSpan
fSrcSpan LocSymbol
s) forall a. Maybe a
Nothing (forall a. PPrint a => a -> Doc
pprint forall a b. (a -> b) -> a -> b
$ forall a. Located a -> a
val LocSymbol
s) (forall a. PPrint a => a -> Doc
pprint BareType
t)
      Doc
"Can't write LiquidHaskell type with hole in a quasiquoter"

simplifyBareType' :: BareType -> Simpl Type
simplifyBareType' :: BareType -> Simpl Type
simplifyBareType' = ([BTyVar], [BareType]) -> BareType -> Simpl Type
simplifyBareType'' ([], [])

simplifyBareType'' :: ([BTyVar], [BareType]) -> BareType -> Simpl Type

simplifyBareType'' :: ([BTyVar], [BareType]) -> BareType -> Simpl Type
simplifyBareType'' ([], []) (RVar BTyVar
v RReft
_) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Name -> Type
VarT forall a b. (a -> b) -> a -> b
$ forall s. Symbolic s => s -> Name
symbolName BTyVar
v
simplifyBareType'' ([], []) (RAppTy BareType
t1 BareType
t2 RReft
_) =
  Type -> Type -> Type
AppT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BareType -> Simpl Type
simplifyBareType' BareType
t1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BareType -> Simpl Type
simplifyBareType' BareType
t2
simplifyBareType'' ([], []) (RFun Symbol
_ RFInfo
_ BareType
i BareType
o RReft
_) =
  (\Type
x Type
y -> Type
ArrowT Type -> Type -> Type
`AppT` Type
x Type -> Type -> Type
`AppT` Type
y)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BareType -> Simpl Type
simplifyBareType' BareType
i forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BareType -> Simpl Type
simplifyBareType' BareType
o
simplifyBareType'' ([], []) (RApp BTyCon
cc [BareType]
as [RTProp BTyCon BTyVar RReft]
_ RReft
_) =
  let c :: LocSymbol
c  = BTyCon -> LocSymbol
btc_tc BTyCon
cc
      c' :: Type
c' | forall c. TyConable c => c -> Bool
isFun   LocSymbol
c = Type
ArrowT
         | forall c. TyConable c => c -> Bool
isTuple LocSymbol
c = Int -> Type
TupleT (forall (t :: * -> *) a. Foldable t => t a -> Int
length [BareType]
as)
         | forall c. TyConable c => c -> Bool
isList  LocSymbol
c = Type
ListT
         | Bool
otherwise = Name -> Type
ConT forall a b. (a -> b) -> a -> b
$ forall s. Symbolic s => s -> Name
symbolName LocSymbol
c
  in  forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Type -> Type -> Type
AppT Type
c' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (forall a. [Simpl a] -> [Simpl a]
filterExprArgs forall a b. (a -> b) -> a -> b
$ BareType -> Simpl Type
simplifyBareType' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BareType]
as)

simplifyBareType'' ([BTyVar], [BareType])
_ (RExprArg Located Expr
e) =
  forall a. SrcSpan -> Simpl a
FoundExprArg forall a b. (a -> b) -> a -> b
$ forall a. Loc a => a -> SrcSpan
fSrcSpan Located Expr
e
simplifyBareType'' ([BTyVar], [BareType])
_ (RHole RReft
_) =
  forall a. Simpl a
FoundHole

simplifyBareType'' ([BTyVar], [BareType])
s(RAllP PVU BTyCon BTyVar
_ BareType
t) =
  ([BTyVar], [BareType]) -> BareType -> Simpl Type
simplifyBareType'' ([BTyVar], [BareType])
s BareType
t
simplifyBareType'' ([BTyVar], [BareType])
s (RAllE Symbol
_ BareType
_ BareType
t) =
  ([BTyVar], [BareType]) -> BareType -> Simpl Type
simplifyBareType'' ([BTyVar], [BareType])
s BareType
t
simplifyBareType'' ([BTyVar], [BareType])
s (REx Symbol
_ BareType
_ BareType
t) =
  ([BTyVar], [BareType]) -> BareType -> Simpl Type
simplifyBareType'' ([BTyVar], [BareType])
s BareType
t
simplifyBareType'' ([BTyVar], [BareType])
s (RRTy [(Symbol, BareType)]
_ RReft
_ Oblig
_ BareType
t) =
  ([BTyVar], [BareType]) -> BareType -> Simpl Type
simplifyBareType'' ([BTyVar], [BareType])
s BareType
t

simplifyBareType'' ([BTyVar]
tvs, [BareType]
cls) (RFun Symbol
_ RFInfo
_ BareType
i BareType
o RReft
_)
  | forall c t t1. TyConable c => RType c t t1 -> Bool
isClassType BareType
i = ([BTyVar], [BareType]) -> BareType -> Simpl Type
simplifyBareType'' ([BTyVar]
tvs, BareType
i forall a. a -> [a] -> [a]
: [BareType]
cls) BareType
o
simplifyBareType'' ([BTyVar]
tvs, [BareType]
cls) (RAllT RTVU BTyCon BTyVar
tv BareType
t RReft
_) =
  ([BTyVar], [BareType]) -> BareType -> Simpl Type
simplifyBareType'' (forall tv s. RTVar tv s -> tv
ty_var_value RTVU BTyCon BTyVar
tv forall a. a -> [a] -> [a]
: [BTyVar]
tvs, [BareType]
cls) BareType
t

simplifyBareType'' ([BTyVar]
tvs, [BareType]
cls) BareType
bt =
  [TyVarBndr Specificity] -> Cxt -> Type -> Type
ForallT ((\BTyVar
t -> forall flag. Name -> flag -> TyVarBndr flag
PlainTV (forall s. Symbolic s => s -> Name
symbolName BTyVar
t) Specificity
SpecifiedSpec) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> [a]
reverse [BTyVar]
tvs)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BareType -> Simpl Type
simplifyBareType' (forall a. [a] -> [a]
reverse [BareType]
cls)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BareType -> Simpl Type
simplifyBareType' BareType
bt


data Simpl a = Simplified a
             | FoundExprArg SrcSpan
             | FoundHole
               deriving (forall a b. a -> Simpl b -> Simpl a
forall a b. (a -> b) -> Simpl a -> Simpl 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 -> Simpl b -> Simpl a
$c<$ :: forall a b. a -> Simpl b -> Simpl a
fmap :: forall a b. (a -> b) -> Simpl a -> Simpl b
$cfmap :: forall a b. (a -> b) -> Simpl a -> Simpl b
Functor)

instance Applicative Simpl where
  pure :: forall a. a -> Simpl a
pure = forall a. a -> Simpl a
Simplified

  Simplified   a -> b
f <*> :: forall a b. Simpl (a -> b) -> Simpl a -> Simpl b
<*> Simplified   a
x = forall a. a -> Simpl a
Simplified forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
  Simpl (a -> b)
_              <*> FoundExprArg SrcSpan
l = forall a. SrcSpan -> Simpl a
FoundExprArg SrcSpan
l
  Simpl (a -> b)
_              <*> Simpl a
FoundHole      = forall a. Simpl a
FoundHole
  FoundExprArg SrcSpan
l <*> Simpl a
_              = forall a. SrcSpan -> Simpl a
FoundExprArg SrcSpan
l
  Simpl (a -> b)
FoundHole      <*> Simpl a
_              = forall a. Simpl a
FoundHole

instance Monad Simpl where
  Simplified   a
x >>= :: forall a b. Simpl a -> (a -> Simpl b) -> Simpl b
>>= a -> Simpl b
f = a -> Simpl b
f a
x
  FoundExprArg SrcSpan
l >>= a -> Simpl b
_ = forall a. SrcSpan -> Simpl a
FoundExprArg SrcSpan
l
  Simpl a
FoundHole      >>= a -> Simpl b
_ = forall a. Simpl a
FoundHole

filterExprArgs :: [Simpl a] -> [Simpl a]
filterExprArgs :: forall a. [Simpl a] -> [Simpl a]
filterExprArgs = forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. Simpl a -> Bool
check
  where
    check :: Simpl a -> Bool
check (FoundExprArg SrcSpan
_) = Bool
False
    check Simpl a
_ = Bool
True

--------------------------------------------------------------------------------
-- QuasiQuoter Annotations -----------------------------------------------------
--------------------------------------------------------------------------------

newtype LiquidQuote = LiquidQuote { LiquidQuote -> BPspec
liquidQuoteSpec :: BPspec }
                      deriving (Typeable LiquidQuote
LiquidQuote -> DataType
LiquidQuote -> Constr
(forall b. Data b => b -> b) -> LiquidQuote -> LiquidQuote
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LiquidQuote -> u
forall u. (forall d. Data d => d -> u) -> LiquidQuote -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LiquidQuote -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LiquidQuote -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LiquidQuote -> m LiquidQuote
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LiquidQuote -> m LiquidQuote
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LiquidQuote
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LiquidQuote -> c LiquidQuote
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LiquidQuote)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LiquidQuote)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LiquidQuote -> m LiquidQuote
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LiquidQuote -> m LiquidQuote
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LiquidQuote -> m LiquidQuote
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LiquidQuote -> m LiquidQuote
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LiquidQuote -> m LiquidQuote
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LiquidQuote -> m LiquidQuote
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LiquidQuote -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LiquidQuote -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> LiquidQuote -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LiquidQuote -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LiquidQuote -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LiquidQuote -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LiquidQuote -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LiquidQuote -> r
gmapT :: (forall b. Data b => b -> b) -> LiquidQuote -> LiquidQuote
$cgmapT :: (forall b. Data b => b -> b) -> LiquidQuote -> LiquidQuote
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LiquidQuote)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LiquidQuote)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LiquidQuote)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LiquidQuote)
dataTypeOf :: LiquidQuote -> DataType
$cdataTypeOf :: LiquidQuote -> DataType
toConstr :: LiquidQuote -> Constr
$ctoConstr :: LiquidQuote -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LiquidQuote
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LiquidQuote
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LiquidQuote -> c LiquidQuote
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LiquidQuote -> c LiquidQuote
Data, Typeable)

--------------------------------------------------------------------------------
-- Template Haskell Utility Functions ------------------------------------------
--------------------------------------------------------------------------------

locSourcePos :: Loc -> SourcePos
locSourcePos :: Loc -> SourcePos
locSourcePos Loc
loc =
  forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> Int -> Int -> SourcePos
safeSourcePos (Loc -> String
loc_filename Loc
loc)) (Loc -> CharPos
loc_start Loc
loc)

dataToExpQ' :: Data a => a -> Q Exp
dataToExpQ' :: forall a. Data a => a -> Q Exp
dataToExpQ' = forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
dataToExpQ (forall a b. a -> b -> a
const forall a. Maybe a
Nothing forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Text -> Maybe (Q Exp)
textToExpQ)

textToExpQ :: T.Text -> Maybe ExpQ
textToExpQ :: Text -> Maybe (Q Exp)
textToExpQ Text
text = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> m Exp
varE 'T.pack forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` forall (m :: * -> *). Quote m => String -> m Exp
stringE (Text -> String
T.unpack Text
text)

extQ :: (Typeable a, Typeable b) => (a -> q) -> (b -> q) -> a -> q
extQ :: forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
extQ a -> q
f b -> q
g a
a = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> q
f a
a) b -> q
g (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
a)