diff --git a/src/Options/UU/Demo.hs b/src/Options/UU/Demo.hs new file mode 100644 --- /dev/null +++ b/src/Options/UU/Demo.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE TemplateHaskell, FlexibleContexts, NoMonomorphismRestriction, TypeSynonymInstances, FlexibleInstances #-} +module Options.UU.Demo 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 = " " + +-- The next thing to do is to specify a initial record containing the default values: +defaults = Name "Atze" Haskell [] + (Address "Utrecht" + "Princetonplein") + +-- Next we define the parser for the options, by specifying for each field 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 +-- >>> ./Demo -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"}} +-- +-- >>> ./Demo -i1 --ints 2 --street=Zandlust --name Doaitse -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", "--agda", "-i3"] +-- Name {name_ = "Atze", prefers_ = Agda, ints_ = [2,5,3], address_ = Address {city_ = "Houten", street_ = "Zandlust"}} + +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 diff --git a/src/Options/UU/Interleaved.hs b/src/Options/UU/Interleaved.hs --- a/src/Options/UU/Interleaved.hs +++ b/src/Options/UU/Interleaved.hs @@ -6,7 +6,24 @@ CPP, TemplateHaskell #-} -module Options.UU.Interleaved where +module Options.UU.Interleaved ( + required, + option, + options, + optionsl, + optionsf, + flag, + flags, + field, + choose, + change, + ShowParserType (..), + pString, + pBool, + run, + OptionResult (..) + + ) where import Data.Functor.Identity import Control.Applicative.Interleaved import Control.Monad.State.Class @@ -20,99 +37,6 @@ -- For a description of how to use these combinators see the accompanying Demo module. -- 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 = " " - --- 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))) - - instance Splittable (P (Str Char String Int)) where getPure = getZeroP getNonPure = getOneP @@ -179,19 +103,35 @@ ) -> (Gram (P (Str Char String Int)) (r -> r), [Char]) +{- required_ a (string, p, tp, kind, info) - = let tp' = case getNonPure p of - Nothing -> "" - Just _ -> tp - align n t = take n (t++repeat ' ') - in ( oG ( pToken ("-" ++ [head string]) *> 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 + = let align n t = take n (t++repeat ' ') + (p', tp') = case ( getNonPure p, getPure p) of + (Nothing, Just pe) -> (const pe <$> pToken "\EOT", "") + (Just pne, Nothing) -> ((pToken "\EOT" <|> pure "") *> lexeme pne, tp) + (Just pne, Just pe) -> error "An option can not be both empty and non-empty" + (Nothing, Nothing) -> error "An option should return a value" + in ( oG ( pToken ("-" ++ [head string]) *> p') a + <|> oG ( pToken ("--" ++ string) *> p') a + <|> oG ( pToken ("--" ++ string ++ "=") *> p') a , "--"++ align 15 string ++ align 15 tp' ++ align 10 kind ++ info ++"\n" ) +-} +required_ a (string, p, tp, kind, info) + = let align n t = take n (t++repeat ' ') + p' = case ( getNonPure p, getPure p) of + (Nothing, Just pe) -> const pe <$> pToken "\EOT" + (Just pne, Nothing) -> (pToken "\EOT" <|> pure "") *> lexeme pne + (Just pne, Just pe) -> error "An option can not be both empty and non-empty" + (Nothing, Nothing) -> error "An option should return a value" + in ( oG (( pToken ("-" ++ [head string]) + <|> pToken ("--" ++ string) ) *> (pToken "=" `opt` "") *> noDash *> p') a + , "--"++ align 15 string ++ align 15 tp ++ align 10 kind ++ info ++"\n" + ) + +noDash = pure "" -- needs further work + -- | 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 @@ -236,7 +176,7 @@ -- | 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") + in (foldr (<|>) empty ps, "-- choose at least one from \n" ++ concat (map (" "++) ts)) -- | A `change` entry is an optional `choose` entry change :: EntryVals a a diff --git a/src/Options/UU/Main.hs b/src/Options/UU/Main.hs deleted file mode 100644 --- a/src/Options/UU/Main.hs +++ /dev/null @@ -1,83 +0,0 @@ -{-# 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 = " " - --- 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, "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"}} --- --- >>> ./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 diff --git a/uu-options.cabal b/uu-options.cabal --- a/uu-options.cabal +++ b/uu-options.cabal @@ -1,5 +1,5 @@ Name: uu-options -Version: 0.1.0.2 +Version: 0.2.0.0 Build-Type: Simple License: MIT Copyright: S Doaitse Swierstra @@ -13,10 +13,9 @@ Description: Using the new Control.Applicative.Interleaved module we use the uu-parsinglib library to construct extremely concise command line processors, which provide helpful information when called incorrectly. . - The module contains a module `OptionsDemo` which serves as an example of how to use the various options of the module; you may take a look at the source code. + The module contains a module `Options.UU.Demo` which serves as an example of how to use the various options of the module; you may take a look at the source code. . - The package also installs the program `option-demo` - which may be called from the command line to see what happens for the various options. It also contains a function demo which may be called from within ghci to experiment. + It also contains a function demo which may be called from within ghci to experiment with. . Background information can be found in a Technical Report at Category: Options @@ -27,13 +26,8 @@ type: svn location: https://svn.science.uu.nl/repos/project.STEC.uu-parsinglib/uu-options -executable demo-options - Main-is: Options/UU/Main.hs - hs-source-dirs: src - 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 && < 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 + Exposed-modules: Options.UU.Interleaved, Options.UU.Demo