{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}

-- | Declarative options parser

module Options.Declarative (
    -- * Command type
    IsCmd,
    Cmd,
    logStr,
    getVerbosity,
    getLogger,

    -- * Argument definition tools
    Option(..),
    Flag,
    Arg,

    -- * Defining argument types
    ArgRead(..),
    Def,

    -- * Subcommands support
    Group(..),
    SubCmd, subCmd,

    -- * Run a command
    run, run_,
    ) where

import           Control.Monad
import           Control.Monad.Reader
import           Data.List
import           Data.Maybe
import           Data.Monoid
import           Data.Proxy
import           GHC.TypeLits
import           System.Console.GetOpt
import           System.Environment
import           System.Exit
import           System.IO
import           Text.Read

-- | Command line option
class Option a where
    -- | Type of the argument' value
    type Value a :: *
    -- | Get the argument' value
    get :: a -> Value a

-- | Named argument
newtype Flag (shortNames  :: Symbol  )
             (longNames   :: [Symbol])
             (placeholder :: Symbol  )
             (help        :: Symbol  )
             a
    = Flag { Flag shortNames longNames placeholder help a -> a
getFlag :: a }

-- | Unnamed argument
newtype Arg (placeholder :: Symbol) a = Arg { Arg placeholder a -> a
getArg :: a }

instance ArgRead a => Option (Flag _a _b _c _d a) where
    type Value (Flag _a _b _c _d a) = Unwrap a
    get :: Flag _a _b _c _d a -> Value (Flag _a _b _c _d a)
get = a -> Unwrap a
forall a. ArgRead a => a -> Unwrap a
unwrap (a -> Unwrap a)
-> (Flag _a _b _c _d a -> a) -> Flag _a _b _c _d a -> Unwrap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag _a _b _c _d a -> a
forall (shortNames :: Symbol) (longNames :: [Symbol])
       (placeholder :: Symbol) (help :: Symbol) a.
Flag shortNames longNames placeholder help a -> a
getFlag

instance Option (Arg _a a) where
    type Value (Arg _a a) = a
    get :: Arg _a a -> Value (Arg _a a)
get = Arg _a a -> Value (Arg _a a)
forall (placeholder :: Symbol) a. Arg placeholder a -> a
getArg

-- | Command line option's annotated types
class ArgRead a where
    -- | Type of the argument
    type Unwrap a :: *
    type Unwrap a = a

    -- | Get the argument's value
    unwrap :: a -> Unwrap a
    default unwrap :: a ~ Unwrap a => a -> Unwrap a
    unwrap = a -> Unwrap a
forall a. a -> a
id

    -- | Argument parser
    argRead :: [String] -> Maybe a
    default argRead :: Read a => [String] -> Maybe a
    argRead [String]
