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 +3/−0
- README.md +12/−13
- descriptive.cabal +1/−1
- src/Descriptive.hs +15/−33
- src/Descriptive/JSON.hs +29/−2
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'