{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}

-- | Parsers for antiquoted Haskell expressions inside strings.
--
-- This module was largely copied from
-- https://github.com/tmhedberg/here/blob/8a616b358bcc16bd215a78a8f6192ad9df8224b6/src/Data/String/Here/Interpolated.hs
module Database.SQLite.Simple.QQ.Interpolated.Parser where

import Data.Char (isDigit, isLetter)
import Data.Functor (($>))
import Control.Monad (unless)
import Control.Monad.State (evalStateT, get, modify)
import Control.Monad.Trans (lift)
import Language.Haskell.Meta (parseExp)
import Language.Haskell.TH (Exp, Q)
import Text.Parsec ( ParseError, anyChar, between, char, eof, incSourceColumn
                   , getInput, lookAhead, manyTill, noneOf, parse, setInput, statePos
                   , string, try, updateParserState, (<|>)
                   )
import Text.Parsec.String (Parser)

data StringPart = Lit String | Esc Char | AntiInject String | AntiParam (Q Exp)

data HsChompState = HsChompState { HsChompState -> QuoteState
quoteState :: QuoteState
                                 , HsChompState -> Int
braceCt :: Int
                                 , HsChompState -> String
consumed :: String
                                 , HsChompState -> Bool
prevCharWasIdentChar :: Bool
                                 }

data QuoteState = None | Single EscapeState | Double EscapeState deriving (QuoteState -> QuoteState -> Bool
(QuoteState -> QuoteState -> Bool)
-> (QuoteState -> QuoteState -> Bool) -> Eq QuoteState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuoteState -> QuoteState -> Bool
$c/= :: QuoteState -> QuoteState -> Bool
== :: QuoteState -> QuoteState -> Bool
$c== :: QuoteState -> QuoteState -> Bool
Eq, Eq QuoteState
Eq QuoteState
-> (QuoteState -> QuoteState -> Ordering)
-> (QuoteState -> QuoteState -> Bool)
-> (QuoteState -> QuoteState -> Bool)
-> (QuoteState -> QuoteState -> Bool)
-> (QuoteState -> QuoteState -> Bool)
-> (QuoteState -> QuoteState -> QuoteState)
-> (QuoteState -> QuoteState -> QuoteState)
-> Ord QuoteState
QuoteState -> QuoteState -> Bool
QuoteState -> QuoteState -> Ordering
QuoteState -> QuoteState -> QuoteState
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 :: QuoteState -> QuoteState -> QuoteState
$cmin :: QuoteState -> QuoteState -> QuoteState
max :: QuoteState -> QuoteState -> QuoteState
$cmax :: QuoteState -> QuoteState -> QuoteState
>= :: QuoteState -> QuoteState -> Bool
$c>= :: QuoteState -> QuoteState -> Bool
> :: QuoteState -> QuoteState -> Bool
$c> :: QuoteState -> QuoteState -> Bool
<= :: QuoteState -> QuoteState -> Bool
$c<= :: QuoteState -> QuoteState -> Bool
< :: QuoteState -> QuoteState -> Bool
$c< :: QuoteState -> QuoteState -> Bool
compare :: QuoteState -> QuoteState -> Ordering
$ccompare :: QuoteState -> QuoteState -> Ordering
$cp1Ord :: Eq QuoteState
Ord, Int -> QuoteState -> ShowS
[QuoteState] -> ShowS
QuoteState -> String
(Int -> QuoteState -> ShowS)
-> (QuoteState -> String)
-> ([QuoteState] -> ShowS)
-> Show QuoteState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuoteState] -> ShowS
$cshowList :: [QuoteState] -> ShowS
show :: QuoteState -> String
$cshow :: QuoteState -> String
showsPrec :: Int -> QuoteState -> ShowS
$cshowsPrec :: Int -> QuoteState -> ShowS
Show)

