{-# 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
$ccompare :: Position -> Position -> Ordering
compare :: Position -> Position -> Ordering
$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
>= :: Position -> Position -> Bool
$cmax :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
min :: Position -> Position -> Position
Ord, Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
/= :: Position -> Position -> Bool
Eq)
instance Show Position where
show :: Position -> String
show (Position Int
ln Int
cn) = String
"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]
++ String
" 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
$cshowsPrec :: Int -> ParseError -> ShowS
showsPrec :: Int -> ParseError -> ShowS
$cshow :: ParseError -> String
show :: ParseError -> String
$cshowList :: [ParseError] -> ShowS
showList :: [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 ParserState
st Char
c = ParserState
st{ subject :: Text
subject = Int -> Text -> Text
T.drop Int
1 (ParserState -> Text
subject ParserState
st)
, position :: Position
position = case Char
c of
Char
'\n' -> Position { line :: Int
line =
Position -> Int
line (ParserState -> Position
position ParserState
st) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
, column :: Int
column = Int
1 }
Char
_ -> 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
+ Int
1
}
, lastChar :: Maybe Char
lastChar = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c }
newtype Parser a = Parser {
forall a.
Parser a -> ParserState -> Either ParseError (ParserState, a)
evalParser :: ParserState -> Either ParseError (ParserState, a)
}
instance Functor Parser where
fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
f (Parser 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
$ \ParserState
st ->
case ParserState -> Either ParseError (ParserState, a)
g ParserState
st of
Right (ParserState
st', a
x) -> (ParserState, b) -> Either ParseError (ParserState, b)
forall a b. b -> Either a b
Right (ParserState
st', a -> b
f a
x)
Left ParseError
e -> ParseError -> Either ParseError (ParserState, b)
forall a b. a -> Either a b
Left ParseError
e
{-# INLINE fmap #-}
instance Applicative Parser where
pure :: forall a. a -> Parser a
pure 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
$ \ParserState
st -> (ParserState, a) -> Either ParseError (ParserState, a)
forall a b. b -> Either a b
Right (ParserState
st, a
x)
(Parser ParserState -> Either ParseError (ParserState, a -> b)
f) <*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
<*> (Parser 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
$ \ParserState
st ->
case ParserState -> Either ParseError (ParserState, a -> b)
f ParserState
st of
Left ParseError
e -> ParseError -> Either ParseError (ParserState, b)
forall a b. a -> Either a b
Left ParseError
e
Right (ParserState
st', a -> b
h) -> case ParserState -> Either ParseError (ParserState, a)
g ParserState
st' of
Right (ParserState
st'', a
x) -> (ParserState, b) -> Either ParseError (ParserState, b)
forall a b. b -> Either a b
Right (ParserState
st'', a -> b
h a
x)
Left 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 :: forall a. 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
$ \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
"(empty)"
(Parser ParserState -> Either ParseError (ParserState, a)
f) <|> :: forall a. Parser a -> Parser a -> Parser a
<|> (Parser 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
$ \ParserState
st ->
case ParserState -> Either ParseError (ParserState, a)
f ParserState
st of
Right (ParserState, a)
res -> (ParserState, a) -> Either ParseError (ParserState, a)
forall a b. b -> Either a b
Right (ParserState, a)
res
Left (ParseError Position
pos String
msg) ->
case ParserState -> Either ParseError (ParserState, a)
g ParserState
st of
Right (ParserState, a)
res -> (ParserState, a) -> Either ParseError (ParserState, a)
forall a b. b -> Either a b
Right (ParserState, a)
res
Left (ParseError Position
pos' 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]
++ String
" or " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg')
{-# INLINE empty #-}
{-# INLINE (<|>) #-}
instance Fail.MonadFail Parser where
fail :: forall a. String -> Parser a
fail 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
$ \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 :: forall a. a -> Parser a
return 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
$ \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
Parser a
p >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= 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
$ \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 ParseError
e -> ParseError -> Either ParseError (ParserState, b)
forall a b. a -> Either a b
Left ParseError
e
Right (ParserState
st',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 :: forall a. 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
$ \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
"(mzero)"
mplus :: forall a. Parser a -> Parser a -> Parser a
mplus Parser a
p1 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
$ \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 (ParserState, a)
res -> (ParserState, a) -> Either ParseError (ParserState, a)
forall a b. b -> Either a b
Right (ParserState, a)
res
Left ParseError
_ -> 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
Parser a
p <?> :: forall a. Parser a -> String -> Parser a
<?> 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
$ \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 Position
_ String
_) ->
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 (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 :: forall a. Parser a -> Text -> Either ParseError a
parse Parser a
p Text
t =
((ParserState, a) -> a)
-> Either ParseError (ParserState, a) -> Either ParseError a
forall a b. (a -> b) -> Either ParseError a -> Either ParseError b
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{ subject :: Text
subject = Text
t
, position :: Position
position = Int -> Int -> Position
Position Int
1 Int
1
, lastChar :: Maybe Char
lastChar = Maybe Char
forall a. Maybe a
Nothing }
failure :: ParserState -> String -> Either ParseError (ParserState, a)
failure :: forall a.
ParserState -> String -> Either ParseError (ParserState, a)
failure ParserState
st 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 :: forall a. ParserState -> a -> Either ParseError (ParserState, a)
success ParserState
st 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 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 ParserState
st = case Text -> Maybe (Char, Text)
T.uncons (ParserState -> Text
subject ParserState
st) of
Just (Char
c, Text
_) | 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
Maybe (Char, Text)
_ -> ParserState -> String -> Either ParseError (ParserState, Char)
forall a.
ParserState -> String -> Either ParseError (ParserState, a)
failure ParserState
st String
"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
$ \ParserState
st ->
case Text -> Maybe (Char, Text)
T.uncons (ParserState -> Text
subject ParserState
st) of
Just (Char
c, Text
_) -> 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)
Maybe (Char, Text)
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
$ \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 Char -> Bool
f = do
Maybe Char
mbc <- Parser (Maybe Char)
peekLastChar
case Maybe Char
mbc of
Maybe Char
Nothing -> () -> Parser ()
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Char
c -> if Char -> Bool
f Char
c then Parser ()
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero else () -> Parser ()
forall a. a -> Parser a
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 (Char
a:Char
'-':Char
b:String
xs) = [Char
a..Char
b] String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
go String
xs
go (Char
x:String
xs) = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go String
xs
go String
_ = String
""
{-# INLINE charClass #-}
inClass :: String -> Char -> Bool
inClass :: String -> Char -> Bool
inClass String
s 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 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
$ \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 String
"end of input"
{-# INLINE endOfInput #-}
char :: Char -> Parser Char
char :: Char -> Parser Char
char 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
$ \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 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
$ \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 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
$ \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 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 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
$ \ParserState
st ->
case (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
f (ParserState -> Text
subject ParserState
st) of
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 String
"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
$ \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 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
$ \ParserState
st ->
case Text -> Maybe (Char, Text)
T.uncons (ParserState -> Text
subject ParserState
st) of
Just (Char
c,Text
_) | 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)) ()
Maybe (Char, Text)
_ -> ParserState -> String -> Either ParseError (ParserState, ())
forall a.
ParserState -> String -> Either ParseError (ParserState, a)
failure ParserState
st String
"character satisfying condition"
{-# INLINE skip #-}
skipWhile :: (Char -> Bool) -> Parser ()
skipWhile :: (Char -> Bool) -> Parser ()
skipWhile 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
$ \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 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
$ \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
"string"
{-# INLINE string #-}
scan :: s -> (s -> Char -> Maybe s) -> Parser Text
scan :: forall s. s -> (s -> Char -> Maybe s) -> Parser Text
scan s
s0 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 String
cs ParserState
st =
case Text -> Maybe (Char, Text)
T.uncons (ParserState -> Text
subject ParserState
st) of
Maybe (Char, Text)
Nothing -> ParserState -> String -> Either ParseError (ParserState, Text)
finish ParserState
st String
cs
Just (Char
c, Text
_) -> case s -> Char -> Maybe s
f s
s Char
c of
Just 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))
Maybe s
Nothing -> ParserState -> String -> Either ParseError (ParserState, Text)
finish ParserState
st String
cs
finish :: ParserState -> String -> Either ParseError (ParserState, Text)
finish ParserState
st 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 :: forall a. Parser a -> Parser a
lookAhead 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
$ \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
_,a
x) -> ParserState -> a -> Either ParseError (ParserState, a)
forall a. ParserState -> a -> Either ParseError (ParserState, a)
success ParserState
st a
x
Left ParseError
_ -> ParserState -> String -> Either ParseError (ParserState, a)
forall a.
ParserState -> String -> Either ParseError (ParserState, a)
failure ParserState
st String
"lookAhead"
{-# INLINE lookAhead #-}
notFollowedBy :: Parser a -> Parser ()
notFollowedBy :: forall a. Parser a -> Parser ()
notFollowedBy 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
$ \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
_,a
_) -> ParserState -> String -> Either ParseError (ParserState, ())
forall a.
ParserState -> String -> Either ParseError (ParserState, a)
failure ParserState
st String
"notFollowedBy"
Left ParseError
_ -> 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 :: forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option a
x f a
p = f a
p f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> f a
forall 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 :: forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 f a
p = (a -> [a] -> [a]) -> f a -> f [a] -> f [a]
forall a b c. (a -> b -> c) -> f a -> f b -> f c
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 a. 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 :: forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill f a
p f b
end = f [a]
go
where go :: f [a]
go = (f b
end f b -> f [a] -> f [a]
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) f [a] -> f [a] -> f [a]
forall a. 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 a b c. (a -> b -> c) -> f a -> f b -> f c
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 :: forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany f a
p = f ()
go
where go :: f ()
go = (f a
p f a -> f () -> f ()
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
go) f () -> f () -> f ()
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE skipMany #-}
skipMany1 :: Alternative f => f a -> f ()
skipMany1 :: forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany1 f a
p = f a
p f a -> f () -> f ()
forall a b. f a -> f b -> f b
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 :: forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
n m a
p = [m a] -> m [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (Int -> m a -> [m a]
forall a. Int -> a -> [a]
replicate Int
n m a
p)
{-# INLINE count #-}