{-# LANGUAGE CPP #-}
module Data.Text.Template
(
Template,
Context,
ContextA,
template,
templateSafe,
render,
substitute,
showTemplate,
renderA,
substituteA,
) where
import Control.Applicative (Applicative(pure), (<$>))
import Control.Monad (liftM, liftM2, replicateM_)
import Control.Monad.State.Strict (State, evalState, get, put)
import Data.Char (isAlphaNum, isLower)
import Data.Function (on)
import Data.Maybe (fromJust, isJust)
import Data.Traversable (traverse)
import Prelude hiding (takeWhile)
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
newtype Template = Template [Frag]
instance Eq Template where
== :: Template -> Template -> Bool
(==) = Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool)
-> (Template -> Text) -> Template -> Template -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Template -> Text
showTemplate
instance Show Template where
show :: Template -> String
show = Text -> String
T.unpack (Text -> String) -> (Template -> Text) -> Template -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template -> Text
showTemplate
showTemplate :: Template -> T.Text
showTemplate :: Template -> Text
showTemplate (Template [Frag]
fs) = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Frag -> Text) -> [Frag] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Frag -> Text
showFrag [Frag]
fs
data Frag = Lit {-# UNPACK #-} !T.Text | Var {-# UNPACK #-} !T.Text !Bool
instance Show Frag where
show :: Frag -> String
show = Text -> String
T.unpack (Text -> String) -> (Frag -> Text) -> Frag -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frag -> Text
showFrag
showFrag :: Frag -> T.Text
showFrag :: Frag -> Text
showFrag (Var Text
s Bool
b)
| Bool
b = [Text] -> Text
T.concat [String -> Text
T.pack String
"${", Text
s, String -> Text
T.pack String
"}"]
| Bool
otherwise = [Text] -> Text
T.concat [String -> Text
T.pack String
"$", Text
s]
showFrag (Lit Text
s) = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escape Text
s
where escape :: Char -> Text
escape Char
'$' = String -> Text
T.pack String
"$$"
escape Char
c = Char -> Text
T.singleton Char
c
type Context = T.Text -> T.Text
type ContextA f = T.Text -> f T.Text
template :: T.Text -> Template
template :: Text -> Template
template = [Frag] -> Template
templateFromFrags ([Frag] -> Template) -> (Text -> [Frag]) -> Text -> Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser [Frag] -> Text -> [Frag]
forall a. Parser a -> Text -> a
runParser Parser [Frag]
pFrags
templateSafe :: T.Text -> Either (Int, Int) Template
templateSafe :: Text -> Either (Int, Int) Template
templateSafe =
((Int, Int) -> Either (Int, Int) Template)
-> ([Frag] -> Either (Int, Int) Template)
-> Either (Int, Int) [Frag]
-> Either (Int, Int) Template
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Int, Int) -> Either (Int, Int) Template
forall a b. a -> Either a b
Left (Template -> Either (Int, Int) Template
forall a b. b -> Either a b
Right (Template -> Either (Int, Int) Template)
-> ([Frag] -> Template) -> [Frag] -> Either (Int, Int) Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Frag] -> Template
templateFromFrags) (Either (Int, Int) [Frag] -> Either (Int, Int) Template)
-> (Text -> Either (Int, Int) [Frag])
-> Text
-> Either (Int, Int) Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Either (Int, Int) [Frag])
-> Text -> Either (Int, Int) [Frag]
forall a. Parser a -> Text -> a
runParser Parser (Either (Int, Int) [Frag])
pFragsSafe
templateFromFrags :: [Frag] -> Template
templateFromFrags :: [Frag] -> Template
templateFromFrags = [Frag] -> Template
Template ([Frag] -> Template) -> ([Frag] -> [Frag]) -> [Frag] -> Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Frag] -> [Frag]
combineLits
combineLits :: [Frag] -> [Frag]
combineLits :: [Frag] -> [Frag]
combineLits [] = []
combineLits [Frag]
xs =
let ([Frag]
lits,[Frag]
xs') = (Frag -> Bool) -> [Frag] -> ([Frag], [Frag])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Frag -> Bool
isLit [Frag]
xs
in case [Frag]
lits of
[] -> [Frag] -> [Frag]
gatherVars [Frag]
xs'
[Frag
lit] -> Frag
lit Frag -> [Frag] -> [Frag]
forall a. a -> [a] -> [a]
: [Frag] -> [Frag]
gatherVars [Frag]
xs'
[Frag]
_ -> Text -> Frag
Lit ([Text] -> Text
T.concat ((Frag -> Text) -> [Frag] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Frag -> Text
fromLit [Frag]
lits)) Frag -> [Frag] -> [Frag]
forall a. a -> [a] -> [a]
: [Frag] -> [Frag]
gatherVars [Frag]
xs'
where
gatherVars :: [Frag] -> [Frag]
gatherVars [] = []
gatherVars [Frag]
ys =
let ([Frag]
vars,[Frag]
ys') = (Frag -> Bool) -> [Frag] -> ([Frag], [Frag])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Frag -> Bool
isVar [Frag]
ys
in [Frag]
vars [Frag] -> [Frag] -> [Frag]
forall a. [a] -> [a] -> [a]
++ [Frag] -> [Frag]
combineLits [Frag]
ys'
isLit :: Frag -> Bool
isLit (Lit Text
_) = Bool
True
isLit Frag
_ = Bool
False
isVar :: Frag -> Bool
isVar = Bool -> Bool
not (Bool -> Bool) -> (Frag -> Bool) -> Frag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frag -> Bool
isLit
fromLit :: Frag -> Text
fromLit (Lit Text
v) = Text
v
fromLit Frag
_ = Text
forall a. HasCallStack => a
undefined
render :: Template -> Context -> LT.Text
render :: Template -> (Text -> Text) -> Text
render (Template [Frag]
frags) Text -> Text
ctxFunc = [Text] -> Text
LT.fromChunks ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Frag -> Text) -> [Frag] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Frag -> Text
renderFrag [Frag]
frags
where
renderFrag :: Frag -> Text
renderFrag (Lit Text
s) = Text
s
renderFrag (Var Text
x Bool
_) = Text -> Text
ctxFunc Text
x
renderA :: Applicative f => Template -> ContextA f -> f LT.Text
renderA :: forall (f :: * -> *).
Applicative f =>
Template -> ContextA f -> f Text
renderA (Template [Frag]
frags) ContextA f
ctxFunc = [Text] -> Text
LT.fromChunks ([Text] -> Text) -> f [Text] -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Frag -> f Text) -> [Frag] -> f [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Frag -> f Text
renderFrag [Frag]
frags
where
renderFrag :: Frag -> f Text
renderFrag (Lit Text
s) = ContextA f
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
renderFrag (Var Text
x Bool
_) = ContextA f
ctxFunc Text
x
substitute :: T.Text -> Context -> LT.Text
substitute :: Text -> (Text -> Text) -> Text
substitute = Template -> (Text -> Text) -> Text
render (Template -> (Text -> Text) -> Text)
-> (Text -> Template) -> Text -> (Text -> Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Template
template
substituteA :: Applicative f => T.Text -> ContextA f -> f LT.Text
substituteA :: forall (f :: * -> *). Applicative f => Text -> ContextA f -> f Text
substituteA = Template -> ContextA f -> f Text
forall (f :: * -> *).
Applicative f =>
Template -> ContextA f -> f Text
renderA (Template -> ContextA f -> f Text)
-> (Text -> Template) -> Text -> ContextA f -> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Template
template
pFrags :: Parser [Frag]
pFrags :: Parser [Frag]
pFrags = do
Maybe Char
c <- Parser (Maybe Char)
peek
case Maybe Char
c of
Maybe Char
Nothing -> [Frag] -> Parser [Frag]
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just Char
'$' -> do Maybe Char
c' <- Parser (Maybe Char)
peekSnd
case Maybe Char
c' of
Just Char
'$' -> do Int -> Parser ()
discard Int
2
StateT S Identity Frag -> Parser [Frag]
continue (Frag -> StateT S Identity Frag
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Frag -> StateT S Identity Frag) -> Frag -> StateT S Identity Frag
forall a b. (a -> b) -> a -> b
$ Text -> Frag
Lit (Text -> Frag) -> Text -> Frag
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"$")
Maybe Char
_ -> StateT S Identity Frag -> Parser [Frag]
continue StateT S Identity Frag
pVar
Maybe Char
_ -> StateT S Identity Frag -> Parser [Frag]
continue StateT S Identity Frag
pLit
where
continue :: StateT S Identity Frag -> Parser [Frag]
continue StateT S Identity Frag
x = (Frag -> [Frag] -> [Frag])
-> StateT S Identity Frag -> Parser [Frag] -> Parser [Frag]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) StateT S Identity Frag
x Parser [Frag]
pFrags
pFragsSafe :: Parser (Either (Int, Int) [Frag])
pFragsSafe :: Parser (Either (Int, Int) [Frag])
pFragsSafe = [Frag] -> Parser (Either (Int, Int) [Frag])
pFragsSafe' []
where
pFragsSafe' :: [Frag] -> Parser (Either (Int, Int) [Frag])
pFragsSafe' [Frag]
frags = do
Maybe Char
c <- Parser (Maybe Char)
peek
case Maybe Char
c of
Maybe Char
Nothing -> Either (Int, Int) [Frag] -> Parser (Either (Int, Int) [Frag])
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Int, Int) [Frag] -> Parser (Either (Int, Int) [Frag]))
-> ([Frag] -> Either (Int, Int) [Frag])
-> [Frag]
-> Parser (Either (Int, Int) [Frag])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Frag] -> Either (Int, Int) [Frag]
forall a b. b -> Either a b
Right ([Frag] -> Either (Int, Int) [Frag])
-> ([Frag] -> [Frag]) -> [Frag] -> Either (Int, Int) [Frag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Frag] -> [Frag]
forall a. [a] -> [a]
reverse ([Frag] -> Parser (Either (Int, Int) [Frag]))
-> [Frag] -> Parser (Either (Int, Int) [Frag])
forall a b. (a -> b) -> a -> b
$ [Frag]
frags
Just Char
'$' -> do Maybe Char
c' <- Parser (Maybe Char)
peekSnd
case Maybe Char
c' of
Just Char
'$' -> do Int -> Parser ()
discard Int
2
Frag -> Parser (Either (Int, Int) [Frag])
continue (Text -> Frag
Lit (Text -> Frag) -> Text -> Frag
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"$")
Maybe Char
_ -> do Either (Int, Int) Frag
e <- Parser (Either (Int, Int) Frag)
pVarSafe
((Int, Int) -> Parser (Either (Int, Int) [Frag]))
-> (Frag -> Parser (Either (Int, Int) [Frag]))
-> Either (Int, Int) Frag
-> Parser (Either (Int, Int) [Frag])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Int, Int) -> Parser (Either (Int, Int) [Frag])
forall {a} {b}. a -> StateT S Identity (Either a b)
abort Frag -> Parser (Either (Int, Int) [Frag])
continue Either (Int, Int) Frag
e
Maybe Char
_ -> do Frag
l <- StateT S Identity Frag
pLit
Frag -> Parser (Either (Int, Int) [Frag])
continue Frag
l
where
continue :: Frag -> Parser (Either (Int, Int) [Frag])
continue Frag
x = [Frag] -> Parser (Either (Int, Int) [Frag])
pFragsSafe' (Frag
x Frag -> [Frag] -> [Frag]
forall a. a -> [a] -> [a]
: [Frag]
frags)
abort :: a -> StateT S Identity (Either a b)
abort = Either a b -> StateT S Identity (Either a b)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> StateT S Identity (Either a b))
-> (a -> Either a b) -> a -> StateT S Identity (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left
pVar :: Parser Frag
pVar :: StateT S Identity Frag
pVar = do
Int -> Parser ()
discard Int
1
Maybe Char
c <- Parser (Maybe Char)
peek
case Maybe Char
c of
Just Char
'{' -> do Int -> Parser ()
discard Int
1
Text
v <- Parser Text
pIdentifier
Maybe Char
c' <- Parser (Maybe Char)
peek
case Maybe Char
c' of
Just Char
'}' -> do Int -> Parser ()
discard Int
1
Frag -> StateT S Identity Frag
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Frag -> StateT S Identity Frag) -> Frag -> StateT S Identity Frag
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Frag
Var Text
v Bool
True
Maybe Char
_ -> ((Int, Int) -> Frag)
-> StateT S Identity (Int, Int) -> StateT S Identity Frag
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int, Int) -> Frag
forall a. (Int, Int) -> a
parseError StateT S Identity (Int, Int)
pos
Maybe Char
_ -> do Text
v <- Parser Text
pIdentifier
Frag -> StateT S Identity Frag
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Frag -> StateT S Identity Frag) -> Frag -> StateT S Identity Frag
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Frag
Var Text
v Bool
False
pVarSafe :: Parser (Either (Int, Int) Frag)
pVarSafe :: Parser (Either (Int, Int) Frag)
pVarSafe = do
Int -> Parser ()
discard Int
1
Maybe Char
c <- Parser (Maybe Char)
peek
case Maybe Char
c of
Just Char
'{' -> do Int -> Parser ()
discard Int
1
Either (Int, Int) Text
e <- Parser (Either (Int, Int) Text)
pIdentifierSafe
case Either (Int, Int) Text
e of
Right Text
v -> do Maybe Char
c' <- Parser (Maybe Char)
peek
case Maybe Char
c' of
Just Char
'}' -> do Int -> Parser ()
discard Int
1
Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag))
-> Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag)
forall a b. (a -> b) -> a -> b
$ Frag -> Either (Int, Int) Frag
forall a b. b -> Either a b
Right (Text -> Bool -> Frag
Var Text
v Bool
True)
Maybe Char
_ -> ((Int, Int) -> Either (Int, Int) Frag)
-> StateT S Identity (Int, Int) -> Parser (Either (Int, Int) Frag)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int, Int) -> Either (Int, Int) Frag
forall a. (Int, Int) -> Either (Int, Int) a
parseErrorSafe StateT S Identity (Int, Int)
pos
Left (Int, Int)
m -> Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag))
-> Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag)
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Either (Int, Int) Frag
forall a b. a -> Either a b
Left (Int, Int)
m
Maybe Char
_ -> do Either (Int, Int) Text
e <- Parser (Either (Int, Int) Text)
pIdentifierSafe
Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag))
-> Either (Int, Int) Frag -> Parser (Either (Int, Int) Frag)
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Either (Int, Int) Frag)
-> (Text -> Either (Int, Int) Frag)
-> Either (Int, Int) Text
-> Either (Int, Int) Frag
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Int, Int) -> Either (Int, Int) Frag
forall a b. a -> Either a b
Left (\Text
v -> Frag -> Either (Int, Int) Frag
forall a b. b -> Either a b
Right (Frag -> Either (Int, Int) Frag) -> Frag -> Either (Int, Int) Frag
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Frag
Var Text
v Bool
False) Either (Int, Int) Text
e
pIdentifier :: Parser T.Text
pIdentifier :: Parser Text
pIdentifier = do
Maybe Char
m <- Parser (Maybe Char)
peek
if Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust Maybe Char
m Bool -> Bool -> Bool
&& Char -> Bool
isIdentifier0 (Maybe Char -> Char
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Char
m)
then (Char -> Bool) -> Parser Text
takeWhile Char -> Bool
isIdentifier1
else ((Int, Int) -> Text) -> StateT S Identity (Int, Int) -> Parser Text
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int, Int) -> Text
forall a. (Int, Int) -> a
parseError StateT S Identity (Int, Int)
pos
pIdentifierSafe :: Parser (Either (Int, Int) T.Text)
pIdentifierSafe :: Parser (Either (Int, Int) Text)
pIdentifierSafe = do
Maybe Char
m <- Parser (Maybe Char)
peek
if Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust Maybe Char
m Bool -> Bool -> Bool
&& Char -> Bool
isIdentifier0 (Maybe Char -> Char
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Char
m)
then (Text -> Either (Int, Int) Text)
-> Parser Text -> Parser (Either (Int, Int) Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Text -> Either (Int, Int) Text
forall a b. b -> Either a b
Right ((Char -> Bool) -> Parser Text
takeWhile Char -> Bool
isIdentifier1)
else ((Int, Int) -> Either (Int, Int) Text)
-> StateT S Identity (Int, Int) -> Parser (Either (Int, Int) Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int, Int) -> Either (Int, Int) Text
forall a. (Int, Int) -> Either (Int, Int) a
parseErrorSafe StateT S Identity (Int, Int)
pos
pLit :: Parser Frag
pLit :: StateT S Identity Frag
pLit = do
Text
s <- (Char -> Bool) -> Parser Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'$')
Frag -> StateT S Identity Frag
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Frag -> StateT S Identity Frag) -> Frag -> StateT S Identity Frag
forall a b. (a -> b) -> a -> b
$ Text -> Frag
Lit Text
s
isIdentifier0 :: Char -> Bool
isIdentifier0 :: Char -> Bool
isIdentifier0 Char
c = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Char -> Bool
isLower Char
c, Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_']
isIdentifier1 :: Char -> Bool
isIdentifier1 :: Char -> Bool
isIdentifier1 Char
c = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Char -> Bool
isAlphaNum 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
"_'"]
parseError :: (Int, Int) -> a
parseError :: forall a. (Int, Int) -> a
parseError = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> ((Int, Int) -> String) -> (Int, Int) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> String
makeParseErrorMessage
parseErrorSafe :: (Int, Int) -> Either (Int, Int) a
parseErrorSafe :: forall a. (Int, Int) -> Either (Int, Int) a
parseErrorSafe = (Int, Int) -> Either (Int, Int) a
forall a b. a -> Either a b
Left
makeParseErrorMessage :: (Int, Int) -> String
makeParseErrorMessage :: (Int, Int) -> String
makeParseErrorMessage (Int
row, Int
col) =
String
"Invalid placeholder at " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"row " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
row String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", col " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
col
data S = S {-# UNPACK #-} !T.Text
{-# UNPACK #-} !Int
{-# UNPACK #-} !Int
type Parser = State S
char :: Parser (Maybe Char)
char :: Parser (Maybe Char)
char = do
S Text
s Int
row Int
col <- StateT S Identity S
forall s (m :: * -> *). MonadState s m => m s
get
if Text -> Bool
T.null Text
s
then Maybe Char -> Parser (Maybe Char)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
forall a. Maybe a
Nothing
else do Char
c <- Char -> StateT S Identity Char
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> StateT S Identity Char) -> Char -> StateT S Identity Char
forall a b. (a -> b) -> a -> b
$! HasCallStack => Text -> Char
Text -> Char
T.head Text
s
case Char
c of
Char
'\n' -> S -> Parser ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (S -> Parser ()) -> S -> Parser ()
forall a b. (a -> b) -> a -> b
$! Text -> Int -> Int -> S
S (HasCallStack => Text -> Text
Text -> Text
T.tail Text
s) (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
1
Char
_ -> S -> Parser ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (S -> Parser ()) -> S -> Parser ()
forall a b. (a -> b) -> a -> b
$! Text -> Int -> Int -> S
S (HasCallStack => Text -> Text
Text -> Text
T.tail Text
s) Int
row (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Maybe Char -> Parser (Maybe Char)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Char -> Parser (Maybe Char))
-> Maybe Char -> Parser (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
peek :: Parser (Maybe Char)
peek :: Parser (Maybe Char)
peek = do
S
s <- StateT S Identity S
forall s (m :: * -> *). MonadState s m => m s
get
Maybe Char
c <- Parser (Maybe Char)
char
S -> Parser ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put S
s
Maybe Char -> Parser (Maybe Char)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
c
peekSnd :: Parser (Maybe Char)
peekSnd :: Parser (Maybe Char)
peekSnd = do
S
s <- StateT S Identity S
forall s (m :: * -> *). MonadState s m => m s
get
Maybe Char
_ <- Parser (Maybe Char)
char
Maybe Char
c <- Parser (Maybe Char)
char
S -> Parser ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put S
s
Maybe Char -> Parser (Maybe Char)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
c
takeWhile :: (Char -> Bool) -> Parser T.Text
takeWhile :: (Char -> Bool) -> Parser Text
takeWhile Char -> Bool
p = do
S Text
s Int
row Int
col <- StateT S Identity S
forall s (m :: * -> *). MonadState s m => m s
get
#if MIN_VERSION_text(0,11,0)
case (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
p Text
s of
#else
case T.spanBy p s of
#endif
(Text
x, Text
s') -> do
let xlines :: [Text]
xlines = Text -> [Text]
T.lines Text
x
row' :: Int
row' = Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
xlines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
col' :: Int
col' = case [Text]
xlines of
[] -> Int
col
[Text
sameLine] -> Text -> Int
T.length Text
sameLine
[Text]
_ -> Text -> Int
T.length ([Text] -> Text
forall a. HasCallStack => [a] -> a
last [Text]
xlines)
S -> Parser ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (S -> Parser ()) -> S -> Parser ()
forall a b. (a -> b) -> a -> b
$! Text -> Int -> Int -> S
S Text
s' Int
row' Int
col'
Text -> Parser Text
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
discard :: Int -> Parser ()
discard :: Int -> Parser ()
discard Int
n = Int -> Parser (Maybe Char) -> Parser ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n Parser (Maybe Char)
char
pos :: Parser (Int, Int)
pos :: StateT S Identity (Int, Int)
pos = do
S Text
_ Int
row Int
col <- StateT S Identity S
forall s (m :: * -> *). MonadState s m => m s
get
(Int, Int) -> StateT S Identity (Int, Int)
forall a. a -> StateT S Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
row, Int
col)
runParser :: Parser a -> T.Text -> a
runParser :: forall a. Parser a -> Text -> a
runParser Parser a
p Text
s = Parser a -> S -> a
forall s a. State s a -> s -> a
evalState Parser a
p (S -> a) -> S -> a
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Int -> S
S Text
s Int
1 Int
0