diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,4 @@ +#!/usr/bin/env runhaskell import Distribution.Simple +main :: IO () main = defaultMain 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 @@ -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 = " " + +-- 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))) - - diff --git a/src/Options/UU/Main.hs b/src/Options/UU/Main.hs --- a/src/Options/UU/Main.hs +++ b/src/Options/UU/Main.hs @@ -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 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.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