uu-options (empty) → 0.1.0.0
raw patch · 5 files changed
+329/−0 lines, 5 filesdep +basedep +lensesdep +mtlsetup-changed
Dependencies added: base, lenses, mtl, transformers, uu-interleaved, uu-parsinglib
Files
- LICENSE +22/−0
- Setup.hs +2/−0
- src/Options/UU/Interleaved.hs +181/−0
- src/Options/UU/OptionsDemo.hs +84/−0
- uu-options.cabal +40/−0
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2010, SD Swierstra+All rights reserved.++The MIT License++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Options/UU/Interleaved.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE NoMonomorphismRestriction, + FlexibleInstances, + ScopedTypeVariables, + RankNTypes, + FlexibleContexts #-} + +module Options.UU.Interleaved where +import Data.Lenses +import Data.Functor.Identity +import Control.Applicative.Interleaved +import Control.Monad.State.Class +import Control.Monad.Trans.State.Lazy +import Text.ParserCombinators.UU -- hiding (pSymbol) +import Text.ParserCombinators.UU.BasicInstances +import Text.ParserCombinators.UU.Utils hiding (lexeme, pSymbol) + + +-- 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 + +-- instance IsParser (Gram (P (Str Char String Int))) + + +instance Splittable (P (Str Char String Int)) where + getPure = getZeroP + getNonPure = getOneP + +{- +pSymbol :: String -> p (Str Char String Int) String +pSymbol [] = pure [] +pSymbol (s:ss) = (:) <$> pSym s <*> pSymbol ss +-} + +type OptionParser a = P (Str Char String Int) a + +type Option a = Gram (P (Str Char String Int)) a + +type BaseEntry s d = MonadState s m => + (m () -> StateT r Identity b) + -> d + -> (Gram (P (Str Char String Int)) (r -> r), [Char]) + +type Entry s a = ShowParserType a => BaseEntry s ([Char], P (Str Char String Int) a, String) + +type EntryVal s a = ShowParserType a => BaseEntry s ([Char], a, String) + +type EntryVals s a = ShowParserType a => BaseEntry s [([Char], a, String)] + +class ShowParserType a where + showType :: OptionParser a -> String + +instance ShowParserType a => ShowParserType [a] where + showType (p :: OptionParser [a]) = let q :: OptionParser a = undefined + in "[" ++ showType q ++ "]" + +instance ShowParserType Int where + showType p = "Int" + +instance ShowParserType Char where + showType p = "Char" + +--instance ShowParserType String where +-- showType p = "String" + +instance ShowParserType Bool where + showType p = "Bool" + +data OptionResult a = Succes a + | Help String + + +lexeme p = p <* pToken "\EOT" + +pString = pMunch (/='\EOT') +pBool = True <$ pToken "True" <|> False <$ pToken "False" + +oG p a = mkG ((a `alter`) <$> p) + + +required_ :: (MonadState a m) + => (m () -> StateT r Identity b) + -> ( [Char] + , OptionParser (a -> a) + , String + , String + , String + ) + -> (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" *> lexeme p) a + <|> oG ( pToken ("--" ++ string ++ "=") *> lexeme p) a + , "--"++ 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` +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 + +option :: Entry a a +option a (string, p, i) = let (r, t) = required_ a (string, const <$> p, showType p, "optional", i) + in (r <|> pure id, t) + +-- | An `options` entry specifies an element which may occur more than once. The final value contains the list of all the values encountered. +options :: Entry [a] a +options a (string, p, i) = let (pars, text) = required_ a ( string + , (:) <$> p + , showType p + , "recurring" + , i) + in (let pm = (.) <$> pars <*> pm <|> pure id in pm, text) + +-- | 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) + + +-- | 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 +flag :: EntryVal a a +flag a (string, v,i) = option a (string, pure v, i) + +-- | A `flags` entry introduces a list of possible parameters, each with a value to which the field should be set +flags :: EntryVals a a +flags a table = foldr (<>) (pure id, "") (map (flag a) table) + +-- | A `set` entry introduces a required entry, which sets a spcific value; it is used in `choose` and probably not very useful by itself. +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 +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 +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") + + + +-- | A `field` entry introduces a collection of options which are used to set fields in a sub-record of the main record +field + :: (Functor f, Control.Monad.State.Class.MonadState a m) => + (m () + -> Control.Monad.Trans.State.Lazy.StateT + r Data.Functor.Identity.Identity b) + -> (f (a -> a), t) -> (f (r -> r), t) +field s opts = let (p, t) = opts in ((s `alter`) <$> p, t) + +-- | The function `run` equips the given option specification with an option to ask for @--help@. It concatenates the files coming from the command line and terminates them with an EOT. +-- Make sure your command line arguments do not contain an EOT. It parses the command line arguments and updates the `default` record passed to it +run :: + a -- ^ the record containing the default values + -> (Gram (P (Str Char String Int)) (a -> a), String) -- ^ the specification of the various options + -> String -- ^ The string containing the given options, separated by EOT + -> Either (OptionResult a) [Char] -- ^ The result is either an updated record (`Succes`) with options or a request for `Help`. In case of erroneous input an error message is returned. + +run defaults (p, t) inp = do let r@(a, errors) = parse ((,) <$> ( Succes <$> (mkP p <*> pure defaults) + <|> Help t <$ pToken "--help\EOT" + ) + <*> pEnd + ) (createStr 0 inp) + if null errors then Left a + else Right (t ++ concat (map (++"\n") ("\n-- Correcting steps:": map show errors))) + + + +
+ src/Options/UU/OptionsDemo.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE TemplateHaskell, FlexibleContexts, NoMonomorphismRestriction, TypeSynonymInstances, FlexibleInstances #-}+module Options.UU.OptionsDemo 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
+ uu-options.cabal view
@@ -0,0 +1,40 @@+Name: uu-options+Version: 0.1.0.0+Build-Type: Simple+License: MIT+Copyright: S Doaitse Swierstra +License-file: LICENSE+Author: Doaitse Swierstra, Utrecht University+Maintainer: Doaitse Swierstra +Stability: experimental+Homepage: http://www.cs.uu.nl/wiki/bin/view/HUT/ParserCombinators+Bug-reports: mailto:doaitse@swierstra.net +Synopsis: Parse command line options using uu-interleave and uu-parsinglib+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 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.+ .+ Background information can be found in a Technical Report at <http://www.cs.uu.nl/research/techreps/UU-CS-2013-005.html>+Category: Options++cabal-version: >= 1.6++source-repository head+ type: svn+ location: https://svn.science.uu.nl/repos/project.STEC.uu-parsinglib/uu-options++executable demo-options+ Main-is: Options/UU/OptionsDemo.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++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+ Exposed-modules: Options.UU.Interleaved+ Options.UU.OptionsDemo+