descriptive 0.1.1 → 0.2.0

raw patch · 5 files changed

+118/−44 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +5/−0
• README.md +2/−3
• descriptive.cabal +1/−1
• src/Descriptive/Options.hs +105/−34
• src/test/Main.hs +5/−6

@@ -1,3 +1,8 @@+0.2.0:+	* Change the type of flag.+	* Add the switch combinator (used to be “flag”).+	* Add the “stop” combinator.+ 0.1.1: 	* Printer fix for options consumer. 

@@ -74,9 +74,8 @@  ``` haskell λ> describe (many (char 'k') <> string "abc") mempty-(And (Bounded 0 UnlimitedBound (Unit "k"))-     (Sequence [Unit "a",Sequence [Unit "b",Sequence [Unit "c",Sequence []]]])-,"")+And (Bounded 0 UnlimitedBound (Unit "k"))+    (Sequence [Unit "a",Sequence [Unit "b",Sequence [Unit "c",Sequence []]]]) λ> consume (many (char 'k') <> string "abc") "kkkabc" (Succeeded "kkkabc") λ> consume (many (char 'k') <> string "abc") "kkkab"

@@ -1,5 +1,5 @@ name:                descriptive-version:             0.1.1+version:             0.2.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

@@ -10,14 +10,18 @@    anyString   ,constant   ,flag+  ,switch   ,prefix   ,arg+  ,stop   -- * Description   ,Option(..)   ,textDescription   ,textOpt)   where +import           Control.Applicative+import           Data.Bifunctor import           Descriptive  import           Data.Char@@ -27,16 +31,38 @@ import qualified Data.Text as T  -- | Description of a commandline option.-data Option+data Option a   = AnyString !Text-  | Constant !Text+  | Constant !Text !Text   | Flag !Text !Text   | Arg !Text !Text   | Prefix !Text !Text+  | Stops+  | Stopped !a   deriving (Show,Eq) --- | Consume one argument from the argument list.-anyString :: Text -> Consumer [Text] Option Text+-- | If the consumer succeeds, stops the whole parser and returns+-- immediately.+stop :: Consumer [Text] (Option a) a+     -- ^ 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'))++-- | 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 ->@@ -45,27 +71,46 @@                 (x:s') -> (Succeeded x,s'))   where d = Unit (AnyString help) --- | Consume one argument from the argument list.-constant :: Text -> Consumer [Text] Option Text-constant x' =+-- | Consume one argument from the argument list which must match the+-- given string.+constant :: Text -- ^ String.+         -> Text -- ^ Description.+         -> Consumer [Text] (Option a) Text+constant x' desc =   consumer (d,)            (\s ->               case s of                 (x:s') | x == x' ->                   (Succeeded x,s')                 _ -> (Failed d,s))-  where d = Unit (Constant x')+  where d = Unit (Constant x' desc) --- | Find a short boolean flag.-flag :: Text -> Text -> Consumer [Text] Option Bool-flag name help =+-- | Find a value flag which must succeed.+flag :: Text -- ^ Name.+     -> Text -- ^ Description.+     -> v    -- ^ Value returned when present.+     -> Consumer [Text] (Option a) v+flag name help v =   consumer (d,)            (\s ->-              (Succeeded (elem ("--" <> name) s),filter (/= "--" <> name) s))+              if elem ("--" <> name) s+                 then (Succeeded v,filter (/= "--" <> name) s)+                 else (Failed d,s)+              )   where d = Unit (Flag name help) +-- | Find a boolean flag. Always succeeds. Omission counts as 'False'.+switch :: Text -- ^ Name.+       -> Text -- ^ Description.+       -> Consumer [Text] (Option a) Bool+switch name help =+  flag name help True <|>+  pure False+ -- | Find an argument prefixed by -X.-prefix :: Text -> Text -> Consumer [Text] Option Text+prefix :: Text -- ^ Prefix string.+       -> Text -- ^ Description.+       -> Consumer [Text] (Option a) Text prefix pref help =   consumer (d,)            (\s ->@@ -74,8 +119,10 @@                 Just a -> (Succeeded (T.drop (T.length pref + 1) a), delete a s))   where d = Unit (Prefix pref help) --- | Find a named argument.-arg :: Text -> Text -> Consumer [Text] Option Text+-- | Find a named argument e.g. @--name value@.+arg :: Text -- ^ Name.+    -> Text -- ^ Description.+    -> Consumer [Text] (Option a) Text arg name help =   consumer (d,)            (\s ->@@ -92,28 +139,27 @@   where d = Unit (Arg name help)  -- | Make a text description of the command line options.-textDescription :: Description Option -> Text-textDescription = go False . clean-  where clean (And None a) = clean a-        clean (And a None) = clean a-        clean (Or a None) = clean a-        clean (Or None a) = clean a-        clean (And a b) =-          And (clean a)-              (clean b)-        clean (Or a b) =-          Or (clean a)-             (clean b)-        clean a = a+textDescription :: Description (Option a) -> Text+textDescription =+  go False .+  clean+  where         go inor d =           case d of+            Or None a -> "[" <> go inor a <> "]"+            Or a None -> "[" <> go inor a <> "]"             Unit o -> textOpt o             Bounded min' _ d' ->-              "[" <> go inor d' <> "]" <>+              "[" <>+              go inor d' <>+              "]" <>               if min' == 0                  then "*"                  else "+"-            And a b -> go inor a <> " " <> go inor b+            And a b ->+              go inor a <>+              " " <>+              go inor b             Or a b ->               (if inor                   then ""@@ -127,13 +173,38 @@             Sequence xs ->               T.intercalate " "                             (map (go inor) xs)-            Wrap o d' -> textOpt o <> " " <> go inor d'+            Wrap o d' ->+              textOpt o <>+              (if T.null (textOpt o)+                  then ""+                  else " ") <>+              go inor d'             None -> "" +-- | Clean up the condition tree for single-line presentation.+clean :: Description a -> Description a+clean (And None a) = clean a+clean (And a None) = clean a+clean (Or a (Or b None)) = Or (clean a) (clean b)+clean (Or a (Or None b)) = Or (clean a) (clean b)+clean (Or None (Or a b)) = Or (clean a) (clean b)+clean (Or (Or a b) None) = Or (clean a) (clean b)+clean (Or a None) = Or (clean a) None+clean (Or None b) = Or None (clean b)+clean (And a b) =+  And (clean a)+      (clean b)+clean (Or a b) =+  Or (clean a)+     (clean b)+clean a = a+ -- | Make a text description of an option.-textOpt :: Option -> Text+textOpt :: (Option a) -> Text textOpt (AnyString t) = T.map toUpper t-textOpt (Constant t) = t-textOpt (Flag t _) = "[--" <> t <> "]"+textOpt (Constant t _) = t+textOpt (Flag t _) = "--" <> t textOpt (Arg t _) = "--" <> t <> " <...>" textOpt (Prefix t _) = "-" <> t <> "<...>"+textOpt Stops = ""+textOpt (Stopped _) = ""

@@ -1,7 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NoMonomorphismRestriction #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}  -- | Test suite for ACE. @@ -18,7 +18,6 @@ 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 @@ -135,9 +134,9 @@ options =   do it "describe options"         (describe server [] ==-         And (And (And (Unit (Options.Constant "start"))+         And (And (And (Unit (Options.Constant "start" "cmd"))                        (Unit (Options.AnyString "SERVER_NAME")))-                  (Unit (Options.Flag "dev" "Enable dev mode?")))+                  (Or (Unit (Options.Flag "dev" "Enable dev mode?")) None))              (Unit (Options.Arg "port" "Port to listen on")))      it "succeeding options"         (consume server ["start","any","--port","1234","--dev"] ==@@ -150,9 +149,9 @@          Failed (Unit (Options.Arg "port" "Port to listen on")))   where server =           ((,,,) <$>-           Options.constant "start" <*>+           Options.constant "start" "cmd" <*>            Options.anyString "SERVER_NAME" <*>-           Options.flag "dev" "Enable dev mode?" <*>+           Options.switch "dev" "Enable dev mode?" <*>            Options.arg "port" "Port to listen on")  --------------------------------------------------------------------------------