{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE CPP #-}
module Descriptive
(
consume
,describe
,runConsumer
,runDescription
,Description(..)
,Bound(..)
,Consumer(..)
,Result(..)
,consumer
,wrap)
where
import Control.Applicative
import Control.Monad.Identity
import Control.Monad.State.Strict
import Data.Bifunctor
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup
#endif
consume :: Consumer s d Identity a
-> s
-> Result (Description d) a
consume :: Consumer s d Identity a -> s -> Result (Description d) a
consume c :: Consumer s d Identity a
c s :: s
s = State s (Result (Description d) a) -> s -> Result (Description d) a
forall s a. State s a -> s -> a
evalState (Consumer s d Identity a -> State s (Result (Description d) a)
forall (m :: * -> *) s d a.
Monad m =>
Consumer s d m a -> StateT s m (Result (Description d) a)
runConsumer Consumer s d Identity a
c) s
s
describe :: Consumer s d Identity a
-> s
-> Description d
describe :: Consumer s d Identity a -> s -> Description d
describe c :: Consumer s d Identity a
c s :: s
s = State s (Description d) -> s -> Description d
forall s a. State s a -> s -> a
evalState (Consumer s d Identity a -> State s (Description d)
forall (m :: * -> *) s d a.
Monad m =>
Consumer s d m a -> StateT s m (Description d)
runDescription Consumer s d Identity a
c) s
s
runConsumer :: Monad m
=> Consumer s d m a
-> StateT s m (Result (Description d) a)
runConsumer :: Consumer s d m a -> StateT s m (Result (Description d) a)
runConsumer (Consumer _ m :: StateT s m (Result (Description d) a)
m) = StateT s m (Result (Description d) a)
m
runDescription :: Monad m
=> Consumer s d m a
-> StateT s m (Description d)
runDescription :: Consumer s d m a -> StateT s m (Description d)
runDescription (Consumer desc :: StateT s m (Description d)
desc _) = StateT s m (Description d)
desc
data Description a
= Unit !a
| Bounded !Integer !Bound !(Description a)
| And !(Description a) !(Description a)
| Or !(Description a) !(Description a)
| Sequence ![Description a]
| Wrap a !(Description a)
| None
deriving (Int -> Description a -> ShowS
[Description a] -> ShowS
Description a -> String
(Int -> Description a -> ShowS)
-> (Description a -> String)
-> ([Description a] -> ShowS)
-> Show (Description a)
forall a. Show a => Int -> Description a -> ShowS
forall a. Show a => [Description a] -> ShowS
forall a. Show a => Description a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Description a] -> ShowS
$cshowList :: forall a. Show a => [Description a] -> ShowS
show :: Description a -> String
$cshow :: forall a. Show a => Description a -> String
showsPrec :: Int -> Description a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Description a -> ShowS
Show,Description a -> Description a -> Bool
(Description a -> Description a -> Bool)
-> (Description a -> Description a -> Bool) -> Eq (Description a)
forall a. Eq a => Description a -> Description a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Description a -> Description a -> Bool
$c/= :: forall a. Eq a => Description a -> Description a -> Bool
== :: Description a -> Description a -> Bool
$c== :: forall a. Eq a => Description a -> Description a -> Bool
Eq,a -> Description b -> Description a
(a -> b) -> Description a -> Description b
(forall a b. (a -> b) -> Description a -> Description b)
-> (forall a b. a -> Description b -> Description a)
-> Functor Description
forall a b. a -> Description b -> Description a
forall a b. (a -> b) -> Description a -> Description b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Description b -> Description a
$c<$ :: forall a b. a -> Description b -> Description a
fmap :: (a -> b) -> Description a -> Description b
$cfmap :: forall a b. (a -> b) -> Description a -> Description b
Functor)
instance Semigroup (Description d) where
<> :: Description d -> Description d -> Description d
(<>) None x :: Description d
x = Description d
x
(<>) x :: Description d
x None = Description d
x
(<>) x :: Description d
x y :: Description d
y = Description d -> Description d -> Description d
forall d. Description d -> Description d -> Description d
And Description d
x Description d
y
instance Monoid (Description d) where
mempty :: Description d
mempty = Description d
forall d. Description d
None
mappend :: Description d -> Description d -> Description d
mappend = Description d -> Description d -> Description d
forall a. Semigroup a => a -> a -> a
(<>)
data Bound
= NaturalBound !Integer
| UnlimitedBound
deriving (Int -> Bound -> ShowS
[Bound] -> ShowS
Bound -> String
(Int -> Bound -> ShowS)
-> (Bound -> String) -> ([Bound] -> ShowS) -> Show Bound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bound] -> ShowS
$cshowList :: [Bound] -> ShowS
show :: Bound -> String
$cshow :: Bound -> String
showsPrec :: Int -> Bound -> ShowS
$cshowsPrec :: Int -> Bound -> ShowS
Show,Bound -> Bound -> Bool
(Bound -> Bound -> Bool) -> (Bound -> Bound -> Bool) -> Eq Bound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bound -> Bound -> Bool
$c/= :: Bound -> Bound -> Bool
== :: Bound -> Bound -> Bool
$c== :: Bound -> Bound -> Bool
Eq)
data Consumer s d m a =
Consumer {Consumer s d m a -> StateT s m (Description d)
consumerDesc :: StateT s m (Description d)
,Consumer s d m a -> StateT s m (Result (Description d) a)
consumerParse :: StateT s m (Result (Description d) a)}
data Result e a
= Failed e
| Succeeded a
| Continued e
deriving (Int -> Result e a -> ShowS
[Result e a] -> ShowS
Result e a -> String
(Int -> Result e a -> ShowS)
-> (Result e a -> String)
-> ([Result e a] -> ShowS)
-> Show (Result e a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show e, Show a) => Int -> Result e a -> ShowS
forall e a. (Show e, Show a) => [Result e a] -> ShowS
forall e a. (Show e, Show a) => Result e a -> String
showList :: [Result e a] -> ShowS
$cshowList :: forall e a. (Show e, Show a) => [Result e a] -> ShowS
show :: Result e a -> String
$cshow :: forall e a. (Show e, Show a) => Result e a -> String
showsPrec :: Int -> Result e a -> ShowS
$cshowsPrec :: forall e a. (Show e, Show a) => Int -> Result e a -> ShowS
Show,Result e a -> Result e a -> Bool
(Result e a -> Result e a -> Bool)
-> (Result e a -> Result e a -> Bool) -> Eq (Result e a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a. (Eq e, Eq a) => Result e a -> Result e a -> Bool
/= :: Result e a -> Result e a -> Bool
$c/= :: forall e a. (Eq e, Eq a) => Result e a -> Result e a -> Bool
== :: Result e a -> Result e a -> Bool
$c== :: forall e a. (Eq e, Eq a) => Result e a -> Result e a -> Bool
Eq,Eq (Result e a)
Eq (Result e a) =>
(Result e a -> Result e a -> Ordering)
-> (Result e a -> Result e a -> Bool)
-> (Result e a -> Result e a -> Bool)
-> (Result e a -> Result e a -> Bool)
-> (Result e a -> Result e a -> Bool)
-> (Result e a -> Result e a -> Result e a)
-> (Result e a -> Result e a -> Result e a)
-> Ord (Result e a)
Result e a -> Result e a -> Bool
Result e a -> Result e a -> Ordering
Result e a -> Result e a -> Result e a
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
forall e a. (Ord e, Ord a) => Eq (Result e a)
forall e a. (Ord e, Ord a) => Result e a -> Result e a -> Bool
forall e a. (Ord e, Ord a) => Result e a -> Result e a -> Ordering
forall e a.
(Ord e, Ord a) =>
Result e a -> Result e a -> Result e a
min :: Result e a -> Result e a -> Result e a
$cmin :: forall e a.
(Ord e, Ord a) =>
Result e a -> Result e a -> Result e a
max :: Result e a -> Result e a -> Result e a
$cmax :: forall e a.
(Ord e, Ord a) =>
Result e a -> Result e a -> Result e a
>= :: Result e a -> Result e a -> Bool
$c>= :: forall e a. (Ord e, Ord a) => Result e a -> Result e a -> Bool
> :: Result e a -> Result e a -> Bool
$c> :: forall e a. (Ord e, Ord a) => Result e a -> Result e a -> Bool
<= :: Result e a -> Result e a -> Bool
$c<= :: forall e a. (Ord e, Ord a) => Result e a -> Result e a -> Bool
< :: Result e a -> Result e a -> Bool
$c< :: forall e a. (Ord e, Ord a) => Result e a -> Result e a -> Bool
compare :: Result e a -> Result e a -> Ordering
$ccompare :: forall e a. (Ord e, Ord a) => Result e a -> Result e a -> Ordering
$cp1Ord :: forall e a. (Ord e, Ord a) => Eq (Result e a)
Ord)
instance Bifunctor Result where
second :: (b -> c) -> Result a b -> Result a c
second f :: b -> c
f r :: Result a b
r =
case Result a b
r of
Succeeded a :: b
a -> c -> Result a c
forall e a. a -> Result e a
Succeeded (b -> c
f b
a)
Failed e :: a
e -> a -> Result a c
forall e a. e -> Result e a
Failed a
e
Continued e :: a
e -> a -> Result a c
forall e a. e -> Result e a
Continued a
e
first :: (a -> b) -> Result a c -> Result b c
first f :: a -> b
f r :: Result a c
r =
case Result a c
r of
Succeeded a :: c
a -> c -> Result b c
forall e a. a -> Result e a
Succeeded c
a
Failed e :: a
e -> b -> Result b c
forall e a. e -> Result e a
Failed (a -> b
f a
e)
Continued e :: a
e -> b -> Result b c
forall e a. e -> Result e a
Continued (a -> b
f a
e)
instance Monad m => Functor (Consumer s d m) where
fmap :: (a -> b) -> Consumer s d m a -> Consumer s d m b
fmap f :: a -> b
f (Consumer d :: StateT s m (Description d)
d p :: StateT s m (Result (Description d) a)
p) =
StateT s m (Description d)
-> StateT s m (Result (Description d) b) -> Consumer s d m b
forall s d (m :: * -> *) a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
Consumer StateT s m (Description d)
d
(do Result (Description d) a
r <- StateT s m (Result (Description d) a)
p
case Result (Description d) a
r of
(Failed e :: Description d
e) ->
Result (Description d) b -> StateT s m (Result (Description d) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) b
forall e a. e -> Result e a
Failed Description d
e)
(Continued e :: Description d
e) ->
Result (Description d) b -> StateT s m (Result (Description d) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) b
forall e a. e -> Result e a
Continued Description d
e)
(Succeeded a :: a
a) ->
Result (Description d) b -> StateT s m (Result (Description d) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Result (Description d) b
forall e a. a -> Result e a
Succeeded (a -> b
f a
a)))
instance Monad m => Applicative (Consumer s d m) where
pure :: a -> Consumer s d m a
pure a :: a
a =
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
forall s (m :: * -> *) d a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer (Description d -> StateT s m (Description d)
forall (m :: * -> *) a. Monad m => a -> m a
return Description d
forall a. Monoid a => a
mempty)
(Result (Description d) a -> StateT s m (Result (Description d) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Result (Description d) a
forall e a. a -> Result e a
Succeeded a
a))
Consumer d :: StateT s m (Description d)
d pf :: StateT s m (Result (Description d) (a -> b))
pf <*> :: Consumer s d m (a -> b) -> Consumer s d m a -> Consumer s d m b
<*> Consumer d' :: StateT s m (Description d)
d' p' :: StateT s m (Result (Description d) a)
p' =
StateT s m (Description d)
-> StateT s m (Result (Description d) b) -> Consumer s d m b
forall s (m :: * -> *) d a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer (do Description d
e <- StateT s m (Description d)
d
Description d
e' <- StateT s m (Description d)
d'
Description d -> StateT s m (Description d)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d
e Description d -> Description d -> Description d
forall a. Semigroup a => a -> a -> a
<> Description d
e'))
(do Result (Description d) (a -> b)
mf <- StateT s m (Result (Description d) (a -> b))
pf
s
s <- StateT s m s
forall s (m :: * -> *). MonadState s m => m s
get
Result (Description d) a
ma <- StateT s m (Result (Description d) a)
p'
case Result (Description d) (a -> b)
mf of
Failed e :: Description d
e ->
do s -> StateT s m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put s
s
Result (Description d) b -> StateT s m (Result (Description d) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) b
forall e a. e -> Result e a
Failed Description d
e)
Continued e :: Description d
e ->
case Result (Description d) a
ma of
Failed e' :: Description d
e' ->
Result (Description d) b -> StateT s m (Result (Description d) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) b
forall e a. e -> Result e a
Failed Description d
e')
Continued e' :: Description d
e' ->
Result (Description d) b -> StateT s m (Result (Description d) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) b
forall e a. e -> Result e a
Continued (Description d
e Description d -> Description d -> Description d
forall a. Semigroup a => a -> a -> a
<> Description d
e'))
Succeeded{} ->
Result (Description d) b -> StateT s m (Result (Description d) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) b
forall e a. e -> Result e a
Continued Description d
e)
Succeeded f :: a -> b
f ->
case Result (Description d) a
ma of
Continued e :: Description d
e ->
Result (Description d) b -> StateT s m (Result (Description d) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) b
forall e a. e -> Result e a
Continued Description d
e)
Failed e :: Description d
e ->
Result (Description d) b -> StateT s m (Result (Description d) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) b
forall e a. e -> Result e a
Failed Description d
e)
Succeeded a :: a
a ->
Result (Description d) b -> StateT s m (Result (Description d) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Result (Description d) b
forall e a. a -> Result e a
Succeeded (a -> b
f a
a)))
instance Monad m => Alternative (Consumer s d m) where
empty :: Consumer s d m a
empty =
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
forall s (m :: * -> *) d a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer (Description d -> StateT s m (Description d)
forall (m :: * -> *) a. Monad m => a -> m a
return Description d
forall a. Monoid a => a
mempty)
(Result (Description d) a -> StateT s m (Result (Description d) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) a
forall e a. e -> Result e a
Failed Description d
forall a. Monoid a => a
mempty))
Consumer d :: StateT s m (Description d)
d p :: StateT s m (Result (Description d) a)
p <|> :: Consumer s d m a -> Consumer s d m a -> Consumer s d m a
<|> Consumer d' :: StateT s m (Description d)
d' p' :: StateT s m (Result (Description d) a)
p' =
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
forall s (m :: * -> *) d a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer (do Description d
d1 <- StateT s m (Description d)
d
Description d
d2 <- StateT s m (Description d)
d'
Description d -> StateT s m (Description d)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Description d -> Description d
forall d. Description d -> Description d -> Description d
disjunct Description d
d1 Description d
d2))
(do s
s <- StateT s m s
forall s (m :: * -> *). MonadState s m => m s
get
Result (Description d) a
r <- StateT s m (Result (Description d) a)
p
case Result (Description d) a
r of
Continued e1 :: Description d
e1 ->
do Result (Description d) a
r' <- StateT s m (Result (Description d) a)
p'
case Result (Description d) a
r' of
Failed e2 :: Description d
e2 ->
Result (Description d) a -> StateT s m (Result (Description d) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) a
forall e a. e -> Result e a
Failed Description d
e2)
Continued e2 :: Description d
e2 ->
Result (Description d) a -> StateT s m (Result (Description d) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) a
forall e a. e -> Result e a
Continued (Description d -> Description d -> Description d
forall d. Description d -> Description d -> Description d
disjunct Description d
e1 Description d
e2))
Succeeded a' :: a
a' ->
Result (Description d) a -> StateT s m (Result (Description d) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Result (Description d) a
forall e a. a -> Result e a
Succeeded a
a')
Failed e1 :: Description d
e1 ->
do s -> StateT s m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put s
s
Result (Description d) a
r' <- StateT s m (Result (Description d) a)
p'
case Result (Description d) a
r' of
Failed e2 :: Description d
e2 ->
Result (Description d) a -> StateT s m (Result (Description d) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) a
forall e a. e -> Result e a
Failed (Description d -> Description d -> Description d
forall d. Description d -> Description d -> Description d
disjunct Description d
e1 Description d
e2))
Continued e2 :: Description d
e2 ->
Result (Description d) a -> StateT s m (Result (Description d) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) a
forall e a. e -> Result e a
Continued Description d
e2)
Succeeded a2 :: a
a2 ->
Result (Description d) a -> StateT s m (Result (Description d) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Result (Description d) a
forall e a. a -> Result e a
Succeeded a
a2)
Succeeded a1 :: a
a1 -> Result (Description d) a -> StateT s m (Result (Description d) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Result (Description d) a
forall e a. a -> Result e a
Succeeded a
a1))
where disjunct :: Description a -> Description a -> Description a
disjunct None x :: Description a
x = Description a
x
disjunct x :: Description a
x None = Description a
x
disjunct x :: Description a
x y :: Description a
y = Description a -> Description a -> Description a
forall d. Description d -> Description d -> Description d
Or Description a
x Description a
y
many :: Consumer s d m a -> Consumer s d m [a]
many = Integer -> Consumer s d m a -> Consumer s d m [a]
forall (m :: * -> *) t d a.
Monad m =>
Integer -> Consumer t d m a -> Consumer t d m [a]
sequenceHelper 0
some :: Consumer s d m a -> Consumer s d m [a]
some = Integer -> Consumer s d m a -> Consumer s d m [a]
forall (m :: * -> *) t d a.
Monad m =>
Integer -> Consumer t d m a -> Consumer t d m [a]
sequenceHelper 1
sequenceHelper :: Monad m => Integer -> Consumer t d m a -> Consumer t d m [a]
sequenceHelper :: Integer -> Consumer t d m a -> Consumer t d m [a]
sequenceHelper minb :: Integer
minb =
(StateT t m (Description d) -> StateT t m (Description d))
-> (StateT t m (Description d)
-> StateT t m (Result (Description d) a)
-> StateT t m (Result (Description d) [a]))
-> Consumer t d m a
-> Consumer t d m [a]
forall t (m :: * -> *) d s a b.
(StateT t m (Description d) -> StateT s m (Description d))
-> (StateT t m (Description d)
-> StateT t m (Result (Description d) a)
-> StateT s m (Result (Description d) b))
-> Consumer t d m a
-> Consumer s d m b
wrap ((Description d -> Description d)
-> StateT t m (Description d) -> StateT t m (Description d)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Description d -> Description d
forall a. Description a -> Description a
redescribe)
(\_ p :: StateT t m (Result (Description d) a)
p ->
((Integer -> [a] -> StateT t m (Result (Description d) [a]))
-> Integer -> [a] -> StateT t m (Result (Description d) [a]))
-> Integer -> [a] -> StateT t m (Result (Description d) [a])
forall a. (a -> a) -> a
fix (\go :: Integer -> [a] -> StateT t m (Result (Description d) [a])
go !Integer
i as :: [a]
as ->
do t
s <- StateT t m t
forall s (m :: * -> *). MonadState s m => m s
get
Result (Description d) a
r <- StateT t m (Result (Description d) a)
p
case Result (Description d) a
r of
Succeeded a :: a
a ->
Integer -> [a] -> StateT t m (Result (Description d) [a])
go (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1)
(a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as)
Continued e :: Description d
e ->
((Description d -> StateT t m (Result (Description d) [a]))
-> Description d -> StateT t m (Result (Description d) [a]))
-> Description d -> StateT t m (Result (Description d) [a])
forall a. (a -> a) -> a
fix (\continue :: Description d -> StateT t m (Result (Description d) [a])
continue e' :: Description d
e' ->
do t
s' <- StateT t m t
forall s (m :: * -> *). MonadState s m => m s
get
Result (Description d) a
r' <- StateT t m (Result (Description d) a)
p
case Result (Description d) a
r' of
Continued e'' :: Description d
e'' ->
Description d -> StateT t m (Result (Description d) [a])
continue (Description d
e' Description d -> Description d -> Description d
forall a. Semigroup a => a -> a -> a
<> Description d
e'')
Succeeded{} -> Description d -> StateT t m (Result (Description d) [a])
continue Description d
e'
Failed e'' :: Description d
e''
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
minb ->
do t -> StateT t m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put t
s'
Result (Description d) [a]
-> StateT t m (Result (Description d) [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) [a]
forall e a. e -> Result e a
Continued Description d
e')
| Bool
otherwise ->
Result (Description d) [a]
-> StateT t m (Result (Description d) [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) [a]
forall e a. e -> Result e a
Failed (Description d -> Description d
forall a. Description a -> Description a
redescribe Description d
e'')))
Description d
e
Failed e :: Description d
e
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
minb ->
do t -> StateT t m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put t
s
Result (Description d) [a]
-> StateT t m (Result (Description d) [a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Result (Description d) [a]
forall e a. a -> Result e a
Succeeded ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
as))
| Bool
otherwise ->
Result (Description d) [a]
-> StateT t m (Result (Description d) [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) [a]
forall e a. e -> Result e a
Failed (Description d -> Description d
forall a. Description a -> Description a
redescribe Description d
e)))
0
[])
where redescribe :: Description a -> Description a
redescribe = Integer -> Bound -> Description a -> Description a
forall a. Integer -> Bound -> Description a -> Description a
Bounded Integer
minb Bound
UnlimitedBound
instance (Semigroup a) => Semigroup (Result (Description d) a) where
x :: Result (Description d) a
x <> :: Result (Description d) a
-> Result (Description d) a -> Result (Description d) a
<> y :: Result (Description d) a
y =
case Result (Description d) a
x of
Failed e :: Description d
e -> Description d -> Result (Description d) a
forall e a. e -> Result e a
Failed Description d
e
Continued e :: Description d
e ->
case Result (Description d) a
y of
Failed e' :: Description d
e' -> Description d -> Result (Description d) a
forall e a. e -> Result e a
Failed Description d
e'
Continued e' :: Description d
e' -> Description d -> Result (Description d) a
forall e a. e -> Result e a
Continued (Description d
e Description d -> Description d -> Description d
forall a. Semigroup a => a -> a -> a
<> Description d
e')
Succeeded _ -> Description d -> Result (Description d) a
forall e a. e -> Result e a
Continued Description d
e
Succeeded a :: a
a ->
case Result (Description d) a
y of
Failed e :: Description d
e -> Description d -> Result (Description d) a
forall e a. e -> Result e a
Failed Description d
e
Continued e :: Description d
e -> Description d -> Result (Description d) a
forall e a. e -> Result e a
Continued Description d
e
Succeeded b :: a
b -> a -> Result (Description d) a
forall e a. a -> Result e a
Succeeded (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)
instance (Semigroup a, Monoid a) => Monoid (Result (Description d) a) where
mempty :: Result (Description d) a
mempty = a -> Result (Description d) a
forall e a. a -> Result e a
Succeeded a
forall a. Monoid a => a
mempty
mappend :: Result (Description d) a
-> Result (Description d) a -> Result (Description d) a
mappend = Result (Description d) a
-> Result (Description d) a -> Result (Description d) a
forall a. Semigroup a => a -> a -> a
(<>)
instance (Semigroup a, Monad m) => Semigroup (Consumer s d m a) where
<> :: Consumer s d m a -> Consumer s d m a -> Consumer s d m a
(<>) = (a -> a -> a)
-> Consumer s d m a -> Consumer s d m a -> Consumer s d m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
instance (Semigroup a, Monoid a, Monad m) => Monoid (Consumer s d m a) where
mempty :: Consumer s d m a
mempty =
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
forall s (m :: * -> *) d a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer (Description d -> StateT s m (Description d)
forall (m :: * -> *) a. Monad m => a -> m a
return Description d
forall a. Monoid a => a
mempty)
(Result (Description d) a -> StateT s m (Result (Description d) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Result (Description d) a
forall a. Monoid a => a
mempty)
mappend :: Consumer s d m a -> Consumer s d m a -> Consumer s d m a
mappend = Consumer s d m a -> Consumer s d m a -> Consumer s d m a
forall a. Semigroup a => a -> a -> a
(<>)
consumer :: (StateT s m (Description d))
-> (StateT s m (Result (Description d) a))
-> Consumer s d m a
consumer :: StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer d :: StateT s m (Description d)
d p :: StateT s m (Result (Description d) a)
p =
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
forall s d (m :: * -> *) a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
Consumer StateT s m (Description d)
d StateT s m (Result (Description d) a)
p
wrap :: (StateT t m (Description d) -> StateT s m (Description d))
-> (StateT t m (Description d) -> StateT t m (Result (Description d) a) -> StateT s m (Result (Description d) b))
-> Consumer t d m a
-> Consumer s d m b
wrap :: (StateT t m (Description d) -> StateT s m (Description d))
-> (StateT t m (Description d)
-> StateT t m (Result (Description d) a)
-> StateT s m (Result (Description d) b))
-> Consumer t d m a
-> Consumer s d m b
wrap redescribe :: StateT t m (Description d) -> StateT s m (Description d)
redescribe reparse :: StateT t m (Description d)
-> StateT t m (Result (Description d) a)
-> StateT s m (Result (Description d) b)
reparse (Consumer d :: StateT t m (Description d)
d p :: StateT t m (Result (Description d) a)
p) =
StateT s m (Description d)
-> StateT s m (Result (Description d) b) -> Consumer s d m b
forall s d (m :: * -> *) a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
Consumer (StateT t m (Description d) -> StateT s m (Description d)
redescribe StateT t m (Description d)
d)
(StateT t m (Description d)
-> StateT t m (Result (Description d) a)
-> StateT s m (Result (Description d) b)
reparse StateT t m (Description d)
d StateT t m (Result (Description d) a)
p)