module Darcs.Patch.ReadMonads (ParserM, Darcs.Patch.ReadMonads.take,
parse, parseStrictly, char, int,
option, choice, skipSpace, skipWhile, string,
lexChar, lexString, lexEof, takeTillChar,
myLex', anyChar, endOfInput, takeTill,
checkConsumes,
linesStartingWith, linesStartingWithEndingWith) where
import Prelude ()
import Darcs.Prelude
import Darcs.Util.ByteString ( dropSpace, breakSpace, breakFirstPS,
readIntPS, breakLastPS )
import qualified Data.ByteString as B (null, drop, length, tail, empty,
ByteString)
import qualified Data.ByteString.Char8 as BC ( uncons, dropWhile, break
, splitAt, length, head )
import Control.Applicative ( Alternative(..) )
import Data.Foldable ( asum )
import Control.Monad ( MonadPlus(..) )
lexChar :: ParserM m => Char -> m ()
lexChar :: Char -> m ()
lexChar c :: Char
c = do
m ()
forall (m :: * -> *). ParserM m => m ()
skipSpace
Char -> m ()
forall (m :: * -> *). ParserM m => Char -> m ()
char Char
c
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
lexString :: ParserM m => B.ByteString -> m ()
lexString :: ByteString -> m ()
lexString str :: ByteString
str = (ByteString -> Maybe (ParserState ())) -> m ()
forall (m :: * -> *) a.
ParserM m =>
(ByteString -> Maybe (ParserState a)) -> m a
work
((ByteString -> Maybe (ParserState ())) -> m ())
-> (ByteString -> Maybe (ParserState ())) -> m ()
forall a b. (a -> b) -> a -> b
$ \s :: ByteString
s -> case ByteString -> Maybe (ParserState ByteString)
myLex ByteString
s of
Just (xs :: ByteString
xs :*: ys :: ByteString
ys) | ByteString
xs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
str -> ParserState () -> Maybe (ParserState ())
forall a. a -> Maybe a
Just (() () -> ByteString -> ParserState ()
forall a. a -> ByteString -> ParserState a
:*: ByteString
ys)
_ -> Maybe (ParserState ())
forall a. Maybe a
Nothing
string :: ParserM m => B.ByteString -> m ()
string :: ByteString -> m ()
string str :: ByteString
str = (ByteString -> Maybe (ParserState ())) -> m ()
forall (m :: * -> *) a.
ParserM m =>
(ByteString -> Maybe (ParserState a)) -> m a
work
((ByteString -> Maybe (ParserState ())) -> m ())
-> (ByteString -> Maybe (ParserState ())) -> m ()
forall a b. (a -> b) -> a -> b
$ \s :: ByteString
s -> case Int -> ByteString -> (ByteString, ByteString)
BC.splitAt (ByteString -> Int
BC.length ByteString
str) ByteString
s of
(h :: ByteString
h, t :: ByteString
t) | ByteString
h ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
str -> ParserState () -> Maybe (ParserState ())
forall a. a -> Maybe a
Just (() () -> ByteString -> ParserState ()
forall a. a -> ByteString -> ParserState a
:*: ByteString
t)
_ -> Maybe (ParserState ())
forall a. Maybe a
Nothing
lexEof :: ParserM m => m ()
lexEof :: m ()
lexEof = (ByteString -> Maybe (ParserState ())) -> m ()
forall (m :: * -> *) a.
ParserM m =>
(ByteString -> Maybe (ParserState a)) -> m a
work
((ByteString -> Maybe (ParserState ())) -> m ())
-> (ByteString -> Maybe (ParserState ())) -> m ()
forall a b. (a -> b) -> a -> b
$ \s :: ByteString
s -> if ByteString -> Bool
B.null (ByteString -> ByteString
dropSpace ByteString
s)
then ParserState () -> Maybe (ParserState ())
forall a. a -> Maybe a
Just (() () -> ByteString -> ParserState ()
forall a. a -> ByteString -> ParserState a
:*: ByteString
B.empty)
else Maybe (ParserState ())
forall a. Maybe a
Nothing
myLex :: B.ByteString -> Maybe (ParserState B.ByteString)
myLex :: ByteString -> Maybe (ParserState ByteString)
myLex s :: ByteString
s = let s' :: ByteString
s' = ByteString -> ByteString
dropSpace ByteString
s
in if ByteString -> Bool
B.null ByteString
s'
then Maybe (ParserState ByteString)
forall a. Maybe a
Nothing
else ParserState ByteString -> Maybe (ParserState ByteString)
forall a. a -> Maybe a
Just (ParserState ByteString -> Maybe (ParserState ByteString))
-> ParserState ByteString -> Maybe (ParserState ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString) -> ParserState ByteString
forall a. (a, ByteString) -> ParserState a
stuple ((ByteString, ByteString) -> ParserState ByteString)
-> (ByteString, ByteString) -> ParserState ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> (ByteString, ByteString)
breakSpace ByteString
s'
myLex' :: ParserM m => m B.ByteString
myLex' :: m ByteString
myLex' = (ByteString -> Maybe (ParserState ByteString)) -> m ByteString
forall (m :: * -> *) a.
ParserM m =>
(ByteString -> Maybe (ParserState a)) -> m a
work ByteString -> Maybe (ParserState ByteString)
myLex
anyChar :: ParserM m => m Char
anyChar :: m Char
anyChar = (ByteString -> Maybe (ParserState Char)) -> m Char
forall (m :: * -> *) a.
ParserM m =>
(ByteString -> Maybe (ParserState a)) -> m a
work ((ByteString -> Maybe (ParserState Char)) -> m Char)
-> (ByteString -> Maybe (ParserState Char)) -> m Char
forall a b. (a -> b) -> a -> b
$ \s :: ByteString
s -> (Char, ByteString) -> ParserState Char
forall a. (a, ByteString) -> ParserState a
stuple ((Char, ByteString) -> ParserState Char)
-> Maybe (Char, ByteString) -> Maybe (ParserState Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
s
endOfInput :: ParserM m => m ()
endOfInput :: m ()
endOfInput = (ByteString -> Maybe (ParserState ())) -> m ()
forall (m :: * -> *) a.
ParserM m =>
(ByteString -> Maybe (ParserState a)) -> m a
work ((ByteString -> Maybe (ParserState ())) -> m ())
-> (ByteString -> Maybe (ParserState ())) -> m ()
forall a b. (a -> b) -> a -> b
$ \s :: ByteString
s -> if ByteString -> Bool
B.null ByteString
s
then ParserState () -> Maybe (ParserState ())
forall a. a -> Maybe a
Just (() () -> ByteString -> ParserState ()
forall a. a -> ByteString -> ParserState a
:*: ByteString
s)
else Maybe (ParserState ())
forall a. Maybe a
Nothing
char :: ParserM m => Char -> m ()
char :: Char -> m ()
char c :: Char
c = (ByteString -> Maybe (ParserState ())) -> m ()
forall (m :: * -> *) a.
ParserM m =>
(ByteString -> Maybe (ParserState a)) -> m a
work ((ByteString -> Maybe (ParserState ())) -> m ())
-> (ByteString -> Maybe (ParserState ())) -> m ()
forall a b. (a -> b) -> a -> b
$ \s :: ByteString
s ->
case ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
s of
Just (c' :: Char
c', s' :: ByteString
s') | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c' -> ParserState () -> Maybe (ParserState ())
forall a. a -> Maybe a
Just (() () -> ByteString -> ParserState ()
forall a. a -> ByteString -> ParserState a
:*: ByteString
s')
_ -> Maybe (ParserState ())
forall a. Maybe a
Nothing
int :: ParserM m => m Int
int :: m Int
int = (ByteString -> Maybe (ParserState Int)) -> m Int
forall (m :: * -> *) a.
ParserM m =>
(ByteString -> Maybe (ParserState a)) -> m a
work ((ByteString -> Maybe (ParserState Int)) -> m Int)
-> (ByteString -> Maybe (ParserState Int)) -> m Int
forall a b. (a -> b) -> a -> b
$ \s :: ByteString
s -> (Int, ByteString) -> ParserState Int
forall a. (a, ByteString) -> ParserState a
stuple ((Int, ByteString) -> ParserState Int)
-> Maybe (Int, ByteString) -> Maybe (ParserState Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Int, ByteString)
readIntPS ByteString
s
skipSpace :: ParserM m => m ()
skipSpace :: m ()
skipSpace = (ByteString -> ByteString) -> m ()
forall (m :: * -> *).
ParserM m =>
(ByteString -> ByteString) -> m ()
alterInput ByteString -> ByteString
dropSpace
skipWhile :: ParserM m => (Char -> Bool) -> m ()
skipWhile :: (Char -> Bool) -> m ()
skipWhile p :: Char -> Bool
p = (ByteString -> ByteString) -> m ()
forall (m :: * -> *).
ParserM m =>
(ByteString -> ByteString) -> m ()
alterInput ((Char -> Bool) -> ByteString -> ByteString
BC.dropWhile Char -> Bool
p)
takeTill :: ParserM m => (Char -> Bool) -> m B.ByteString
takeTill :: (Char -> Bool) -> m ByteString
takeTill p :: Char -> Bool
p = (ByteString -> Maybe (ParserState ByteString)) -> m ByteString
forall (m :: * -> *) a.
ParserM m =>
(ByteString -> Maybe (ParserState a)) -> m a
work ((ByteString -> Maybe (ParserState ByteString)) -> m ByteString)
-> (ByteString -> Maybe (ParserState ByteString)) -> m ByteString
forall a b. (a -> b) -> a -> b
$ \s :: ByteString
s -> ParserState ByteString -> Maybe (ParserState ByteString)
forall a. a -> Maybe a
Just (ParserState ByteString -> Maybe (ParserState ByteString))
-> ParserState ByteString -> Maybe (ParserState ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString) -> ParserState ByteString
forall a. (a, ByteString) -> ParserState a
stuple ((Char -> Bool) -> ByteString -> (ByteString, ByteString)
BC.break Char -> Bool
p ByteString
s)
takeTillChar :: ParserM m => Char -> m B.ByteString
takeTillChar :: Char -> m ByteString
takeTillChar c :: Char
c = (ByteString -> Maybe (ParserState ByteString)) -> m ByteString
forall (m :: * -> *) a.
ParserM m =>
(ByteString -> Maybe (ParserState a)) -> m a
work ((ByteString -> Maybe (ParserState ByteString)) -> m ByteString)
-> (ByteString -> Maybe (ParserState ByteString)) -> m ByteString
forall a b. (a -> b) -> a -> b
$ \s :: ByteString
s -> ParserState ByteString -> Maybe (ParserState ByteString)
forall a. a -> Maybe a
Just (ParserState ByteString -> Maybe (ParserState ByteString))
-> ParserState ByteString -> Maybe (ParserState ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString) -> ParserState ByteString
forall a. (a, ByteString) -> ParserState a
stuple ((Char -> Bool) -> ByteString -> (ByteString, ByteString)
BC.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c) ByteString
s)
take :: ParserM m => Int -> m B.ByteString
take :: Int -> m ByteString
take n :: Int
n = (ByteString -> Maybe (ParserState ByteString)) -> m ByteString
forall (m :: * -> *) a.
ParserM m =>
(ByteString -> Maybe (ParserState a)) -> m a
work ((ByteString -> Maybe (ParserState ByteString)) -> m ByteString)
-> (ByteString -> Maybe (ParserState ByteString)) -> m ByteString
forall a b. (a -> b) -> a -> b
$ \s :: ByteString
s -> if ByteString -> Int
B.length ByteString
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
then ParserState ByteString -> Maybe (ParserState ByteString)
forall a. a -> Maybe a
Just (ParserState ByteString -> Maybe (ParserState ByteString))
-> ParserState ByteString -> Maybe (ParserState ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString) -> ParserState ByteString
forall a. (a, ByteString) -> ParserState a
stuple ((ByteString, ByteString) -> ParserState ByteString)
-> (ByteString, ByteString) -> ParserState ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
BC.splitAt Int
n ByteString
s
else Maybe (ParserState ByteString)
forall a. Maybe a
Nothing
linesStartingWith :: ParserM m => Char -> m [B.ByteString]
linesStartingWith :: Char -> m [ByteString]
linesStartingWith c :: Char
c = (ByteString -> Maybe (ParserState [ByteString])) -> m [ByteString]
forall (m :: * -> *) a.
ParserM m =>
(ByteString -> Maybe (ParserState a)) -> m a
work ((ByteString -> Maybe (ParserState [ByteString]))
-> m [ByteString])
-> (ByteString -> Maybe (ParserState [ByteString]))
-> m [ByteString]
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> Maybe (ParserState [ByteString])
linesStartingWith' Char
c
linesStartingWith' :: Char -> B.ByteString -> Maybe (ParserState [B.ByteString])
linesStartingWith' :: Char -> ByteString -> Maybe (ParserState [ByteString])
linesStartingWith' c :: Char
c thes :: ByteString
thes =
ParserState [ByteString] -> Maybe (ParserState [ByteString])
forall a. a -> Maybe a
Just ([ByteString] -> ByteString -> ParserState [ByteString]
lsw [] ByteString
thes)
where lsw :: [ByteString] -> ByteString -> ParserState [ByteString]
lsw acc :: [ByteString]
acc s :: ByteString
s | ByteString -> Bool
B.null ByteString
s Bool -> Bool -> Bool
|| ByteString -> Char
BC.head ByteString
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c = [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc [ByteString] -> ByteString -> ParserState [ByteString]
forall a. a -> ByteString -> ParserState a
:*: ByteString
s
lsw acc :: [ByteString]
acc s :: ByteString
s = let s' :: ByteString
s' = ByteString -> ByteString
B.tail ByteString
s
in case Char -> ByteString -> Maybe (ByteString, ByteString)
breakFirstPS '\n' ByteString
s' of
Just (l :: ByteString
l, r :: ByteString
r) -> [ByteString] -> ByteString -> ParserState [ByteString]
lsw (ByteString
lByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc) ByteString
r
Nothing -> [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse (ByteString
s'ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc) [ByteString] -> ByteString -> ParserState [ByteString]
forall a. a -> ByteString -> ParserState a
:*: ByteString
B.empty
linesStartingWithEndingWith :: ParserM m => Char -> Char -> m [B.ByteString]
linesStartingWithEndingWith :: Char -> Char -> m [ByteString]
linesStartingWithEndingWith st :: Char
st en :: Char
en = (ByteString -> Maybe (ParserState [ByteString])) -> m [ByteString]
forall (m :: * -> *) a.
ParserM m =>
(ByteString -> Maybe (ParserState a)) -> m a
work ((ByteString -> Maybe (ParserState [ByteString]))
-> m [ByteString])
-> (ByteString -> Maybe (ParserState [ByteString]))
-> m [ByteString]
forall a b. (a -> b) -> a -> b
$ Char -> Char -> ByteString -> Maybe (ParserState [ByteString])
linesStartingWithEndingWith' Char
st Char
en
linesStartingWithEndingWith' :: Char -> Char -> B.ByteString
-> Maybe (ParserState [B.ByteString])
linesStartingWithEndingWith' :: Char -> Char -> ByteString -> Maybe (ParserState [ByteString])
linesStartingWithEndingWith' st :: Char
st en :: Char
en = ByteString -> Maybe (ParserState [ByteString])
lswew
where
lswew :: ByteString -> Maybe (ParserState [ByteString])
lswew x :: ByteString
x
| ByteString -> Bool
B.null ByteString
x = Maybe (ParserState [ByteString])
forall a. Maybe a
Nothing
| ByteString -> Char
BC.head ByteString
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
en = ParserState [ByteString] -> Maybe (ParserState [ByteString])
forall a. a -> Maybe a
Just (ParserState [ByteString] -> Maybe (ParserState [ByteString]))
-> ParserState [ByteString] -> Maybe (ParserState [ByteString])
forall a b. (a -> b) -> a -> b
$ [] [ByteString] -> ByteString -> ParserState [ByteString]
forall a. a -> ByteString -> ParserState a
:*: ByteString -> ByteString
B.tail ByteString
x
| ByteString -> Char
BC.head ByteString
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
st = Maybe (ParserState [ByteString])
forall a. Maybe a
Nothing
| Bool
otherwise = case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BC.break ('\n' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) (ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.tail ByteString
x of
(l :: ByteString
l,r :: ByteString
r) -> case ByteString -> Maybe (ParserState [ByteString])
lswew (ByteString -> Maybe (ParserState [ByteString]))
-> ByteString -> Maybe (ParserState [ByteString])
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.tail ByteString
r of
Just (ls :: [ByteString]
ls :*: r' :: ByteString
r') -> ParserState [ByteString] -> Maybe (ParserState [ByteString])
forall a. a -> Maybe a
Just ((ByteString
lByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
ls) [ByteString] -> ByteString -> ParserState [ByteString]
forall a. a -> ByteString -> ParserState a
:*: ByteString
r')
Nothing ->
case Char -> ByteString -> Maybe (ByteString, ByteString)
breakLastPS Char
en ByteString
l of
Just (l2 :: ByteString
l2,_) ->
ParserState [ByteString] -> Maybe (ParserState [ByteString])
forall a. a -> Maybe a
Just ([ByteString
l2] [ByteString] -> ByteString -> ParserState [ByteString]
forall a. a -> ByteString -> ParserState a
:*: Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
l2Int -> Int -> Int
forall a. Num a => a -> a -> a
+2) ByteString
x)
Nothing -> Maybe (ParserState [ByteString])
forall a. Maybe a
Nothing
alterInput :: ParserM m
=> (B.ByteString -> B.ByteString) -> m ()
alterInput :: (ByteString -> ByteString) -> m ()
alterInput f :: ByteString -> ByteString
f = (ByteString -> Maybe (ParserState ())) -> m ()
forall (m :: * -> *) a.
ParserM m =>
(ByteString -> Maybe (ParserState a)) -> m a
work (\s :: ByteString
s -> ParserState () -> Maybe (ParserState ())
forall a. a -> Maybe a
Just (() () -> ByteString -> ParserState ()
forall a. a -> ByteString -> ParserState a
:*: ByteString -> ByteString
f ByteString
s))
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
choice :: Alternative f => [f a] -> f a
choice :: [f a] -> f a
choice = [f a] -> f a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
checkConsumes :: ParserM m => m a -> m a
checkConsumes :: m a -> m a
checkConsumes parser :: m a
parser = do
Int
x <- ByteString -> Int
B.length (ByteString -> Int) -> m ByteString -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteString
forall (m :: * -> *). ParserM m => m ByteString
peekInput
a
res <- m a
parser
Int
x' <- ByteString -> Int
B.length (ByteString -> Int) -> m ByteString -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteString
forall (m :: * -> *). ParserM m => m ByteString
peekInput
if Int
x' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
x then a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res else m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
class (Functor m, Applicative m, Alternative m, Monad m, MonadPlus m) => ParserM m where
work :: (B.ByteString -> Maybe (ParserState a)) -> m a
peekInput :: m B.ByteString
parse :: m a -> B.ByteString -> Maybe (a, B.ByteString)
parseStrictly :: SM a -> B.ByteString -> Maybe (a, B.ByteString)
parseStrictly :: SM a -> ByteString -> Maybe (a, ByteString)
parseStrictly (SM f :: ByteString -> Maybe (ParserState a)
f) s :: ByteString
s = case ByteString -> Maybe (ParserState a)
f ByteString
s of
Just (a :: a
a :*: r :: ByteString
r) -> (a, ByteString) -> Maybe (a, ByteString)
forall a. a -> Maybe a
Just (a
a, ByteString
r)
_ -> Maybe (a, ByteString)
forall a. Maybe a
Nothing
data ParserState a = !a :*: !B.ByteString
stuple :: (a, B.ByteString) -> ParserState a
stuple :: (a, ByteString) -> ParserState a
stuple (a :: a
a, b :: ByteString
b) = a
a a -> ByteString -> ParserState a
forall a. a -> ByteString -> ParserState a
:*: ByteString
b
newtype SM a = SM (B.ByteString -> Maybe (ParserState a))
bindSM :: SM a -> (a -> SM b) -> SM b
bindSM :: SM a -> (a -> SM b) -> SM b
bindSM (SM m :: ByteString -> Maybe (ParserState a)
m) k :: a -> SM b
k = (ByteString -> Maybe (ParserState b)) -> SM b
forall a. (ByteString -> Maybe (ParserState a)) -> SM a
SM ((ByteString -> Maybe (ParserState b)) -> SM b)
-> (ByteString -> Maybe (ParserState b)) -> SM b
forall a b. (a -> b) -> a -> b
$ \s :: ByteString
s -> case ByteString -> Maybe (ParserState a)
m ByteString
s of
Nothing -> Maybe (ParserState b)
forall a. Maybe a
Nothing
Just (x :: a
x :*: s' :: ByteString
s') ->
case a -> SM b
k a
x of
SM y :: ByteString -> Maybe (ParserState b)
y -> ByteString -> Maybe (ParserState b)
y ByteString
s'
{-# INLINE bindSM #-}
returnSM :: a -> SM a
returnSM :: a -> SM a
returnSM x :: a
x = (ByteString -> Maybe (ParserState a)) -> SM a
forall a. (ByteString -> Maybe (ParserState a)) -> SM a
SM (\s :: ByteString
s -> ParserState a -> Maybe (ParserState a)
forall a. a -> Maybe a
Just (a
x a -> ByteString -> ParserState a
forall a. a -> ByteString -> ParserState a
:*: ByteString
s))
{-# INLINE returnSM #-}
failSM :: String -> SM a
failSM :: String -> SM a
failSM _ = (ByteString -> Maybe (ParserState a)) -> SM a
forall a. (ByteString -> Maybe (ParserState a)) -> SM a
SM (\_ -> Maybe (ParserState a)
forall a. Maybe a
Nothing)
{-# INLINE failSM #-}
instance Monad SM where
>>= :: SM a -> (a -> SM b) -> SM b
(>>=) = SM a -> (a -> SM b) -> SM b
forall a b. SM a -> (a -> SM b) -> SM b
bindSM
return :: a -> SM a
return = a -> SM a
forall a. a -> SM a
returnSM
instance ParserM SM where
work :: (ByteString -> Maybe (ParserState a)) -> SM a
work = (ByteString -> Maybe (ParserState a)) -> SM a
forall a. (ByteString -> Maybe (ParserState a)) -> SM a
SM
peekInput :: SM ByteString
peekInput = (ByteString -> Maybe (ParserState ByteString)) -> SM ByteString
forall a. (ByteString -> Maybe (ParserState a)) -> SM a
SM ((ByteString -> Maybe (ParserState ByteString)) -> SM ByteString)
-> (ByteString -> Maybe (ParserState ByteString)) -> SM ByteString
forall a b. (a -> b) -> a -> b
$ \s :: ByteString
s -> ParserState ByteString -> Maybe (ParserState ByteString)
forall a. a -> Maybe a
Just (ByteString
s ByteString -> ByteString -> ParserState ByteString
forall a. a -> ByteString -> ParserState a
:*: ByteString
s)
parse :: SM a -> ByteString -> Maybe (a, ByteString)
parse = SM a -> ByteString -> Maybe (a, ByteString)
forall a. SM a -> ByteString -> Maybe (a, ByteString)
parseStrictly
instance MonadPlus SM where
mzero :: SM a
mzero = String -> SM a
forall a. String -> SM a
failSM ""
mplus :: SM a -> SM a -> SM a
mplus (SM a :: ByteString -> Maybe (ParserState a)
a) (SM b :: ByteString -> Maybe (ParserState a)
b) = (ByteString -> Maybe (ParserState a)) -> SM a
forall a. (ByteString -> Maybe (ParserState a)) -> SM a
SM ((ByteString -> Maybe (ParserState a)) -> SM a)
-> (ByteString -> Maybe (ParserState a)) -> SM a
forall a b. (a -> b) -> a -> b
$ \s :: ByteString
s ->
case ByteString -> Maybe (ParserState a)
a ByteString
s of
Nothing -> ByteString -> Maybe (ParserState a)
b ByteString
s
r :: Maybe (ParserState a)
r -> Maybe (ParserState a)
r
instance Functor SM where
fmap :: (a -> b) -> SM a -> SM b
fmap f :: a -> b
f m :: SM a
m = SM a
m SM a -> (a -> SM b) -> SM b
forall a b. SM a -> (a -> SM b) -> SM b
`bindSM` (b -> SM b
forall a. a -> SM a
returnSM (b -> SM b) -> (a -> b) -> a -> SM b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
instance Applicative SM where
pure :: a -> SM a
pure = a -> SM a
forall a. a -> SM a
returnSM
a :: SM (a -> b)
a <*> :: SM (a -> b) -> SM a -> SM b
<*> b :: SM a
b =
SM (a -> b)
a SM (a -> b) -> ((a -> b) -> SM b) -> SM b
forall a b. SM a -> (a -> SM b) -> SM b
`bindSM` \c :: a -> b
c ->
SM a
b SM a -> (a -> SM b) -> SM b
forall a b. SM a -> (a -> SM b) -> SM b
`bindSM` \d :: a
d ->
b -> SM b
forall a. a -> SM a
returnSM (a -> b
c a
d)
instance Alternative SM where
empty :: SM a
empty = String -> SM a
forall a. String -> SM a
failSM ""
<|> :: SM a -> SM a -> SM a
(<|>) = SM a -> SM a -> SM a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus