{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE CPP #-}

-- | Descriptive parsers.

module Descriptive
  (-- * Consuming and describing
   consume
  ,describe
   -- * Lower-level runners
  ,runConsumer
  ,runDescription
  -- * Types
  ,Description(..)
  ,Bound(..)
  ,Consumer(..)
  ,Result(..)
  -- * Combinators
  ,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

--------------------------------------------------------------------------------
-- Running

-- | Run a consumer.
consume :: Consumer s d Identity a -- ^ The consumer to run.
        -> s -- ^ Initial state.
        -> 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 a consumer.
describe :: Consumer s d Identity a -- ^ The consumer to run.
         -> s -- ^ Initial state. Can be \"empty\" if you don't use it for
              -- generating descriptions.
         -> Description d -- ^ A description and resultant state.
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

-- | Run a consumer.
runConsumer :: Monad m
            => Consumer s d m a -- ^ The consumer to run.
            -> 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

-- | Describe a consumer.
runDescription :: Monad m
               => Consumer s d m a -- ^ The consumer to run.
               -> StateT s m (Description d) -- ^ A description and resultant state.
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

--------------------------------------------------------------------------------
-- Types

-- | Description of a consumable thing.
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
(<>)

-- | The bounds of a many-consumable thing.
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)

-- | A consumer.
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)}

-- | Some result.
data Result e a
  = Failed e    -- ^ The whole process failed.
  | Succeeded a -- ^ The whole process succeeded.
  | Continued e -- ^ There were errors but we continued to collect all the errors.
  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

-- | An internal sequence maker which describes itself better than
-- regular Alternative, and is strict, not lazy.
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
(<>)

--------------------------------------------------------------------------------
-- Combinators

-- | Make a self-describing consumer.
consumer :: (StateT s m (Description d))
         -- ^ Produce description based on the state.
         -> (StateT s m (Result (Description d) a))
         -- ^ Parse the state and maybe transform it if desired.
         -> 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 a consumer with another consumer. The type looks more
-- intimidating than it actually is. The source code is trivial. It
-- simply allows for a way to transform the type of the state.
wrap :: (StateT t m (Description d) -> StateT s m (Description d))
     -- ^ Transform the description.
     -> (StateT t m (Description d) -> StateT t m (Result (Description d) a) -> StateT s m (Result (Description d) b))
     -- ^ Transform the parser. Can re-run the parser as many times as desired.
     -> 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)