{- | Provides support for processing command-line arguments.
This is a simple wrapper around get-opt.
Here is an example of a typical usage:

> data Settings = Settings
>   { verbose :: Bool
>   , inPar   :: Int
>   , files   :: [String]
>   }
>
> options :: OptSpec Settings
> options = optSpec
>   { progDescription = [ "A useful utility." ]
>
>   , progOptions =
>       [ Option ['v'] ["verbose"]
>         "Display more information while working."
>         $ NoArg $ \s -> Right s { verbose = True }
>
>       , Option ['p'] ["par"]
>         "Process that many files at once."
>         $ ReqArg "NUM" $ \a s ->
>           case readMaybe a of
>             Just n | n > 0  -> Right s { inPar = n }
>             _               -> Left "Invalid value for `par`"
>       ]
>
>   , progParamDocs =
>       [ ("FILES",   "The files that need processing.") ]
>
>   , progParams = \p s -> Right s { files = p : files s }
>
>   , progArgOrder = Permute
>   }

Here is what the usage information looks like:

> *Main> dumpUsage options
> A useful utility.
> 
> Parameters:
>   FILES    The files that need processing.
> 
> Flags:
>   -v      --verbose  Display more information while working.
>   -p NUM  --par=NUM  Process that many files at once.

-}

module SimpleGetOpt
  ( -- * Basic functionality
    getOpts
  , getOptsX
  , getOptsFrom
  , OptSpec(..)
  , OptDescr(..)
  , OptSetter
  , ArgDescr(..)
  , GetOptException(..)
  , GetOpt.ArgOrder(..)
  , optSpec

  -- * Information and error reporting.
  , dumpUsage
  , reportUsageError
  , usageString

  -- * Direct interaction with GetOpt
  , specToGetOpt
  ) where

import qualified System.Console.GetOpt as GetOpt
import System.IO(stderr,hPutStrLn)
import System.Exit(exitFailure)
import System.Environment(getArgs)

import Control.Monad(unless)
import Control.Exception(Exception,throwIO,catch)



-- | Specification of a collection of options, described by type @a@.
data OptSpec a = OptSpec
  { progDescription :: [String]
    -- ^ Free form lines to be shown with the generated help

  , progOptions  :: [OptDescr a]
    -- ^ A list of options and command-line flags.

  , progParamDocs       :: [(String,String)]
    -- ^ Documentation for the free-form parameters.

  , progParams      :: String -> OptSetter a
    -- ^ Used to add the parameters that are not an option or a flag
    -- (i.e., this is just a free form command line parameter)
    -- in left-to-right order.

  , progArgOrder :: !(GetOpt.ArgOrder (OptSetter a))
    -- ^ What to do with parameters
  }

-- | A default empty specification.  The default argument order is 'Permute'.
optSpec :: OptSpec a
optSpec = OptSpec
  { progDescription = []
  , progOptions     = []
  , progParamDocs   = []
  , progParams      = \_ _ -> Left "Unexpected parameter"
  , progArgOrder    = GetOpt.Permute
  }



-- | Describe an option.
data OptDescr a = Option
  { optShortFlags  :: [Char]
  , optLongFlags   :: [String]
  , optDescription :: String
  , optArgument    :: ArgDescr a
  }

-- | Manipulate options of type @a@, with support for errors.
type OptSetter a = a -> Either String a

-- | Describe an option argumnet.
data ArgDescr a =

    NoArg (OptSetter a)
    -- ^ This option does not take an argument.

  | ReqArg String (String -> OptSetter a)
    -- ^ This option has a required argument.
    -- The string describes the type of the argument.

  | OptArg String (Maybe String -> OptSetter a)
    -- ^ This option has an optional argument.
    -- The string describes the type of the argument.


specToGetOpt :: OptSpec a -> [ GetOpt.OptDescr (OptSetter a) ]
specToGetOpt = map convertOpt . progOptions

convertArg :: ArgDescr a -> GetOpt.ArgDescr (OptSetter a)
convertArg arg =
  case arg of
    NoArg a    -> GetOpt.NoArg a
    ReqArg s a -> GetOpt.ReqArg a s
    OptArg s a -> GetOpt.OptArg a s

convertOpt :: OptDescr a -> GetOpt.OptDescr (OptSetter a)
convertOpt (Option a b c d) = GetOpt.Option a b (convertArg d) c



addOpt :: (a, [String]) -> (a -> Either String a) -> (a, [String])
addOpt (a,es) f = case f a of
                    Left e   -> (a,e:es)
                    Right a1 -> (a1,es)

addFile :: (String -> OptSetter a) -> (a, [String]) -> String -> (a,[String])
addFile add (a,es) file = case add file a of
                            Left e    -> (a,e:es)
                            Right a1  -> (a1,es)


-- | Process the given command line options according to the given spec.
-- The options will be permuted to get flags.
-- Returns errors on the 'Left'.
getOptsFrom :: a -> OptSpec a -> [String] -> Either GetOptException a
getOptsFrom dflt os as =
  do let (funs,files,errs) = GetOpt.getOpt (progArgOrder os) (specToGetOpt os) as
     unless (null errs) $ Left (GetOptException errs)
     let (a, errs1) = foldl addOpt (dflt,[]) funs
     unless (null errs1) $ Left (GetOptException errs1)
     let (b, errs2) = foldl (addFile (progParams os)) (a,[]) files
     unless (null errs2) $ Left (GetOptException errs2)
     pure b



-- | Get the command-line options and process them according to the given spec.
-- The options will be permuted to get flags.
-- Throws a 'GetOptException' if some problems are found.
getOptsX :: a -> OptSpec a -> IO a
getOptsX dflt os =
  do as <- getArgs
     case getOptsFrom dflt os as of
       Left e -> throwIO e
       Right a -> pure a

-- | Get the command-line options and process them according to the given spec.
-- The options will be permuted to get flags.
-- On failure, print an error message on standard error and exit.
getOpts :: a -> OptSpec a -> IO a
getOpts dlft os =
  getOptsX dlft os `catch` \(GetOptException errs) -> reportUsageError os errs

-- | Print the given messages on 'stderr' and show the program's usage info,
-- then exit.
reportUsageError :: OptSpec a -> [String] -> IO b
reportUsageError os es =
  do hPutStrLn stderr "Invalid command line options:"
     hPutStrLn stderr $ unlines $ map ("  " ++) es
     dumpUsage os
     exitFailure

-- | Show the program's usage information on 'stderr'.
dumpUsage :: OptSpec a -> IO ()
dumpUsage os = hPutStrLn stderr (usageString os)


-- | A string descibing the options.
usageString :: OptSpec a -> String
usageString os = GetOpt.usageInfo (desc ++ params ++ "Flags:") (specToGetOpt os)
  where
  desc = case progDescription os of
           [] -> []
           xs -> unlines xs ++ "\n"

  params = case concatMap ppParam (progParamDocs os) of
             "" -> ""
             ps -> "Parameters:\n" ++ ps ++ "\n"

  ppParam (x,y) = "  " ++ padKey x ++ " " ++ y ++ "\n"

  keyWidth = maximum (0 : map (length . fst) (progParamDocs os))
  padKey k = k ++ replicate (keyWidth - length k) ' '

data GetOptException = GetOptException [String] deriving Show

instance Exception GetOptException