data EscapeState = Escaped | Unescaped deriving (EscapeState
EscapeState -> EscapeState -> Bounded EscapeState
forall a. a -> a -> Bounded a
maxBound :: EscapeState
$cmaxBound :: EscapeState
minBound :: EscapeState
$cminBound :: EscapeState
Bounded, Int -> EscapeState
EscapeState -> Int
EscapeState -> [EscapeState]
EscapeState -> EscapeState
EscapeState -> EscapeState -> [EscapeState]
EscapeState -> EscapeState -> EscapeState -> [EscapeState]
(EscapeState -> EscapeState)
-> (EscapeState -> EscapeState)
-> (Int -> EscapeState)
-> (EscapeState -> Int)
-> (EscapeState -> [EscapeState])
-> (EscapeState -> EscapeState -> [EscapeState])
-> (EscapeState -> EscapeState -> [EscapeState])
-> (EscapeState -> EscapeState -> EscapeState -> [EscapeState])
-> Enum EscapeState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EscapeState -> EscapeState -> EscapeState -> [EscapeState]
$cenumFromThenTo :: EscapeState -> EscapeState -> EscapeState -> [EscapeState]
enumFromTo :: EscapeState -> EscapeState -> [EscapeState]
$cenumFromTo :: EscapeState -> EscapeState -> [EscapeState]
enumFromThen :: EscapeState -> EscapeState -> [EscapeState]
$cenumFromThen :: EscapeState -> EscapeState -> [EscapeState]
enumFrom :: EscapeState -> [EscapeState]
$cenumFrom :: EscapeState -> [EscapeState]
fromEnum :: EscapeState -> Int
$cfromEnum :: EscapeState -> Int
toEnum :: Int -> EscapeState
$ctoEnum :: Int -> EscapeState
pred :: EscapeState -> EscapeState
$cpred :: EscapeState -> EscapeState
succ :: EscapeState -> EscapeState
$csucc :: EscapeState -> EscapeState
Enum, EscapeState -> EscapeState -> Bool
(EscapeState -> EscapeState -> Bool)
-> (EscapeState -> EscapeState -> Bool) -> Eq EscapeState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EscapeState -> EscapeState -> Bool
$c/= :: EscapeState -> EscapeState -> Bool
== :: EscapeState -> EscapeState -> Bool
$c== :: EscapeState -> EscapeState -> Bool
Eq, Eq EscapeState
Eq EscapeState
-> (EscapeState -> EscapeState -> Ordering)
-> (EscapeState -> EscapeState -> Bool)
-> (EscapeState -> EscapeState -> Bool)
-> (EscapeState -> EscapeState -> Bool)
-> (EscapeState -> EscapeState -> Bool)
-> (EscapeState -> EscapeState -> EscapeState)
-> (EscapeState -> EscapeState -> EscapeState)
-> Ord EscapeState
EscapeState -> EscapeState -> Bool
EscapeState -> EscapeState -> Ordering
EscapeState -> EscapeState -> EscapeState
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 :: EscapeState -> EscapeState -> EscapeState
$cmin :: EscapeState -> EscapeState -> EscapeState
max :: EscapeState -> EscapeState -> EscapeState
$cmax :: EscapeState -> EscapeState -> EscapeState
>= :: EscapeState -> EscapeState -> Bool
$c>= :: EscapeState -> EscapeState -> Bool
> :: EscapeState -> EscapeState -> Bool
$c> :: EscapeState -> EscapeState -> Bool
<= :: EscapeState -> EscapeState -> Bool
$c<= :: EscapeState -> EscapeState -> Bool
< :: EscapeState -> EscapeState -> Bool
$c< :: EscapeState -> EscapeState -> Bool
compare :: EscapeState -> EscapeState -> Ordering
$ccompare :: EscapeState -> EscapeState -> Ordering
$cp1Ord :: Eq EscapeState
Ord, Int -> EscapeState -> ShowS
[EscapeState] -> ShowS
EscapeState -> String
(Int -> EscapeState -> ShowS)
-> (EscapeState -> String)
-> ([EscapeState] -> ShowS)
-> Show EscapeState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EscapeState] -> ShowS
$cshowList :: [EscapeState] -> ShowS
show :: EscapeState -> String
$cshow :: EscapeState -> String
showsPrec :: Int -> EscapeState -> ShowS
$cshowsPrec :: Int -> EscapeState -> ShowS
Show)

