diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,7 +3,7 @@ Self-describing consumers/parsers -[Haddocks](http://chrisdone.com/descriptive/) +[Documentation](http://chrisdone.github.io/descriptive/) There are a variety of Haskell libraries which are implementable through a common interface: self-describing parsers: @@ -25,12 +25,11 @@ To make a consumer, this combinator is used: ``` haskell --- | Make a self-describing consumer. -consumer :: (forall m. Monad m => StateT s m (Description d)) +consumer :: (StateT s m (Description d)) -- ^ Produce description based on the state. - -> (forall m. Monad m => StateT s m (Result (Description d) a)) + -> (StateT s m (Result (Description d) a)) -- ^ Parse the state and maybe transform it if desired. - -> Consumer s d a + -> Consumer s d m a ``` The first argument generates a description based on some state. The @@ -44,11 +43,11 @@ To use a consumer or describe what it does, these are used: ``` haskell -consume :: Consumer s d a -- ^ The consumer to run. +consume :: Consumer s d Identity a -- ^ The consumer to run. -> s -- ^ Initial state. -> Result (Description d) a -describe :: Consumer s d a -- ^ The consumer to run. +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. @@ -58,14 +57,12 @@ ``` haskell runConsumer :: Monad m - => Consumer s d a -- ^ The consumer to run. + => Consumer s d m 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 + => Consumer s d m a -- ^ The consumer to run. + -> StateT s m (Description d) -- ^ A description and resultant state. ``` ### Descriptions @@ -102,25 +99,23 @@ validation, things of that nature: ``` haskell -wrap :: (forall m. Monad m => StateT t m (Description d) - -> StateT s m (Description d)) +wrap :: (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)) + -> (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 + -> Consumer t d m a + -> Consumer s d m b ``` There is also a handy function written in terms of `wrap` which will validate a consumer. ``` haskell -validate :: d -- ^ Description of what it expects. - -> (forall m. MonadState s m => a -> m (Maybe b)) -- ^ Attempt to parse the value. - -> Consumer s d a -- ^ Consumer to add validation to. - -> Consumer s d b -- ^ A new validating 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. ``` See below for some examples of this library. @@ -244,7 +239,7 @@ ,submissionSubreddit :: !Integer} deriving (Show) -submission :: Consumer Value Doc Submission +submission :: Monad m => Consumer Value Doc m Submission submission = object "Submission" (Submission diff --git a/descriptive.cabal b/descriptive.cabal --- a/descriptive.cabal +++ b/descriptive.cabal @@ -1,5 +1,5 @@ name: descriptive -version: 0.7.0 +version: 0.8.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 diff --git a/src/Descriptive.hs b/src/Descriptive.hs --- a/src/Descriptive.hs +++ b/src/Descriptive.hs @@ -271,7 +271,7 @@ (reparse d p) -- | Add validation to a consumer. -validate :: Monad m +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. diff --git a/src/Descriptive/JSON.hs b/src/Descriptive/JSON.hs --- a/src/Descriptive/JSON.hs +++ b/src/Descriptive/JSON.hs @@ -23,7 +23,6 @@ ,null -- * Annotations ,label - ,info -- * Description ,Doc(..) ) @@ -48,7 +47,7 @@ import Prelude hiding (null) -- | Description of parseable things. -data Doc +data Doc a = Integer !Text | Double !Text | Text !Text @@ -57,15 +56,14 @@ | Object !Text | Key !Text | Array !Text - | Label !Text - | Info !Text + | Label !a deriving (Eq,Show,Typeable,Data) -- | Consume an object. object :: Monad m => Text -- ^ Description of what the object is. - -> Consumer Object Doc m a -- ^ An object consumer. - -> Consumer Value Doc m a + -> Consumer Object (Doc d) m a -- ^ An object consumer. + -> Consumer Value (Doc d) m a object desc = wrap (\d -> do s <- get @@ -76,7 +74,7 @@ do v <- get case fromJSON v of Error{} -> - return (Failed (Unit doc)) + return (Continued (Unit doc)) Success (o :: Object) -> do s <- get runSubStateT @@ -85,7 +83,7 @@ (do r <- p case r of Failed e -> - return (Failed (Wrap doc e)) + return (Continued (Wrap doc e)) Continued e -> return (Continued (Wrap doc e)) Succeeded a -> @@ -95,8 +93,8 @@ -- | Consume from object at the given key. key :: Monad m => Text -- ^ The key to lookup. - -> Consumer Value Doc m a -- ^ A value consumer of the object at the key. - -> Consumer Object Doc m a + -> Consumer Value (Doc d) m a -- ^ A value consumer of the object at the key. + -> Consumer Object (Doc d) m a key k = wrap (\d -> do s <- get @@ -108,7 +106,7 @@ case parseMaybe (const (s .: k)) () of Nothing -> - return (Failed (Unit doc)) + return (Continued (Unit doc)) Just (v :: Value) -> do r <- runSubStateT (const v) @@ -121,8 +119,8 @@ -- exists. keyMaybe :: Monad m => Text -- ^ The key to lookup. - -> Consumer Value Doc m a -- ^ A value consumer of the object at the key. - -> Consumer Object Doc m (Maybe a) + -> Consumer Value (Doc d) m a -- ^ A value consumer of the object at the key. + -> Consumer Object (Doc d) m (Maybe a) keyMaybe k = wrap (\d -> do s <- get @@ -146,15 +144,15 @@ -- | Consume an array. array :: Monad m => Text -- ^ Description of this array. - -> Consumer Value Doc m a -- ^ Consumer for each element in the array. - -> Consumer Value Doc m (Vector a) + -> Consumer Value (Doc d) m a -- ^ Consumer for each element in the array. + -> Consumer Value (Doc d) m (Vector a) array desc = wrap (\d -> liftM (Wrap doc) d) (\_ p -> do s <- get case fromJSON s of Error{} -> - return (Failed (Unit doc)) + return (Continued (Unit doc)) Success (o :: Vector Value) -> fix (\loop i acc -> if i < V.length o - 1 @@ -164,9 +162,9 @@ p case r of Failed e -> - return (Failed (Wrap doc e)) + return (Continued (Wrap doc e)) Continued e -> - return (Failed (Wrap doc e)) + return (Continued (Wrap doc e)) Succeeded a -> loop (i + 1) (a : acc) @@ -178,12 +176,12 @@ -- | Consume a string. string :: Monad m => Text -- ^ Description of what the string is for. - -> Consumer Value Doc m Text + -> Consumer Value (Doc d) m Text string doc = consumer (return d) (do s <- get case fromJSON s of - Error{} -> return (Failed d) + Error{} -> return (Continued d) Success a -> return (Succeeded a)) where d = Unit (Text doc) @@ -191,7 +189,7 @@ -- | Consume an integer. integer :: Monad m => Text -- ^ Description of what the integer is for. - -> Consumer Value Doc m Integer + -> Consumer Value (Doc d) m Integer integer doc = consumer (return d) (do s <- get @@ -199,31 +197,31 @@ Number a | Right i <- floatingOrInteger a -> return (Succeeded i) - _ -> return (Failed d)) + _ -> return (Continued d)) where d = Unit (Integer doc) -- | Consume an double. double :: Monad m => Text -- ^ Description of what the double is for. - -> Consumer Value Doc m Double + -> Consumer Value (Doc d) m Double double doc = consumer (return d) (do s <- get case s of Number a -> return (Succeeded (toRealFloat a)) - _ -> return (Failed d)) + _ -> return (Continued d)) where d = Unit (Double doc) -- | Parse a boolean. bool :: Monad m => Text -- ^ Description of what the bool is for. - -> Consumer Value Doc m Bool + -> Consumer Value (Doc d) m Bool bool doc = consumer (return d) (do s <- get case fromJSON s of - Error{} -> return (Failed d) + Error{} -> return (Continued d) Success a -> return (Succeeded a)) where d = Unit (Boolean doc) @@ -231,42 +229,27 @@ -- | Expect null. null :: Monad m => Text -- ^ What the null is for. - -> Consumer Value Doc m () + -> Consumer Value (Doc d) m () null doc = consumer (return d) (do s <- get case fromJSON s of Success Aeson.Null -> return (Succeeded ()) - _ -> return (Failed d)) + _ -> return (Continued d)) where d = Unit (Null doc) -- | Wrap a consumer with a label e.g. a type tag. label :: Monad m - => Text -- ^ Some label. - -> Consumer s Doc m a -- ^ A value consumer. - -> Consumer s Doc m a + => d -- ^ Some label. + -> Consumer s (Doc d) m a -- ^ A value consumer. + -> Consumer s (Doc d) m a label desc = wrap (liftM (Wrap doc)) (\_ p -> do r <- p case r of Failed e -> - return (Failed (Wrap doc e)) + return (Continued (Wrap doc e)) k -> return k) where doc = Label desc - --- | Wrap a consumer with some handy information. -info :: Monad m - => Text -- ^ Some information. - -> Consumer s Doc m a -- ^ A value consumer. - -> Consumer s Doc m a -info desc = - 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 diff --git a/src/test/Main.hs b/src/test/Main.hs --- a/src/test/Main.hs +++ b/src/test/Main.hs @@ -164,7 +164,7 @@ ,submissionSubreddit :: !Integer} deriving (Show,Eq) -submission :: Monad m => Consumer Value JSON.Doc m Submission +submission :: Monad m => Consumer Value (JSON.Doc Text) m Submission submission = JSON.object "Submission" (Submission @@ -210,6 +210,6 @@ ,submissionSubreddit = 234214})) it "failing json" (consume submission badsample == - Failed (Wrap (JSON.Object "Submission") - (Wrap (JSON.Key "comment") - (Unit (JSON.Text "Submission comment"))))) + Continued (Wrap (JSON.Object "Submission") + (Wrap (JSON.Key "comment") + (Unit (JSON.Text "Submission comment")))))