packages feed

descriptive 0.8.0 → 0.9.0

raw patch · 5 files changed

+60/−49 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Descriptive: validate :: Monad m => d -> (a -> StateT s m (Maybe b)) -> Consumer s d m a -> Consumer s d m b
+ Descriptive: instance Functor Description
+ Descriptive.JSON: parse :: Monad m => d -> (a -> StateT s m (Maybe b)) -> Consumer s d m a -> Consumer s d m b

Files

CHANGELOG view
@@ -1,3 +1,6 @@+0.9.0:+	* Move 'validate' to .JSON as 'parse'.+ 0.5.0: 	* Changed the parser/doc type to use StateT m. So now you can use 	monads as part of your consumers.
README.md view
@@ -205,7 +205,6 @@    anyString "SERVER_NAME" <*>    switch "dev" "Enable dev mode?" <*>    arg "port" "Port to listen on")-   ((,,,) <$> ```  ``` haskell@@ -267,15 +266,15 @@  ``` haskell λ> describe submission (toJSON ())-Wrap (Struct "Submission")-      (And (And (And (Wrap (Key "token")-                           (Unit (Integer "Submission token; see the API docs")))-                     (Wrap (Key "title")-                           (Unit (Text "Submission title"))))-                (Wrap (Key "comment")-                      (Unit (Text "Submission comment"))))-           (Wrap (Key "subreddit")-                 (Unit (Integer "The ID of the subreddit"))))+Wrap (Object "Submission")+     (And (And (And (Wrap (Key "token")+                          (Unit (Integer "Submission token; see the API docs")))+                    (Wrap (Key "title")+                          (Unit (Text "Submission title"))))+               (Wrap (Key "comment")+                     (Unit (Text "Submission comment"))))+          (Wrap (Key "subreddit")+                (Unit (Integer "The ID of the subreddit"))))   λ> consume submission sample@@ -284,9 +283,9 @@                    ,submissionComment = "This is good"                    ,submissionSubreddit = 234214}) λ> consume submission badsample-Failed (Wrap (Struct "Submission")-            (Wrap (Key "comment")-                  (Unit (Text "Submission comment"))))+Failed (Wrap (Object "Submission")+             (Wrap (Key "comment")+                   (Unit (Text "Submission comment")))) ```  The bad sample yields an informative message that:
descriptive.cabal view
@@ -1,5 +1,5 @@ name:                descriptive-version:             0.8.0+version:             0.9.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
src/Descriptive.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -21,13 +23,12 @@   ,Result(..)   -- * Combinators   ,consumer-  ,wrap-  ,validate)+  ,wrap)   where  import Control.Applicative-import Control.Monad.State.Strict import Control.Monad.Identity+import Control.Monad.State.Strict import Data.Bifunctor import Data.Monoid @@ -71,11 +72,13 @@   | Sequence ![Description a]   | Wrap a !(Description a)   | None-  deriving (Show,Eq)+  deriving (Show,Eq,Functor)  instance Monoid (Description d) where   mempty = None-  mappend = And+  mappend None x = x+  mappend x None = x+  mappend x y = And x y  -- | The bounds of a many-consumable thing. data Bound@@ -158,7 +161,7 @@   Consumer d p <|> Consumer d' p' =     consumer (do d1 <- d                  d2 <- d'-                 return (Or d1 d2))+                 return (disjunct d1 d2))              (do s <- get                  r <- p                  case r of@@ -168,7 +171,7 @@                           Failed e2 ->                             return (Failed e2)                           Continued e2 ->-                            return (Continued (e1 <> e2))+                            return (Continued (disjunct e1 e2))                           Succeeded a' ->                             return (Succeeded a')                    Failed e1 ->@@ -176,12 +179,15 @@                         r' <- p'                         case r' of                           Failed e2 ->-                            return (Failed (Or e1 e2))+                            return (Failed (disjunct e1 e2))                           Continued e2 ->                             return (Continued e2)                           Succeeded a2 ->                             return (Succeeded a2)                    Succeeded a1 -> return (Succeeded a1))+    where disjunct None x = x+          disjunct x None = x+          disjunct x y = Or x y   many = sequenceHelper 0   some = sequenceHelper 1 @@ -243,7 +249,7 @@   mempty =     consumer (return mempty)              (return mempty)-  mappend x y = (<>) <$> x <*> y+  mappend = liftA2 (<>)  -------------------------------------------------------------------------------- -- Combinators@@ -269,27 +275,3 @@ wrap redescribe reparse (Consumer d p) =   Consumer (redescribe d)            (reparse d p)---- | Add validation to a consumer.-validate :: Monad m-         => d                           -- ^ Description of what it expects.-         -> (a -> StateT s m (Maybe b)) -- ^ Attempt to parse the value.-         -> Consumer s d m a            -- ^ Consumer to add validation to.-         -> Consumer s d m b            -- ^ A new validating consumer.-validate d' check =-  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) ->-                 do r' <- check a-                    case r' of-                      Nothing ->-                        do doc <- withStateT (const s) d-                           return (Continued (wrapper doc))-                      Just a' -> return (Succeeded a'))-  where wrapper = Wrap d'
src/Descriptive/JSON.hs view
@@ -12,7 +12,8 @@  module Descriptive.JSON   (-- * Consumers-   object+   parse+  ,object   ,key   ,keyMaybe   ,array@@ -155,7 +156,7 @@                  return (Continued (Unit doc))                Success (o :: Vector Value) ->                  fix (\loop i acc ->-                        if i < V.length o - 1+                        if i < V.length o                            then do r <-                                      runSubStateT (const (o ! i))                                                   (const s)@@ -250,6 +251,32 @@           do r <- p              case r of                Failed e ->+                 return (Failed (Wrap doc e))+               Continued e ->                  return (Continued (Wrap doc e))                k -> return k)   where doc = Label desc++-- | Parse from a consumer.+parse :: Monad m+      => d                           -- ^ Description of what it expects.+      -> (a -> StateT s m (Maybe b)) -- ^ Attempt to parse the value.+      -> Consumer s d m a            -- ^ Consumer to add validation to.+      -> Consumer s d m b            -- ^ A new validating consumer.+parse d' check =+  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) ->+                 do r' <- check a+                    case r' of+                      Nothing ->+                        do doc <- withStateT (const s) d+                           return (Continued (wrapper doc))+                      Just a' -> return (Succeeded a'))+  where wrapper = Wrap d'