{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ident] -> ShowS
$cshowList :: [Ident] -> ShowS
show :: Ident -> String
$cshow :: Ident -> String
showsPrec :: Int -> Ident -> ShowS
$cshowsPrec :: Int -> Ident -> ShowS
Show, Ident -> Ident -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ident -> Ident -> Bool
$c/= :: Ident -> Ident -> Bool
== :: Ident -> Ident -> Bool
$c== :: Ident -> Ident -> Bool
Eq, ReadPrec [Ident]
ReadPrec Ident
Int -> ReadS Ident
ReadS [Ident]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Ident]
$creadListPrec :: ReadPrec [Ident]
readPrec :: ReadPrec Ident
$creadPrec :: ReadPrec Ident
readList :: ReadS [Ident]
$creadList :: ReadS [Ident]
readsPrec :: Int -> ReadS Ident
$creadsPrec :: Int -> ReadS Ident
Read, Typeable Ident
Ident -> DataType
Ident -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ident -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ident -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Ident -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Ident -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
gmapT :: (forall b. Data b => b -> b) -> Ident -> Ident
$cgmapT :: (forall b. Data b => b -> b) -> Ident -> Ident
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ident)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ident)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ident)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ident)
dataTypeOf :: Ident -> DataType
$cdataTypeOf :: Ident -> DataType
toConstr :: Ident -> Constr
$ctoConstr :: Ident -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ident
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ident
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident -> c Ident
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident -> c Ident
Data, Typeable, Eq 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
min :: Ident -> Ident -> Ident
$cmin :: Ident -> Ident -> Ident
max :: Ident -> Ident -> Ident
$cmax :: Ident -> Ident -> Ident
>= :: Ident -> Ident -> Bool
$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
compare :: Ident -> Ident -> Ordering
$ccompare :: Ident -> Ident -> Ordering
Ord, 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
liftTyped :: forall (m :: * -> *). Quote m => Ident -> Code m Ident
$cliftTyped :: forall (m :: * -> *). Quote m => Ident -> Code m Ident
lift :: forall (m :: * -> *). Quote m => Ident -> m Exp
$clift :: forall (m :: * -> *). Quote m => Ident -> m Exp
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Deref] -> ShowS
$cshowList :: [Deref] -> ShowS
show :: Deref -> String
$cshow :: Deref -> String
showsPrec :: Int -> Deref -> ShowS
$cshowsPrec :: Int -> Deref -> ShowS
Show, Deref -> Deref -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Deref -> Deref -> Bool
$c/= :: Deref -> Deref -> Bool
== :: Deref -> Deref -> Bool
$c== :: Deref -> Deref -> Bool
Eq, ReadPrec [Deref]
ReadPrec Deref
Int -> ReadS Deref
ReadS [Deref]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Deref]
$creadListPrec :: ReadPrec [Deref]
readPrec :: ReadPrec Deref
$creadPrec :: ReadPrec Deref
readList :: ReadS [Deref]
$creadList :: ReadS [Deref]
readsPrec :: Int -> ReadS Deref
$creadsPrec :: Int -> ReadS Deref
Read, Typeable Deref
Deref -> DataType
Deref -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Deref -> m Deref
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Deref -> m Deref
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Deref -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Deref -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Deref -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Deref -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Deref -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Deref -> r
gmapT :: (forall b. Data b => b -> b) -> Deref -> Deref
$cgmapT :: (forall b. Data b => b -> b) -> Deref -> Deref
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Deref)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Deref)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Deref)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Deref)
dataTypeOf :: Deref -> DataType
$cdataTypeOf :: Deref -> DataType
toConstr :: Deref -> Constr
$ctoConstr :: Deref -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Deref
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Deref
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Deref -> c Deref
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Deref -> c Deref
Data, Typeable, Eq 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
min :: Deref -> Deref -> Deref
$cmin :: Deref -> Deref -> Deref
max :: Deref -> Deref -> Deref
$cmax :: Deref -> Deref -> Deref
>= :: Deref -> Deref -> Bool
$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
compare :: Deref -> Deref -> Ordering
$ccompare :: Deref -> Deref -> Ordering
Ord, 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
liftTyped :: forall (m :: * -> *). Quote m => Deref -> Code m Deref
$cliftTyped :: forall (m :: * -> *). Quote m => Deref -> Code m Deref
lift :: forall (m :: * -> *). Quote m => Deref -> m Exp
$clift :: forall (m :: * -> *). Quote m => Deref -> m Exp
Lift)
derefParens, derefCurlyBrackets :: UserParser a Deref
derefParens :: forall a. UserParser a Deref
derefParens = 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 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(') (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')') forall a. UserParser a Deref
parseDeref
derefCurlyBrackets :: forall a. UserParser a Deref
derefCurlyBrackets = 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 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{') (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}') forall a. UserParser a Deref
parseDeref
derefList, derefTuple :: UserParser a Deref
derefList :: forall a. UserParser a Deref
derefList = 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 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[') (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']') (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Deref] -> Deref
DerefList forall a b. (a -> b) -> a -> b
$ 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 forall a. UserParser a Deref
parseDeref (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','))
derefTuple :: forall a. UserParser a Deref
derefTuple = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
[Deref]
x <- 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]
sepBy1 forall a. UserParser a Deref
parseDeref (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Deref]
x forall a. Ord a => a -> a -> Bool
< Int
2) forall a b. (a -> b) -> a -> b
$ forall tok st a. GenParser tok st a
pzero
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Deref] -> Deref
DerefTuple [Deref]
x
parseDeref :: UserParser a Deref
parseDeref :: forall a. UserParser a Deref
parseDeref = do
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t")
forall a. UserParser a Deref
derefList forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. UserParser a Deref
derefTuple forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. UserParser a Deref
derefOther
where
derefOther :: ParsecT String u Identity Deref
derefOther = do
Deref
x <- forall a. UserParser a Deref
derefSingle
forall {st}. Deref -> GenParser Char st Deref
derefInfix Deref
x forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {st}. Deref -> GenParser Char st Deref
derefPrefix Deref
x
delim :: ParsecT String u Identity ()
delim = (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return())
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"(\"" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ())
derefOp :: GenParser Char st Deref
derefOp = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
String
x <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
" \t\n\r()"
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ident -> Deref
DerefIdent forall a b. (a -> b) -> a -> b
$ String -> Ident
Ident String
x
isOperatorChar :: Char -> Bool
isOperatorChar Char
c
| Char -> Bool
isAscii Char
c = Char
c 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
Deref
res <- forall {t :: * -> *} {u}.
Foldable t =>
([Deref] -> t Deref) -> ParsecT String u Identity Deref
deref' forall a b. (a -> b) -> a -> b
$ (:) Deref
x
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t"
forall (m :: * -> *) a. Monad m => a -> m a
return Deref
res
derefInfix :: Deref -> GenParser Char st Deref
derefInfix Deref
x = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do
()
_ <- forall {u}. ParsecT String u Identity ()
delim
[Deref]
xs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall a. UserParser a Deref
derefSingle forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Deref
x' -> forall {u}. ParsecT String u Identity ()
delim forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Deref
x'
String
op <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isOperatorChar) forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"operator"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
op forall a. Eq a => a -> a -> Bool
== String
"$") forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"don't handle $"
let op' :: Deref
op' = Ident -> Deref
DerefIdent forall a b. (a -> b) -> a -> b
$ String -> Ident
Ident String
op
[Deref]
ys <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall {u}. ParsecT String u Identity ()
delim forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. UserParser a Deref
derefSingle
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Deref -> Deref -> Deref
DerefBranch (Deref -> Deref -> Deref
DerefBranch Deref
op' forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Deref -> Deref -> Deref
DerefBranch forall a b. (a -> b) -> a -> b
$ Deref
x forall a. a -> [a] -> [a]
: [Deref]
xs) (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Deref -> Deref -> Deref
DerefBranch [Deref]
ys)
derefSingle :: ParsecT String u Identity Deref
derefSingle = do
Deref
x <- forall a. UserParser a Deref
derefTuple forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. UserParser a Deref
derefList forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. UserParser a Deref
derefOp forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. UserParser a Deref
derefParens forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. UserParser a Deref
numeric forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. UserParser a Deref
strLit forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. UserParser a Deref
ident
[String]
fields <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall {u}. ParsecT String u Identity String
recordDot
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Deref -> String -> Deref
DerefGetField Deref
x [String]
fields
recordDot :: ParsecT String u Identity String
recordDot = do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
Char
x <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
lower forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'
String
xs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'')
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char
x forall a. a -> [a] -> [a]
: String
xs)
deref' :: ([Deref] -> t Deref) -> ParsecT String u Identity Deref
deref' [Deref] -> t Deref
lhs =
forall a. UserParser a Deref
dollar 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'
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Deref -> Deref -> Deref
DerefBranch forall a b. (a -> b) -> a -> b
$ [Deref] -> t Deref
lhs [])
where
dollar :: ParsecT String st Identity Deref
dollar = do
Char
_ <- forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall {u}. ParsecT String u Identity ()
delim forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$'
Deref
rhs <- forall a. UserParser a Deref
parseDeref
let lhs' :: Deref
lhs' = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Deref -> Deref -> Deref
DerefBranch forall a b. (a -> b) -> a -> b
$ [Deref] -> t Deref
lhs []
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Deref -> Deref -> Deref
DerefBranch Deref
lhs' Deref
rhs
derefSingle' :: ParsecT String u Identity Deref
derefSingle' = do
Deref
x <- forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall {u}. ParsecT String u Identity ()
delim forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. UserParser a Deref
derefSingle
([Deref] -> t Deref) -> ParsecT String u Identity Deref
deref' forall a b. (a -> b) -> a -> b
$ [Deref] -> t Deref
lhs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Deref
x
numeric :: ParsecT String u Identity Deref
numeric = do
String
n <- (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return String
"-") forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return String
""
String
x <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
Maybe String
y <- (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit)) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe String
y of
Maybe String
Nothing -> Integer -> Deref
DerefIntegral forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> String -> a
read' String
"Integral" forall a b. (a -> b) -> a -> b
$ String
n forall a. [a] -> [a] -> [a]
++ String
x
Just String
z -> Rational -> Deref
DerefRational forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational
(forall a. Read a => String -> String -> a
read' String
"Rational" forall a b. (a -> b) -> a -> b
$ String
n forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ Char
'.' forall a. a -> [a] -> [a]
: String
z :: Double)
strLit :: ParsecT String u Identity Deref
strLit = do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
String
chars <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall {u}. ParsecT String u Identity Char
quotedChar
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Deref
DerefString String
chars
quotedChar :: ParsecT String u Identity Char
quotedChar = (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {u}. ParsecT String u Identity Char
escapedChar) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> 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 forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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
[String]
mods <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall {u}. ParsecT String u Identity String
modul
String
func <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'')
let func' :: Ident
func' = String -> Ident
Ident String
func
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
mods
then Ident -> Deref
DerefIdent Ident
func'
else [String] -> Ident -> Deref
DerefModulesIdent [String]
mods Ident
func'
modul :: GenParser Char st String
modul = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do
Char
c <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
upper
String
cs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_')
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char
c forall a. a -> [a] -> [a]
: String
cs
read' :: Read a => String -> String -> a
read' :: forall a. Read a => String -> String -> a
read' String
t String
s =
case forall a. Read a => ReadS a
reads String
s of
(a
x, String
_):[(a, String)]
_ -> a
x
[] -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
t forall a. [a] -> [a] -> [a]
++ String
" read failed: " 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 forall a. Eq a => a -> a -> Bool
== Char
':' then Name -> Exp
ConE else Name -> Exp
VarE
expType (Ident String
"") = 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 forall a b. (a -> b) -> a -> b
$ OccName -> NameFlavour -> Name
Name (String -> OccName
mkOccName String
s) (ModName -> NameFlavour
NameQ forall a b. (a -> b) -> a -> b
$ String -> ModName
mkModName forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String]
mods)
derefToExp Scope
scope (DerefIdent i :: Ident
i@(Ident String
s)) =
case 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 forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
s
derefToExp Scope
_ (DerefIntegral Integer
i) = Lit -> Exp
LitE forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL Integer
i
derefToExp Scope
_ (DerefRational Rational
r) = Lit -> Exp
LitE forall a b. (a -> b) -> a -> b
$ Rational -> Lit
RationalL Rational
r
derefToExp Scope
_ (DerefString String
s) = Lit -> Exp
LitE forall a b. (a -> b) -> a -> b
$ String -> Lit
StringL String
s
derefToExp Scope
s (DerefList [Deref]
ds) = [Exp] -> Exp
ListE forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$
#if MIN_VERSION_template_haskell(2,16,0)
forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
#endif
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)) = forall a. a -> Maybe a
Just [String
x]
flattenDeref (DerefBranch (DerefIdent (Ident String
x)) Deref
y) = do
[String]
y' <- Deref -> Maybe [String]
flattenDeref Deref
y
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [String]
y' forall a. [a] -> [a] -> [a]
++ [String
x]
flattenDeref Deref
_ = forall a. Maybe a
Nothing
parseHash :: UserParser a (Either String Deref)
parseHash :: forall a. UserParser a (Either String Deref)
parseHash = 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
_<- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
String
var <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"}"
Char
_<- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Char
'{'forall a. a -> [a] -> [a]
:String
var) forall a. [a] -> [a] -> [a]
++ String
"}"
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
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
(forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left [Char
c])) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do
Deref
deref <- forall a. UserParser a Deref
derefCurlyBrackets
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Deref
deref) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do
()
_ <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"\r\n" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
""
) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left [Char
c])
parseAt :: UserParser a (Either String (Deref, Bool))
parseAt :: forall a. UserParser a (Either String (Deref, Bool))
parseAt = 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
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
(forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left [Char
c])) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do
Bool
x <- (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
d forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
(do
Deref
deref <- forall a. UserParser a Deref
derefCurlyBrackets
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Deref
deref, Bool
x))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ if Bool
x then [Char
c, Char
d] else [Char
c]))
parseInterpolatedString :: Char -> UserParser a (Either String String)
parseInterpolatedString :: forall a. Char -> UserParser a (Either String String)
parseInterpolatedString Char
c = do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
(forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left [Char
'\\', Char
c])) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do
String
bracketed <- forall {u}. ParsecT String u Identity String
curlyBrackets
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Char
cforall a. a -> [a] -> [a]
:String
bracketed)) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left [Char
c])
parseVarString :: Char -> UserParser a (Either String String)
parseVarString :: forall a. Char -> UserParser a (Either String String)
parseVarString = 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
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
(forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left [Char
c, Char
'\\'])) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do
String
ds <- (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
d forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return [Char
d]) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return []
(do String
bracketed <- forall {u}. ParsecT String u Identity String
curlyBrackets
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Char
cforall a. a -> [a] -> [a]
:String
ds forall a. [a] -> [a] -> [a]
++ String
bracketed))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Char
cforall a. a -> [a] -> [a]
:String
ds)))
parseIntString :: Char -> UserParser a (Either String String)
parseIntString :: forall a. Char -> UserParser a (Either String String)
parseIntString = forall a. Char -> UserParser a (Either String String)
parseInterpolatedString
parseCaret :: UserParser a (Either String Deref)
parseCaret :: forall a. UserParser a (Either String Deref)
parseCaret = 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
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
(forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left [Char
c, Char
'{'])) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do
Deref
deref <- forall a. UserParser a Deref
derefCurlyBrackets
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Deref
deref) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left [Char
c])
parseUnder :: UserParser a (Either String Deref)
parseUnder :: forall a. UserParser a (Either String Deref)
parseUnder = do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'
(forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left String
"_")) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do
Deref
deref <- forall a. UserParser a Deref
derefCurlyBrackets
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Deref
deref) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left String
"_")
readUtf8FileString :: FilePath -> IO String
readUtf8FileString :: String -> IO String
readUtf8FileString String
fp = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
TL.unpack 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
Handle
h <- String -> IOMode -> IO Handle
SIO.openFile String
fp IOMode
SIO.ReadMode
Handle -> TextEncoding -> IO ()
SIO.hSetEncoding Handle
h TextEncoding
SIO.utf8_bom
Text
ret <- Handle -> IO Text
TIO.hGetContents Handle
h
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
#ifdef WINDOWS
TL.filter ('\r'/=) ret
#else
Text
ret
#endif
readFileQ :: FilePath -> Q String
readFileQ :: String -> Q String
readFileQ String
rawFp = do
String
fp <- String -> Q String
makeRelativeToProject String
rawFp
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (String -> IO String
readUtf8FileString String
fp)
readFileRecompileQ :: FilePath -> Q String
readFileRecompileQ :: String -> Q String
readFileRecompileQ String
rawFp = do
String
fp <- String -> Q String
makeRelativeToProject String
rawFp
String -> Q ()
addDependentFile String
fp
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (String -> IO String
readUtf8FileString String
fp)