module Database.TxtSushi.Util.CommandLineArgument (
extractCommandLineArguments,
formatCommandLine,
CommandLineDescription(CommandLineDescription),
options,
minTailArgumentCount,
tailArgumentNames,
tailArgumentCountIsFixed,
OptionDescription(OptionDescription),
isRequired,
optionFlag,
argumentNames,
minArgumentCount,
argumentCountIsFixed) where
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
data CommandLineDescription = CommandLineDescription {
options :: [OptionDescription],
minTailArgumentCount :: Int,
tailArgumentNames :: [String],
tailArgumentCountIsFixed :: Bool} deriving (Show, Eq, Ord)
data OptionDescription = OptionDescription {
isRequired :: Bool,
optionFlag :: String,
argumentNames :: [String],
minArgumentCount :: Int,
argumentCountIsFixed :: Bool} deriving (Show, Eq, Ord)
space :: String
space = " "
etc :: String
etc = "..."
formatCommandLine :: CommandLineDescription -> String
formatCommandLine commandLine =
let formattedOptions = formatOptions (options commandLine)
formattedTailArgs = formatTailArguments commandLine
in
if null formattedOptions || null formattedTailArgs then
formattedOptions ++ formattedTailArgs
else
formattedOptions ++ space ++ formattedTailArgs
formatTailArguments :: CommandLineDescription -> String
formatTailArguments commandLine =
let tailArgs = tailArgumentNames commandLine
minTailArgs = minTailArgumentCount commandLine
formattedTailArgs = intercalate space (take minTailArgs (cycle tailArgs))
in
if tailArgumentCountIsFixed commandLine then
formattedTailArgs
else
if null formattedTailArgs then etc
else formattedTailArgs ++ space ++ etc
formatOptions :: [OptionDescription] -> String
formatOptions [] = ""
formatOptions (headOption:optionsTail) =
let argSubstring = argumentSubstring headOption
spacedArgSubstring = if null argSubstring then "" else space ++ argSubstring
requiredOptionString = (optionFlag headOption) ++ spacedArgSubstring
formattedOptionsTail = if null optionsTail then "" else space ++ (formatOptions optionsTail)
in
if isRequired headOption then
requiredOptionString ++ formattedOptionsTail
else
"[" ++ requiredOptionString ++ "]" ++ formattedOptionsTail
argumentSubstring :: OptionDescription -> String
argumentSubstring option =
let minArgs = minArgumentCount option
in
if argumentCountIsFixed option then
if minArgs == 0 then ""
else intercalate space (take minArgs (cycle (argumentNames option)))
else
(intercalate space (take minArgs (cycle (argumentNames option)))) ++ space ++ etc
extractCommandLineArguments ::
CommandLineDescription ->
[String] ->
(Map.Map OptionDescription [[String]], [String])
extractCommandLineArguments cmdLineDesc argValues =
let unreservedArgCount = (length argValues) (minTailArgumentCount cmdLineDesc)
(unreservedArgs, reservedArgs) = splitAt unreservedArgCount argValues
theOptions = options cmdLineDesc
(optionMap, remainingArgs) = extractOptions theOptions unreservedArgs
anyOptionsInReservedArgs =
let (hopefullyEmptyMap, _) = extractOptions theOptions reservedArgs
in not $ Map.null hopefullyEmptyMap
in
if anyOptionsInReservedArgs then
(Map.empty, [])
else
(optionMap, remainingArgs ++ reservedArgs)
extractOptions ::
[OptionDescription] ->
[String] ->
(Map.Map OptionDescription [[String]], [String])
extractOptions [] argValues = (Map.empty, argValues)
extractOptions _ [] = (Map.empty, [])
extractOptions optDescs argValues@(argHead:_) =
case (find (\optDesc -> optionFlag optDesc == argHead) optDescs) of
Nothing ->
(Map.empty, argValues)
Just optDesc ->
let (optArgs, afterOptArgs) = extractOption optDesc optDescs (tail argValues)
(tailArgsMap, afterTailArgs) = extractOptions optDescs afterOptArgs
in (addOptionArgsToMap tailArgsMap optDesc optArgs, afterTailArgs)
extractOption ::
OptionDescription ->
[OptionDescription] ->
[String] ->
([String], [String])
extractOption optDesc allOptDescs optArgsEtc =
let optArgExtent = argumentExtent optDesc allOptDescs optArgsEtc
in splitAt optArgExtent optArgsEtc
argumentExtent :: OptionDescription -> [OptionDescription] -> [String] -> Int
argumentExtent optionDescription allOptDescs afterOptArgs =
let allOptFlags = map optionFlag allOptDescs
maybeNextArgIndex = findIndex (\arg -> any (== arg) allOptFlags) afterOptArgs
minArgCount = minArgumentCount optionDescription
isFixed = argumentCountIsFixed optionDescription
in
case maybeNextArgIndex of
Nothing ->
let afterOptLength = length afterOptArgs
in
if afterOptLength < minArgCount then missingParameters
else if isFixed then minArgCount
else afterOptLength
Just nextArgIndex ->
if nextArgIndex < minArgCount then missingParameters
else if isFixed then minArgCount
else nextArgIndex
where
missingParameters =
error $ "missing parameter(s) for " ++ (optionFlag optionDescription)
addOptionArgsToMap ::
Map.Map OptionDescription [[String]] ->
OptionDescription ->
[String] ->
Map.Map OptionDescription [[String]]
addOptionArgsToMap optArgMap opt args =
case (Map.lookup opt optArgMap) of
Nothing -> Map.insert opt [args] optArgMap
Just currArgs -> Map.insert opt (currArgs ++ [args]) optArgMap