ss = Last a -> Maybe a
forall a. Last a -> Maybe a
getLast (Last a -> Maybe a) -> Last a -> Maybe a
forall a b. (a -> b) -> a -> b
$ [Last a] -> Last a
forall a. Monoid a => [a] -> a
mconcat ([Last a] -> Last a) -> [Last a] -> Last a
forall a b. (a -> b) -> a -> b
$ Maybe a -> Last a
forall a. Maybe a -> Last a
Last (Maybe a -> Last a) -> (String -> Maybe a) -> String -> Last a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String -> Last a) -> [String] -> [Last a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
ss

    -- | Indicate this argument is mandatory
    needArg :: Proxy a -> Bool
    needArg Proxy a
_ = Bool
True

instance ArgRead Int

instance ArgRead Integer

instance ArgRead Double

instance {-# OVERLAPPING #-} ArgRead String where
    argRead :: [String] -> Maybe String
argRead [] = Maybe String
forall a. Maybe a
Nothing
    argRead [String]
xs = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
last [String]
xs

instance ArgRead Bool where
    argRead :: [String] -> Maybe Bool
argRead []    = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    argRead [String
"f"] = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    argRead [String
"t"] = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    argRead [String]
_     = Maybe Bool
forall a. Maybe a
Nothing

    needArg :: Proxy Bool -> Bool
needArg Proxy Bool
_ = Bool
False

instance ArgRead a => ArgRead (Maybe a) where
    argRead :: [String] -> Maybe (Maybe a)
argRead [] = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
    argRead [String]
xs = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Maybe a -> Maybe (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Maybe a
forall a. ArgRead a => [String] -> Maybe a
argRead [String]
xs

instance {-# OVERLAPPABLE #-} ArgRead a => ArgRead [a] where
    argRead :: [String] -> Maybe [a]
argRead [String]
xs = [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a]) -> [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$ (String -> Maybe a) -> [String] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([String] -> Maybe a
forall a. ArgRead a => [String] -> Maybe a
argRead ([String] -> Maybe a) -> (String -> [String]) -> String -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[])) [String]
xs

-- | The argument which has default value
newtype Def (defaultValue :: Symbol) a =
    Def { Def defaultValue a -> a
getDef :: a }

instance (KnownSymbol defaultValue, ArgRead a) => ArgRead (Def defaultValue a) where
    type Unwrap (Def defaultValue a) = Unwrap a
    unwrap :: Def defaultValue a -> Unwrap (Def defaultValue a)
unwrap = a -> Unwrap a
forall a. ArgRead a => a -> Unwrap a
unwrap (a -> Unwrap a)
-> (Def defaultValue a -> a) -> Def defaultValue a -> Unwrap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Def defaultValue a -> a
forall (defaultValue :: Symbol) a. Def defaultValue a -> a
getDef

    argRead :: [String] -> Maybe (Def defaultValue a)
argRead [String]
s =
        let s' :: [String]
s' = case [String]
s of
                 [] -> [Proxy defaultValue -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy defaultValue
forall k (t :: k). Proxy t
Proxy :: Proxy defaultValue)]
                 [String]
v  -> [String]
v
        in a -> Def defaultValue a
forall (defaultValue :: Symbol) a. a -> Def defaultValue a
Def (a -> Def defaultValue a) -> Maybe a -> Maybe (Def defaultValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Maybe a
forall a. ArgRead a => [String] -> Maybe a
argRead [String]
s'

-- | Command
newtype Cmd (help :: Symbol) a =
    Cmd (ReaderT Int IO a)
    deriving (a -> Cmd help b -> Cmd help a
(a -> b) -> Cmd help a -> Cmd help b
(forall a b. (a -> b) -> Cmd help a -> Cmd help b)
-> (forall a b. a -> Cmd help b -> Cmd help a)
-> Functor (Cmd help)
forall a b. a -> Cmd help b -> Cmd help a
forall a b. (a -> b) -> Cmd help a -> Cmd help b
forall (help :: Symbol) a b. a -> Cmd help b -> Cmd help a
forall (help :: Symbol) a b. (a -> b) -> Cmd help a -> Cmd help b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Cmd help b -> Cmd help a
$c<$ :: forall (help :: Symbol) a b. a -> Cmd help b -> Cmd help a
fmap :: (a -> b) -> Cmd help a -> Cmd help b
$cfmap :: forall (help :: Symbol) a b. (a -> b) -> Cmd help a -> Cmd help b
Functor, Functor (Cmd help)
a -> Cmd help a
Functor (Cmd help)
-> (forall a. a -> Cmd help a)
-> (forall a b. Cmd help (a -> b) -> Cmd help a -> Cmd help b)
-> (forall a b c.
    (a -> b -> c) -> Cmd help a -> Cmd help b -> Cmd help c)
-> (forall a b. Cmd help a -> Cmd help b -> Cmd help b)
-> (forall a b. Cmd help a -> Cmd help b -> Cmd help a)
-> Applicative (Cmd help)
Cmd help a -> Cmd help b -> Cmd help b
Cmd help a -> Cmd help b -> Cmd help a
Cmd help (a -> b) -> Cmd help a -> Cmd help b
(a -> b -> c) -> Cmd help a -> Cmd help b -> Cmd help c
forall a. a -> Cmd help a
forall a b. Cmd help a -> Cmd help b -> Cmd help a
forall a b. Cmd help a -> Cmd help b -> Cmd help b
forall a b. Cmd help (a -> b) -> Cmd help a -> Cmd help b
forall a b c.
(a -> b -> c) -> Cmd help a -> Cmd help b -> Cmd help c
forall (help :: Symbol). Functor (Cmd help)
forall (help :: Symbol) a. a -> Cmd help a
forall (help :: Symbol) a b. Cmd help a -> Cmd help b -> Cmd help a
forall (help :: Symbol) a b. Cmd help a -> Cmd help b -> Cmd help b
forall (help :: Symbol) a b.
Cmd help (a -> b) -> Cmd help a -> Cmd help b
forall (help :: Symbol) a b c.
(a -> b -> c) -> Cmd help a -> Cmd help b -> Cmd help c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Cmd help a -> Cmd help b -> Cmd help a
$c<* :: forall (help :: Symbol) a b. Cmd help a -> Cmd help b -> Cmd help a
*> :: Cmd help a -> Cmd help b -> Cmd help b
$c*> :: forall (help :: Symbol) a b. Cmd help a -> Cmd help b -> Cmd help b
liftA2 :: (a -> b -> c) -> Cmd help a -> Cmd help b -> Cmd help c
$cliftA2 :: forall (help :: Symbol) a b c.
(a -> b -> c) -> Cmd help a -> Cmd help b -> Cmd help c
<*> :: Cmd help (a -> b) -> Cmd help a -> Cmd help b
$c<*> :: forall (help :: Symbol) a b.
Cmd help (a -> b) -> Cmd help a -> Cmd help b
pure :: a -> Cmd help a
$cpure :: forall (help :: Symbol) a. a -> Cmd help a
$cp1Applicative :: forall (help :: Symbol). Functor (Cmd help)
Applicative, Applicative (Cmd help)
a -> Cmd help a
Applicative (Cmd help)
-> (forall a b. Cmd help a -> (a -> Cmd help b) -> Cmd help b)
-> (forall a b. Cmd help a -> Cmd help b -> Cmd help b)
-> (forall a. a -> Cmd help a)
-> Monad (Cmd help)
Cmd help a -> (a -> Cmd help b) -> Cmd help b
Cmd help a -> Cmd help b -> Cmd help b
forall a. a -> Cmd help a
forall a b. Cmd help a -> Cmd help b -> Cmd help b
forall a b. Cmd help a -> (a -> Cmd help b) -> Cmd help b
forall (help :: Symbol). Applicative (Cmd help)
forall (help :: Symbol) a. a -> Cmd help a
forall (help :: Symbol) a b. Cmd help a -> Cmd help b -> Cmd help b
forall (help :: Symbol) a b.
Cmd help a -> (a -> Cmd help b) -> Cmd help b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Cmd help a
$creturn :: forall (help :: Symbol) a. a -> Cmd help a
>> :: Cmd help a -> Cmd help b -> Cmd help b
$c>> :: forall (help :: Symbol) a b. Cmd help a -> Cmd help b -> Cmd help b
>>= :: Cmd help a -> (a -> Cmd help b) -> Cmd help b
$c>>= :: forall (help :: Symbol) a b.
Cmd help a -> (a -> Cmd help b) -> Cmd help b
$cp1Monad :: forall (help :: Symbol). Applicative (Cmd help)
Monad, Monad (Cmd help)
Monad (Cmd help)
-> (forall a. IO a -> Cmd help a) -> MonadIO (Cmd help)
IO a -> Cmd help a
forall a. IO a -> Cmd help a
forall (help :: Symbol). Monad (Cmd help)
forall (help :: Symbol) a. IO a -> Cmd help a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Cmd help a
$cliftIO :: forall (help :: Symbol) a. IO a -> Cmd help a
$cp1MonadIO :: forall (help :: Symbol). Monad (Cmd help)
MonadIO)

-- | Output string when the verbosity level is greater than or equal to `logLevel`
logStr :: Int         -- ^ Verbosity Level
       -> String      -- ^ Message
       -> Cmd help ()
logStr :: Int -> String -> Cmd help ()
logStr Int
logLevel String
msg = do
    Int -> String -> Cmd help ()
l <- Cmd help (Int -> String -> Cmd help ())
forall (m :: * -> *) (a :: Symbol).
MonadIO m =>
Cmd a (Int -> String -> m ())
getLogger
    Int -> String -> Cmd help ()
l Int
logLevel String
msg

-- | Return the verbosity level ('--verbosity=n')
getVerbosity :: Cmd help Int
getVerbosity :: Cmd help Int
getVerbosity = ReaderT Int IO Int -> Cmd help Int
forall (help :: Symbol) a. ReaderT Int IO a -> Cmd help a
Cmd ReaderT Int IO Int
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Retrieve the logger function
getLogger :: MonadIO m => Cmd a (Int -> String -> m ())
getLogger :: Cmd a (Int -> String -> m ())
getLogger = do
    Int
verbosity <- Cmd a Int
forall (help :: Symbol). Cmd help Int
getVerbosity
    (Int -> String -> m ()) -> Cmd a (Int -> String -> m ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int -> String -> m ()) -> Cmd a (Int -> String -> m ()))
-> (Int -> String -> m ()) -> Cmd a (Int -> String -> m ())
forall a b. (a -> b) -> a -> b
$ \Int
logLevel String
msg -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
verbosity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
logLevel) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
msg

-- | Command group
data Group =
    Group
    { Group -> String
groupHelp :: String
    , Group -> [SubCmd]
groupCmds :: [SubCmd]
    }

-- | Sub command
data SubCmd = forall c. IsCmd c => SubCmd String c

-- | Command class
class IsCmd c where
    getCmdHelp  :: c -> String
    default getCmdHelp :: (c ~ (a -> b), IsCmd b) => c -> String
    getCmdHelp c
f = b -> String
forall c. IsCmd c => c -> String
getCmdHelp (b -> String) -> b -> String
forall a b. (a -> b) -> a -> b
$ c
a -> b
f a
forall a. HasCallStack => a
undefined

    getOptDescr :: c -> [OptDescr (String, String)]
    default getOptDescr :: (c ~ (a -> b), IsCmd b) => c -> [OptDescr (String, String)]
    getOptDescr c
f = b -> [OptDescr (String, String)]
forall c. IsCmd c => c -> [OptDescr (String, String)]
getOptDescr (b -> [OptDescr (String, String)])
-> b -> [OptDescr (String, String)]
forall a b. (a -> b) -> a -> b
$ c
a -> b
f a
forall a. HasCallStack => a
undefined

    getUsageHeader :: c -> String -> String
    default getUsageHeader :: (c ~ (a -> b), IsCmd b) => c -> String -> String
    getUsageHeader c
f = b -> String -> String
forall c. IsCmd c => c -> String -> String
getUsageHeader (b -> String -> String) -> b -> String -> String
forall a b. (a -> b) -> a -> b
$ c
a -> b
f a
forall a. HasCallStack => a
undefined

    getUsageFooter :: c -> String -> String
    default getUsageFooter :: (c ~ (a -> b), IsCmd b) => c -> String -> String
    getUsageFooter c
f = b -> String -> String
forall c. IsCmd c => c -> String -> String
getUsageFooter (b -> String -> String) -> b -> String -> String
forall a b. (a -> b) -> a -> b
$ c
a -> b
f a
forall a. HasCallStack => a
undefined

    runCmd :: c
           -> [String]            -- ^ Command name
           -> Maybe String        -- ^ Version
           -> [(String, String)]  -- ^ Options
           -> [String]            -- ^ Non options
           -> [String]            -- ^ Unrecognized options
           -> IO ()

class KnownSymbols (s :: [Symbol]) where
    symbolVals :: Proxy s -> [String]

instance KnownSymbols '[] where
    symbolVals :: Proxy '[] -> [String]
symbolVals Proxy '[]
_ = []

instance (KnownSymbol s, KnownSymbols ss) => KnownSymbols (s ': ss) where
    symbolVals :: Proxy (s : ss) -> [String]
symbolVals Proxy (s : ss)
_ = Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Proxy ss -> [String]
forall (s :: [Symbol]). KnownSymbols s => Proxy s -> [String]
symbolVals (Proxy ss
forall k (t :: k). Proxy t
Proxy :: Proxy ss)

instance ( KnownSymbol shortNames
         , KnownSymbols longNames
         , KnownSymbol placeholder
         , KnownSymbol help
         , ArgRead a
         , IsCmd c )
         => IsCmd (Flag shortNames longNames placeholder help a -> c) where
    getOptDescr :: (Flag shortNames longNames placeholder help a -> c)
-> [OptDescr (String, String)]
getOptDescr Flag shortNames longNames placeholder help a -> c
f =
        let flagName :: String
flagName = [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
                       Proxy longNames -> [String]
forall (s :: [Symbol]). KnownSymbols s => Proxy s -> [String]
symbolVals (Proxy longNames
forall k (t :: k). Proxy t
Proxy :: Proxy longNames) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                       [ [Char
c] | Char
c <- Proxy shortNames -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy shortNames
forall k (t :: k). Proxy t
Proxy :: Proxy shortNames) ]
        in String
-> [String]
-> ArgDescr (String, String)
-> String
-> OptDescr (String, String)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
            (Proxy shortNames -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy shortNames
forall k (t :: k). Proxy t
Proxy :: Proxy shortNames))
            (Proxy longNames -> [String]
forall (s :: [Symbol]). KnownSymbols s => Proxy s -> [String]
symbolVals (Proxy longNames
forall k (t :: k). Proxy t
Proxy :: Proxy longNames))
            (if Proxy a -> Bool
forall a. ArgRead a => Proxy a -> Bool
needArg (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
             then (String -> (String, String)) -> String -> ArgDescr (String, String)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
                  (String
flagName, )
                  (Proxy placeholder -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy placeholder
forall k (t :: k). Proxy t
Proxy :: Proxy placeholder))
             else (String, String) -> ArgDescr (String, String)
forall a. a -> ArgDescr a
NoArg
                  (String
flagName, String
"t"))
            (Proxy help -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy help
forall k (t :: k). Proxy t
Proxy :: Proxy help))
        OptDescr (String, String)
