hydrogen-cli-args (empty) → 0.9
raw patch · 6 files changed
+252/−0 lines, 6 filesdep +basedep +containersdep +hydrogen-multimapsetup-changed
Dependencies added: base, containers, hydrogen-multimap, hydrogen-prelude
Files
- CHANGELOG.md +0/−0
- LICENSE +19/−0
- README.md +52/−0
- Setup.hs +2/−0
- hydrogen-cli-args.cabal +38/−0
- src/Hydrogen/CliArgs.hs +141/−0
+ CHANGELOG.md view
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2014 Julian Fleischer++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.
+ README.md view
@@ -0,0 +1,52 @@+hydrogen-cli-args+=================++An easy to use command line arguments parser.++ main = do++ (options, switches, args) <- getOpts [+ 'V' ~: switch "version"+ , 'h' ~: switch "help"+ , optarg "inFile"+ , optarg "outFile"+ , 'v' ~: switch "verbose"+ , 'f' ~: optarg "flag"+ , 'D' ~: optarg "config"+ ]++ when (switches ? "version") $ println "Example v1.0"++ when (switches ? "help") showManual++ let flags = options ! "flag"+ config = options ! "config"++ ...++This program will accept arguments like that:++ -h --version -DHELLLO --config=SOME_CONFIG -f flagvalue+++ `options` in the above example is a `MultiMap String String`++ `switches` is a `Set String`++ `args` contains the remaining arguments as a `[String]`.++If an optional argument, defined by `optarg` is given (by its short alias or by+its long name) it will show up in the `options` `MultiMap`. Note that you can check+for a key beings set with `(?)` and retrieve all associated values with `(!)`.+Also note that `(!)` will always return a list, but possibly en empty one (if no option+was given).++Long options can be given as `--key value` or as `--key=value`.++Short options can be given as `-D value` as well as `--Dvalue`.++If a switch, defined by `switch` is given, it will show up in the `switches` `Set`.+You can query for whether a switch is set or not with `(?)`.++Switches can be comined, i.e. `-hv` is the same as `-h -v`.++If `--` is supplied as an argument, no options are evaluated beyond this point.+Any unknown or malformed option (`-x`, `--xxxx`) will be treated as an argument.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hydrogen-cli-args.cabal view
@@ -0,0 +1,38 @@+name: hydrogen-cli-args+version: 0.9+homepage: https://scravy.de/hydrogen-cli-args/+synopsis: Hydrogen Command Line Arguments Parser+license: MIT+license-file: LICENSE+extra-source-files: CHANGELOG.md, README.md+author: Julian Fleischer+maintainer: julian@scravy.de+category: Language+build-type: Simple+cabal-version: >=1.14++source-repository head+ type: git+ location: https://github.com/scravy/hydrogen-cli-args++library+ exposed-modules: Hydrogen.CliArgs+ build-depends: base ==4.7.*+ , containers ==0.5.*+ , hydrogen-multimap ==0.1+ , hydrogen-prelude ==0.9+ hs-source-dirs: src+ ghc-options: -Wall+ default-language: Haskell2010+ default-extensions: CPP+ , DeriveDataTypeable+ , DeriveGeneric+ , EmptyCase+ , FlexibleContexts+ , GADTs+ , LambdaCase+ , MultiWayIf+ , NoImplicitPrelude+ , RecordWildCards+ , ScopedTypeVariables+
+ src/Hydrogen/CliArgs.hs view
@@ -0,0 +1,141 @@+module Hydrogen.CliArgs (+ Option+ , switch+ , optarg+ , (~:)+ , (~?)+ , (~=)+ , getOpts+ , getOpts'+ , Set+ , Has (..)+ , MultiMap+ , Container (..)+ ) where++import Hydrogen.Prelude.System+import qualified Hydrogen.MultiMap as MultiMap+import qualified Data.Map as Map+import qualified Data.Set as Set++switch, optarg :: String -> Option++switch = OptSwitch+optarg = OptArg++infixl 2 ~:+infixl 1 ~?++(~:) :: Char -> Option -> Option+(~:) = OptShort++(~?) :: Option -> (String -> Bool) -> Option+(~?) = flip OptCheck++(~=) :: Option -> String -> Option+(~=) = \opt pattern -> OptCheck (=~ pattern) opt++data Option =+ OptArg String+ | OptSwitch String+ | OptCheck (String -> Bool) Option+ | OptShort Char Option+ deriving (Show, Generic, Typeable)++isArg :: Option -> Bool+isArg = \case+ OptArg _ -> True+ OptShort _ x -> isArg x+ OptCheck _ x -> isArg x+ _ -> False++shorts :: Option -> [Char]+shorts = \case+ OptShort c xs -> c : shorts xs+ OptCheck _ xs -> shorts xs+ _ -> []++long :: Option -> String+long = \case+ OptArg x -> x+ OptSwitch x -> x+ OptShort _ xs -> long xs+ OptCheck _ xs -> long xs++check :: Option -> Maybe (String -> Bool)+check = \case+ OptArg _ -> Nothing+ OptSwitch _ -> Nothing+ OptShort _ xs -> check xs+ OptCheck x _ -> Just x++getOpts :: [Option] -> IO (MultiMap String String, Set String, [String])+getOpts opts = getOpts' opts <$> getArgs++getOpts' :: [Option] -> [String] -> (MultiMap String String, Set String, [String])+getOpts' opts = readArgs MultiMap.empty Set.empty++ where++ readArgs :: MultiMap String String -> Set String -> [String]+ -> (MultiMap String String, Set String, [String])+ readArgs args switches = \case+ x : xs+ | x =~ "^--[^ =-]+=" -> break (== '=') x |> \case+ (key, arg) | opt `elem` longArgs && test opt val+ -> readArgs (MultiMap.insert opt val args) switches xs+ where+ val = tail arg+ opt = drop 2 key++ _ -> readArg++ | x =~ "^--[^-]" -> drop 2 x |> \case+ opt+ | opt `elem` longArgs && not (null xs) && test opt val+ -> readArgs (MultiMap.insert opt val args) switches (tail xs)+ | opt `elem` longSwitches+ -> readArgs args (Set.insert opt switches) xs+ where+ val = head xs++ _ -> readArg++ | x =~ "^-[^ =-]" -> drop 1 x |> \case+ optString@(shortOpt : val)+ | shortOpt `elem` shortArgs && not (null val) && test opt val+ -> readArgs (MultiMap.insert opt val args) switches xs+ | shortOpt `elem` shortArgs && not (null xs) && test opt val'+ -> readArgs (MultiMap.insert opt val' args) switches (tail xs)+ | otherwise+ -> readArgs args (foldr Set.insert switches shortOpts) xs+ where+ val' = head xs+ opt = aliasMap ! shortOpt+ shortOpts = map (aliasMap !) $ filter (`elem` shortSwitches) optString++ _ -> readArg++ | x == "--" -> (args, switches, xs)++ | otherwise -> readArg++ where+ readArg = (args', switches', x : xs')+ (args', switches', xs') = readArgs args switches xs++ _ -> (args, switches, [])+++ (optArgs, optSwitches) = partition isArg opts+ + (longArgs, longSwitches) = (map long optArgs, map long optSwitches)+ (shortArgs, shortSwitches) = (concatMap shorts optArgs, concatMap shorts optSwitches)+ + aliasMap = foldr aliases Map.empty opts+ aliases opt = flip (foldr (flip Map.insert (long opt))) (shorts opt)++ patternMap = foldr patterns Map.empty opts+ patterns opt = maybe id (Map.insert (long opt)) (check opt)++ test opt val = maybe True (val |>) (Map.lookup opt patternMap)