{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP #-}
module Text.Shakespeare.Base
( Deref (..)
, Ident (..)
, Scope
, parseDeref
, parseHash
, parseVar
, parseVarString
, parseAt
, parseUrl
, parseUrlString
, parseCaret
, parseUnder
, parseInt
, parseIntString
, derefToExp
, flattenDeref
, readUtf8File
, readUtf8FileString
, readFileQ
, readFileRecompileQ
) where
import Language.Haskell.TH.Syntax hiding (makeRelativeToProject)
import Language.Haskell.TH (appE)
import Data.Char (isUpper, isSymbol, isPunctuation, isAscii)
import Data.FileEmbed (makeRelativeToProject)
import Text.ParserCombinators.Parsec
import Text.Parsec.Prim (Parsec)
import Data.List (intercalate)
import Data.Ratio (Ratio, numerator, denominator, (%))
import Data.Data (Data)
import Data.Typeable (Typeable)
import qualified Data.Text.Lazy as TL
import qualified System.IO as SIO
import qualified Data.Text.Lazy.IO as TIO
import Control.Monad (when)
newtype Ident = Ident String
deriving (Int -> Ident -> ShowS
[Ident] -> ShowS
Ident -> String
(Int -> Ident -> ShowS)
-> (Ident -> String) -> ([Ident] -> ShowS) -> Show Ident
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ident -> ShowS
showsPrec :: Int -> Ident -> ShowS
$cshow :: Ident -> String
show :: Ident -> String
$cshowList :: [Ident] -> ShowS
showList :: [Ident] -> ShowS
Show, Ident -> Ident -> Bool
(Ident -> Ident -> Bool) -> (Ident -> Ident -> Bool) -> Eq Ident
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ident -> Ident -> Bool
== :: Ident -> Ident -> Bool
$c/= :: Ident -> Ident -> Bool
/= :: Ident -> Ident -> Bool
Eq, ReadPrec [Ident]
ReadPrec Ident
Int -> ReadS Ident
ReadS [Ident]
(Int -> ReadS Ident)
-> ReadS [Ident]
-> ReadPrec Ident
-> ReadPrec [Ident]
-> Read Ident
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Ident
readsPrec :: Int -> ReadS Ident
$creadList :: ReadS [Ident]
readList :: ReadS [Ident]
$creadPrec :: ReadPrec Ident
readPrec :: ReadPrec Ident
$creadListPrec :: ReadPrec [Ident]
readListPrec :: ReadPrec [Ident]
Read, Typeable Ident
Typeable Ident =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident -> c Ident)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ident)
-> (Ident -> Constr)
-> (Ident -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ident))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ident))
-> ((forall b. Data b => b -> b) -> Ident -> Ident)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r)
-> (forall u. (forall d. Data d => d -> u) -> Ident -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Ident -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident)
-> Data Ident
Ident -> Constr
Ident -> DataType
(forall b. Data b => b -> b) -> Ident -> Ident
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) -> Ident -> u
forall u. (forall d. Data d => d -> u) -> Ident -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ident
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident -> c Ident
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ident)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ident)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident -> c Ident
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident -> c Ident
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ident
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ident
$ctoConstr :: Ident -> Constr
toConstr :: Ident -> Constr
$cdataTypeOf :: Ident -> DataType
dataTypeOf :: Ident -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ident)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ident)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ident)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ident)
$cgmapT :: (forall b. Data b => b -> b) -> Ident -> Ident
gmapT :: (forall b. Data b => b -> b) -> Ident -> Ident
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Ident -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Ident -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ident -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ident -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
Data, Typeable, Eq Ident
Eq Ident =>
(Ident -> Ident -> Ordering)
-> (Ident -> Ident -> Bool)
-> (Ident -> Ident -> Bool)
-> (Ident -> Ident -> Bool)
-> (Ident -> Ident -> Bool)
-> (Ident -> Ident -> Ident)
-> (Ident -> Ident -> Ident)
-> Ord Ident
Ident -> Ident -> Bool
Ident -> Ident -> Ordering
Ident -> Ident -> Ident
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Ident -> Ident -> Ordering
compare :: Ident -> Ident -> Ordering
$c< :: Ident -> Ident -> Bool
< :: Ident -> Ident -> Bool
$c<= :: Ident -> Ident -> Bool
<= :: Ident -> Ident -> Bool
$c> :: Ident -> Ident -> Bool
> :: Ident -> Ident -> Bool
$c>= :: Ident -> Ident -> Bool
>= :: Ident -> Ident -> Bool
$cmax :: Ident -> Ident -> Ident
max :: Ident -> Ident -> Ident
$cmin :: Ident -> Ident -> Ident
min :: Ident -> Ident -> Ident
Ord, (forall (m :: * -> *). Quote m => Ident -> m Exp)
-> (forall (m :: * -> *). Quote m => Ident -> Code m Ident)
-> Lift Ident
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Ident -> m Exp
forall (m :: * -> *). Quote m => Ident -> Code m Ident
$clift :: forall (m :: * -> *). Quote m => Ident -> m Exp
lift :: forall (m :: * -> *). Quote m => Ident -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Ident -> Code m Ident
liftTyped :: forall (m :: * -> *). Quote m => Ident -> Code m Ident
Lift)
type Scope = [(Ident, Exp)]
data Deref = DerefModulesIdent [String] Ident
| DerefIdent Ident
| DerefIntegral Integer
| DerefRational Rational
| DerefString String
| DerefBranch Deref Deref
| DerefList [Deref]
| DerefTuple [Deref]
| DerefGetField Deref String
deriving (Int -> Deref -> ShowS
[Deref] -> ShowS
Deref -> String
(Int -> Deref -> ShowS)
-> (Deref -> String) -> ([Deref] -> ShowS) -> Show Deref
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Deref -> ShowS
showsPrec :: Int -> Deref -> ShowS
$cshow :: Deref -> String
show :: Deref -> String
$cshowList :: [Deref] -> ShowS
showList :: [Deref] -> ShowS
Show, Deref -> Deref -> Bool
(Deref -> Deref -> Bool) -> (Deref -> Deref -> Bool) -> Eq Deref
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Deref -> Deref -> Bool
== :: Deref -> Deref -> Bool
$c/= :: Deref -> Deref -> Bool
/= :: Deref -> Deref -> Bool
Eq, ReadPrec [Deref]
ReadPrec Deref
Int -> ReadS Deref
ReadS [Deref]
(Int -> ReadS Deref)
-> ReadS [Deref]
-> ReadPrec Deref
-> ReadPrec [Deref]
-> Read Deref
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Deref
readsPrec :: Int -> ReadS Deref
$creadList :: ReadS [Deref]
readList :: ReadS [Deref]
$creadPrec :: ReadPrec Deref
readPrec :: ReadPrec Deref
$creadListPrec :: ReadPrec [Deref]
readListPrec :: ReadPrec [Deref]
Read, Typeable Deref
Typeable Deref =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Deref -> c Deref)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Deref)
-> (Deref -> Constr)
-> (Deref -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Deref))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Deref))
-> ((forall b. Data b => b -> b) -> Deref -> Deref)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Deref -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Deref -> r)
-> (forall u. (forall d. Data d => d -> u) -> Deref -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Deref -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Deref -> m Deref)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Deref -> m Deref)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Deref -> m Deref)
-> Data Deref
Deref -> Constr
Deref -> DataType
(forall b. Data b => b -> b) -> Deref -> Deref
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) -> Deref -> u
forall u. (forall d. Data d => d -> u) -> Deref -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Deref -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Deref -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Deref -> m Deref
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Deref -> m Deref
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Deref
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Deref -> c Deref
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Deref)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Deref)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Deref -> c Deref
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Deref -> c Deref
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Deref
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Deref
$ctoConstr :: Deref -> Constr
toConstr :: Deref -> Constr
$cdataTypeOf :: Deref -> DataType
dataTypeOf :: Deref -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Deref)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Deref)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Deref)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Deref)
$cgmapT :: (forall b. Data b => b -> b) -> Deref -> Deref
gmapT :: (forall b. Data b => b -> b) -> Deref -> Deref
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Deref -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Deref -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Deref -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Deref -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Deref -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Deref -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Deref -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Deref -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Deref -> m Deref
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Deref -> m Deref
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Deref -> m Deref
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Deref -> m Deref
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Deref -> m Deref
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Deref -> m Deref
Data, Typeable, Eq Deref
Eq Deref =>
(Deref -> Deref -> Ordering)
-> (Deref -> Deref -> Bool)
-> (Deref -> Deref -> Bool)
-> (Deref -> Deref -> Bool)
-> (Deref -> Deref -> Bool)
-> (Deref -> Deref -> Deref)
-> (Deref -> Deref -> Deref)
-> Ord Deref
Deref -> Deref -> Bool
Deref -> Deref -> Ordering
Deref -> Deref -> Deref
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Deref -> Deref -> Ordering
compare :: Deref -> Deref -> Ordering
$c< :: Deref -> Deref -> Bool
< :: Deref -> Deref -> Bool
$c<= :: Deref -> Deref -> Bool
<= :: Deref -> Deref -> Bool
$c> :: Deref -> Deref -> Bool
> :: Deref -> Deref -> Bool
$c>= :: Deref -> Deref -> Bool
>= :: Deref -> Deref -> Bool
$cmax :: Deref -> Deref -> Deref
max :: Deref -> Deref -> Deref
$cmin :: Deref -> Deref -> Deref
min :: Deref -> Deref -> Deref
Ord, (forall (m :: * -> *). Quote m => Deref -> m Exp)
-> (forall (m :: * -> *). Quote m => Deref -> Code m Deref)
-> Lift Deref
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Deref -> m Exp
forall (m :: * -> *). Quote m => Deref -> Code m Deref
$clift :: forall (m :: * -> *). Quote m => Deref -> m Exp
lift :: forall (m :: * -> *). Quote m => Deref -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Deref -> Code m Deref
liftTyped :: forall (m :: * -> *). Quote m => Deref -> Code m Deref
Lift)
derefParens, derefCurlyBrackets :: UserParser a Deref
derefParens :: forall a. UserParser a Deref
derefParens = ParsecT String a Identity Char
-> ParsecT String a Identity Char
-> ParsecT String a Identity Deref
-> ParsecT String a Identity Deref
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(') (Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')') ParsecT String a Identity Deref
forall a. UserParser a Deref
parseDeref
derefCurlyBrackets :: forall a. UserParser a Deref
derefCurlyBrackets = ParsecT String a Identity Char
-> ParsecT String a Identity Char
-> ParsecT String a Identity Deref
-> ParsecT String a Identity Deref
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{') (Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}') ParsecT String a Identity Deref
forall a. UserParser a Deref
parseDeref
derefList, derefTuple :: UserParser a Deref
derefList :: forall a. UserParser a Deref
derefList = ParsecT String a Identity Char
-> ParsecT String a Identity Char
-> ParsecT String a Identity Deref
-> ParsecT String a Identity Deref
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[') (Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']') (([Deref] -> Deref)
-> ParsecT String a Identity [Deref]
-> ParsecT String a Identity Deref
forall a b.
(a -> b)
-> ParsecT String a Identity a -> ParsecT String a Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Deref] -> Deref
DerefList (ParsecT String a Identity [Deref]
-> ParsecT String a Identity Deref)
-> ParsecT String a Identity [Deref]
-> ParsecT String a Identity Deref
forall a b. (a -> b) -> a -> b
$ ParsecT String a Identity Deref
-> ParsecT String a Identity Char
-> ParsecT String a Identity [Deref]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT String a Identity Deref
forall a. UserParser a Deref
parseDeref (Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','))
derefTuple :: forall a. UserParser a Deref
derefTuple = GenParser Char a Deref -> GenParser Char a Deref
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char a Deref -> GenParser Char a Deref)
-> GenParser Char a Deref -> GenParser Char a Deref
forall a b. (a -> b) -> a -> b
$ do
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
x <- sepBy1 parseDeref (char ',')
when (length x < 2) $ pzero
_ <- char ')'
return $ DerefTuple x
parseDeref :: UserParser a Deref
parseDeref :: forall a. UserParser a Deref
parseDeref = do
ParsecT String a Identity Char -> ParsecT String a Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (String -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t")
UserParser a Deref
forall a. UserParser a Deref
derefList UserParser a Deref -> UserParser a Deref -> UserParser a Deref
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> UserParser a Deref
forall a. UserParser a Deref
derefTuple UserParser a Deref -> UserParser a Deref -> UserParser a Deref
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> UserParser a Deref
forall a. UserParser a Deref
derefOther
where
derefOther :: ParsecT String u Identity Deref
derefOther = do
x <- ParsecT String u Identity Deref
forall a. UserParser a Deref
derefSingle
derefInfix x <|> derefPrefix x
delim :: ParsecT String u Identity ()
delim = (ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ') ParsecT String u Identity String
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT String u Identity ()
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return())
ParsecT String u Identity ()
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity () -> ParsecT String u Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"(\"" ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT String u Identity ()
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
derefOp :: GenParser Char st Deref
derefOp = GenParser Char st Deref -> GenParser Char st Deref
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st Deref -> GenParser Char st Deref)
-> GenParser Char st Deref -> GenParser Char st Deref
forall a b. (a -> b) -> a -> b
$ do
_ <- Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
x <- many1 $ noneOf " \t\n\r()"
_ <- char ')'
return $ DerefIdent $ Ident x
isOperatorChar :: Char -> Bool
isOperatorChar Char
c
| Char -> Bool
isAscii Char
c = Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"!#$%&*+./<=>?@\\^|-~:"
| Bool
otherwise = Char -> Bool
isSymbol Char
c Bool -> Bool -> Bool
|| Char -> Bool
isPunctuation Char
c
derefPrefix :: Deref -> ParsecT String u Identity Deref
derefPrefix Deref
x = do
res <- ([Deref] -> [Deref]) -> ParsecT String u Identity Deref
forall {t :: * -> *} {u}.
Foldable t =>
([Deref] -> t Deref) -> ParsecT String u Identity Deref
deref' (([Deref] -> [Deref]) -> ParsecT String u Identity Deref)
-> ([Deref] -> [Deref]) -> ParsecT String u Identity Deref
forall a b. (a -> b) -> a -> b
$ (:) Deref
x
skipMany $ oneOf " \t"
return res
derefInfix :: Deref -> GenParser Char st Deref
derefInfix Deref
x = GenParser Char st Deref -> GenParser Char st Deref
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st Deref -> GenParser Char st Deref)
-> GenParser Char st Deref -> GenParser Char st Deref
forall a b. (a -> b) -> a -> b
$ do
_ <- ParsecT String st Identity ()
forall {u}. ParsecT String u Identity ()
delim
xs <- many $ try $ derefSingle >>= \Deref
x' -> ParsecT String st Identity ()
forall {u}. ParsecT String u Identity ()
delim ParsecT String st Identity ()
-> GenParser Char st Deref -> GenParser Char st Deref
forall a b.
ParsecT String st Identity a
-> ParsecT String st Identity b -> ParsecT String st Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Deref -> GenParser Char st Deref
forall a. a -> ParsecT String st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Deref
x'
op <- many1 (satisfy isOperatorChar) <?> "operator"
when (op == "$") $ fail "don't handle $"
let op' = Ident -> Deref
DerefIdent (Ident -> Deref) -> Ident -> Deref
forall a b. (a -> b) -> a -> b
$ String -> Ident
Ident String
op
ys <- many1 $ try $ delim >> derefSingle
skipMany $ oneOf " \t"
return $ DerefBranch (DerefBranch op' $ foldl1 DerefBranch $ x : xs) (foldl1 DerefBranch ys)
derefSingle :: ParsecT String u Identity Deref
derefSingle = do
x <- ParsecT String u Identity Deref
forall a. UserParser a Deref
derefTuple ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity Deref
forall a. UserParser a Deref
derefList ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity Deref
forall a. UserParser a Deref
derefOp ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity Deref
forall a. UserParser a Deref
derefParens ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity Deref
forall a. UserParser a Deref
numeric ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity Deref
forall a. UserParser a Deref
strLit ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity Deref
forall a. UserParser a Deref
ident
fields <- many recordDot
pure $ foldl DerefGetField x fields
recordDot :: ParsecT String u Identity String
recordDot = do
_ <- Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
x <- lower <|> char '_'
xs <- many (alphaNum <|> char '_' <|> char '\'')
pure (x : xs)
deref' :: ([Deref] -> t Deref) -> ParsecT String u Identity Deref
deref' [Deref] -> t Deref
lhs =
ParsecT String u Identity Deref
forall a. UserParser a Deref
dollar ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity Deref
derefSingle'
ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Deref -> ParsecT String u Identity Deref
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Deref -> Deref -> Deref) -> t Deref -> Deref
forall a. (a -> a -> a) -> t a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Deref -> Deref -> Deref
DerefBranch (t Deref -> Deref) -> t Deref -> Deref
forall a b. (a -> b) -> a -> b
$ [Deref] -> t Deref
lhs [])
where
dollar :: ParsecT String st Identity Deref
dollar = do
_ <- GenParser Char st Char -> GenParser Char st Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st Char -> GenParser Char st Char)
-> GenParser Char st Char -> GenParser Char st Char
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity ()
forall {u}. ParsecT String u Identity ()
delim ParsecT String st Identity ()
-> GenParser Char st Char -> GenParser Char st Char
forall a b.
ParsecT String st Identity a
-> ParsecT String st Identity b -> ParsecT String st Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> GenParser Char st Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$'
rhs <- parseDeref
let lhs' = (Deref -> Deref -> Deref) -> t Deref -> Deref
forall a. (a -> a -> a) -> t a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Deref -> Deref -> Deref
DerefBranch (t Deref -> Deref) -> t Deref -> Deref
forall a b. (a -> b) -> a -> b
$ [Deref] -> t Deref
lhs []
return $ DerefBranch lhs' rhs
derefSingle' :: ParsecT String u Identity Deref
derefSingle' = do
x <- ParsecT String u Identity Deref -> ParsecT String u Identity Deref
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String u Identity Deref
-> ParsecT String u Identity Deref)
-> ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
forall a b. (a -> b) -> a -> b
$ ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
delim ParsecT String u Identity ()
-> ParsecT String u Identity Deref
-> ParsecT String u Identity Deref
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity Deref
forall a. UserParser a Deref
derefSingle
deref' $ lhs . (:) x
numeric :: ParsecT String u Identity Deref
numeric = do
n <- (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT String u Identity Char
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String u Identity String
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"-") ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String u Identity String
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
x <- many1 digit
y <- (char '.' >> fmap Just (many1 digit)) <|> return Nothing
return $ case y of
Maybe String
Nothing -> Integer -> Deref
DerefIntegral (Integer -> Deref) -> Integer -> Deref
forall a b. (a -> b) -> a -> b
$ String -> String -> Integer
forall a. Read a => String -> String -> a
read' String
"Integral" (String -> Integer) -> String -> Integer
forall a b. (a -> b) -> a -> b
$ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
Just String
z -> Rational -> Deref
DerefRational (Rational -> Deref) -> Rational -> Deref
forall a b. (a -> b) -> a -> b
$ Double -> Rational
forall a. Real a => a -> Rational
toRational
(String -> String -> Double
forall a. Read a => String -> String -> a
read' String
"Rational" (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'.' Char -> ShowS
forall a. a -> [a] -> [a]
: String
z :: Double)
strLit :: ParsecT String u Identity Deref
strLit = do
_ <- Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
chars <- many quotedChar
_ <- char '"'
return $ DerefString chars
quotedChar :: ParsecT String u Identity Char
quotedChar = (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity Char
forall {u}. ParsecT String u Identity Char
escapedChar) ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\""
escapedChar :: ParsecT String u Identity Char
escapedChar =
let cecs :: [(Char, Char)]
cecs = [(Char
'n', Char
'\n'), (Char
'r', Char
'\r'), (Char
'b', Char
'\b'), (Char
't', Char
'\t')
,(Char
'\\', Char
'\\'), (Char
'"', Char
'"'), (Char
'\'', Char
'\'')]
in [ParsecT String u Identity Char] -> ParsecT String u Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String u Identity Char
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
ec | (Char
c, Char
ec) <- [(Char, Char)]
cecs]
ident :: ParsecT String u Identity Deref
ident = do
mods <- ParsecT String u Identity String
-> ParsecT String u Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String u Identity String
forall {u}. ParsecT String u Identity String
modul
func <- many1 (alphaNum <|> char '_' <|> char '\'')
let func' = String -> Ident
Ident String
func
return $
if null mods
then DerefIdent func'
else DerefModulesIdent mods func'
modul :: GenParser Char st String
modul = GenParser Char st String -> GenParser Char st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st String -> GenParser Char st String)
-> GenParser Char st String -> GenParser Char st String
forall a b. (a -> b) -> a -> b
$ do
c <- ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
upper
cs <- many (alphaNum <|> char '_')
_ <- char '.'
return $ c : cs
read' :: Read a => String -> String -> a
read' :: forall a. Read a => String -> String -> a
read' String
t String
s =
case ReadS a
forall a. Read a => ReadS a
reads String
s of
(a
x, String
_):[(a, String)]
_ -> a
x
[] -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" read failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
expType :: Ident -> Name -> Exp
expType :: Ident -> Name -> Exp
expType (Ident (Char
c:String
_)) = if Char -> Bool
isUpper Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' then Name -> Exp
ConE else Name -> Exp
VarE
expType (Ident String
"") = String -> Name -> Exp
forall a. HasCallStack => String -> a
error String
"Bad Ident"
derefToExp :: Scope -> Deref -> Exp
derefToExp :: Scope -> Deref -> Exp
derefToExp Scope
s (DerefBranch Deref
x Deref
y) = Scope -> Deref -> Exp
derefToExp Scope
s Deref
x Exp -> Exp -> Exp
`AppE` Scope -> Deref -> Exp
derefToExp Scope
s Deref
y
derefToExp Scope
_ (DerefModulesIdent [String]
mods i :: Ident
i@(Ident String
s)) =
Ident -> Name -> Exp
expType Ident
i (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ OccName -> NameFlavour -> Name
Name (String -> OccName
mkOccName String
s) (ModName -> NameFlavour
NameQ (ModName -> NameFlavour) -> ModName -> NameFlavour
forall a b. (a -> b) -> a -> b
$ String -> ModName
mkModName (String -> ModName) -> String -> ModName
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String]
mods)
derefToExp Scope
scope (DerefIdent i :: Ident
i@(Ident String
s)) =
case Ident -> Scope -> Maybe Exp
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Ident
i Scope
scope of
Just Exp
e -> Exp
e
Maybe Exp
Nothing -> Ident -> Name -> Exp
expType Ident
i (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
s
derefToExp Scope
_ (DerefIntegral Integer
i) = Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL Integer
i
derefToExp Scope
_ (DerefRational Rational
r) = Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Rational -> Lit
RationalL Rational
r
derefToExp Scope
_ (DerefString String
s) = Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Lit
StringL String
s
derefToExp Scope
s (DerefList [Deref]
ds) = [Exp] -> Exp
ListE ([Exp] -> Exp) -> [Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (Deref -> Exp) -> [Deref] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Scope -> Deref -> Exp
derefToExp Scope
s) [Deref]
ds
derefToExp Scope
s (DerefTuple [Deref]
ds) = [Maybe Exp] -> Exp
TupE ([Maybe Exp] -> Exp) -> [Maybe Exp] -> Exp
forall a b. (a -> b) -> a -> b
$
#if MIN_VERSION_template_haskell(2,16,0)
(Exp -> Maybe Exp) -> [Exp] -> [Maybe Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Maybe Exp
forall a. a -> Maybe a
Just ([Exp] -> [Maybe Exp]) -> [Exp] -> [Maybe Exp]
forall a b. (a -> b) -> a -> b
$
#endif
(Deref -> Exp) -> [Deref] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Scope -> Deref -> Exp
derefToExp Scope
s) [Deref]
ds
derefToExp Scope
s (DerefGetField Deref
x String
f) =
#if MIN_VERSION_template_haskell(2,18,0)
Exp -> String -> Exp
GetFieldE (Scope -> Deref -> Exp
derefToExp Scope
s Deref
x) String
f
#else
error "Your compiler doesn't support OverloadedRecordDot"
#endif
flattenDeref :: Deref -> Maybe [String]
flattenDeref :: Deref -> Maybe [String]
flattenDeref (DerefIdent (Ident String
x)) = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
x]
flattenDeref (DerefBranch (DerefIdent (Ident String
x)) Deref
y) = do
y' <- Deref -> Maybe [String]
flattenDeref Deref
y
Just $ y' ++ [x]
flattenDeref Deref
_ = Maybe [String]
forall a. Maybe a
Nothing
parseHash :: UserParser a (Either String Deref)
parseHash :: forall a. UserParser a (Either String Deref)
parseHash = Char -> UserParser a (Either String Deref)
forall a. Char -> UserParser a (Either String Deref)
parseVar Char
'#'
curlyBrackets :: UserParser a String
curlyBrackets :: forall {u}. ParsecT String u Identity String
curlyBrackets = do
_<- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
var <- many1 $ noneOf "}"
_<- char '}'
return $ ('{':var) ++ "}"
type UserParser a = Parsec String a
parseVar :: Char -> UserParser a (Either String Deref)
parseVar :: forall a. Char -> UserParser a (Either String Deref)
parseVar Char
c = do
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
(char '\\' >> return (Left [c])) <|> (do
deref <- derefCurlyBrackets
return $ Right deref) <|> (do
_ <- lookAhead (oneOf "\r\n" >> return ()) <|> eof
return $ Left ""
) <|> return (Left [c])
parseAt :: UserParser a (Either String (Deref, Bool))
parseAt :: forall a. UserParser a (Either String (Deref, Bool))
parseAt = Char -> Char -> UserParser a (Either String (Deref, Bool))
forall a.
Char -> Char -> UserParser a (Either String (Deref, Bool))
parseUrl Char
'@' Char
'?'
parseUrl :: Char -> Char -> UserParser a (Either String (Deref, Bool))
parseUrl :: forall a.
Char -> Char -> UserParser a (Either String (Deref, Bool))
parseUrl Char
c Char
d = do
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
(char '\\' >> return (Left [c])) <|> (do
x <- (char d >> return True) <|> return False
(do
deref <- derefCurlyBrackets
return $ Right (deref, x))
<|> return (Left $ if x then [c, d] else [c]))
parseInterpolatedString :: Char -> UserParser a (Either String String)
parseInterpolatedString :: forall a. Char -> UserParser a (Either String String)
parseInterpolatedString Char
c = do
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
(char '\\' >> return (Left ['\\', c])) <|> (do
bracketed <- curlyBrackets
return $ Right (c:bracketed)) <|> return (Left [c])
parseVarString :: Char -> UserParser a (Either String String)
parseVarString :: forall a. Char -> UserParser a (Either String String)
parseVarString = Char -> UserParser a (Either String String)
forall a. Char -> UserParser a (Either String String)
parseInterpolatedString
parseUrlString :: Char -> Char -> UserParser a (Either String String)
parseUrlString :: forall a. Char -> Char -> UserParser a (Either String String)
parseUrlString Char
c Char
d = do
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
(char '\\' >> return (Left [c, '\\'])) <|> (do
ds <- (char d >> return [d]) <|> return []
(do bracketed <- curlyBrackets
return $ Right (c:ds ++ bracketed))
<|> return (Left (c:ds)))
parseIntString :: Char -> UserParser a (Either String String)
parseIntString :: forall a. Char -> UserParser a (Either String String)
parseIntString = Char -> UserParser a (Either String String)
forall a. Char -> UserParser a (Either String String)
parseInterpolatedString
parseCaret :: UserParser a (Either String Deref)
parseCaret :: forall a. UserParser a (Either String Deref)
parseCaret = Char -> UserParser a (Either String Deref)
forall a. Char -> UserParser a (Either String Deref)
parseInt Char
'^'
parseInt :: Char -> UserParser a (Either String Deref)
parseInt :: forall a. Char -> UserParser a (Either String Deref)
parseInt Char
c = do
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
(try $ char '\\' >> char '{' >> return (Left [c, '{'])) <|> (do
deref <- derefCurlyBrackets
return $ Right deref) <|> return (Left [c])
parseUnder :: UserParser a (Either String Deref)
parseUnder :: forall a. UserParser a (Either String Deref)
parseUnder = do
_ <- Char -> ParsecT String a Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'
(char '\\' >> return (Left "_")) <|> (do
deref <- derefCurlyBrackets
return $ Right deref) <|> return (Left "_")
readUtf8FileString :: FilePath -> IO String
readUtf8FileString :: String -> IO String
readUtf8FileString String
fp = (Text -> String) -> IO Text -> IO String
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
TL.unpack (IO Text -> IO String) -> IO Text -> IO String
forall a b. (a -> b) -> a -> b
$ String -> IO Text
readUtf8File String
fp
readUtf8File :: FilePath -> IO TL.Text
readUtf8File :: String -> IO Text
readUtf8File String
fp = do
h <- String -> IOMode -> IO Handle
SIO.openFile String
fp IOMode
SIO.ReadMode
SIO.hSetEncoding h SIO.utf8_bom
ret <- TIO.hGetContents h
return $
#ifdef WINDOWS
TL.filter ('\r'/=) ret
#else
ret
#endif
readFileQ :: FilePath -> Q String
readFileQ :: String -> Q String
readFileQ String
rawFp = do
fp <- String -> Q String
makeRelativeToProject String
rawFp
qRunIO (readUtf8FileString fp)
readFileRecompileQ :: FilePath -> Q String
readFileRecompileQ :: String -> Q String
readFileRecompileQ String
rawFp = do
fp <- String -> Q String
makeRelativeToProject String
rawFp
addDependentFile fp
qRunIO (readUtf8FileString fp)