parseInterpolated :: String -> Either ParseError [StringPart]
parseInterpolated :: String -> Either ParseError [StringPart]
parseInterpolated = Parsec String () [StringPart]
-> String -> String -> Either ParseError [StringPart]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () [StringPart]
pInterp String
""

pInterp :: Parser [StringPart]
pInterp :: Parsec String () [StringPart]
pInterp = ParsecT String () Identity StringPart
-> ParsecT String () Identity () -> Parsec String () [StringPart]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity StringPart
pStringPart ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof

pStringPart :: Parser StringPart
pStringPart :: ParsecT String () Identity StringPart
pStringPart = ParsecT String () Identity StringPart
pAntiInject ParsecT String () Identity StringPart
-> ParsecT String () Identity StringPart
-> ParsecT String () Identity StringPart
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity StringPart
pAntiParam ParsecT String () Identity StringPart
-> ParsecT String () Identity StringPart
-> ParsecT String () Identity StringPart
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity StringPart
pEsc ParsecT String () Identity StringPart
-> ParsecT String () Identity StringPart
-> ParsecT String () Identity StringPart
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity StringPart
pLit

pAntiInject :: Parser StringPart
pAntiInject :: ParsecT String () Identity StringPart
pAntiInject = String -> StringPart
AntiInject (String -> StringPart)
-> ParsecT String () Identity String
-> ParsecT String () Identity StringPart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
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 (ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String () Identity String
pAntiOpenInject) ParsecT String () Identity String
pAntiClose ParsecT String () Identity String
pAntiName

pAntiOpenInject :: Parser String
pAntiOpenInject :: ParsecT String () Identity String
pAntiOpenInject = String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"!{"

pAntiName :: Parser String
pAntiName :: ParsecT String () Identity String
pAntiName = ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT String () Identity String
pAntiClose)

pAntiParam :: Parser StringPart
pAntiParam :: ParsecT String () Identity StringPart
pAntiParam = Q Exp -> StringPart
AntiParam (Q Exp -> StringPart)
-> ParsecT String () Identity (Q Exp)
-> ParsecT String () Identity StringPart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity (Q Exp)
-> ParsecT String () Identity (Q Exp)
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 (ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String () Identity String
pAntiOpenParam) ParsecT String () Identity String
pAntiClose ParsecT String () Identity (Q Exp)
pAntiExpr

pAntiOpenParam :: Parser String
pAntiOpenParam :: ParsecT String () Identity String
pAntiOpenParam = String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"${"

