uu-options 0.1.0.1 → 0.1.0.2

raw patch · 4 files changed

+115/−22 lines, 4 filesdep +template-haskelldep ~lensesdep ~uu-interleaveddep ~uu-parsinglibsetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: template-haskell

Dependency ranges changed: lenses, uu-interleaved, uu-parsinglib

API changes (from Hackage documentation)

Files

• Setup.hs +2/−0
• src/Options/UU/Interleaved.hs +107/−15
• src/Options/UU/Main.hs +3/−4
• uu-options.cabal +3/−3

@@ -1,2 +1,4 @@+#!/usr/bin/env runhaskell import Distribution.Simple+main :: IO () main = defaultMain

@@ -2,10 +2,11 @@              FlexibleInstances,  
              ScopedTypeVariables,
              RankNTypes,
-             FlexibleContexts #-}
+             FlexibleContexts,
+             CPP,
+             TemplateHaskell  #-}
 
 module Options.UU.Interleaved where
-import Data.Lenses
 import Data.Functor.Identity
 import Control.Applicative.Interleaved
 import Control.Monad.State.Class
@@ -13,11 +14,102 @@ import Text.ParserCombinators.UU -- hiding (pSymbol)
 import Text.ParserCombinators.UU.BasicInstances 
 import Text.ParserCombinators.UU.Utils hiding (lexeme, pSymbol)
-
+import Data.Lenses
+import Data.Lenses.Template
 
 -- For a description of how to use these combinators see the accompanying Demo module. 
--- Further information can be founs in a Technical report at http://www.cs.uu.nl/research/techreps/UU-CS-2013-005.html
+-- Further information can be found in a Technical report at http://www.cs.uu.nl/research/techreps/UU-CS-2013-005.html
 
