{- | 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
  { forall a. OptSpec a -> [String]
progDescription :: [String]
    -- ^ Free form lines to be shown with the generated help

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

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

  , forall a. OptSpec a -> String -> OptSetter a
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.

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

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



-- | Describe an option.
data OptDescr a = Option
  { forall a. OptDescr a -> String
optShortFlags  :: [Char]
  , forall a. OptDescr a -> [String]
optLongFlags   :: [String]
  , forall a. OptDescr a -> String
optDescription :: String
  , forall a. OptDescr a -> ArgDescr a
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 :: forall a. OptSpec a -> [OptDescr (OptSetter a)]
specToGetOpt = forall a b. (a -> b) -> [a] -> [b]
map forall a. OptDescr a -> OptDescr (OptSetter a)
convertOpt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. OptSpec a -> [OptDescr a]
progOptions

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

convertOpt :: OptDescr a -> GetOpt.OptDescr (OptSetter a)
convertOpt :: forall a. OptDescr a -> OptDescr (OptSetter a)
convertOpt (Option String
a [String]
b String
c ArgDescr a
d) = forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option String
a [String]
b (forall a. ArgDescr a -> ArgDescr (OptSetter a)
convertArg ArgDescr a
d) String
c



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

addFile :: (String -> OptSetter a) -> (a, [String]) -> String -> (a,[String])
addFile :: forall a.
(String -> OptSetter a) -> (a, [String]) -> String -> (a, [String])
addFile String -> OptSetter a
add (a
a,[String]
es) String
file = case String -> OptSetter a
add String
file a
a of
                            Left String
e    -> (a
a,String
eforall a. a -> [a] -> [a]
:[String]
es)
                            Right a
a1  -> (a
a1,[String]
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 :: forall a. a -> OptSpec a -> [String] -> Either GetOptException a
getOptsFrom a
dflt OptSpec a
os [String]
as =
  do let ([OptSetter a]
funs,[String]
files,[String]
errs) = forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
GetOpt.getOpt (forall a. OptSpec a -> ArgOrder (OptSetter a)
progArgOrder OptSpec a
os) (forall a. OptSpec a -> [OptDescr (OptSetter a)]
specToGetOpt OptSpec a
os) [String]
as
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs) forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ([String] -> GetOptException
GetOptException [String]
errs)
     let (a
a, [String]
errs1) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. (a, [String]) -> (a -> Either String a) -> (a, [String])
addOpt (a
dflt,[]) [OptSetter a]
funs
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs1) forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ([String] -> GetOptException
GetOptException [String]
errs1)
     let (a
b, [String]
errs2) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a.
(String -> OptSetter a) -> (a, [String]) -> String -> (a, [String])
addFile (forall a. OptSpec a -> String -> OptSetter a
progParams OptSpec a
os)) (a
a,[]) [String]
files
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs2) forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ([String] -> GetOptException
GetOptException [String]
errs2)
     forall (f :: * -> *) a. Applicative f => a -> f a
pure a
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 :: forall a. a -> OptSpec a -> IO a
getOptsX a
dflt OptSpec a
os =
  do [String]
as <- IO [String]
getArgs
     case forall a. a -> OptSpec a -> [String] -> Either GetOptException a
getOptsFrom a
dflt OptSpec a
os [String]
as of
       Left GetOptException
e -> forall e a. Exception e => e -> IO a
throwIO GetOptException
e
       Right a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
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 :: forall a. a -> OptSpec a -> IO a
getOpts a
dlft OptSpec a
os =
  forall a. a -> OptSpec a -> IO a
getOptsX a
dlft OptSpec a
os forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(GetOptException [String]
errs) -> forall a b. OptSpec a -> [String] -> IO b
reportUsageError OptSpec a
os [String]
errs

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

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


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

  params :: String
params = case forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, String) -> String
ppParam (forall a. OptSpec a -> [(String, String)]
progParamDocs OptSpec a
os) of
             String
"" -> String
""
             String
ps -> String
"Parameters:\n" forall a. [a] -> [a] -> [a]
++ String
ps forall a. [a] -> [a] -> [a]
++ String
"\n"

  ppParam :: (String, String) -> String
ppParam (String
x,String
y) = String
"  " forall a. [a] -> [a] -> [a]
++ String -> String
padKey String
x forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
y forall a. [a] -> [a] -> [a]
++ String
"\n"

  keyWidth :: Int
keyWidth = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall a. OptSpec a -> [(String, String)]
progParamDocs OptSpec a
os))
  padKey :: String -> String
padKey String
k = String
k forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
keyWidth forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
k) Char
' '

data GetOptException = GetOptException [String] deriving Int -> GetOptException -> String -> String
[GetOptException] -> String -> String
GetOptException -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GetOptException] -> String -> String
$cshowList :: [GetOptException] -> String -> String
show :: GetOptException -> String
$cshow :: GetOptException -> String
showsPrec :: Int -> GetOptException -> String -> String
$cshowsPrec :: Int -> GetOptException -> String -> String
Show

instance Exception GetOptException