descriptive 0.0.2 → 0.1.0

raw patch · 10 files changed

+413/−133 lines, 10 filesdep +HUnitdep +descriptivedep +hspecdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, descriptive, hspec

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG +3/−0
• README.md +42/−57
• descriptive.cabal +11/−2
• src/Descriptive.hs +98/−36
• src/Descriptive/Char.hs +7/−6
• src/Descriptive/Form.hs +10/−8
• src/Descriptive/Formlet.hs +4/−4
• src/Descriptive/JSON.hs +10/−9
• src/Descriptive/Options.hs +11/−11
• src/test/Main.hs +217/−0

@@ -0,0 +1,3 @@+0.1.0:++* Change to Result type which supports Continued constructor.

@@ -24,7 +24,7 @@  ``` haskell consumer :: (s -> (Description d,s))-         -> (s -> (Either (Description d) a,s))+         -> (s -> (Result (Description d) a,s))          -> Consumer s d a ``` @@ -37,8 +37,8 @@ To use a consumer or describe what it does, these are used:  ``` haskell-consume :: Consumer s d a -> s -> (Either (Description d) a,s)-describe :: Consumer s d a -> s -> (Description d,s)+consume :: Consumer s d a -> s -> Result (Description d) a+describe :: Consumer s d a -> s -> Description d ```  A description is like this:@@ -61,9 +61,9 @@ parser, a text parsing grammar, etc. For example:  ``` haskell-describeParser :: Consumer [Char] Text Demo -> Text-describeForm :: Consumer (Map Text Text) (Html ()) Login -> Html ()-describeArgs :: Consumer [Text] CmdArgs MyApp -> CmdArgs+describeParser :: Description Text -> Text+describeForm :: Description (Html ()) -> Html ()+describeArgs :: Description CmdArgs -> Text ```  See below for some examples of this library.@@ -78,11 +78,11 @@      (Sequence [Unit "a",Sequence [Unit "b",Sequence [Unit "c",Sequence []]]]) ,"") λ> consume (many (char 'k') <> string "abc") "kkkabc"-(Right "kkkabc","")+(Succeeded "kkkabc") λ> consume (many (char 'k') <> string "abc") "kkkab"-(Left (Unit "a character"),"")+(Failed (Unit "a character")) λ> consume (many (char 'k') <> string "abc") "kkkabj"-(Left (Unit "c"),"")+(Failed (Unit "c")) ```  ## Validating forms with named inputs@@ -97,32 +97,35 @@             input "username" <*>             input "password")            (M.fromList [("username","chrisdone"),("password","god")])-(Right ("chrisdone","god")+(Succeeded ("chrisdone","god") ,fromList [("password","god"),("username","chrisdone")]) ```  Conditions on two inputs:  ``` haskell-login = validate "confirmed password (entered the same twice)"-                 (\(x,y) ->-                    if x == y-                       then Just y-                       else Nothing)-                 ((,) <$>-                  input "password" <*>-                  input "password2")+login =+  validate "confirmed password (entered the same twice)"+           (\(x,y) ->+              if x == y+                 then Just y+                 else Nothing)+           ((,) <$>+            input "password" <*>+            input "password2") <|>+  input "token" ```  ``` haskell-λ> describe login mempty-(Wrap (Constraint "confirmed password (entered the same twice)")-      (And (Unit (Input "password"))-           (Unit (Input "password2")))-,fromList [])- λ> consume login (M.fromList [("password2","gob"),("password","gob")])-(Right "gob",fromList [("password","gob"),("password2","gob")])+Succeeded "gob"+λ> consume login (M.fromList [("password2","gob"),("password","go")])+Continued (And (Wrap (Constraint "confirmed password (entered the same twice)")+                     (And (Unit (Input "password"))+                          (Unit (Input "password2"))))+               (Unit (Input "token")))+λ> consume login (M.fromList [("password2","gob"),("password","go"),("token","woot")])+Succeeded "woot" ```  ## Validating forms with auto-generated input indexes@@ -132,22 +135,15 @@ ``` haskell λ> describe ((,) <$> indexed <*> indexed)             (FormletState mempty 0)-(And (Unit (Index 0))-     (Unit (Index 1))-,FormletState {formletMap = fromList []+And (Unit (Index 0))+    (Unit (Index 1))               ,formletIndex = 2}) λ> consume ((,) <$> indexed <*> indexed)            (FormletState (M.fromList [(0,"chrisdone"),(1,"god")]) 0)-(Right ("chrisdone","god")-,FormletState {formletMap =-                 fromList [(0,"chrisdone"),(1,"god")]-              ,formletIndex = 2})+Succeeded ("chrisdone","god") λ> consume ((,) <$> indexed <*> indexed)            (FormletState (M.fromList [(0,"chrisdone")]) 0)-(Left (Unit (Index 1))-,FormletState {formletMap =-                 fromList [(0,"chrisdone")]-              ,formletIndex = 2})+Failed (Unit (Index 1)) ```  ## Parsing command-line options@@ -165,17 +161,15 @@  ``` haskell λ> describe server []-(And (And (And (Unit (Constant "start"))+And (And (And (Unit (Constant "start"))                (Unit (AnyString "SERVER_NAME")))           (Unit (Flag "dev" "Enable dev mode?")))      (Unit (Arg "port" "Port to listen on"))-,[])-λ> consume server ["start","any","--port","1234","-fdev"]-(Right ("start","any",True,"1234"),[])+λ> consume server ["start","any","--port","1234","--dev"]+Succeeded ("start","any",True,"1234") λ> consume server ["start","any","--port","1234"]-(Right ("start","any",False,"1234"),[])-λ> consume server ["start","any"]-(Left (Unit (Arg "port" "Port to listen on")),[])+Succeeded ("start","any",False,"1234")+λ> ```  ## Self-documenting JSON parser@@ -219,7 +213,7 @@  ``` haskell λ> describe submission (toJSON ())-(Wrap (Struct "Submission")+Wrap (Struct "Submission")       (And (And (And (Wrap (Key "token")                            (Unit (Integer "Submission token; see the API docs")))                      (Wrap (Key "title")@@ -228,26 +222,17 @@                       (Unit (Text "Submission comment"))))            (Wrap (Key "subreddit")                  (Unit (Integer "The ID of the subreddit"))))-,Array (fromList [])) + λ> consume submission sample-(Right (Submission {submissionToken = 123+Succeeded (Submission {submissionToken = 123                    ,submissionTitle = "Some title"                    ,submissionComment = "This is good"                    ,submissionSubreddit = 234214})-,Object (fromList [("token",Number 123.0)-                  ,("subreddit",Number 234214.0)-                  ,("title",String "Some title")-                  ,("comment",String "This is good")]))- λ> consume submission badsample-(Left (Wrap (Struct "Submission")+Failed (Wrap (Struct "Submission")             (Wrap (Key "comment")                   (Unit (Text "Submission comment"))))-,Object (fromList [("token",Number 123.0)-                  ,("subreddit",Number 234214.0)-                  ,("title",String "Some title")-                  ,("comment",Number 123.0)])) ```  The bad sample yields an informative message that:@@ -266,7 +251,7 @@  ``` haskell parsed complV "<distrans-verb> a <noun> <prep> a <noun>" ==-Right (ComplVDisV (DistransitiveV "<distrans-verb>")+Succeeded (ComplVDisV (DistransitiveV "<distrans-verb>")                   (ComplNP (NPCoordUnmarked (UnmarkedNPCoord anoun Nothing)))                   (ComplPP (PP (Preposition "<prep>")                                (NPCoordUnmarked (UnmarkedNPCoord anoun Nothing)))))