+{-| An example of how to use this module
+@
+{-# LANGUAGE TemplateHaskell, FlexibleContexts, NoMonomorphismRestriction, TypeSynonymInstances, FlexibleInstances #-}
+module Main where
+import Data.Lenses.Template
+import Text.ParserCombinators.UU
+import Text.ParserCombinators.UU.BasicInstances
+import Text.ParserCombinators.UU.Utils
+import Text.ParserCombinators.UU.Interleaved
+import Options.UU.Interleaved
+import Data.Monoid
+import System.Environment
+@
+-}
+{-
+-- We assume that we store our options in a data type for which we generate lenses
+
+data Prefers  =  Agda | Haskell deriving Show
+data Address  =  Address  {  city_ :: String
+                          ,  street_ :: String} 
+                 deriving Show
+data Name     =  Name  {  name_:: String 
+                       ,  prefers_:: Prefers
+                       ,  ints_ :: [Int]
+                       ,  address_ :: Address} 
+                 deriving Show
+
+$(deriveLenses ''Name)
+$(deriveLenses ''Address)
+
+instance ShowParserType Prefers where
+   showType p = " <Agda | Haskell> "
+
+-- The next thing to do is to specify a default record containing the default values:
+defaults = Name  "Atze" Haskell [] 
+                 (Address  "Utrecht" 
+                           "Princetonplein")
+
+-- Next we define the parser for the options, by specifying for each filed what may be specified:
+
+oName =
+                 name     `option`   ("name",       pString,      "Name")
+            <>   ints     `options`  ("ints",       pNaturalRaw,  "A couple of numbers") 
+            <>   prefers  `choose`   [("agda",      Agda,         "In case you prefer Agda")
+                                     ,("haskell",   Haskell,      "In case you prefer Haskell")
+                                     ] 
+            <>   address  `field`
+                           (   city     `option`  ("city",   pString, "Home city")  
+                           <>  street   `option`  ("street" ,pString, "Home Street" )
+                           )
+-- | The function `main` may serve as a template for your own option handling. You can also use this module to see what  the effectis  of the various ways of passing options
+-- >>> ./OptionsDemo -i1 --ints 2 --street=Zandlust -a -nDoaitse -i3 --ints=4 --city=Tynaarlo
+--     Name {name_ = "Doaitse", prefers_ = Agda, ints_ = [1,2,3,4], address_ = Address {city_ = "Tynaarlo", street_ = "Zandlust"}}
+--
+-- >>> ./OptionsDemo -i1 --ints 2 --street=Zandlust -nDoaitse -i3 --ints=4 --city=Tynaarlo
+--     --name           [Char]         optional  Name
+--     --ints           Int            recurring A couple of numbers
+--     Choose at least one from(
+--     --agda                          required  In case you prefer Agda
+--     --haskell                       required  In case you prefer Haskell
+--     )
+--     --city           [Char]         optional  Home city
+--     --street         [Char]         optional  Home Street
+--     --
+--     --  Correcting steps:
+--     --    Inserted  "-a" at position 70 expecting one of ["--agda", "--agda=", "--haskell", "--haskell=", "--ints=", "--ints", "-i", "-h", "-a"]
+--     --    Inserted  "\EOT" at position 70 expecting "\EOT"
+
+main  ::IO ()
+main = do args  <- getArgs
+          case run  defaults oName  (concat (map  (++ "\EOT") args)) of
+            Left a        -> case a of
+                                   Succes v -> print v
+                                   Help   t -> putStrLn t
+            Right errors  -> putStrLn errors
+
+-- | The function `demo` can be used from within ghci:
+{-
+-- >>> demo ["-i2", "--street=Zandlust", "--ints=5", "-nAtze", "--city=Houten"]
+--
+-}
+demo :: [[Char]] -> IO ()
+demo args =  case run  defaults oName  (concat (map  (++ "\EOT") args)) of
+                  Left a        -> case a of
+                                   Succes v -> print v
+                                   Help   t -> putStrLn t
+                  Right errors  -> putStr errors
+
+@
+-}
 -- instance  IsParser (Gram (P (Str Char String Int)))
 
 
@@ -35,7 +127,7 @@ 
 type Option a = Gram (P (Str Char String Int)) a
 
-type BaseEntry s d = MonadState s m =>
+type BaseEntry s d = forall m r b. MonadState s m =>
      (m () -> StateT r Identity b)
      -> d
      -> (Gram (P (Str Char String Int)) (r -> r), [Char])
@@ -93,17 +185,19 @@                         Just _   -> tp
                   align n t = take n (t++repeat ' ')
               in (       oG ( pToken ("-"   ++ [head string])             *> lexeme p) a
-                    <|>  oG ( pToken ("--"  ++ string) <* pToken "\EOT"   *> lexeme p) a
+                    <|>  oG ( pToken ("--"  ++ string) <* pToken "\EOT"   *> case getNonPure p of
+                                                                               Nothing -> p
+                                                                               Just p' -> lexeme p) a
                     <|>  oG ( pToken ("--"  ++ string ++ "=")             *> lexeme p) a
-                 , "--"++ align 15 string ++ align 15 tp ++ align 10 kind ++ info ++"\n"
+                 , "--"++ align 15 string ++ align 15 tp' ++ align 10 kind ++ info ++"\n"
                  )
 
--- | a `required` entry specied an entry which has to be provided; in the recrod containing the default values one may put `undefined`
+-- | a `required` entry specied an entry which has to be provided; in the record containing the default values one may put `undefined`
 required  :: Entry a a
 
 required a   (string, p, info)  = required_ a (string, const <$> p, showType p, "required", info)
 
--- | an `option` entry specied an enetry which may  be provided; if absent the default value is taken
+-- | an `option` entry specied an entry which may  be provided; if absent the default value is taken
 
 option :: Entry a a
 option   a   (string, p, i)      =  let (r, t) = required_  a (string, const <$> p, showType p, "optional", i) 
@@ -120,14 +214,14 @@ 
 -- | An `optionl` entry specifies an element which may occur more than once. The last one encountered is taken
 -- optionsl :: Entry a a
-optionsl  a (string, p, i)  =  let (pars, t) = options a (string, p, i ++"last  one is taken")  in ( (last .)  <$> pars, t)
+optionsl  a (string, p, i)  =  let (pars, t) = options a (string, p, i ++"last  one is taken")  in ( (const. last .($[]))  <$> pars, t)
 
 
 -- | An `optionf` entry specifies an element which may occur more than once. The first one encountered is taken
 -- optionsf :: Entry a a
 optionsf  a (string, p, i)  =  let (pars, t) = options a (string, p, i ++"first  one is taken") in ( (head .)  <$> pars, t)
 
--- | A `flag` entry sets   a filed to a specific value when encountered
+-- | A `flag` entry sets   a field to a specific value when encountered
 flag :: EntryVal a a
 flag     a   (string, v,i)       =  option    a (string, pure v, i)
 
@@ -139,12 +233,12 @@ set :: EntryVal a a
 set     a   (string, v,i)      =  required_    a (string, pure (const v), "", "required", i)
 
--- | A `choose` entry introduces a list of choices for the specific entry; at least one should be given
+-- | A `choose` entry introduces a list of choices for the specific entry; precisely one should be given
 choose :: EntryVals a a
 choose  a   table              =  let (ps, ts) =  unzip (map (set a) table)
                                   in (foldr (<|>) empty ps, "Choose at least one from(\n" ++ concat ts ++ ")\n")
 
--- | A `choose` entry is an optional `change` entry
+-- | A `change` entry is an optional `choose` entry
 change :: EntryVals a a 
 change  a   table              =  let (ps, ts) =  unzip (map (set a) table)
                                   in (foldr (<|>) (pure id) ps, "You may choose one from(\n" ++ concat ts ++ ")\n")
@@ -175,7 +269,5 @@                                                          ) (createStr 0 inp)
                               if null errors then  Left a
                                              else  Right (t ++ concat (map (++"\n") ("\n--  Correcting steps:":  map show errors)))
-
-
 
 

@@ -37,14 +37,13 @@ oName =                  name     `option`   ("name",       pString,      "Name")             <>   ints     `options`  ("ints",       pNaturalRaw,  "A couple of numbers") -            <>   prefers  `choose`   [("agda",      Agda,         "In case you prefer Agda")-                                     ,("haskell",   Haskell,      "In case you prefer Haskell")+            <>   prefers  `choose`   [("agda",      Agda,         "You prefer Agda")+                                     ,("haskell",   Haskell,      "You prefer Haskell")                                      ]              <>   address  `field`                            (   city     `option`  ("city",   pString, "Home city")                              <>  street   `option`  ("street" ,pString, "Home Street" )                            )-{- -- | The function `main` may serve as a template for your own option handling. You can also use this module to see what  the effectis  of the various ways of passing options -- >>> ./OptionsDemo -i1 --ints 2 --street=Zandlust -a -nDoaitse -i3 --ints=4 --city=Tynaarlo --     Name {name_ = "Doaitse", prefers_ = Agda, ints_ = [1,2,3,4], address_ = Address {city_ = "Tynaarlo", street_ = "Zandlust"}}@@ -62,7 +61,7 @@ --     --  Correcting steps: --     --    Inserted  "-a" at position 70 expecting one of ["--agda", "--agda=", "--haskell", "--haskell=", "--ints=", "--ints", "-i", "-h", "-a"] --     --    Inserted  "\EOT" at position 70 expecting "\EOT"--}+ main  ::IO () main = do args  <- getArgs           case run  defaults oName  (concat (map  (++ "\EOT") args)) of

@@ -1,5 +1,5 @@ Name:                uu-options-Version:             0.1.0.1+Version:             0.1.0.2 Build-Type:          Simple License:             MIT Copyright:           S Doaitse Swierstra @@ -30,10 +30,10 @@ executable           demo-options   Main-is:           Options/UU/Main.hs   hs-source-dirs:    src-  Build-Depends:     base >= 4.2 && <5, uu-parsinglib >=2.8 && < 2.9, uu-interleaved >=0.1.0 && < 0.2, lenses >= 0.1.6 && < 0.1.7, transformers >= 0.3.0.0, mtl+  Build-Depends:     base >= 4.2 && <5, uu-parsinglib >=2.8 && < 3.0, uu-interleaved >=0.1.0 && < 0.3, transformers >= 0.3.0.0, mtl, template-haskell,  lenses >= 0.1.7  Library   hs-source-dirs:    src-  Build-Depends:     base >= 4.2 && <5, uu-parsinglib >=2.8 && < 2.9, uu-interleaved >=0.1.0 && < 0.2, lenses >= 0.1.6 && < 0.1.7, transformers >= 0.3.0.0, mtl+  Build-Depends:     base >= 4.2 && <5, uu-parsinglib >=2.8 && < 3.0, uu-interleaved >=0.1.0 && < 0.3, transformers >= 0.3.0.0, mtl, template-haskell, lenses >= 0.1.7   Exposed-modules:   Options.UU.Interleaved