diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hydrogen-cli-args.cabal b/hydrogen-cli-args.cabal new file mode 100644 --- /dev/null +++ b/hydrogen-cli-args.cabal @@ -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 + diff --git a/src/Hydrogen/CliArgs.hs b/src/Hydrogen/CliArgs.hs new file mode 100644 --- /dev/null +++ b/src/Hydrogen/CliArgs.hs @@ -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)