{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}

-- | Consuming form a list of characters.

module Descriptive.Char where

#if __GLASGOW_HASKELL__ < 802
import           Data.Traversable
#endif
import           Descriptive

import           Control.Monad.State.Strict
import           Data.Text (Text)
import qualified Data.Text as T

-- | Consume any character.
anyChar :: Monad m => Consumer [Char] Text m Char
anyChar :: Consumer [Char] Text m Char
anyChar =
  StateT [Char] m (Description Text)
-> StateT [Char] m (Result (Description Text) Char)
-> Consumer [Char] Text m Char
forall s (m :: * -> *) d a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer (Description Text -> StateT [Char] m (Description Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Description Text
d)
           (do [Char]
s <- StateT [Char] m [Char]
forall s (m :: * -> *). MonadState s m => m s
get
               case [Char]
s of
                 (c' :: Char
c':cs' :: [Char]
cs') -> do [Char] -> StateT [Char] m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Char]
cs'
                                Result (Description Text) Char
-> StateT [Char] m (Result (Description Text) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Result (Description Text) Char
forall e a. a -> Result e a
Succeeded Char
c')
                 [] -> Result (Description Text) Char
-> StateT [Char] m (Result (Description Text) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description Text -> Result (Description Text) Char
forall e a. e -> Result e a
Failed Description Text
d))
  where d :: Description Text
d = Text -> Description Text
forall a. a -> Description a
Unit "a character"

-- | A character consumer.
char :: Monad m => Char -> Consumer [Char] Text m Char
char :: Char -> Consumer [Char] Text m Char
char c :: Char
c =
  (StateT [Char] m (Description Text)
 -> StateT [Char] m (Description Text))
-> (StateT [Char] m (Description Text)
    -> StateT [Char] m (Result (Description Text) Char)
    -> StateT [Char] m (Result (Description Text) Char))
-> Consumer [Char] Text m Char
-> Consumer [Char] Text m Char
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 Text -> Description Text)
-> StateT [Char] m (Description Text)
-> StateT [Char] m (Description Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Description Text -> Description Text -> Description Text
forall a b. a -> b -> a
const Description Text
d))
       (\_ p :: StateT [Char] m (Result (Description Text) Char)
p ->
          do Result (Description Text) Char
r <- StateT [Char] m (Result (Description Text) Char)
p
             Result (Description Text) Char
-> StateT [Char] m (Result (Description Text) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (case Result (Description Text) Char
r of
                       (Failed e :: Description Text
e) -> Description Text -> Result (Description Text) Char
forall e a. e -> Result e a
Failed Description Text
e
                       (Continued e :: Description Text
e) ->
                         Description Text -> Result (Description Text) Char
forall e a. e -> Result e a
Continued Description Text
e
                       (Succeeded c' :: Char
c')
                         | Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c -> Char -> Result (Description Text) Char
forall e a. a -> Result e a
Succeeded Char
c
                         | Bool
otherwise -> Description Text -> Result (Description Text) Char
forall e a. e -> Result e a
Failed Description Text
d))
       Consumer [Char] Text m Char
forall (m :: * -> *). Monad m => Consumer [Char] Text m Char
anyChar
  where d :: Description Text
d = Text -> Description Text
forall a. a -> Description a
Unit (Char -> Text
T.singleton Char
c)

-- | A string consumer.
string :: Monad m => [Char] -> Consumer [Char] Text m [Char]
string :: [Char] -> Consumer [Char] Text m [Char]
string =
  (StateT [Char] m (Description Text)
 -> StateT [Char] m (Description Text))
-> (StateT [Char] m (Description Text)
    -> StateT [Char] m (Result (Description Text) [Char])
    -> StateT [Char] m (Result (Description Text) [Char]))
-> Consumer [Char] Text m [Char]
-> Consumer [Char] Text m [Char]
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 Text -> Description Text)
-> StateT [Char] m (Description Text)
-> StateT [Char] m (Description Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([Description Text] -> Description Text
forall a. [Description a] -> Description a
Sequence ([Description Text] -> Description Text)
-> (Description Text -> [Description Text])
-> Description Text
-> Description Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Description Text -> [Description Text]
forall a. Description a -> [Description a]
flattenAnds))
       (\_ p :: StateT [Char] m (Result (Description Text) [Char])
p -> StateT [Char] m (Result (Description Text) [Char])
p) (Consumer [Char] Text m [Char] -> Consumer [Char] Text m [Char])
-> ([Char] -> Consumer [Char] Text m [Char])
-> [Char]
-> Consumer [Char] Text m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  [Consumer [Char] Text m Char] -> Consumer [Char] Text m [Char]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ([Consumer [Char] Text m Char] -> Consumer [Char] Text m [Char])
-> ([Char] -> [Consumer [Char] Text m Char])
-> [Char]
-> Consumer [Char] Text m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Consumer [Char] Text m Char)
-> [Char] -> [Consumer [Char] Text m Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Consumer [Char] Text m Char
forall (m :: * -> *).
Monad m =>
Char -> Consumer [Char] Text m Char
char
  where flattenAnds :: Description a -> [Description a]
flattenAnds (And x :: Description a
x y :: Description a
y) = Description a -> [Description a]
flattenAnds Description a
x [Description a] -> [Description a] -> [Description a]
forall a. [a] -> [a] -> [a]
++ Description a -> [Description a]
flattenAnds Description a
y
        flattenAnds x :: Description a
x = [Description a
x]