descriptive 0.4.3 → 0.5.0

raw patch · 11 files changed

+426/−331 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +4/−0
• README.md +35/−16
• descriptive.cabal +2/−1
• src/Descriptive.hs +130/−131
• src/Descriptive/Char.hs +24/−15
• src/Descriptive/Form.hs +21/−19
• src/Descriptive/Formlet.hs +14/−7
• src/Descriptive/Internal.hs +13/−0
• src/Descriptive/JSON.hs +130/−92
• src/Descriptive/Options.hs +52/−48
• src/test/Main.hs +1/−2

@@ -1,3 +1,7 @@+0.5.0:+	* Changed the parser/doc type to use StateT m. So now you can use+	monads as part of your consumers.+ 0.2.0: 	* Change the type of flag. 	* Add the switch combinator (used to be “flag”).

@@ -23,8 +23,11 @@ To make a consumer, this combinator is used:  ``` haskell-consumer :: (s -> (Description d,s))-         -> (s -> (Result (Description d) a,s))+-- | Make a self-describing consumer.+consumer :: (forall m. Monad m => StateT s m (Description d))+         -- ^ Produce description based on the state.+         -> (forall m. Monad m => StateT s m (Result (Description d) a))+         -- ^ Parse the state and maybe transform it if desired.          -> Consumer s d a ``` @@ -37,10 +40,28 @@ To use a consumer or describe what it does, these are used:  ``` haskell-consume :: Consumer s d a -> s -> Result (Description d) a-describe :: Consumer s d a -> s -> Description d+consume :: Consumer s d a -- ^ The consumer to run.+        -> s -- ^ Initial state.+        -> Result (Description d) a+describe :: Consumer s d 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. ``` +Alternatively the parser/printer can be run in a monad of your choice:++``` haskell+runConsumer :: Monad m+            => Consumer s d a -- ^ The consumer to run.+            -> StateT s m (Result (Description d) a)+runConsumer (Consumer _ m) = m+runDescription :: Monad m+               => Consumer s d a -- ^ The consumer to run.+               -> StateT s m (Description d)+runDescription (Consumer desc _) = desc+```+ A description is like this:  ``` haskell@@ -48,10 +69,10 @@   = Unit !a   | Bounded !Integer !Bound !(Description a)   | And !(Description a) !(Description a)-  | Sequence [Description a]-  | Wrap a (Description a)+  | Or !(Description a) !(Description a)+  | Sequence ![Description a]+  | Wrap a !(Description a)   | None-  deriving (Show) ```  You configure the `a` for your use-case, but the rest is generatable@@ -75,7 +96,7 @@ ``` haskell λ> describe (many (char 'k') <> string "abc") mempty And (Bounded 0 UnlimitedBound (Unit "k"))-    (Sequence [Unit "a",Sequence [Unit "b",Sequence [Unit "c",Sequence []]]])+    (Sequence [Unit "a",Unit "b",Unit "c",None]) λ> consume (many (char 'k') <> string "abc") "kkkabc" (Succeeded "kkkabc") λ> consume (many (char 'k') <> string "abc") "kkkab"@@ -90,14 +111,13 @@  ``` haskell λ> describe ((,) <$> input "username" <*> input "password") mempty-(And (Unit (Input "username")) (Unit (Input "password")),fromList [])+And (Unit (Input "username")) (Unit (Input "password"))  λ> consume ((,) <$>             input "username" <*>             input "password")            (M.fromList [("username","chrisdone"),("password","god")])-(Succeeded ("chrisdone","god")-,fromList [("password","god"),("username","chrisdone")])+Succeeded ("chrisdone","god") ```  Conditions on two inputs:@@ -134,9 +154,7 @@ ``` haskell λ> describe ((,) <$> indexed <*> indexed)             (FormletState mempty 0)-And (Unit (Index 0))-    (Unit (Index 1))-              ,formletIndex = 2})+And (Unit (Index 0)) (Unit (Index 1)) λ> consume ((,) <$> indexed <*> indexed)            (FormletState (M.fromList [(0,"chrisdone"),(1,"god")]) 0) Succeeded ("chrisdone","god")@@ -152,10 +170,11 @@ ``` haskell server =   ((,,,) <$>-   constant "start" <*>+   constant "start" "cmd" () <*>    anyString "SERVER_NAME" <*>-   flag "dev" "Enable dev mode?" <*>+   switch "dev" "Enable dev mode?" <*>    arg "port" "Port to listen on")+   ((,,,) <$> ```  ``` haskell

@@ -1,5 +1,5 @@ name:                descriptive-version:             0.4.3+version:             0.5.0 synopsis:            Self-describing consumers/parsers; forms, cmd-line args, JSON, etc. description:         Self-describing consumers/parsers. See the README.md for more information. It is currently EXPERIMENTAL. stability:           Experimental@@ -23,6 +23,7 @@                      Descriptive.Formlet                      Descriptive.Options                      Descriptive.JSON+  other-modules:     Descriptive.Internal   build-depends:     aeson                    , base >= 4 && <5                    , bifunctors

@@ -21,13 +21,12 @@   ,Result(..)   -- * Combinators   ,consumer-  ,wrap-  ,sequencing)+  ,wrap)   where  import Control.Applicative+import Control.Monad.State.Strict import Data.Bifunctor-import Data.Function import Data.Monoid  --------------------------------------------------------------------------------@@ -37,26 +36,25 @@ consume :: Consumer s d a -- ^ The consumer to run.         -> s -- ^ Initial state.         -> Result (Description d) a-consume (Consumer _ m) = fst . m+consume c s = evalState (runConsumer c) s  -- | Describe a consumer. describe :: Consumer s d a -- ^ The consumer to run.-         -> s -- ^ Initial state. Can be empty if you don't use it for+         -> s -- ^ Initial state. Can be \"empty\" if you don't use it for               -- generating descriptions.          -> Description d -- ^ A description and resultant state.-describe (Consumer desc _) = fst . desc+describe c s = evalState (runDescription c) s  -- | Run a consumer.-runConsumer :: Consumer s d a -- ^ The consumer to run.-            -> s -- ^ Initial state.-            -> (Result (Description d) a,s)+runConsumer :: Monad m+            => Consumer s d a -- ^ The consumer to run.+            -> StateT s m (Result (Description d) a) runConsumer (Consumer _ m) = m  -- | Describe a consumer.-runDescription :: Consumer s d a -- ^ The consumer to run.-               -> s -- ^ Initial state. Can be empty if you don't use it for-                    -- generating descriptions.-               -> (Description d,s) -- ^ A description and resultant state.+runDescription :: Monad m+               => Consumer s d a -- ^ The consumer to run.+               -> StateT s m (Description d) -- ^ A description and resultant state. runDescription (Consumer desc _) = desc  --------------------------------------------------------------------------------@@ -68,8 +66,8 @@   | Bounded !Integer !Bound !(Description a)   | And !(Description a) !(Description a)   | Or !(Description a) !(Description a)-  | Sequence [Description a]-  | Wrap a (Description a)+  | Sequence ![Description a]+  | Wrap a !(Description a)   | None   deriving (Show,Eq) @@ -85,8 +83,8 @@  -- | A consumer. data Consumer s d a =-  Consumer {consumerDesc :: s -> (Description d,s)-           ,consumerParse :: s -> (Result (Description d) a,s)}+  Consumer {consumerDesc :: forall m. Monad m => StateT s m (Description d)+           ,consumerParse :: forall m. Monad m => StateT s m (Result (Description d) a)}  -- | Some result. data Result e a@@ -110,109 +108,116 @@ instance Functor (Consumer s d) where   fmap f (Consumer d p) =     Consumer d-             (\s ->-                case p s of-                  (Failed e,s') -> (Failed e,s')-                  (Continued e,s') -> (Continued e,s')-                  (Succeeded a,s') ->-                    (Succeeded (f a),s'))+             (do r <- p+                 case r of+                   (Failed e) ->+                     return (Failed e)+                   (Continued e) ->+                     return (Continued e)+                   (Succeeded a) ->+                     return (Succeeded (f a)))  instance Applicative (Consumer s d) where   pure a =-    consumer (\s -> (mempty,s))-             (\s -> (Succeeded a,s))+    consumer (return mempty)+             (return (Succeeded a))   Consumer d pf <*> Consumer d' p' =-    consumer (\s ->-                let !(e,s') = d s-                    !(e',s'') = d' s'-                in (e <> e',s''))-             (\s ->-                let !(mf,s') = pf s-                    !(ma,s'') = p' s'-                in case mf of-                     Failed e -> (Failed e,s')-                     Continued e ->-                       case ma of-                         Failed e' ->-                           (Failed e',s'')-                         Continued e' ->-                           (Continued (e <> e'),s'')-                         Succeeded _ ->-                           (Continued e,s'')-                     Succeeded f ->-                       case ma of-                         Continued e ->-                           (Continued e,s'')-                         Failed e ->-                           (Failed e,s'')-                         Succeeded a ->-                           (Succeeded (f a),s''))+    consumer (do e <- d+                 e' <- d'+                 return (e <> e'))+             (do mf <- pf+                 s <- get+                 ma <- p'+                 case mf of+                   Failed e ->+                     do put s+                        return (Failed e)+                   Continued e ->+                     case ma of+                       Failed e' ->+                         return (Failed e')+                       Continued e' ->+                         return (Continued (e <> e'))+                       Succeeded{} ->+                         return (Continued e)+                   Succeeded f ->+                     case ma of+                       Continued e ->+                         return (Continued e)+                       Failed e ->+                         return (Failed e)+                       Succeeded a ->+                         return (Succeeded (f a)))  instance Alternative (Consumer s d) where   empty =-    Consumer (\s -> (mempty,s))-             (\s -> (Failed mempty,s))-  a <|> b =-    Consumer (\s ->-                let !(d1,s') = consumerDesc a s-                    !(d2,s'') = consumerDesc b s'-                in (Or d1 d2,s''))-             (\s ->-                case consumerParse a s of-                  (Continued e1,s') ->-                    case consumerParse b s' of-                      (Failed e2,s'') ->-                        (Failed e2,s'')-                      (Continued e2,s'') ->-                        (Continued (e1 <> e2),s'')-                      (Succeeded a',s'') ->-                        (Succeeded a',s'')-                  (Failed e1,_) ->-                    case consumerParse b s of-                      (Failed e2,s') ->-                        (Failed (Or e1 e2),s')-                      (Continued e2,s'') ->-                        (Continued e2,s'')-                      (Succeeded a2,s') ->-                        (Succeeded a2,s')-                  (Succeeded a1,s') ->-                    (Succeeded a1,s'))-  some = sequenceHelper 1+    consumer (return mempty)+             (return (Failed mempty))+  Consumer d p <|> Consumer d' p' =+    consumer (do d1 <- d+                 d2 <- d'+                 return (Or d1 d2))+             (do s <- get+                 r <- p+                 case r of+                   Continued e1 ->+                     do r' <- p'+                        case r' of+                          Failed e2 ->+                            return (Failed e2)+                          Continued e2 ->+                            return (Continued (e1 <> e2))+                          Succeeded a' ->+                            return (Succeeded a')+                   Failed e1 ->+                     do put s+                        r' <- p'+                        case r' of+                          Failed e2 ->+                            return (Failed (Or e1 e2))+                          Continued e2 ->+                            return (Continued e2)+                          Succeeded a2 ->+                            return (Succeeded a2)+                   Succeeded a1 -> return (Succeeded a1))   many = sequenceHelper 0+  some = sequenceHelper 1  -- | An internal sequence maker which describes itself better than -- regular Alternative, and is strict, not lazy. sequenceHelper :: Integer -> Consumer t d a -> Consumer t d [a] sequenceHelper minb =-  wrap (\s d -> first redescribe (d s))-       (\s _ r ->-          fix (\go !i s' as ->-                 case r s' of-                   (Succeeded a,s'') ->-                     go (i + 1)-                        s''-                        (a : as)-                   (Continued e,s'') ->-                     fix (\continue e' s''' ->-                            case r s''' of-                              (Continued e'',s'''') ->-                                continue (e' <> e'') s''''-                              (Succeeded{},s'''') ->-                                continue e' s''''-                              (Failed e'',s'''')-                                | i >= minb ->-                                  (Continued e',s''')-                                | otherwise ->-                                  (Failed (redescribe e''),s''''))-                         e-                         s''-                   (Failed e,s'')-                     | i >= minb ->-                       (Succeeded (reverse as),s')-                     | otherwise ->-                       (Failed (redescribe e),s''))+  wrap (liftM redescribe)+       (\_ p ->+          fix (\go !i as ->+                 do s <- get+                    r <- p+                    case r of+                      Succeeded a ->+                        go (i + 1)+                           (a : as)+                      Continued e ->+                        fix (\continue e' ->+                               do s' <- get+                                  r' <- p+                                  case r' of+                                    Continued e'' ->+                                      continue (e' <> e'')+                                    Succeeded{} -> continue e'+                                    Failed e''+                                      | i >= minb ->+                                        do put s'+                                           return (Continued e')+                                      | otherwise ->+                                        return (Failed (redescribe e'')))+                            e+                      Failed e+                        | i >= minb ->+                          do put s+                             return (Succeeded (reverse as))+                        | otherwise ->+                          return (Failed (redescribe e)))               0-              s               [])   where redescribe = Bounded minb UnlimitedBound @@ -233,38 +238,32 @@           Succeeded b -> Succeeded (a <> b)  instance (Monoid a) => Monoid (Consumer s d a) where-  mempty = Consumer (\s -> (mempty,s)) (\s -> (mempty,s))+  mempty =+    consumer (return mempty)+             (return mempty)   mappend x y = (<>) <$> x <*> y  -------------------------------------------------------------------------------- -- Combinators --- | Make a consumer.-consumer :: (s -> (Description d,s)) -- ^ Produce description based on the state.-         -> (s -> (Result (Description d) a,s)) -- ^ Parse the state and maybe transform it if desired.+-- | Make a self-describing consumer.+consumer :: (forall m. Monad m => StateT s m (Description d))+         -- ^ Produce description based on the state.+         -> (forall m. Monad m => StateT s m (Result (Description d) a))+         -- ^ Parse the state and maybe transform it if desired.          -> Consumer s d a consumer d p =   Consumer d p --- | Wrap a consumer with another consumer.-wrap :: (s -> (t -> (Description d,t)) -> (Description d,s)) -- ^ Transformer the description.-     -> (s -> (t -> (Description d,t)) -> (t -> (Result (Description d) a,t)) -> (Result (Description d) b,s)) -- ^ Transform the parser. Can re-run the parser if desired.-     -> Consumer t d a -- ^ The consumer to transform.-     -> Consumer s d b -- ^ A new consumer with a potentially new state type.+-- | 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 :: (forall m. Monad m => StateT t m (Description d) -> StateT s m (Description d))+     -- ^ Transform the description.+     -> (forall m. Monad m => 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 a+     -> Consumer s d b wrap redescribe reparse (Consumer d p) =-  Consumer (\s -> redescribe s d)-           (\s -> reparse s d p)---- | Compose contiguous items into one sequence. Similar to 'sequenceA'.-sequencing :: [Consumer d s a] -> Consumer d s [a]-sequencing =-  wrap (\s d ->-          first (Sequence . se)-                (d s))-       (\s _ p -> p s) .-  go-  where se (And x y) = x : se y-        se None = []-        se x = [x]-        go (x:xs) = (:) <$> x <*> sequencing xs-        go [] = mempty+  Consumer (redescribe d)+           (reparse d p)

@@ -6,36 +6,45 @@  module Descriptive.Char where +import           Data.Traversable import           Descriptive +import           Control.Monad.State.Strict import           Data.Text (Text) import qualified Data.Text as T  -- | Consume any character. anyChar :: Consumer [Char] Text Char anyChar =-  consumer (d,)-           (\s ->-              case s of-                (c':cs') -> (Succeeded c',cs')-                [] -> (Failed d,s))+  consumer (return d)+           (do s <- get+               case s of+                 (c':cs') -> do put cs'+                                return (Succeeded c')+                 [] -> return (Failed d))   where d = Unit "a character"  -- | A character consumer. char :: Char -> Consumer [Char] Text Char char c =-  wrap (const .-        (d,))-       (\s _ p ->-          case p s of-            (Failed e,s') -> (Failed e,s')-            (Continued e,s') -> (Continued e,s')-            (Succeeded c',s')-              | c' == c -> (Succeeded c,s')-              | otherwise -> (Failed d,s'))+  wrap (liftM (const d))+       (\_ p ->+          do r <- p+             return (case r of+                       (Failed e) -> Failed e+                       (Continued e) ->+                         Continued e+                       (Succeeded c')+                         | c' == c -> Succeeded c+                         | otherwise -> Failed d))        anyChar   where d = Unit (T.singleton c)  -- | A string consumer. string :: [Char] -> Consumer [Char] Text [Char]-string = sequencing . map char+string =+  wrap (liftM (Sequence . flattenAnds))+       (\_ p -> p) .+  sequenceA . map char+  where flattenAnds (And x y) = flattenAnds x ++ flattenAnds y+        flattenAnds x = [x]

@@ -14,7 +14,7 @@  import           Descriptive -import           Control.Arrow+import           Control.Monad.State.Strict import           Data.Map.Strict (Map) import qualified Data.Map.Strict as M import           Data.Text (Text)@@ -28,12 +28,11 @@ -- | Consume any input value. input :: Text -> Consumer (Map Text Text) Form Text input name =-  consumer (d,)-           (\s ->-              (case M.lookup name s of-                 Nothing -> Continued d-                 Just a -> Succeeded a-              ,s))+  consumer (return d)+           (do s <- get+               return (case M.lookup name s of+                         Nothing -> Continued d+                         Just a -> Succeeded a))   where d = Unit (Input name)  -- | Validate a form input with a description of what's required.@@ -42,15 +41,18 @@          -> Consumer (Map Text Text) Form a -- ^ Consumer to add validation to.          -> Consumer (Map Text Text) Form b validate d' check =-  wrap (\s d -> redescribe (d s))-       (\s d p ->-          case p s of-            (Failed e,s') -> (Failed e,s')-            (Continued e,s') -> (Continued (wrapper e),s')-            (Succeeded a,s') ->-              case check a of-                Nothing ->-                  (Continued (fst (redescribe (d s))),s')-                Just a' -> (Succeeded a',s'))-  where redescribe = first wrapper-        wrapper = Wrap (Constraint d')+  wrap (liftM wrapper)+       (\d p ->+          do s <- get+             r <- p+             case r of+               (Failed e) -> return (Failed e)+               (Continued e) ->+                 return (Continued (wrapper e))+               (Succeeded a) ->+                 case check a of+                   Nothing ->+                     do doc <- withStateT (const s) d+                        return (Continued (wrapper doc))+                   Just a' -> return (Succeeded a'))+  where wrapper = Wrap (Constraint d')

@@ -13,6 +13,7 @@  import           Descriptive +import           Control.Monad.State.Strict import           Data.Map.Strict (Map) import qualified Data.Map.Strict as M import           Data.Text (Text)@@ -32,11 +33,17 @@ -- | Consume any character. indexed :: Consumer FormletState Formlet Text indexed =-  consumer (\(nextIndex -> (i,s)) -> (d i,s))-           (\(nextIndex -> (i,s)) ->-              case M.lookup i (formletMap s) of-                Nothing -> (Failed (d i),s)-                Just a -> (Succeeded a,s))+  consumer (do i <- nextIndex+               return (d i))+           (do i <- nextIndex+               s <- get+               return (case M.lookup i (formletMap s) of+                         Nothing -> Failed (d i)+                         Just a -> Succeeded a))   where d = Unit . Index-        nextIndex s =-          (formletIndex s,s {formletIndex = formletIndex s + 1})+        nextIndex :: MonadState FormletState m => m Integer+        nextIndex =+          do i <- gets formletIndex+             modify (\s ->+                       s {formletIndex = formletIndex s + 1})+             return i

@@ -0,0 +1,13 @@+-- | Internal functions not necessary to be exported.++module Descriptive.Internal where++import Control.Monad.State.Strict++-- | Run a different state in this state monad.+runSubStateT :: Monad m+             => (s -> s') -> (s' -> s) -> StateT s' m a -> StateT s m a+runSubStateT to from m =+  StateT (\s ->+            liftM (\(a,s') -> (a,from s'))+                  (runStateT m (to s)))

@@ -29,9 +29,11 @@   )   where -import           Data.Scientific import           Descriptive+import           Descriptive.Internal +import           Control.Monad.State.Strict+import           Data.Scientific import           Data.Function import           Data.Aeson hiding (Value(Object,Null,Array),object) import           Data.Aeson.Types (Value,parseMaybe)@@ -64,16 +66,29 @@        -> Consumer Object Doc a -- ^ An object consumer.        -> Consumer Value Doc a object desc =-  wrap (\v d -> (Wrap doc (fst (d mempty)),v))-       (\v _ p ->-          case fromJSON v of-            Error{} -> (Failed (Unit doc),v)-            Success o ->-              (case p o of-                 (Failed e,_) -> Failed (Wrap doc e)-                 (Continued e,_) -> Failed (Wrap doc e)-                 (Succeeded a,_) -> Succeeded a-              ,toJSON o))+  wrap (\d ->+          do s <- get+             runSubStateT (const mempty)+                          (const s)+                          (liftM (Wrap doc) d))+       (\_ p ->+          do v <- get+             case fromJSON v of+               Error{} ->+                 return (Failed (Unit doc))+               Success (o :: Object) ->+                 do s <- get+                    runSubStateT+                      (const o)+                      (const s)+                      (do r <- p+                          case r of+                            Failed e ->+                              return (Failed (Wrap doc e))+                            Continued e ->+                              return (Continued (Wrap doc e))+                            Succeeded a ->+                              return (Succeeded a)))   where doc = Object desc  -- | Consume from object at the given key.@@ -81,18 +96,23 @@     -> Consumer Value Doc a -- ^ A value consumer of the object at the key.     -> Consumer Object Doc a key k =-  wrap (\o d ->-          first (Wrap doc)-                (second (const o)-                        (d (toJSON o))))-       (\o _ p ->-          case parseMaybe (const (o .: k))-                          () of-            Nothing -> (Failed (Unit doc),o)-            Just (v :: Value) ->-              first (bimap (Wrap doc) id)-                    (second (const o)-                            (p v)))+  wrap (\d ->+          do s <- get+             runSubStateT toJSON+                          (const s)+                          (liftM (Wrap doc) d))+       (\_ p ->+          do s <- get+             case parseMaybe (const (s .: k))+                             () of+               Nothing ->+                 return (Failed (Unit doc))+               Just (v :: Value) ->+                 do r <-+                      runSubStateT (const v)+                                   (const s)+                                   p+                    return (bimap (Wrap doc) id r))   where doc = Key k  -- | Optionally consume from object at the given key, only if it@@ -101,18 +121,23 @@          -> Consumer Value Doc a -- ^ A value consumer of the object at the key.          -> Consumer Object Doc (Maybe a) keyMaybe k =-  wrap (\o d ->-          first (Wrap doc)-                (second (const o)-                        (d (toJSON o))))-       (\o _ p ->-          case parseMaybe (const (o .: k))-                          () of-            Nothing -> (Succeeded Nothing,o)-            Just (v :: Value) ->-              first (bimap (Wrap doc) Just)-                    (second (const o)-                            (p v)))+  wrap (\d ->+          do s <- get+             runSubStateT toJSON+                          (const s)+                          (liftM (Wrap doc) d))+       (\_ p ->+          do s <- get+             case parseMaybe (const (s .: k))+                             () of+               Nothing ->+                 return (Succeeded Nothing)+               Just (v :: Value) ->+                 do r <-+                      runSubStateT (const v)+                                   (const s)+                                   p+                    return (bimap (Wrap doc) Just r))   where doc = Key k  -- | Consume an array.@@ -120,82 +145,91 @@       -> Consumer Value Doc a -- ^ Consumer for each element in the array.       -> Consumer Value Doc (Vector a) array desc =-  wrap (\v d -> (Wrap doc (fst (d Aeson.Null)),v))-       (\v _ p ->-          case fromJSON v of-            Error{} -> (Failed (Unit doc),v)-            Success (o :: Vector Value) ->-              (fix (\loop i acc ->-                      if i < V.length o - 1-                         then case p (o ! i) of-                                (Failed e,_) ->-                                  Failed (Wrap doc e)-                                (Continued e,_) ->-                                  Failed (Wrap doc e)-                                (Succeeded a,_) ->-                                  loop (i + 1) (a : acc)-                         else Succeeded (V.fromList (reverse acc)))-                   0-                   []-              ,v))+  wrap (\d -> liftM (Wrap doc) d)+       (\_ p ->+          do s <- get+             case fromJSON s of+               Error{} ->+                 return (Failed (Unit doc))+               Success (o :: Vector Value) ->+                 fix (\loop i acc ->+                        if i < V.length o - 1+                           then do r <-+                                     runSubStateT (const (o ! i))+                                                  (const s)+                                                  p+                                   case r of+                                     Failed e ->+                                       return (Failed (Wrap doc e))+                                     Continued e ->+                                       return (Failed (Wrap doc e))+                                     Succeeded a ->+                                       loop (i + 1)+                                            (a : acc)+                           else return (Succeeded (V.fromList (reverse acc))))+                     0+                     [])   where doc = Array desc  -- | Consume a string. string :: Text -- ^ Description of what the string is for.        -> Consumer Value Doc Text string doc =-  consumer (d,)-           (\s ->-              case fromJSON s of-                Error{} -> (Failed d,s)-                Success a -> (Succeeded a,s))+  consumer (return d)+           (do s <- get+               case fromJSON s of+                 Error{} -> return (Failed d)+                 Success a ->+                   return (Succeeded a))   where d = Unit (Text doc)  -- | Consume an integer. integer :: Text -- ^ Description of what the integer is for.         -> Consumer Value Doc Integer integer doc =-  consumer (d,)-           (\s ->-              case s of-                Number a-                  | Right i <- floatingOrInteger a ->-                    (Succeeded i,s)-                _ -> (Failed d,s))+  consumer (return d)+           (do s <- get+               case s of+                 Number a+                   | Right i <- floatingOrInteger a ->+                     return (Succeeded i)+                 _ -> return (Failed d))   where d = Unit (Integer doc)  -- | Consume an double. double :: Text -- ^ Description of what the double is for.-        -> Consumer Value Doc Double+       -> Consumer Value Doc Double double doc =-  consumer (d,)-           (\s ->-              case s of-                Number a ->-                  (Succeeded (toRealFloat a),s)-                _ -> (Failed d,s))+  consumer (return d)+           (do s <- get+               case s of+                 Number a ->+                   return (Succeeded (toRealFloat a))+                 _ -> return (Failed d))   where d = Unit (Double doc)  -- | Parse a boolean. bool :: Text -- ^ Description of what the bool is for.      -> Consumer Value Doc Bool bool doc =-  consumer (d,)-           (\s ->-              case fromJSON s of-                Error{} -> (Failed d,s)-                Success a -> (Succeeded a,s))+  consumer (return d)+           (do s <- get+               case fromJSON s of+                 Error{} -> return (Failed d)+                 Success a ->+                   return (Succeeded a))   where d = Unit (Boolean doc)  -- | Expect null. null :: Text -- ^ What the null is for.        -> Consumer Value Doc () null doc =-  consumer (d,)-           (\s ->-              case fromJSON s of-                Success Aeson.Null -> (Succeeded (),s)-                _ -> (Failed d,s))+  consumer (return d)+           (do s <- get+               case fromJSON s of+                 Success Aeson.Null ->+                   return (Succeeded ())+                 _ -> return (Failed d))   where d = Unit (Null doc)  -- | Wrap a consumer with a label e.g. a type tag.@@ -203,11 +237,13 @@       -> Consumer s Doc a -- ^ A value consumer.       -> Consumer s Doc a label desc =-  wrap (\s d -> (Wrap doc (fst (d s)),s))-       (\s _ p ->-          case p s of-            (Failed e,s') -> (Failed (Wrap doc e),s')-            k -> k)+  wrap (liftM (Wrap doc))+       (\_ p ->+          do r <- p+             case r of+               Failed e ->+                 return (Failed (Wrap doc e))+               k -> return k)   where doc = Label desc  -- | Wrap a consumer with some handy information.@@ -215,9 +251,11 @@      -> Consumer s Doc a -- ^ A value consumer.      -> Consumer s Doc a info desc =-  wrap (\s d -> (Wrap doc (fst (d s)),s))-       (\s _ p ->-          case p s of-            (Failed e,s') -> (Failed (Wrap doc e),s')-            k -> k)+  wrap (liftM (Wrap doc))+       (\_ p ->+          do r <- p+             case r of+               Failed e ->+                 return (Failed (Wrap doc e))+               k -> return k)   where doc = Info desc

@@ -1,5 +1,4 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE TupleSections #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} @@ -24,10 +23,10 @@   ,textOpt)   where -import           Control.Applicative-import           Data.Bifunctor import           Descriptive +import           Control.Applicative+import           Control.Monad.State.Strict import           Data.Char import           Data.List import           Data.Monoid@@ -51,28 +50,31 @@      -- ^ A parser which, when it succeeds, causes the whole parser to stop.      -> Consumer [Text] (Option a) () stop =-  wrap (\s d ->-          first (Wrap Stops)-                (d s))-       (\s d p ->-          case p s of-            (Failed _,s') -> (Succeeded (),s')-            (Continued e,s') -> (Continued e,s')-            (Succeeded a,s') ->-              (Failed (Wrap (Stopped a)-                            (fst (d s)))-              ,s'))+  wrap (liftM (Wrap Stops))+       (\d p ->+          do r <- p+             s <- get+             case r of+               (Failed _) ->+                 return (Succeeded ())+               (Continued e) ->+                 return (Continued e)+               (Succeeded a) ->+                 do doc <- withStateT (const s) d+                    return (Failed (Wrap (Stopped a)+                                         doc)))  -- | Consume one argument from the argument list and pops it from the -- start of the list. anyString :: Text -- Help for the string.           -> Consumer [Text] (Option a) Text anyString help =-  consumer (d,)-           (\s ->-              case s of-                [] -> (Failed d,s)-                (x:s') -> (Succeeded x,s'))+  consumer (return d)+           (do s <- get+               case s of+                 [] -> return (Failed d)+                 (x:s') -> do put s'+                              return (Succeeded x))   where d = Unit (AnyString help)  -- | Consume one argument from the argument list which must match the@@ -82,12 +84,13 @@          -> v          -> Consumer [Text] (Option a) v constant x' desc v =-  consumer (d,)-           (\s ->-              case s of-                (x:s') | x == x' ->-                  (Succeeded v,s')-                _ -> (Failed d,s))+  consumer (return d)+           (do s <- get+               case s of+                 (x:s') | x == x' ->+                   do put s'+                      return (Succeeded v)+                 _ -> return (Failed d))   where d = Unit (Constant x' desc)  -- | Find a value flag which must succeed. Removes it from the@@ -97,12 +100,12 @@      -> v    -- ^ Value returned when present.      -> Consumer [Text] (Option a) v flag name help v =-  consumer (d,)-           (\s ->-              if elem ("--" <> name) s-                 then (Succeeded v,filter (/= "--" <> name) s)-                 else (Failed d,s)-              )+  consumer (return d)+           (do s <- get+               if elem ("--" <> name) s+                  then do put (filter (/= "--" <> name) s)+                          return (Succeeded v)+                  else return (Failed d))   where d = Unit (Flag name help)  -- | Find a boolean flag. Always succeeds. Omission counts as@@ -120,11 +123,12 @@        -> Text -- ^ Description.        -> Consumer [Text] (Option a) Text prefix pref help =-  consumer (d,)-           (\s ->-              case find (T.isPrefixOf ("-" <> pref)) s of-                Nothing -> (Failed d,s)-                Just a -> (Succeeded (T.drop (T.length pref + 1) a), delete a s))+  consumer (return d)+           (do s <- get+               case find (T.isPrefixOf ("-" <> pref)) s of+                 Nothing -> return (Failed d)+                 Just a -> do put (delete a s)+                              return (Succeeded (T.drop (T.length pref + 1) a)))   where d = Unit (Prefix pref help)  -- | Find a named argument e.g. @--name value@. Removes it from the@@ -133,18 +137,18 @@     -> Text -- ^ Description.     -> Consumer [Text] (Option a) Text arg name help =-  consumer (d,)-           (\s ->-              let indexedArgs =-                    zip [0 :: Integer ..] s-              in case find ((== "--" <> name) . snd) indexedArgs of-                   Nothing -> (Failed d,s)-                   Just (i,_) ->-                     case lookup (i + 1) indexedArgs of-                       Nothing -> (Failed d,s)-                       Just text ->-                         (Succeeded text-                         ,map snd (filter (\(j,_) -> j /= i && j /= i + 1) indexedArgs)))+  consumer (return d)+           (do s <- get+               let indexedArgs =+                     zip [0 :: Integer ..] s+               case find ((== "--" <> name) . snd) indexedArgs of+                 Nothing -> return (Failed d)+                 Just (i,_) ->+                   case lookup (i + 1) indexedArgs of+                     Nothing -> return (Failed d)+                     Just text ->+                       do put (map snd (filter (\(j,_) -> j /= i && j /= i + 1) indexedArgs))+                          return (Succeeded text))   where d = Unit (Arg name help)  -- | Make a text description of the command line options.

@@ -44,8 +44,7 @@                    Char.string "abc")                   mempty ==          And (Bounded 0 UnlimitedBound (Unit "k"))-             (Sequence [Unit "a"-                       ,Sequence [Unit "b",Sequence [Unit "c",Sequence []]]]))+             (Sequence [Unit "a",Unit "b",Unit "c",None]))      it "consume"         (consume (many (Char.char 'k') <>                   Char.string "abc")