pAntiExpr :: Parser (Q Exp)
pAntiExpr :: ParsecT String () Identity (Q Exp)
pAntiExpr = ParsecT String () Identity String
pUntilUnbalancedCloseBrace ParsecT String () Identity String
-> (String -> ParsecT String () Identity (Q Exp))
-> ParsecT String () Identity (Q Exp)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> ParsecT String () Identity (Q Exp))
-> (Exp -> ParsecT String () Identity (Q Exp))
-> Either String Exp
-> ParsecT String () Identity (Q Exp)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ParsecT String () Identity (Q Exp)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Q Exp -> ParsecT String () Identity (Q Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Q Exp -> ParsecT String () Identity (Q Exp))
-> (Exp -> Q Exp) -> Exp -> ParsecT String () Identity (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (Either String Exp -> ParsecT String () Identity (Q Exp))
-> (String -> Either String Exp)
-> String
-> ParsecT String () Identity (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Exp
parseExp

pAntiClose :: Parser String
pAntiClose :: ParsecT String () Identity String
pAntiClose = String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"}"

pUntilUnbalancedCloseBrace :: Parser String
pUntilUnbalancedCloseBrace :: ParsecT String () Identity String
pUntilUnbalancedCloseBrace = StateT HsChompState (ParsecT String () Identity) String
-> HsChompState -> ParsecT String () Identity String
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT HsChompState (ParsecT String () Identity) String
go (HsChompState -> ParsecT String () Identity String)
-> HsChompState -> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ QuoteState -> Int -> String -> Bool -> HsChompState
HsChompState QuoteState
None Int
0 String
"" Bool
False
  where
    go :: StateT HsChompState (ParsecT String () Identity) String
go = do
      Char
c <- ParsecT String () Identity Char
-> StateT HsChompState (ParsecT String () Identity) Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
      (HsChompState -> HsChompState)
-> StateT HsChompState (ParsecT String () Identity) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((HsChompState -> HsChompState)
 -> StateT HsChompState (ParsecT String () Identity) ())
-> (HsChompState -> HsChompState)
-> StateT HsChompState (ParsecT String () Identity) ()
forall a b. (a -> b) -> a -> b
$ \st :: HsChompState
st@HsChompState {String
consumed :: String
consumed :: HsChompState -> String
consumed} -> HsChompState
st {consumed :: String
consumed = Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
consumed}
      HsChompState{Bool
Int
String
QuoteState
prevCharWasIdentChar :: Bool
consumed :: String
braceCt :: Int
quoteState :: QuoteState
prevCharWasIdentChar :: HsChompState -> Bool
consumed :: HsChompState -> String
braceCt :: HsChompState -> Int
quoteState :: HsChompState -> QuoteState
..} <- StateT HsChompState (ParsecT String () Identity) HsChompState
forall s (m :: * -> *). MonadState s m => m s
get
      let next :: StateT HsChompState (ParsecT String () Identity) String
next = Char -> StateT HsChompState (ParsecT String () Identity) ()
forall (m :: * -> *). MonadState HsChompState m => Char -> m ()
setIdentifierCharState Char
c StateT HsChompState (ParsecT String () Identity) ()
-> StateT HsChompState (ParsecT String () Identity) String
-> StateT HsChompState (ParsecT String () Identity) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT HsChompState (ParsecT String () Identity) String
go
      case QuoteState
quoteState of
        QuoteState
None -> case Char
c of
          Char
'{' -> Int -> StateT HsChompState (ParsecT String () Identity) ()
forall (m :: * -> *). MonadState HsChompState m => Int -> m ()
incBraceCt Int
1 StateT HsChompState (ParsecT String () Identity) ()
-> StateT HsChompState (ParsecT String () Identity) String
-> StateT HsChompState (ParsecT String () Identity) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT HsChompState (ParsecT String () Identity) String
next
          Char
'}' | Int
braceCt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Int -> StateT HsChompState (ParsecT String () Identity) ()
forall (m :: * -> *). MonadState HsChompState m => Int -> m ()
incBraceCt (-Int
1) StateT HsChompState (ParsecT String () Identity) ()
-> StateT HsChompState (ParsecT String () Identity) String
-> StateT HsChompState (ParsecT String () Identity) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT HsChompState (ParsecT String () Identity) String
next
              | Bool
otherwise -> StateT HsChompState (ParsecT String () Identity) ()
forall u. StateT HsChompState (ParsecT String u Identity) ()
stepBack StateT HsChompState (ParsecT String () Identity) ()
-> String
-> StateT HsChompState (ParsecT String () Identity) String
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ShowS
forall a. [a] -> [a]
reverse (ShowS
forall a. [a] -> [a]
tail String
consumed)
          Char
'\'' -> Bool
-> StateT HsChompState (ParsecT String () Identity) ()
-> StateT HsChompState (ParsecT String () Identity) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
prevCharWasIdentChar (QuoteState -> StateT HsChompState (ParsecT String () Identity) ()
forall (m :: * -> *).
MonadState HsChompState m =>
QuoteState -> m ()
setQuoteState (QuoteState -> StateT HsChompState (ParsecT String () Identity) ())
-> QuoteState
-> StateT HsChompState (ParsecT String () Identity) ()
forall a b. (a -> b) -> a -> b
$ EscapeState -> QuoteState
Single EscapeState
Unescaped)
               StateT HsChompState (ParsecT String () Identity) ()
-> StateT HsChompState (ParsecT String () Identity) String
-> StateT HsChompState (ParsecT String () Identity) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT HsChompState (ParsecT String () Identity) String
next
          Char
'"' -> QuoteState -> StateT HsChompState (ParsecT String () Identity) ()
forall (m :: * -> *).
MonadState HsChompState m =>
QuoteState -> m ()
setQuoteState (EscapeState -> QuoteState
Double EscapeState
Unescaped) StateT HsChompState (ParsecT String () Identity) ()
-> StateT HsChompState (ParsecT String () Identity) String
-> StateT HsChompState (ParsecT String () Identity) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT HsChompState (ParsecT String () Identity) String
next
          Char
_ -> StateT HsChompState (ParsecT String () Identity) String
next
        Single EscapeState
Unescaped -> do case Char
c of Char
'\\' -> QuoteState -> StateT HsChompState (ParsecT String () Identity) ()
forall (m :: * -> *).
MonadState HsChompState m =>
QuoteState -> m ()
setQuoteState (EscapeState -> QuoteState
Single EscapeState
Escaped)
                                         Char
'\'' -> QuoteState -> StateT HsChompState (ParsecT String () Identity) ()
forall (m :: * -> *).
MonadState HsChompState m =>
QuoteState -> m ()
setQuoteState QuoteState
None
                                         Char
_ -> () -> StateT HsChompState (ParsecT String () Identity) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                               StateT HsChompState (ParsecT String () Identity) String
next
        Single EscapeState
Escaped -> QuoteState -> StateT HsChompState (ParsecT String () Identity) ()
forall (m :: * -> *).
MonadState HsChompState m =>
QuoteState -> m ()
setQuoteState (EscapeState -> QuoteState
Single EscapeState
Unescaped) StateT HsChompState (ParsecT String () Identity) ()
-> StateT HsChompState (ParsecT String () Identity) String
-> StateT HsChompState (ParsecT String () Identity) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT HsChompState (ParsecT String () Identity) String
next
        Double EscapeState
Unescaped -> do case Char
c of Char
'\\' -> QuoteState -> StateT HsChompState (ParsecT String () Identity) ()
forall (m :: * -> *).
MonadState HsChompState m =>
QuoteState -> m ()
setQuoteState (EscapeState -> QuoteState
Double EscapeState
Escaped)
                                         Char
'"' -> QuoteState -> StateT HsChompState (ParsecT String () Identity) ()
forall (m :: * -> *).
MonadState HsChompState m =>
QuoteState -> m ()
setQuoteState QuoteState
None
                                         Char
_ -> () -> StateT HsChompState (ParsecT String () Identity) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                               StateT HsChompState (ParsecT String () Identity) String
next
        Double EscapeState
Escaped -> QuoteState -> StateT HsChompState (ParsecT String () Identity) ()
forall (m :: * -> *).
MonadState HsChompState m =>
QuoteState -> m ()
setQuoteState (EscapeState -> QuoteState
Double EscapeState
Unescaped) StateT HsChompState (ParsecT String () Identity) ()
-> StateT HsChompState (ParsecT String () Identity) String
-> StateT HsChompState (ParsecT String () Identity) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT HsChompState (ParsecT String () Identity) String
next
    stepBack :: StateT HsChompState (ParsecT String u Identity) ()
stepBack = ParsecT String u Identity ()
-> StateT HsChompState (ParsecT String u Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT String u Identity ()
 -> StateT HsChompState (ParsecT String u Identity) ())
-> ParsecT String u Identity ()
-> StateT HsChompState (ParsecT String u Identity) ()
forall a b. (a -> b) -> a -> b
$
      (State String u -> State String u)
-> ParsecT String u Identity (State String u)
forall s u (m :: * -> *).
(State s u -> State s u) -> ParsecT s u m (State s u)
updateParserState
        (\State String u
s -> State String u
s {statePos :: SourcePos
statePos = SourcePos -> Int -> SourcePos
incSourceColumn (State String u -> SourcePos
forall s u. State s u -> SourcePos
statePos State String u
s) (-Int
1)})
        ParsecT String u Identity (State String u)
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String u Identity String
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
        ParsecT String u Identity String
-> (String -> ParsecT String u Identity ())
-> ParsecT String u Identity ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT String u Identity ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput (String -> ParsecT String u Identity ())
-> ShowS -> String -> ParsecT String u Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'}'Char -> ShowS
forall a. a -> [a] -> [a]
:)
    incBraceCt :: Int -> m ()
incBraceCt Int
n = (HsChompState -> HsChompState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((HsChompState -> HsChompState) -> m ())
-> (HsChompState -> HsChompState) -> m ()
forall a b. (a -> b) -> a -> b
$ \st :: HsChompState
st@HsChompState {Int
braceCt :: Int
braceCt :: HsChompState -> Int
braceCt} ->
      HsChompState
st {braceCt :: Int
braceCt = Int
braceCt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n}
    setQuoteState :: QuoteState -> m ()
setQuoteState QuoteState
qs = (HsChompState -> HsChompState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((HsChompState -> HsChompState) -> m ())
-> (HsChompState -> HsChompState) -> m ()
forall a b. (a -> b) -> a -> b
$ \HsChompState
st -> HsChompState
st {quoteState :: QuoteState
quoteState = QuoteState
qs}
    setIdentifierCharState :: Char -> m ()
setIdentifierCharState Char
c = (HsChompState -> HsChompState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((HsChompState -> HsChompState) -> m ())
-> (HsChompState -> HsChompState) -> m ()
forall a b. (a -> b) -> a -> b
$ \HsChompState
st ->
      HsChompState
st
        {prevCharWasIdentChar :: Bool
prevCharWasIdentChar = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Char -> Bool
isLetter Char
c, Char -> Bool
isDigit Char
c, Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_', Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'']}

pEsc :: Parser StringPart
pEsc :: ParsecT String () Identity StringPart
pEsc = Char -> StringPart
Esc (Char -> StringPart)
-> ParsecT String () Identity Char
-> ParsecT String () Identity StringPart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)

pLit :: Parser StringPart
pLit :: ParsecT String () Identity StringPart
pLit = (String -> StringPart)
-> ParsecT String () Identity String
-> ParsecT String () Identity StringPart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> StringPart
Lit (ParsecT String () Identity String
 -> ParsecT String () Identity StringPart)
-> ParsecT String () Identity String
-> ParsecT String () Identity StringPart
forall a b. (a -> b) -> a -> b
$
  ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String
-> ParsecT String () Identity String
forall u end.
ParsecT String u Identity end -> ParsecT String u Identity String
litCharTil (ParsecT String () Identity String
 -> ParsecT String () Identity String)
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String
 -> ParsecT String () Identity String)
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT String () Identity String
pAntiOpenInject ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT String () Identity String
pAntiOpenParam ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\"))
    ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity () -> ParsecT String () Identity String
forall u end.
ParsecT String u Identity end -> ParsecT String u Identity String
litCharTil ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  where litCharTil :: ParsecT String u Identity end -> ParsecT String u Identity String
litCharTil = ParsecT String u Identity Char
-> ParsecT String u Identity end
-> ParsecT String u Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (ParsecT String u Identity Char
 -> ParsecT String u Identity end
 -> ParsecT String u Identity String)
-> ParsecT String u Identity Char
-> ParsecT String u Identity end
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
'\\']