-> [OptDescr (String, String)] -> [OptDescr (String, String)]
forall a. a -> [a] -> [a]
: c -> [OptDescr (String, String)]
forall c. IsCmd c => c -> [OptDescr (String, String)]
getOptDescr (Flag shortNames longNames placeholder help a -> c
f Flag shortNames longNames placeholder help a
forall a. HasCallStack => a
undefined)

    runCmd :: (Flag shortNames longNames placeholder help a -> c)
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
runCmd Flag shortNames longNames placeholder help a -> c
f [String]
name Maybe String
mbver [(String, String)]
options [String]
nonOptions [String]
unrecognized =
        let flagName :: String
flagName = [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
                       Proxy longNames -> [String]
forall (s :: [Symbol]). KnownSymbols s => Proxy s -> [String]
symbolVals (Proxy longNames
forall k (t :: k). Proxy t
Proxy :: Proxy longNames) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                       [ [Char
c] | Char
c <- Proxy shortNames -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy shortNames
forall k (t :: k). Proxy t
Proxy :: Proxy shortNames) ]
            mbs :: [String]
mbs = ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd ([(String, String)] -> [String]) -> [(String, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
flagName) (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
options
        in case ([String] -> Maybe a
forall a. ArgRead a => [String] -> Maybe a
argRead [String]
mbs, [String]
mbs) of
            (Maybe a
Nothing, []) ->
                [String] -> String -> IO ()
errorExit [String]
name (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"flag must be specified: --" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
flagName
            (Maybe a
Nothing, String
s:[String]
_) ->
                [String] -> String -> IO ()
errorExit [String]
name (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"bad argument: --" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
flagName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
            (Just a
arg, [String]
_) ->
                c
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
forall c.
IsCmd c =>
c
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
runCmd (Flag shortNames longNames placeholder help a -> c
f (Flag shortNames longNames placeholder help a -> c)
-> Flag shortNames longNames placeholder help a -> c
forall a b. (a -> b) -> a -> b
$ a -> Flag shortNames longNames placeholder help a
forall (shortNames :: Symbol) (longNames :: [Symbol])
       (placeholder :: Symbol) (help :: Symbol) a.
a -> Flag shortNames longNames placeholder help a
Flag a
arg) [String]
name Maybe String
mbver [(String, String)]
options [String]
nonOptions [String]
unrecognized

instance {-# OVERLAPPABLE #-}
         ( KnownSymbol placeholder, ArgRead a, IsCmd c )
         => IsCmd (Arg placeholder a -> c) where
    getUsageHeader :: (Arg placeholder a -> c) -> String -> String
getUsageHeader = Proxy placeholder -> (Arg placeholder a -> c) -> String -> String
forall (placeholder :: Symbol) a c.
(KnownSymbol placeholder, ArgRead a, IsCmd c) =>
Proxy placeholder -> (Arg placeholder a -> c) -> String -> String
getUsageHeaderOne (Proxy placeholder
forall k (t :: k). Proxy t
Proxy :: Proxy placeholder)

    runCmd :: (Arg placeholder a -> c)
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
runCmd = (Arg placeholder a -> c)
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
forall a c (placeholder :: Symbol).
(ArgRead a, IsCmd c) =>
(Arg placeholder a -> c)
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
runCmdOne

instance {-# OVERLAPPING #-}
         ( KnownSymbol placeholder, IsCmd c )
         => IsCmd (Arg placeholder String -> c) where
    getUsageHeader :: (Arg placeholder String -> c) -> String -> String
getUsageHeader = Proxy placeholder
-> (Arg placeholder String -> c) -> String -> String
forall (placeholder :: Symbol) a c.
(KnownSymbol placeholder, ArgRead a, IsCmd c) =>
Proxy placeholder -> (Arg placeholder a -> c) -> String -> String
getUsageHeaderOne (Proxy placeholder
forall k (t :: k). Proxy t
Proxy :: Proxy placeholder)

    runCmd :: (Arg placeholder String -> c)
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
runCmd = (Arg placeholder String -> c)
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
forall a c (placeholder :: Symbol).
(ArgRead a, IsCmd c) =>
(Arg placeholder a -> c)
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
runCmdOne

getUsageHeaderOne :: ( KnownSymbol placeholder, ArgRead a, IsCmd c )
                  => Proxy placeholder -> (Arg placeholder a -> c) -> String -> String
getUsageHeaderOne :: Proxy placeholder -> (Arg placeholder a -> c) -> String -> String
getUsageHeaderOne Proxy placeholder
proxy Arg placeholder a -> c
f String
prog =
    String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Proxy placeholder -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy placeholder
proxy String -> String -> String
forall a. [a] -> [a] -> [a]
++ c -> String -> String
forall c. IsCmd c => c -> String -> String
getUsageHeader (Arg placeholder a -> c
f Arg placeholder a
forall a. HasCallStack => a
undefined) String
prog

runCmdOne :: (Arg placeholder a -> c)
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
runCmdOne Arg placeholder a -> c
f [String]
name Maybe String
mbver [(String, String)]
options [String]
nonOptions [String]
unrecognized =
    case [String]
nonOptions of
        [] -> [String] -> String -> IO ()
errorExit [String]
name String
"not enough arguments"
        (String
opt: [String]
rest) ->
            case [String] -> Maybe a
forall a. ArgRead a => [String] -> Maybe a
argRead [String
opt] of
                Maybe a
Nothing ->
                    [String] -> String -> IO ()
errorExit [String]
name (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"bad argument: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt
                Just a
arg ->
                    c
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
forall c.
IsCmd c =>
c
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
runCmd (Arg placeholder a -> c
f (Arg placeholder a -> c) -> Arg placeholder a -> c
forall a b. (a -> b) -> a -> b
$ a -> Arg placeholder a
forall (placeholder :: Symbol) a. a -> Arg placeholder a
Arg a
arg) [String]
name Maybe String
mbver [(String, String)]
options [String]
rest [String]
unrecognized

instance {-# OVERLAPPING #-}
         ( KnownSymbol placeholder, ArgRead a, IsCmd c )
         => IsCmd (Arg placeholder [a] -> c) where
    getUsageHeader :: (Arg placeholder [a] -> c) -> String -> String
getUsageHeader Arg placeholder [a] -> c
f String
prog =
        String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Proxy placeholder -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy placeholder
forall k (t :: k). Proxy t
Proxy :: Proxy placeholder) String -> String -> String
forall a. [a] -> [a] -> [a]
++ c -> String -> String
forall c. IsCmd c => c -> String -> String
getUsageHeader (Arg placeholder [a] -> c
f Arg placeholder [a]
forall a. HasCallStack => a
undefined) String
prog

    runCmd :: (Arg placeholder [a] -> c)
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
runCmd Arg placeholder [a] -> c
f [String]
name Maybe String
mbver [(String, String)]
options [String]
nonOptions [String]
unrecognized =
        case ([String] -> Maybe a) -> [[String]] -> Maybe [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [String] -> Maybe a
forall a. ArgRead a => [String] -> Maybe a
argRead ([[String]] -> Maybe [a]) -> [[String]] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$ (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String]) -> [String] -> [[String]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
nonOptions of
            Maybe [a]
Nothing ->
                [String] -> String -> IO ()
errorExit [String]
name (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"bad arguments: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
nonOptions
            Just [a]
opts ->
                c
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
forall c.
IsCmd c =>
c
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
runCmd (Arg placeholder [a] -> c
f (Arg placeholder [a] -> c) -> Arg placeholder [a] -> c
forall a b. (a -> b) -> a -> b
$ [a] -> Arg placeholder [a]
forall (placeholder :: Symbol) a. a -> Arg placeholder a
Arg [a]
opts) [String]
name Maybe String
mbver [(String, String)]
options [] [String]
unrecognized

instance KnownSymbol help => IsCmd (Cmd help ()) where
    getCmdHelp :: Cmd help () -> String
getCmdHelp  Cmd help ()
_ = Proxy help -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy help
forall k (t :: k). Proxy t
Proxy :: Proxy help)
    getOptDescr :: Cmd help () -> [OptDescr (String, String)]
getOptDescr Cmd help ()
_ = []

    getUsageHeader :: Cmd help () -> String -> String
getUsageHeader Cmd help ()
_ String
_ = String
""
    getUsageFooter :: Cmd help () -> String -> String
getUsageFooter Cmd help ()
_ String
_ = String
""

    runCmd :: Cmd help ()
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
runCmd (Cmd ReaderT Int IO ()
m) [String]
name Maybe String
_ [(String, String)]
options [String]
nonOptions [String]
unrecognized =
        case ([(String, String)]
options, [String]
nonOptions, [String]
unrecognized) of
            ([(String, String)]
_, [], []) -> do
                let verbosityLevel :: Int
verbosityLevel = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ do
                        String
s <- String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"verbose" [(String, String)]
options
                        if | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s -> Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
                           | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'v') String
s -> Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                           | Bool
otherwise -> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
s
                ReaderT Int IO () -> Int -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Int IO ()
m Int
verbosityLevel

            ([(String, String)], [String], [String])
_ -> do
                [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
nonOptions ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
o ->
                    [String] -> String -> IO ()
errorExit [String]
name (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"unrecognized argument '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
                [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
unrecognized ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
o ->
                    [String] -> String -> IO ()
errorExit [String]
name (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"unrecognized option '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
                IO ()
forall a. IO a
exitFailure

instance IsCmd Group where
    getCmdHelp :: Group -> String
getCmdHelp = Group -> String
groupHelp
    getOptDescr :: Group -> [OptDescr (String, String)]
getOptDescr Group
_ = []

    getUsageHeader :: Group -> String -> String
getUsageHeader Group
_ String
_ = String
" <COMMAND> [ARGS...]"
    getUsageFooter :: Group -> String -> String
getUsageFooter Group
g String
_ = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
        [ String
""
        , String
"Commands: "
        ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
        [ String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
name) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ c -> String
forall c. IsCmd c => c -> String
getCmdHelp c
c
        | SubCmd String
name c
c <- Group -> [SubCmd]
groupCmds Group
g
        ]

    runCmd :: Group
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
runCmd Group
g [String]
name Maybe String
mbver [(String, String)]
_options (String
cmd: [String]
nonOptions) [String]
unrecognized =
        case [ String -> c -> SubCmd
forall c. IsCmd c => String -> c -> SubCmd
SubCmd String
subname c
c | SubCmd String
subname c
c <- Group -> [SubCmd]
groupCmds Group
g, String
subname String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
cmd ] of
           [SubCmd String
subname c
c] ->
               c -> [String] -> Maybe String -> [String] -> IO ()
forall c.
IsCmd c =>
c -> [String] -> Maybe String -> [String] -> IO ()
run' c
c ([String]
name [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
subname]) Maybe String
mbver ([String]
nonOptions [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
unrecognized)
           [SubCmd]
_ ->
               [String] -> String -> IO ()
errorExit [String]
name (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"unrecognized command: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmd
    runCmd Group
_ [String]
name Maybe String
_ [(String, String)]
_ [String]
_ [String]
_ =
        [String] -> String -> IO ()
errorExit [String]
name String
"no command given"

-- | Make a sub command
subCmd :: IsCmd c => String -> c -> SubCmd
subCmd :: String -> c -> SubCmd
subCmd = String -> c -> SubCmd
forall c. IsCmd c => String -> c -> SubCmd
SubCmd

-- runner

run' :: IsCmd c => c -> [String] -> Maybe String -> [String] -> IO ()
run' :: c -> [String] -> Maybe String -> [String] -> IO ()
run' c
cmd [String]
name Maybe String
mbver [String]
args = do
    let optDescr :: [OptDescr (String, String)]
optDescr =
            c -> [OptDescr (String, String)]
forall c. IsCmd c => c -> [OptDescr (String, String)]
getOptDescr c
cmd
            [OptDescr (String, String)]
-> [OptDescr (String, String)] -> [OptDescr (String, String)]
forall a. [a] -> [a] -> [a]
++ [ String
-> [String]
-> ArgDescr (String, String)
-> String
-> OptDescr (String, String)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"?" [String
"help"]    ((String, String) -> ArgDescr (String, String)
forall a. a -> ArgDescr a
NoArg (String
"help",    String
"t")) String
"display this help and exit" ]
            [OptDescr (String, String)]
-> [OptDescr (String, String)] -> [OptDescr (String, String)]
forall a. [a] -> [a] -> [a]
++ [ String
-> [String]
-> ArgDescr (String, String)
-> String
-> OptDescr (String, String)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"V" [String
"version"] ((String, String) -> ArgDescr (String, String)
forall a. a -> ArgDescr a
NoArg (String
"version", String
"t")) String
"output version information and exit"
               | Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
mbver ]
            [OptDescr (String, String)]
-> [OptDescr (String, String)] -> [OptDescr (String, String)]
forall a. [a] -> [a] -> [a]
++ [ String
-> [String]
-> ArgDescr (String, String)
-> String
-> OptDescr (String, String)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"v" [String
"verbose"] ((Maybe String -> (String, String))
-> String -> ArgDescr (String, String)
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg (\Maybe String
arg -> (String
"verbose", String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
arg)) String
"n") String
"set verbosity level" ]

        prog :: String
prog     = [String] -> String
unwords [String]
name
        verMsg :: String
verMsg   = String
prog String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
" version " String -> String -> String
forall a. [a] -> [a] -> [a]
++) Maybe String
mbver
        header :: String
header = String
"Usage: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prog String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [OPTION...]" String -> String -> String
forall a. [a] -> [a] -> [a]
++ c -> String -> String
forall c. IsCmd c => c -> String -> String
getUsageHeader c
cmd String
prog String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                 String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ c -> String
forall c. IsCmd c => c -> String
getCmdHelp c
cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                 String
"Options:"

        usage :: String
usage    =
            String -> [OptDescr (String, String)] -> String
forall a. String -> [OptDescr a] -> String
usageInfo String
header [OptDescr (String, String)]
optDescr String -> String -> String
forall a. [a] -> [a] -> [a]
++
            c -> String -> String
forall c. IsCmd c => c -> String -> String
getUsageFooter c
cmd String
prog

    case ArgOrder (String, String)
-> [OptDescr (String, String)]
-> [String]
-> ([(String, String)], [String], [String], [String])
forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
getOpt' ArgOrder (String, String)
forall a. ArgOrder a
RequireOrder [OptDescr (String, String)]
optDescr [String]
args of
        ([(String, String)]
options, [String]
nonOptions, [String]
unrecognized, [String]
errors)
            | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errors ->
                  [String] -> String -> IO ()
errorExit [String]
name (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
errors
            | Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"help" [(String, String)]
options) -> do
                  String -> IO ()
putStr String
usage
                  IO ()
forall a. IO a
exitSuccess
            | Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"version" [(String, String)]
options) -> do
                  String -> IO ()
putStrLn String
verMsg
                  IO ()
forall a. IO a
exitSuccess
            | Bool
otherwise ->
                  c
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
forall c.
IsCmd c =>
c
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
runCmd c
cmd [String]
name Maybe String
mbver [(String, String)]
options [String]
nonOptions [String]
unrecognized

-- | Run a command with specifying program name and version
run :: IsCmd c => String -> Maybe String -> c -> IO ()
run :: String -> Maybe String -> c -> IO ()
run String
progName Maybe String
progVer c
cmd =
    c -> [String] -> Maybe String -> [String] -> IO ()
forall c.
IsCmd c =>
c -> [String] -> Maybe String -> [String] -> IO ()
run' c
cmd [String
progName] Maybe String
progVer ([String] -> IO ()) -> IO [String] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [String]
getArgs

-- | Run a command
run_ :: IsCmd c => c -> IO ()
run_ :: c -> IO ()
run_ c
cmd = do
    String
progName <- IO String
getProgName
    String -> Maybe String -> c -> IO ()
forall c. IsCmd c => String -> Maybe String -> c -> IO ()
run String
progName Maybe String
forall a. Maybe a
Nothing c
cmd

errorExit :: [String] -> String -> IO ()
errorExit :: [String] -> String -> IO ()
errorExit [String]
name String
msg = do
    let prog :: String
prog = [String] -> String
unwords [String]
name
    Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
prog String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
    Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Try '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prog String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" --help' for more information."
    IO ()
forall a. IO a
exitFailure