@@ -1,5 +1,5 @@ name:                descriptive-version:             0.0.2+version:             0.1.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@@ -12,7 +12,7 @@ category:            Parsing build-type:          Simple cabal-version:       >=1.8-extra-source-files:  README.md+extra-source-files:  README.md, CHANGELOG  library   hs-source-dirs:    src/@@ -25,3 +25,12 @@                      Descriptive.JSON   build-depends:     base >= 4 && <5,                      transformers, containers, text, mtl, aeson, bifunctors++test-suite test+    type: exitcode-stdio-1.0+    main-is: Main.hs+    hs-source-dirs: src/test+    build-depends: base,+                   descriptive, transformers, containers, text, mtl, aeson, bifunctors,+                   HUnit,+                   hspec

@@ -18,6 +18,7 @@   ,Description(..)   ,Bound(..)   ,Consumer(..)+  ,Result(..)   -- * Combinators   ,consumer   ,wrap@@ -25,7 +26,7 @@   where  import Control.Applicative-import Control.Arrow+import Data.Bifunctor import Data.Function import Data.Monoid @@ -35,7 +36,7 @@ -- | Run a consumer. consume :: Consumer s d a -- ^ The consumer to run.         -> s -- ^ Initial state.-        -> Either (Description d) a+        -> Result (Description d) a consume (Consumer _ m) = fst . m  -- | Describe a consumer.@@ -48,7 +49,7 @@ -- | Run a consumer. runConsumer :: Consumer s d a -- ^ The consumer to run.             -> s -- ^ Initial state.-            -> (Either (Description d) a,s)+            -> (Result (Description d) a,s) runConsumer (Consumer _ m) = m  -- | Describe a consumer.@@ -70,7 +71,7 @@   | Sequence [Description a]   | Wrap a (Description a)   | None-  deriving (Show)+  deriving (Show,Eq)  instance Monoid (Description d) where   mempty = None@@ -80,26 +81,46 @@ data Bound   = NaturalBound !Integer   | UnlimitedBound-  deriving (Show)+  deriving (Show,Eq)  -- | A consumer. data Consumer s d a =   Consumer {consumerDesc :: s -> (Description d,s)-           ,consumerParse :: s -> (Either (Description d) a,s)}+           ,consumerParse :: s -> (Result (Description d) a,s)} +-- | Some result.+data Result e a+  = Failed e    -- ^ The whole process failed.+  | Succeeded a -- ^ The whole process succeeded.+  | Continued e -- ^ There were errors but we continued to collect all the errors.+  deriving (Show,Eq,Ord)++instance Bifunctor Result where+  second f r =+    case r of+      Succeeded a -> Succeeded (f a)+      Failed e -> Failed e+      Continued e -> Continued e+  first f r =+    case r of+      Succeeded a -> Succeeded a+      Failed e -> Failed (f e)+      Continued e -> Continued (f e)+ instance Functor (Consumer s d) where   fmap f (Consumer d p) =     Consumer d              (\s ->                 case p s of-                  (Left e,s') -> (Left e,s')-                  (Right a,s') ->-                    (Right (f a),s'))+                  (Failed e,s') -> (Failed e,s')+                  (Continued e,s') -> (Continued e,s')+                  (Succeeded a,s') ->+                    (Succeeded (f a),s'))  instance Applicative (Consumer s d) where   pure a =     consumer (\s -> (mempty,s))-             (\s -> (Right a,s))+             (\s -> (Succeeded a,s))   Consumer d pf <*> Consumer d' p' =     consumer (\s ->                 let !(e,s') = d s@@ -109,17 +130,28 @@                 let !(mf,s') = pf s                     !(ma,s'') = p' s'                 in case mf of-                     Left e -> (Left e,s')-                     Right f ->+                     Failed e -> (Failed e,s')+                     Continued e ->                        case ma of-                         Left e -> (Left e,s'')-                         Right a ->-                           (Right (f a),s''))+                         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''))  instance Alternative (Consumer s d) where   empty =     Consumer (\s -> (mempty,s))-             (\s -> (Left mempty,s))+             (\s -> (Failed mempty,s))   a <|> b =     Consumer (\s ->                 let !(d1,s') = consumerDesc a s@@ -127,13 +159,24 @@                 in (Or d1 d2,s''))              (\s ->                 case consumerParse a s of-                  (Left e1,_) ->+                  (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-                      (Left e2,s') ->-                        (Left (Or e1 e2),s')-                      (Right a2,s') ->-                        (Right a2,s')-                  (Right a1,s') -> (Right a1,s'))+                      (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   many = sequenceHelper 0 @@ -145,30 +188,49 @@        (\s _ r ->           fix (\go !i s' as ->                  case r s' of-                   (Right a,s'') ->+                   (Succeeded a,s'') ->                      go (i + 1)                         s''                         (a : as)-                   (Left e,s'')+                   (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 ->-                       (Right (reverse as),s')+                       (Succeeded (reverse as),s')                      | otherwise ->-                       (Left (redescribe e),s''))+                       (Failed (redescribe e),s''))               0               s               [])-  where redescribe =-          Bounded minb UnlimitedBound+  where redescribe = Bounded minb UnlimitedBound -instance (Monoid a) => Monoid (Either (Description d) a) where-  mempty = Right mempty+instance (Monoid a) => Monoid (Result (Description d) a) where+  mempty = Succeeded mempty   mappend x y =     case x of-      Left e -> Left e-      Right a ->+      Failed e -> Failed e+      Continued e ->         case y of-          Left e -> Left e-          Right b -> Right (a <> b)+          Failed e' -> Failed e'+          Continued e' -> Continued (e <> e')+          Succeeded _ -> Continued e+      Succeeded a ->+        case y of+          Failed e -> Failed e+          Continued e -> Continued e+          Succeeded b -> Succeeded (a <> b)  instance (Monoid a) => Monoid (Consumer s d a) where   mempty = Consumer (\s -> (mempty,s)) (\s -> (mempty,s))@@ -179,14 +241,14 @@  -- | Make a consumer. consumer :: (s -> (Description d,s)) -- ^ Produce description based on the state.-         -> (s -> (Either (Description d) a,s)) -- ^ Parse the state and maybe transform it if desired.+         -> (s -> (Result (Description d) a,s)) -- ^ 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 -> (Either (Description d) a,t)) -> (Either (Description d) b,s)) -- ^ Transform the parser. Can re-run the parser if desired.+     -> (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 redescribe reparse (Consumer d p) =

@@ -17,8 +17,8 @@   consumer (d,)            (\s ->               case s of-                (c':cs') -> (Right c',cs')-                [] -> (Left d,s))+                (c':cs') -> (Succeeded c',cs')+                [] -> (Failed d,s))   where d = Unit "a character"  -- | A character consumer.@@ -28,10 +28,11 @@         (d,))        (\s _ p ->           case p s of-            (Left e,s') -> (Left e,s')-            (Right c',s')-              | c' == c -> (Right c,s')-              | otherwise -> (Left d,s'))+            (Failed e,s') -> (Failed e,s')+            (Continued e,s') -> (Continued e,s')+            (Succeeded c',s')+              | c' == c -> (Succeeded c,s')+              | otherwise -> (Failed d,s'))        anyChar   where d = Unit (T.singleton c) 

@@ -23,7 +23,7 @@ data Form   = Input !Text   | Constraint !Text-  deriving (Show)+  deriving (Show,Eq)  -- | Consume any input value. input :: Text -> Consumer (Map Text Text) Form Text@@ -31,8 +31,8 @@   consumer (d,)            (\s ->               (case M.lookup name s of-                 Nothing -> Left d-                 Just a -> Right a+                 Nothing -> Continued d+                 Just a -> Succeeded a               ,s))   where d = Unit (Input name) @@ -45,10 +45,12 @@   wrap (\s d -> redescribe (d s))        (\s d p ->           case p s of-            (Left e,s') -> (Left e,s')-            (Right a,s') ->+            (Failed e,s') -> (Failed e,s')+            (Continued e,s') -> (Continued (wrapper e),s')+            (Succeeded a,s') ->               case check a of                 Nothing ->-                  (Left (fst (redescribe (d s))),s')-                Just a' -> (Right a',s'))-  where redescribe = first (Wrap (Constraint d'))+                  (Continued (fst (redescribe (d s))),s')+                Just a' -> (Succeeded a',s'))+  where redescribe = first wrapper+        wrapper = Wrap (Constraint d')

@@ -21,13 +21,13 @@ data Formlet   = Index !Integer   | Constrained !Text-  deriving (Show)+  deriving (Show,Eq)  -- | State used when running a formlet. data FormletState =   FormletState {formletMap :: (Map Integer Text)                ,formletIndex :: !Integer}-  deriving (Show)+  deriving (Show,Eq)  -- | Consume any character. indexed :: Consumer FormletState Formlet Text@@ -35,8 +35,8 @@   consumer (\(nextIndex -> (i,s)) -> (d i,s))            (\(nextIndex -> (i,s)) ->               case M.lookup i (formletMap s) of-                Nothing -> (Left (d i),s)-                Just a -> (Right a,s))+                Nothing -> (Failed (d i),s)+                Just a -> (Succeeded a,s))   where d = Unit . Index         nextIndex s =           (formletIndex s,s {formletIndex = formletIndex s + 1})

@@ -32,7 +32,7 @@   | Text !Text   | Struct !Text   | Key !Text-  deriving (Show)+  deriving (Show,Eq)  -- | Consume an object. obj :: Text -- ^ Description of what the object is.@@ -42,11 +42,12 @@   wrap (\v d -> (Wrap doc (fst (d mempty)),v))        (\v _ p ->           case fromJSON v of-            Error{} -> (Left (Unit doc),v)+            Error{} -> (Failed (Unit doc),v)             Success o ->               (case p o of-                 (Left e,_) -> Left (Wrap doc e)-                 (Right a,_) -> Right a+                 (Failed e,_) -> Failed (Wrap doc e)+                 (Continued e,_) -> Failed (Wrap doc e)+                 (Succeeded a,_) -> Succeeded a               ,toJSON o))   where doc = Struct desc @@ -62,7 +63,7 @@        (\o _ p ->           case parseMaybe (const (o .: k))                           () of-            Nothing -> (Left (Unit doc),o)+            Nothing -> (Failed (Unit doc),o)             Just (v :: Value) ->               first (bimap (Wrap doc) id)                     (second (const o)@@ -76,8 +77,8 @@   consumer (d,)            (\s ->               case fromJSON s of-                Error{} -> (Left d,s)-                Success a -> (Right a,s))+                Error{} -> (Failed d,s)+                Success a -> (Succeeded a,s))   where d = Unit (Text doc)  -- | Consume an integer.@@ -87,6 +88,6 @@   consumer (d,)            (\s ->               case fromJSON s of-                Error{} -> (Left d,s)-                Success a -> (Right a,s))+                Error{} -> (Failed d,s)+                Success a -> (Succeeded a,s))   where d = Unit (Integer doc)

@@ -33,7 +33,7 @@   | Flag !Text !Text   | Arg !Text !Text   | Prefix !Text !Text-  deriving (Show)+  deriving (Show,Eq)  -- | Consume one argument from the argument list. anyString :: Text -> Consumer [Text] Option Text@@ -41,8 +41,8 @@   consumer (d,)            (\s ->               case s of-                [] -> (Left d,s)-                (x:s') -> (Right x,s'))+                [] -> (Failed d,s)+                (x:s') -> (Succeeded x,s'))   where d = Unit (AnyString help)  -- | Consume one argument from the argument list.@@ -52,8 +52,8 @@            (\s ->               case s of                 (x:s') | x == x' ->-                  (Right x,s')-                _ -> (Left d,s))+                  (Succeeded x,s')+                _ -> (Failed d,s))   where d = Unit (Constant x')  -- | Find a short boolean flag.@@ -61,7 +61,7 @@ flag name help =   consumer (d,)            (\s ->-              (Right (elem ("--" <> name) s),filter (/= "--" <> name) s))+              (Succeeded (elem ("--" <> name) s),filter (/= "--" <> name) s))   where d = Unit (Flag name help)  -- | Find an argument prefixed by -X.@@ -70,8 +70,8 @@   consumer (d,)            (\s ->               case find (T.isPrefixOf ("-" <> pref)) s of-                Nothing -> (Left d,s)-                Just a -> (Right (T.drop (T.length pref + 1) a), delete a s))+                Nothing -> (Failed d,s)+                Just a -> (Succeeded (T.drop (T.length pref + 1) a), delete a s))   where d = Unit (Prefix pref help)  -- | Find a named argument.@@ -82,12 +82,12 @@               let indexedArgs =                     zip [0 :: Integer ..] s               in case find ((== "--" <> name) . snd) indexedArgs of-                   Nothing -> (Left d,s)+                   Nothing -> (Failed d,s)                    Just (i,_) ->                      case lookup (i + 1) indexedArgs of-                       Nothing -> (Left d,s)+                       Nothing -> (Failed d,s)                        Just text ->-                         (Right text+                         (Succeeded text                          ,map snd (filter (\(j,_) -> j /= i && j /= i + 1) indexedArgs)))   where d = Unit (Arg name help) 

@@ -0,0 +1,217 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++-- | Test suite for ACE.++module Main where++import           Control.Applicative+import           Data.Aeson (Value(..),toJSON,object,(.=))+import qualified Data.Map.Strict as M+import           Data.Monoid+import           Data.Text (Text)+import           Descriptive+import qualified Descriptive.Char as Char+import qualified Descriptive.Form as Form+import qualified Descriptive.Formlet as Formlet+import qualified Descriptive.JSON as JSON+import qualified Descriptive.Options as Options+import           Test.HUnit+import           Test.Hspec (Spec,it,hspec)+import qualified Test.Hspec as Hspec++-- | Test suite entry point, returns exit failure if any test fails.+main :: IO ()+main = hspec spec++-- | Test suite.+spec :: Spec+spec = do+  Hspec.describe "Descriptive.Char" characters+  Hspec.describe "Descriptive.Form" form+  Hspec.describe "Descriptive.Formlet" formlet+  Hspec.describe "Descriptive.JSON" json+  Hspec.describe "Descriptive.Options" options++--------------------------------------------------------------------------------+-- Character parsing tests++characters :: Spec+characters =+  do it "describe"+        (describe (many (Char.char 'k') <>+                   Char.string "abc")+                  mempty ==+         And (Bounded 0 UnlimitedBound (Unit "k"))+             (Sequence [Unit "a"+                       ,Sequence [Unit "b",Sequence [Unit "c",Sequence []]]]))+     it "consume"+        (consume (many (Char.char 'k') <>+                  Char.string "abc")+                 "kkkabc" ==+         (Succeeded "kkkabc"))+     it "fail generic"+        (consume (many (Char.char 'k') <>+                  Char.string "abc")+                 "kkkab" ==+         (Failed (Unit "a character")))+     it "fail specific"+        (consume (many (Char.char 'k') <>+                  Char.string "abc")+                 "kkkabj" ==+         (Failed (Unit "c")))++--------------------------------------------------------------------------------+-- Form tests++form :: Spec+form =+  do it "basic describe login"+        (describe ((,) <$>+                   Form.input "username" <*>+                   Form.input "password")+                  mempty ==+         (And (Unit (Form.Input "username"))+              (Unit (Form.Input "password"))))+     it "basic describe login"+        (consume ((,) <$>+                  Form.input "username" <*>+                  Form.input "password")+                 (M.fromList [("username","chrisdone"),("password","god")]) ==+         Succeeded ("chrisdone","god"))+     it "succeeding login"+        (consume login (M.fromList [("password2","gob"),("password","gob")]) ==+         Succeeded "gob")+     it "continuing login"+        (consume login (M.fromList [("password2","gob"),("password","go")]) ==+         Continued (And (Wrap (Form.Constraint "confirmed password (entered the same twice)")+                              (And (Unit (Form.Input "password"))+                                   (Unit (Form.Input "password2"))))+                        (Unit (Form.Input "token"))))+     it "succeeding disjunction"+        (consume login+                 (M.fromList+                    [("password2","gob"),("password","go"),("token","woot")]) ==+         Succeeded "woot")+  where login =+          Form.validate+            "confirmed password (entered the same twice)"+            (\(x,y) ->+               if x == y+                  then Just y+                  else Nothing)+            ((,) <$>+             Form.input "password" <*>+             Form.input "password2") <|>+          Form.input "token"++--------------------------------------------------------------------------------+-- Formlet tests++formlet :: Spec+formlet =+  do it "basic formlet"+        (describe ((,) <$> Formlet.indexed <*> Formlet.indexed)+                  (Formlet.FormletState mempty 0) ==+         And (Unit (Formlet.Index 0))+             (Unit (Formlet.Index 1)))+     it "succeeding formlet"+        (consume ((,) <$> Formlet.indexed <*> Formlet.indexed)+                 (Formlet.FormletState (M.fromList [(0,"chrisdone"),(1,"god")])+                                       0) ==+         Succeeded ("chrisdone","god"))+     it "succeeding formlet"+        (consume ((,) <$> Formlet.indexed <*> Formlet.indexed)+                 (Formlet.FormletState (M.fromList [(0,"chrisdone")])+                                       0) ==+         Failed (Unit (Formlet.Index 1)))++--------------------------------------------------------------------------------+-- Options tests++options :: Spec+options =+  do it "describe options"+        (describe server [] ==+         And (And (And (Unit (Options.Constant "start"))+                       (Unit (Options.AnyString "SERVER_NAME")))+                  (Unit (Options.Flag "dev" "Enable dev mode?")))+             (Unit (Options.Arg "port" "Port to listen on")))+     it "succeeding options"+        (consume server ["start","any","--port","1234","--dev"] ==+         Succeeded ("start","any",True,"1234"))+     it "succeeding omitting port options"+        (consume server ["start","any","--port","1234"] ==+         Succeeded ("start","any",False,"1234"))+     it "failing options"+        (consume server ["start","any"] ==+         Failed (Unit (Options.Arg "port" "Port to listen on")))+  where server =+          ((,,,) <$>+           Options.constant "start" <*>+           Options.anyString "SERVER_NAME" <*>+           Options.flag "dev" "Enable dev mode?" <*>+           Options.arg "port" "Port to listen on")++--------------------------------------------------------------------------------+-- JSON tests++-- | Submit a URL to reddit.+data Submission =+  Submission {submissionToken :: !Integer+             ,submissionTitle :: !Text+             ,submissionComment :: !Text+             ,submissionSubreddit :: !Integer}+  deriving (Show,Eq)++submission :: Consumer Value JSON.Doc Submission+submission =+  JSON.obj "Submission"+           (Submission+             <$> JSON.key "token" (JSON.integer "Submission token; see the API docs")+             <*> JSON.key "title" (JSON.string "Submission title")+             <*> JSON.key "comment" (JSON.string "Submission comment")+             <*> JSON.key "subreddit" (JSON.integer "The ID of the subreddit"))++sample :: Value+sample =+  toJSON (object+            ["token" .= 123+            ,"title" .= "Some title"+            ,"comment" .= "This is good"+            ,"subreddit" .= 234214])++badsample :: Value+badsample =+  toJSON (object+            ["token" .= 123+            ,"title" .= "Some title"+            ,"comment" .= 123+            ,"subreddit" .= 234214])++json :: Spec+json =+  do it "describe JSON"+        (describe submission (toJSON ()) ==+         Wrap (JSON.Struct "Submission")+              (And (And (And (Wrap (JSON.Key "token")+                                   (Unit (JSON.Integer "Submission token; see the API docs")))+                             (Wrap (JSON.Key "title")+                                   (Unit (JSON.Text "Submission title"))))+                        (Wrap (JSON.Key "comment")+                              (Unit (JSON.Text "Submission comment"))))+                   (Wrap (JSON.Key "subreddit")+                         (Unit (JSON.Integer "The ID of the subreddit")))))+     it "succeeding json"+        (consume submission sample ==+         Succeeded (Submission {submissionToken = 123+                               ,submissionTitle = "Some title"+                               ,submissionComment = "This is good"+                               ,submissionSubreddit = 234214}))+     it "failing json"+        (consume submission badsample ==+         Failed (Wrap (JSON.Struct "Submission")+                      (Wrap (JSON.Key "comment")+                            (Unit (JSON.Text "Submission comment")))))