{-# LANGUAGE RankNTypes #-}
module Pipes.Parse (
Parser
, draw
, skip
, drawAll
, skipAll
, unDraw
, peek
, isEndOfInput
, foldAll
, foldAllM
, span
, splitAt
, groupBy
, group
, toParser
, toParser_
, parsed
, parsed_
, parseForever
, parseForever_
, module Control.Monad.Trans.Class
, module Control.Monad.Trans.State.Strict
, module Pipes
) where
import Control.Monad (join, forever, liftM)
import Control.Monad.Trans.Class (lift)
import qualified Control.Monad.Trans.State.Strict as S
import Control.Monad.Trans.State.Strict (
StateT(StateT, runStateT), evalStateT, execStateT )
import Data.Functor.Constant (Constant(Constant, getConstant))
import Data.Foldable (forM_)
import Pipes.Internal (unsafeHoist, closed)
import Pipes (Producer, yield, next)
import Pipes as NoReexport
import Prelude hiding (span, splitAt)
type Parser a m r = forall x . StateT (Producer a m x) m r
draw :: Monad m => Parser a m (Maybe a)
draw :: forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
draw = do
Producer a m x
p <- forall (m :: * -> *) s. Monad m => StateT s m s
S.get
Either x (a, Producer a m x)
x <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer a m x
p)
case Either x (a, Producer a m x)
x of
Left x
r -> do
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
S.put (forall (m :: * -> *) a. Monad m => a -> m a
return x
r)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Right (a
a, Producer a m x
p') -> do
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
S.put Producer a m x
p'
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a)
{-# INLINABLE draw #-}
skip :: Monad m => Parser a m Bool
skip :: forall (m :: * -> *) a. Monad m => Parser a m Bool
skip = do
Maybe a
x <- forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
draw
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe a
x of
Maybe a
Nothing -> Bool
False
Just a
_ -> Bool
True
{-# INLINABLE skip #-}
drawAll :: Monad m => Parser a m [a]
drawAll :: forall (m :: * -> *) a. Monad m => Parser a m [a]
drawAll = forall {m :: * -> *} {a} {c} {x}.
Monad m =>
([a] -> c) -> StateT (Producer a m x) m c
go forall a. a -> a
id
where
go :: ([a] -> c) -> StateT (Producer a m x) m c
go [a] -> c
diffAs = do
Maybe a
x <- forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
draw
case Maybe a
x of
Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> c
diffAs [])
Just a
a -> ([a] -> c) -> StateT (Producer a m x) m c
go ([a] -> c
diffAs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
aforall a. a -> [a] -> [a]
:))
{-# INLINABLE drawAll #-}
skipAll :: Monad m => Parser a m ()
skipAll :: forall (m :: * -> *) a. Monad m => Parser a m ()
skipAll = forall {a} {x}. StateT (Producer a m x) m ()
go
where
go :: StateT (Producer a m x) m ()
go = do
Maybe a
x <- forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
draw
case Maybe a
x of
Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just a
_ -> StateT (Producer a m x) m ()
go
{-# INLINABLE skipAll #-}
unDraw :: Monad m => a -> Parser a m ()
unDraw :: forall (m :: * -> *) a. Monad m => a -> Parser a m ()
unDraw a
a = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
S.modify (forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>)
{-# INLINABLE unDraw #-}
peek :: Monad m => Parser a m (Maybe a)
peek :: forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
peek = do
Maybe a
x <- forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
draw
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe a
x forall a b. (a -> b) -> a -> b
$ \a
a -> forall (m :: * -> *) a. Monad m => a -> Parser a m ()
unDraw a
a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
x
{-# INLINABLE peek #-}
isEndOfInput :: Monad m => Parser a m Bool
isEndOfInput :: forall (m :: * -> *) a. Monad m => Parser a m Bool
isEndOfInput = do
Maybe a
x <- forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
peek
forall (m :: * -> *) a. Monad m => a -> m a
return (case Maybe a
x of
Maybe a
Nothing -> Bool
True
Just a
_ -> Bool
False )
{-# INLINABLE isEndOfInput #-}
foldAll
:: Monad m
=> (x -> a -> x)
-> x
-> (x -> b)
-> Parser a m b
foldAll :: forall (m :: * -> *) x a b.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Parser a m b
foldAll x -> a -> x
step x
begin x -> b
done = forall {m :: * -> *} {x}.
Monad m =>
x -> StateT (Producer a m x) m b
go x
begin
where
go :: x -> StateT (Producer a m x) m b
go x
x = do
Maybe a
ea <- forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
draw
case Maybe a
ea of
Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (x -> b
done x
x)
Just a
a -> x -> StateT (Producer a m x) m b
go forall a b. (a -> b) -> a -> b
$! x -> a -> x
step x
x a
a
{-# INLINABLE foldAll #-}
foldAllM
:: Monad m
=> (x -> a -> m x)
-> m x
-> (x -> m b)
-> Parser a m b
foldAllM :: forall (m :: * -> *) x a b.
Monad m =>
(x -> a -> m x) -> m x -> (x -> m b) -> Parser a m b
foldAllM x -> a -> m x
step m x
begin x -> m b
done = do
x
x0 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m x
begin
forall {x}. x -> StateT (Producer a m x) m b
go x
x0
where
go :: x -> StateT (Producer a m x) m b
go x
x = do
Maybe a
ea <- forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
draw
case Maybe a
ea of
Maybe a
Nothing -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (x -> m b
done x
x)
Just a
a -> do
x
x' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (x -> a -> m x
step x
x a
a)
x -> StateT (Producer a m x) m b
go forall a b. (a -> b) -> a -> b
$! x
x'
{-# INLINABLE foldAllM #-}
type Lens' a b = forall f . (Functor f) => (b -> f b) -> a -> f a
span
:: Monad m
=> (a -> Bool) -> Lens' (Producer a m x) (Producer a m (Producer a m x))
span :: forall (m :: * -> *) a x.
Monad m =>
(a -> Bool)
-> Lens' (Producer a m x) (Producer a m (Producer a m x))
span a -> Bool
predicate Producer a m (Producer a m x) -> f (Producer a m (Producer a m x))
k Producer a m x
p0 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Producer a m (Producer a m x) -> f (Producer a m (Producer a m x))
k (forall {m :: * -> *} {a} {x'} {x}.
Monad m =>
Producer a m a -> Proxy x' x () a m (Producer a m a)
to Producer a m x
p0))
where
to :: Producer a m a -> Proxy x' x () a m (Producer a m a)
to Producer a m a
p = do
Either a (a, Producer a m a)
x <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer a m a
p)
case Either a (a, Producer a m a)
x of
Left a
r -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. Monad m => a -> m a
return a
r)
Right (a
a, Producer a m a
p') ->
if a -> Bool
predicate a
a
then do
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a
Producer a m a -> Proxy x' x () a m (Producer a m a)
to Producer a m a
p'
else forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Producer a m a
p')
{-# INLINABLE span #-}
splitAt
:: Monad m
=> Int -> Lens' (Producer a m x) (Producer a m (Producer a m x))
splitAt :: forall (m :: * -> *) a x.
Monad m =>
Int -> Lens' (Producer a m x) (Producer a m (Producer a m x))
splitAt Int
n0 Producer a m (Producer a m x) -> f (Producer a m (Producer a m x))
k Producer a m x
p0 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Producer a m (Producer a m x) -> f (Producer a m (Producer a m x))
k (forall {t} {m :: * -> *} {a} {r} {x'} {x}.
(Ord t, Num t, Monad m) =>
t -> Producer a m r -> Proxy x' x () a m (Producer a m r)
to Int
n0 Producer a m x
p0))
where
to :: t -> Producer a m r -> Proxy x' x () a m (Producer a m r)
to t
n Producer a m r
p =
if t
n forall a. Ord a => a -> a -> Bool
<= t
0
then forall (m :: * -> *) a. Monad m => a -> m a
return Producer a m r
p
else do
Either r (a, Producer a m r)
x <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer a m r
p)
case Either r (a, Producer a m r)
x of
Left r
r -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. Monad m => a -> m a
return r
r)
Right (a
a, Producer a m r
p') -> do
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a
t -> Producer a m r -> Proxy x' x () a m (Producer a m r)
to (t
n forall a. Num a => a -> a -> a
- t
1) Producer a m r
p'
{-# INLINABLE splitAt #-}
(^.) :: a -> ((b -> Constant b b) -> a -> Constant b a) -> b
a
a ^. :: forall a b. a -> ((b -> Constant b b) -> a -> Constant b a) -> b
^. (b -> Constant b b) -> a -> Constant b a
lens = forall {k} a (b :: k). Constant a b -> a
getConstant ((b -> Constant b b) -> a -> Constant b a
lens forall {k} a (b :: k). a -> Constant a b
Constant a
a)
groupBy
:: Monad m
=> (a -> a -> Bool)
-> Lens' (Producer a m x) (Producer a m (Producer a m x))
groupBy :: forall (m :: * -> *) a x.
Monad m =>
(a -> a -> Bool)
-> Lens' (Producer a m x) (Producer a m (Producer a m x))
groupBy a -> a -> Bool
equals Producer a m (Producer a m x) -> f (Producer a m (Producer a m x))
k Producer a m x
p0 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Producer a m (Producer a m x) -> f (Producer a m (Producer a m x))
k (forall {m :: * -> *} {b}.
Monad m =>
Producer a m b -> Proxy X () () a m (Producer a m b)
to Producer a m x
p0))
where
to :: Producer a m b -> Proxy X () () a m (Producer a m b)
to Producer a m b
p = do
Either b (a, Producer a m b)
x <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer a m b
p)
case Either b (a, Producer a m b)
x of
Left b
r -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. Monad m => a -> m a
return b
r)
Right (a
a, Producer a m b
p') -> (forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Producer a m b
p') forall a b. a -> ((b -> Constant b b) -> a -> Constant b a) -> b
^. forall (m :: * -> *) a x.
Monad m =>
(a -> Bool)
-> Lens' (Producer a m x) (Producer a m (Producer a m x))
span (a -> a -> Bool
equals a
a)
{-# INLINABLE groupBy #-}
group
:: (Monad m, Eq a) => Lens' (Producer a m x) (Producer a m (Producer a m x))
group :: forall (m :: * -> *) a x.
(Monad m, Eq a) =>
Lens' (Producer a m x) (Producer a m (Producer a m x))
group = forall (m :: * -> *) a x.
Monad m =>
(a -> a -> Bool)
-> Lens' (Producer a m x) (Producer a m (Producer a m x))
groupBy forall a. Eq a => a -> a -> Bool
(==)
{-# INLINABLE group #-}
toParser :: Monad m => Consumer (Maybe a) m r -> Parser a m r
toParser :: forall (m :: * -> *) a r.
Monad m =>
Consumer (Maybe a) m r -> Parser a m r
toParser Consumer (Maybe a) m r
consumer = forall (m :: * -> *) r. Monad m => Effect m r -> m r
runEffect (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
draw forall (m :: * -> *) a' a y' y b c.
Functor m =>
Proxy a' a y' y m b -> Proxy () b y' y m c -> Proxy a' a y' y m c
>~ forall (m :: * -> *) (n :: * -> *) a' a b' b r.
Functor m =>
(forall x. m x -> n x)
-> Proxy a' a b' b m r -> Proxy a' a b' b n r
unsafeHoist forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Consumer (Maybe a) m r
consumer)
{-# INLINABLE toParser #-}
toParser_ :: Monad m => Consumer a m X -> Parser a m ()
toParser_ :: forall (m :: * -> *) a. Monad m => Consumer a m X -> Parser a m ()
toParser_ Consumer a m X
consumer = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \Producer a m x
producer -> do
x
r <- forall (m :: * -> *) r. Monad m => Effect m r -> m r
runEffect (Producer a m x
producer forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. X -> a
closed Consumer a m X
consumer)
forall (m :: * -> *) a. Monad m => a -> m a
return ((), forall (m :: * -> *) a. Monad m => a -> m a
return x
r)
{-# INLINABLE toParser_ #-}
parsed
:: Monad m
=> Parser a m (Either e b)
-> Producer a m r -> Producer b m (e, Producer a m r)
parsed :: forall (m :: * -> *) a e b r.
Monad m =>
Parser a m (Either e b)
-> Producer a m r -> Producer b m (e, Producer a m r)
parsed Parser a m (Either e b)
parser = forall {x} {x'} {x}.
Producer a m x -> Proxy x' x () b m (e, Producer a m x)
go
where
go :: Producer a m x -> Proxy x' x () b m (e, Producer a m x)
go Producer a m x
p = do
(Either e b
x, Producer a m x
p') <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Parser a m (Either e b)
parser Producer a m x
p)
case Either e b
x of
Left e
r -> forall (m :: * -> *) a. Monad m => a -> m a
return (e
r, Producer a m x
p')
Right b
b -> do
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield b
b
Producer a m x -> Proxy x' x () b m (e, Producer a m x)
go Producer a m x
p'
{-# INLINABLE parsed #-}
parsed_
:: Monad m
=> Parser a m (Maybe b)
-> Producer a m r
-> Producer b m (Producer a m r)
parsed_ :: forall (m :: * -> *) a b r.
Monad m =>
Parser a m (Maybe b)
-> Producer a m r -> Producer b m (Producer a m r)
parsed_ Parser a m (Maybe b)
parser Producer a m r
p = do
((), Producer a m r
p') <- forall (m :: * -> *) a e b r.
Monad m =>
Parser a m (Either e b)
-> Producer a m r -> Producer b m (e, Producer a m r)
parsed forall {x}. StateT (Producer a m x) m (Either () b)
parser' Producer a m r
p
forall (m :: * -> *) a. Monad m => a -> m a
return Producer a m r
p'
where
parser' :: StateT (Producer a m x) m (Either () b)
parser' = do
Maybe b
x <- Parser a m (Maybe b)
parser
forall (m :: * -> *) a. Monad m => a -> m a
return (case Maybe b
x of
Maybe b
Nothing -> forall a b. a -> Either a b
Left ()
Just b
b -> forall a b. b -> Either a b
Right b
b )
{-# INLINABLE parsed_ #-}
parseForever ::
Monad m =>
(forall n. Monad n => Parser a n (Either r b)) ->
Pipe a b m r
parseForever :: forall (m :: * -> *) a r b.
Monad m =>
(forall (n :: * -> *). Monad n => Parser a n (Either r b))
-> Pipe a b m r
parseForever forall (n :: * -> *). Monad n => Parser a n (Either r b)
parse = forall {m :: * -> *} {x'} {x} {x}.
Functor m =>
Producer a (Proxy x' x () b m) x -> Proxy x' x () b m r
go (forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *) a. Functor m => Consumer' a m a
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield))
where go :: Producer a (Proxy x' x () b m) x -> Proxy x' x () b m r
go Producer a (Proxy x' x () b m) x
prod = do (Either r b
b, Producer a (Proxy x' x () b m) x
prod') <- forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT forall (n :: * -> *). Monad n => Parser a n (Either r b)
parse Producer a (Proxy x' x () b m) x
prod
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. Monad m => a -> m a
return ((forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Producer a (Proxy x' x () b m) x -> Proxy x' x () b m r
go Producer a (Proxy x' x () b m) x
prod') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield) Either r b
b
{-# DEPRECATED parseForever "Use `parsed` instead" #-}
parseForever_ ::
Monad m =>
(forall n. Monad n => Parser a n (Maybe b)) ->
Pipe a b m ()
parseForever_ :: forall (m :: * -> *) a b.
Monad m =>
(forall (n :: * -> *). Monad n => Parser a n (Maybe b))
-> Pipe a b m ()
parseForever_ forall (n :: * -> *). Monad n => Parser a n (Maybe b)
parse = forall (m :: * -> *) a r b.
Monad m =>
(forall (n :: * -> *). Monad n => Parser a n (Either r b))
-> Pipe a b m r
parseForever (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left ()) forall a b. b -> Either a b
Right) forall (n :: * -> *). Monad n => Parser a n (Maybe b)
parse)
{-# DEPRECATED parseForever_ "Use `parsed_` instead" #-}