{-# LANGUAGE CPP #-}
module Cheapskate.ParserCombinators (
Position(..)
, Parser
, parse
, (<?>)
, satisfy
, peekChar
, peekLastChar
, notAfter
, inClass
, notInClass
, endOfInput
, char
, anyChar
, getPosition
, setPosition
, takeWhile
, takeTill
, takeWhile1
, takeText
, skip
, skipWhile
, string
, scan
, lookAhead
, notFollowedBy
, option
, many1
, manyTill
, skipMany
, skipMany1
, count
) where
import Prelude hiding (takeWhile)
import Data.Text (Text)
import qualified Data.Text as T
import Control.Monad
import qualified Control.Monad.Fail as Fail
import Control.Applicative
import qualified Data.Set as Set
data Position = Position { Position -> Int
line :: Int, Position -> Int
column :: Int }
deriving (Eq Position
Eq Position =>
(Position -> Position -> Ordering)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Position)
-> (Position -> Position -> Position)
-> Ord Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
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 :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c< :: Position -> Position -> Bool
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
$cp1Ord :: Eq Position
Ord, Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: Position -> Position -> Bool
Eq)
instance Show Position where
show :: Position -> String
show (Position ln :: Int
ln cn :: Int
cn) = "line " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ln String -> ShowS
forall a. [a] -> [a] -> [a]
++ " column " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
cn
data ParseError = ParseError Position String deriving Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
(Int -> ParseError -> ShowS)
-> (ParseError -> String)
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseError] -> ShowS
$cshowList :: [ParseError] -> ShowS
show :: ParseError -> String
$cshow :: ParseError -> String
showsPrec :: Int -> ParseError -> ShowS
$cshowsPrec :: Int -> ParseError -> ShowS
Show
data ParserState = ParserState { ParserState -> Text
subject :: Text
, ParserState -> Position
position :: Position
, ParserState -> Maybe Char
lastChar :: Maybe Char
}
advance :: ParserState -> Text -> ParserState
advance :: ParserState -> Text -> ParserState
advance = (ParserState -> Char -> ParserState)
-> ParserState -> Text -> ParserState
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' ParserState -> Char -> ParserState
go
where go :: ParserState -> Char -> ParserState
go :: ParserState -> Char -> ParserState
go st :: ParserState
st c :: Char
c = ParserState
st{ subject :: Text
subject = Int -> Text -> Text
T.drop 1 (ParserState -> Text
subject ParserState
st)
, position :: Position
position = case Char
c of
'\n' -> Position :: Int -> Int -> Position
Position { line :: Int
line =
Position -> Int
line (ParserState -> Position
position ParserState
st) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
, column :: Int
column = 1 }
_ -> Position :: Int -> Int -> Position
Position { line :: Int
line =
Position -> Int
line (ParserState -> Position
position ParserState
st)
, column :: Int
column =
Position -> Int
column (ParserState -> Position
position ParserState
st) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
}
, lastChar :: Maybe Char
lastChar = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c }
newtype Parser a = Parser {
Parser a -> ParserState -> Either ParseError (ParserState, a)
evalParser :: ParserState -> Either ParseError (ParserState, a)
}
instance Functor Parser where
fmap :: (a -> b) -> Parser a -> Parser b
fmap f :: a -> b
f (Parser g :: ParserState -> Either ParseError (ParserState, a)
g) = (ParserState -> Either ParseError (ParserState, b)) -> Parser b
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, b)) -> Parser b)
-> (ParserState -> Either ParseError (ParserState, b)) -> Parser b
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st ->
case ParserState -> Either ParseError (ParserState, a)
g ParserState
st of
Right (st' :: ParserState
st', x :: a
x) -> (ParserState, b) -> Either ParseError (ParserState, b)
forall a b. b -> Either a b
Right (ParserState
st', a -> b
f a
x)
Left e :: ParseError
e -> ParseError -> Either ParseError (ParserState, b)
forall a b. a -> Either a b
Left ParseError
e
{-# INLINE fmap #-}
instance Applicative Parser where
pure :: a -> Parser a
pure x :: a
x = (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, a)) -> Parser a)
-> (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st -> (ParserState, a) -> Either ParseError (ParserState, a)
forall a b. b -> Either a b
Right (ParserState
st, a
x)
(Parser f :: ParserState -> Either ParseError (ParserState, a -> b)
f) <*> :: Parser (a -> b) -> Parser a -> Parser b
<*> (Parser g :: ParserState -> Either ParseError (ParserState, a)
g) = (ParserState -> Either ParseError (ParserState, b)) -> Parser b
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, b)) -> Parser b)
-> (ParserState -> Either ParseError (ParserState, b)) -> Parser b
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st ->
case ParserState -> Either ParseError (ParserState, a -> b)
f ParserState
st of
Left e :: ParseError
e -> ParseError -> Either ParseError (ParserState, b)
forall a b. a -> Either a b
Left ParseError
e
Right (st' :: ParserState
st', h :: a -> b
h) -> case ParserState -> Either ParseError (ParserState, a)
g ParserState
st' of
Right (st'' :: ParserState
st'', x :: a
x) -> (ParserState, b) -> Either ParseError (ParserState, b)
forall a b. b -> Either a b
Right (ParserState
st'', a -> b
h a
x)
Left e :: ParseError
e -> ParseError -> Either ParseError (ParserState, b)
forall a b. a -> Either a b
Left ParseError
e
{-# INLINE pure #-}
{-# INLINE (<*>) #-}
instance Alternative Parser where
empty :: Parser a
empty = (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, a)) -> Parser a)
-> (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st -> ParseError -> Either ParseError (ParserState, a)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (ParserState, a))
-> ParseError -> Either ParseError (ParserState, a)
forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseError
ParseError (ParserState -> Position
position ParserState
st) "(empty)"
(Parser f :: ParserState -> Either ParseError (ParserState, a)
f) <|> :: Parser a -> Parser a -> Parser a
<|> (Parser g :: ParserState -> Either ParseError (ParserState, a)
g) = (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, a)) -> Parser a)
-> (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st ->
case ParserState -> Either ParseError (ParserState, a)
f ParserState
st of
Right res :: (ParserState, a)
res -> (ParserState, a) -> Either ParseError (ParserState, a)
forall a b. b -> Either a b
Right (ParserState, a)
res
Left (ParseError pos :: Position
pos msg :: String
msg) ->
case ParserState -> Either ParseError (ParserState, a)
g ParserState
st of
Right res :: (ParserState, a)
res -> (ParserState, a) -> Either ParseError (ParserState, a)
forall a b. b -> Either a b
Right (ParserState, a)
res
Left (ParseError pos' :: Position
pos' msg' :: String
msg') -> ParseError -> Either ParseError (ParserState, a)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (ParserState, a))
-> ParseError -> Either ParseError (ParserState, a)
forall a b. (a -> b) -> a -> b
$
case () of
_ | Position
pos' Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
> Position
pos -> Position -> String -> ParseError
ParseError Position
pos' String
msg'
| Position
pos' Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< Position
pos -> Position -> String -> ParseError
ParseError Position
pos String
msg
| Bool
otherwise
-> Position -> String -> ParseError
ParseError Position
pos (String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ " or " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg')
{-# INLINE empty #-}
{-# INLINE (<|>) #-}
instance Fail.MonadFail Parser where
fail :: String -> Parser a
fail e :: String
e = (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, a)) -> Parser a)
-> (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st -> ParseError -> Either ParseError (ParserState, a)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (ParserState, a))
-> ParseError -> Either ParseError (ParserState, a)
forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseError
ParseError (ParserState -> Position
position ParserState
st) String
e
instance Monad Parser where
return :: a -> Parser a
return x :: a
x = (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, a)) -> Parser a)
-> (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st -> (ParserState, a) -> Either ParseError (ParserState, a)
forall a b. b -> Either a b
Right (ParserState
st, a
x)
#if !MIN_VERSION_base(4,13,0)
fail = Fail.fail
#endif
p :: Parser a
p >>= :: Parser a -> (a -> Parser b) -> Parser b
>>= g :: a -> Parser b
g = (ParserState -> Either ParseError (ParserState, b)) -> Parser b
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, b)) -> Parser b)
-> (ParserState -> Either ParseError (ParserState, b)) -> Parser b
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st ->
case Parser a -> ParserState -> Either ParseError (ParserState, a)
forall a.
Parser a -> ParserState -> Either ParseError (ParserState, a)
evalParser Parser a
p ParserState
st of
Left e :: ParseError
e -> ParseError -> Either ParseError (ParserState, b)
forall a b. a -> Either a b
Left ParseError
e
Right (st' :: ParserState
st',x :: a
x) -> Parser b -> ParserState -> Either ParseError (ParserState, b)
forall a.
Parser a -> ParserState -> Either ParseError (ParserState, a)
evalParser (a -> Parser b
g a
x) ParserState
st'
{-# INLINE return #-}
{-# INLINE (>>=) #-}
instance MonadPlus Parser where
mzero :: Parser a
mzero = (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, a)) -> Parser a)
-> (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st -> ParseError -> Either ParseError (ParserState, a)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (ParserState, a))
-> ParseError -> Either ParseError (ParserState, a)
forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseError
ParseError (ParserState -> Position
position ParserState
st) "(mzero)"
mplus :: Parser a -> Parser a -> Parser a
mplus p1 :: Parser a
p1 p2 :: Parser a
p2 = (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, a)) -> Parser a)
-> (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st ->
case Parser a -> ParserState -> Either ParseError (ParserState, a)
forall a.
Parser a -> ParserState -> Either ParseError (ParserState, a)
evalParser Parser a
p1 ParserState
st of
Right res :: (ParserState, a)
res -> (ParserState, a) -> Either ParseError (ParserState, a)
forall a b. b -> Either a b
Right (ParserState, a)
res
Left _ -> Parser a -> ParserState -> Either ParseError (ParserState, a)
forall a.
Parser a -> ParserState -> Either ParseError (ParserState, a)
evalParser Parser a
p2 ParserState
st
{-# INLINE mzero #-}
{-# INLINE mplus #-}
(<?>) :: Parser a -> String -> Parser a
p :: Parser a
p <?> :: Parser a -> String -> Parser a
<?> msg :: String
msg = (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, a)) -> Parser a)
-> (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st ->
let startpos :: Position
startpos = ParserState -> Position
position ParserState
st in
case Parser a -> ParserState -> Either ParseError (ParserState, a)
forall a.
Parser a -> ParserState -> Either ParseError (ParserState, a)
evalParser Parser a
p ParserState
st of
Left (ParseError _ _) ->
ParseError -> Either ParseError (ParserState, a)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (ParserState, a))
-> ParseError -> Either ParseError (ParserState, a)
forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseError
ParseError Position
startpos String
msg
Right r :: (ParserState, a)
r -> (ParserState, a) -> Either ParseError (ParserState, a)
forall a b. b -> Either a b
Right (ParserState, a)
r
{-# INLINE (<?>) #-}
infixl 5 <?>
parse :: Parser a -> Text -> Either ParseError a
parse :: Parser a -> Text -> Either ParseError a
parse p :: Parser a
p t :: Text
t =
((ParserState, a) -> a)
-> Either ParseError (ParserState, a) -> Either ParseError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParserState, a) -> a
forall a b. (a, b) -> b
snd (Either ParseError (ParserState, a) -> Either ParseError a)
-> Either ParseError (ParserState, a) -> Either ParseError a
forall a b. (a -> b) -> a -> b
$ Parser a -> ParserState -> Either ParseError (ParserState, a)
forall a.
Parser a -> ParserState -> Either ParseError (ParserState, a)
evalParser Parser a
p ParserState :: Text -> Position -> Maybe Char -> ParserState
ParserState{ subject :: Text
subject = Text
t
, position :: Position
position = Int -> Int -> Position
Position 1 1
, lastChar :: Maybe Char
lastChar = Maybe Char
forall a. Maybe a
Nothing }
failure :: ParserState -> String -> Either ParseError (ParserState, a)
failure :: ParserState -> String -> Either ParseError (ParserState, a)
failure st :: ParserState
st msg :: String
msg = ParseError -> Either ParseError (ParserState, a)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (ParserState, a))
-> ParseError -> Either ParseError (ParserState, a)
forall a b. (a -> b) -> a -> b
$ Position -> String -> ParseError
ParseError (ParserState -> Position
position ParserState
st) String
msg
{-# INLINE failure #-}
success :: ParserState -> a -> Either ParseError (ParserState, a)
success :: ParserState -> a -> Either ParseError (ParserState, a)
success st :: ParserState
st x :: a
x = (ParserState, a) -> Either ParseError (ParserState, a)
forall a b. b -> Either a b
Right (ParserState
st, a
x)
{-# INLINE success #-}
satisfy :: (Char -> Bool) -> Parser Char
satisfy :: (Char -> Bool) -> Parser Char
satisfy f :: Char -> Bool
f = (ParserState -> Either ParseError (ParserState, Char))
-> Parser Char
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ParserState -> Either ParseError (ParserState, Char)
g
where g :: ParserState -> Either ParseError (ParserState, Char)
g st :: ParserState
st = case Text -> Maybe (Char, Text)
T.uncons (ParserState -> Text
subject ParserState
st) of
Just (c :: Char
c, _) | Char -> Bool
f Char
c ->
ParserState -> Char -> Either ParseError (ParserState, Char)
forall a. ParserState -> a -> Either ParseError (ParserState, a)
success (ParserState -> Text -> ParserState
advance ParserState
st (Char -> Text
T.singleton Char
c)) Char
c
_ -> ParserState -> String -> Either ParseError (ParserState, Char)
forall a.
ParserState -> String -> Either ParseError (ParserState, a)
failure ParserState
st "character meeting condition"
{-# INLINE satisfy #-}
peekChar :: Parser (Maybe Char)
peekChar :: Parser (Maybe Char)
peekChar = (ParserState -> Either ParseError (ParserState, Maybe Char))
-> Parser (Maybe Char)
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, Maybe Char))
-> Parser (Maybe Char))
-> (ParserState -> Either ParseError (ParserState, Maybe Char))
-> Parser (Maybe Char)
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st ->
case Text -> Maybe (Char, Text)
T.uncons (ParserState -> Text
subject ParserState
st) of
Just (c :: Char
c, _) -> ParserState
-> Maybe Char -> Either ParseError (ParserState, Maybe Char)
forall a. ParserState -> a -> Either ParseError (ParserState, a)
success ParserState
st (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c)
Nothing -> ParserState
-> Maybe Char -> Either ParseError (ParserState, Maybe Char)
forall a. ParserState -> a -> Either ParseError (ParserState, a)
success ParserState
st Maybe Char
forall a. Maybe a
Nothing
{-# INLINE peekChar #-}
peekLastChar :: Parser (Maybe Char)
peekLastChar :: Parser (Maybe Char)
peekLastChar = (ParserState -> Either ParseError (ParserState, Maybe Char))
-> Parser (Maybe Char)
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, Maybe Char))
-> Parser (Maybe Char))
-> (ParserState -> Either ParseError (ParserState, Maybe Char))
-> Parser (Maybe Char)
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st -> ParserState
-> Maybe Char -> Either ParseError (ParserState, Maybe Char)
forall a. ParserState -> a -> Either ParseError (ParserState, a)
success ParserState
st (ParserState -> Maybe Char
lastChar ParserState
st)
{-# INLINE peekLastChar #-}
notAfter :: (Char -> Bool) -> Parser ()
notAfter :: (Char -> Bool) -> Parser ()
notAfter f :: Char -> Bool
f = do
Maybe Char
mbc <- Parser (Maybe Char)
peekLastChar
case Maybe Char
mbc of
Nothing -> () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just c :: Char
c -> if Char -> Bool
f Char
c then Parser ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero else () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
charClass :: String -> Set.Set Char
charClass :: String -> Set Char
charClass = String -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList (String -> Set Char) -> ShowS -> String -> Set Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
go
where go :: ShowS
go (a :: Char
a:'-':b :: Char
b:xs :: String
xs) = [Char
a..Char
b] String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
go String
xs
go (x :: Char
x:xs :: String
xs) = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go String
xs
go _ = ""
{-# INLINE charClass #-}
inClass :: String -> Char -> Bool
inClass :: String -> Char -> Bool
inClass s :: String
s c :: Char
c = Char
c Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
s'
where s' :: Set Char
s' = String -> Set Char
charClass String
s
{-# INLINE inClass #-}
notInClass :: String -> Char -> Bool
notInClass :: String -> Char -> Bool
notInClass s :: String
s = Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char -> Bool
inClass String
s
{-# INLINE notInClass #-}
endOfInput :: Parser ()
endOfInput :: Parser ()
endOfInput = (ParserState -> Either ParseError (ParserState, ())) -> Parser ()
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, ())) -> Parser ())
-> (ParserState -> Either ParseError (ParserState, ()))
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st ->
if Text -> Bool
T.null (ParserState -> Text
subject ParserState
st)
then ParserState -> () -> Either ParseError (ParserState, ())
forall a. ParserState -> a -> Either ParseError (ParserState, a)
success ParserState
st ()
else ParserState -> String -> Either ParseError (ParserState, ())
forall a.
ParserState -> String -> Either ParseError (ParserState, a)
failure ParserState
st "end of input"
{-# INLINE endOfInput #-}
char :: Char -> Parser Char
char :: Char -> Parser Char
char c :: Char
c = (Char -> Bool) -> Parser Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)
{-# INLINE char #-}
anyChar :: Parser Char
anyChar :: Parser Char
anyChar = (Char -> Bool) -> Parser Char
satisfy (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)
{-# INLINE anyChar #-}
getPosition :: Parser Position
getPosition :: Parser Position
getPosition = (ParserState -> Either ParseError (ParserState, Position))
-> Parser Position
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, Position))
-> Parser Position)
-> (ParserState -> Either ParseError (ParserState, Position))
-> Parser Position
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st -> ParserState
-> Position -> Either ParseError (ParserState, Position)
forall a. ParserState -> a -> Either ParseError (ParserState, a)
success ParserState
st (ParserState -> Position
position ParserState
st)
{-# INLINE getPosition #-}
setPosition :: Position -> Parser ()
setPosition :: Position -> Parser ()
setPosition pos :: Position
pos = (ParserState -> Either ParseError (ParserState, ())) -> Parser ()
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, ())) -> Parser ())
-> (ParserState -> Either ParseError (ParserState, ()))
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st -> ParserState -> () -> Either ParseError (ParserState, ())
forall a. ParserState -> a -> Either ParseError (ParserState, a)
success ParserState
st{ position :: Position
position = Position
pos } ()
{-# INLINE setPosition #-}
takeWhile :: (Char -> Bool) -> Parser Text
takeWhile :: (Char -> Bool) -> Parser Text
takeWhile f :: Char -> Bool
f = (ParserState -> Either ParseError (ParserState, Text))
-> Parser Text
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, Text))
-> Parser Text)
-> (ParserState -> Either ParseError (ParserState, Text))
-> Parser Text
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st ->
let t :: Text
t = (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
f (ParserState -> Text
subject ParserState
st) in
ParserState -> Text -> Either ParseError (ParserState, Text)
forall a. ParserState -> a -> Either ParseError (ParserState, a)
success (ParserState -> Text -> ParserState
advance ParserState
st Text
t) Text
t
{-# INLINE takeWhile #-}
takeTill :: (Char -> Bool) -> Parser Text
takeTill :: (Char -> Bool) -> Parser Text
takeTill f :: Char -> Bool
f = (Char -> Bool) -> Parser Text
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
f)
{-# INLINE takeTill #-}
takeWhile1 :: (Char -> Bool) -> Parser Text
takeWhile1 :: (Char -> Bool) -> Parser Text
takeWhile1 f :: Char -> Bool
f = (ParserState -> Either ParseError (ParserState, Text))
-> Parser Text
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, Text))
-> Parser Text)
-> (ParserState -> Either ParseError (ParserState, Text))
-> Parser Text
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st ->
case (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
f (ParserState -> Text
subject ParserState
st) of
t :: Text
t | Text -> Bool
T.null Text
t -> ParserState -> String -> Either ParseError (ParserState, Text)
forall a.
ParserState -> String -> Either ParseError (ParserState, a)
failure ParserState
st "characters satisfying condition"
| Bool
otherwise -> ParserState -> Text -> Either ParseError (ParserState, Text)
forall a. ParserState -> a -> Either ParseError (ParserState, a)
success (ParserState -> Text -> ParserState
advance ParserState
st Text
t) Text
t
{-# INLINE takeWhile1 #-}
takeText :: Parser Text
takeText :: Parser Text
takeText = (ParserState -> Either ParseError (ParserState, Text))
-> Parser Text
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, Text))
-> Parser Text)
-> (ParserState -> Either ParseError (ParserState, Text))
-> Parser Text
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st ->
let t :: Text
t = ParserState -> Text
subject ParserState
st in
ParserState -> Text -> Either ParseError (ParserState, Text)
forall a. ParserState -> a -> Either ParseError (ParserState, a)
success (ParserState -> Text -> ParserState
advance ParserState
st Text
t) Text
t
{-# INLINE takeText #-}
skip :: (Char -> Bool) -> Parser ()
skip :: (Char -> Bool) -> Parser ()
skip f :: Char -> Bool
f = (ParserState -> Either ParseError (ParserState, ())) -> Parser ()
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, ())) -> Parser ())
-> (ParserState -> Either ParseError (ParserState, ()))
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st ->
case Text -> Maybe (Char, Text)
T.uncons (ParserState -> Text
subject ParserState
st) of
Just (c :: Char
c,_) | Char -> Bool
f Char
c -> ParserState -> () -> Either ParseError (ParserState, ())
forall a. ParserState -> a -> Either ParseError (ParserState, a)
success (ParserState -> Text -> ParserState
advance ParserState
st (Char -> Text
T.singleton Char
c)) ()
_ -> ParserState -> String -> Either ParseError (ParserState, ())
forall a.
ParserState -> String -> Either ParseError (ParserState, a)
failure ParserState
st "character satisfying condition"
{-# INLINE skip #-}
skipWhile :: (Char -> Bool) -> Parser ()
skipWhile :: (Char -> Bool) -> Parser ()
skipWhile f :: Char -> Bool
f = (ParserState -> Either ParseError (ParserState, ())) -> Parser ()
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, ())) -> Parser ())
-> (ParserState -> Either ParseError (ParserState, ()))
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st ->
let t' :: Text
t' = (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
f (ParserState -> Text
subject ParserState
st) in
ParserState -> () -> Either ParseError (ParserState, ())
forall a. ParserState -> a -> Either ParseError (ParserState, a)
success (ParserState -> Text -> ParserState
advance ParserState
st Text
t') ()
{-# INLINE skipWhile #-}
string :: Text -> Parser Text
string :: Text -> Parser Text
string s :: Text
s = (ParserState -> Either ParseError (ParserState, Text))
-> Parser Text
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, Text))
-> Parser Text)
-> (ParserState -> Either ParseError (ParserState, Text))
-> Parser Text
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st ->
if Text
s Text -> Text -> Bool
`T.isPrefixOf` (ParserState -> Text
subject ParserState
st)
then ParserState -> Text -> Either ParseError (ParserState, Text)
forall a. ParserState -> a -> Either ParseError (ParserState, a)
success (ParserState -> Text -> ParserState
advance ParserState
st Text
s) Text
s
else ParserState -> String -> Either ParseError (ParserState, Text)
forall a.
ParserState -> String -> Either ParseError (ParserState, a)
failure ParserState
st "string"
{-# INLINE string #-}
scan :: s -> (s -> Char -> Maybe s) -> Parser Text
scan :: s -> (s -> Char -> Maybe s) -> Parser Text
scan s0 :: s
s0 f :: s -> Char -> Maybe s
f = (ParserState -> Either ParseError (ParserState, Text))
-> Parser Text
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, Text))
-> Parser Text)
-> (ParserState -> Either ParseError (ParserState, Text))
-> Parser Text
forall a b. (a -> b) -> a -> b
$ s -> String -> ParserState -> Either ParseError (ParserState, Text)
go s
s0 []
where go :: s -> String -> ParserState -> Either ParseError (ParserState, Text)
go s :: s
s cs :: String
cs st :: ParserState
st =
case Text -> Maybe (Char, Text)
T.uncons (ParserState -> Text
subject ParserState
st) of
Nothing -> ParserState -> String -> Either ParseError (ParserState, Text)
finish ParserState
st String
cs
Just (c :: Char
c, _) -> case s -> Char -> Maybe s
f s
s Char
c of
Just s' :: s
s' -> s -> String -> ParserState -> Either ParseError (ParserState, Text)
go s
s' (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs)
(ParserState -> Text -> ParserState
advance ParserState
st (Char -> Text
T.singleton Char
c))
Nothing -> ParserState -> String -> Either ParseError (ParserState, Text)
finish ParserState
st String
cs
finish :: ParserState -> String -> Either ParseError (ParserState, Text)
finish st :: ParserState
st cs :: String
cs =
ParserState -> Text -> Either ParseError (ParserState, Text)
forall a. ParserState -> a -> Either ParseError (ParserState, a)
success ParserState
st (String -> Text
T.pack (ShowS
forall a. [a] -> [a]
reverse String
cs))
{-# INLINE scan #-}
lookAhead :: Parser a -> Parser a
lookAhead :: Parser a -> Parser a
lookAhead p :: Parser a
p = (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, a)) -> Parser a)
-> (ParserState -> Either ParseError (ParserState, a)) -> Parser a
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st ->
case Parser a -> ParserState -> Either ParseError (ParserState, a)
forall a.
Parser a -> ParserState -> Either ParseError (ParserState, a)
evalParser Parser a
p ParserState
st of
Right (_,x :: a
x) -> ParserState -> a -> Either ParseError (ParserState, a)
forall a. ParserState -> a -> Either ParseError (ParserState, a)
success ParserState
st a
x
Left _ -> ParserState -> String -> Either ParseError (ParserState, a)
forall a.
ParserState -> String -> Either ParseError (ParserState, a)
failure ParserState
st "lookAhead"
{-# INLINE lookAhead #-}
notFollowedBy :: Parser a -> Parser ()
notFollowedBy :: Parser a -> Parser ()
notFollowedBy p :: Parser a
p = (ParserState -> Either ParseError (ParserState, ())) -> Parser ()
forall a.
(ParserState -> Either ParseError (ParserState, a)) -> Parser a
Parser ((ParserState -> Either ParseError (ParserState, ())) -> Parser ())
-> (ParserState -> Either ParseError (ParserState, ()))
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \st :: ParserState
st ->
case Parser a -> ParserState -> Either ParseError (ParserState, a)
forall a.
Parser a -> ParserState -> Either ParseError (ParserState, a)
evalParser Parser a
p ParserState
st of
Right (_,_) -> ParserState -> String -> Either ParseError (ParserState, ())
forall a.
ParserState -> String -> Either ParseError (ParserState, a)
failure ParserState
st "notFollowedBy"
Left _ -> ParserState -> () -> Either ParseError (ParserState, ())
forall a. ParserState -> a -> Either ParseError (ParserState, a)
success ParserState
st ()
{-# INLINE notFollowedBy #-}
option :: Alternative f => a -> f a -> f a
option :: a -> f a -> f a
option x :: a
x p :: f a
p = f a
p f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# INLINE option #-}
many1 :: Alternative f => f a -> f [a]
many1 :: f a -> f [a]
many1 p :: f a
p = (a -> [a] -> [a]) -> f a -> f [a] -> f [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) f a
p (f a -> f [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many f a
p)
{-# INLINE many1 #-}
manyTill :: Alternative f => f a -> f b -> f [a]
manyTill :: f a -> f b -> f [a]
manyTill p :: f a
p end :: f b
end = f [a]
go
where go :: f [a]
go = (f b
end f b -> f [a] -> f [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [a] -> f [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) f [a] -> f [a] -> f [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> [a] -> [a]) -> f a -> f [a] -> f [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) f a
p f [a]
go
{-# INLINE manyTill #-}
skipMany :: Alternative f => f a -> f ()
skipMany :: f a -> f ()
skipMany p :: f a
p = f ()
go
where go :: f ()
go = (f a
p f a -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
go) f () -> f () -> f ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE skipMany #-}
skipMany1 :: Alternative f => f a -> f ()
skipMany1 :: f a -> f ()
skipMany1 p :: f a
p = f a
p f a -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f a -> f ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany f a
p
{-# INLINE skipMany1 #-}
count :: Monad m => Int -> m a -> m [a]
count :: Int -> m a -> m [a]
count n :: Int
n p :: m a
p = [m a] -> m [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Int -> m a -> [m a]
forall a. Int -> a -> [a]
replicate Int
n m a
p)
{-# INLINE count #-}