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)

-- | a data structure for describing command line arguments
data OptionDescription = OptionDescription {
    
    -- | determines if this is a required option or not
    isRequired :: Bool,
    
    {- |
    What flag should we use. Eg: "-pretty-output"
    -}
    optionFlag :: String,
    
    {- |
    The name(s) to use for the argument(s).
    -}
    argumentNames :: [String],
    
    {- |
    the minimum number of args allowed
    -}
    minArgumentCount :: Int,
    
    {- |
    if true then 'minArgumentCount' is the upper threshold
    -}
    argumentCountIsFixed :: Bool} deriving (Show, Eq, Ord)

space :: String
space = " "

etc :: String
etc = "..."

-- | converts a command line description into a string version that
--   you can show the user
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
            -- take care of the bounded case
            (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
        -- TODO this if else is really lame. we should replace all this
        --      along w/ error handling with status codes
        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