{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module WithCli (
  withCli,
  WithCli(),
  HasArguments(argumentsParser),
  atomicArgumentsParser,
  Argument(argumentType, parseArgument),
  -- * Modifiers
  withCliModified,
  Modifier(..),
  -- * Useful Re-exports
  GHC.Generic,
  Typeable,
  Proxy(..),
  ) where

import           Data.Proxy
import           Data.Typeable
import qualified GHC.Generics as GHC
import           System.Environment

import           WithCli.Argument
import           WithCli.HasArguments
import           WithCli.Modifier
import           WithCli.Parser
import qualified WithCli.Pure.Internal
import           WithCli.Result

-- | 'withCli' converts an IO operation into a program with a proper CLI.
--   Retrieves command line arguments through 'withArgs'.
--   @main@ (the given IO operation) can have arbitrarily many parameters
--   provided all parameters have instances for 'HasArguments'.
--
--   May throw the following exceptions:
--
--   - @'ExitFailure' 1@ in case of invalid options. Error messages are written
--     to @stderr@.
--   - @'ExitSuccess'@ in case @--help@ is given. (@'ExitSuccess'@ behaves like
--     a normal exception, except that -- if uncaught -- the process will exit
--     with exit-code @0@.) Help output is written to @stdout@.
--
--   Example:

-- ### Start "docs/Simple.hs" "module Simple where\n\n" Haddock ###

-- |
-- >  import WithCli
-- >
-- >  main :: IO ()
-- >  main = withCli run
-- >
-- >  run :: String -> Int -> Bool -> IO ()
-- >  run s i b = print (s, i, b)

-- ### End ###

-- | Using the above program in a shell:

-- ### Start "docs/Simple.shell-protocol" "" Haddock ###

-- |
-- >  $ program foo 42 true
-- >  ("foo",42,True)
-- >  $ program --help
-- >  program [OPTIONS] STRING INTEGER BOOL
-- >    -h  --help  show help and exit
-- >  $ program foo 42 bar
-- >  cannot parse as BOOL: bar
-- >  # exit-code 1
-- >  $ program
-- >  missing argument of type STRING
-- >  missing argument of type INTEGER
-- >  missing argument of type BOOL
-- >  # exit-code 1
-- >  $ program foo 42 yes bar
-- >  unknown argument: bar
-- >  # exit-code 1

-- ### End ###

withCli :: WithCli main => main -> IO ()
withCli :: forall main. WithCli main => main -> IO ()
withCli = forall main. WithCli main => [Modifier] -> main -> IO ()
withCliModified []

-- | This is a variant of 'withCli' that allows tweaking the generated
--   command line interface by providing a list of 'Modifier's.
withCliModified :: WithCli main => [Modifier] -> main -> IO ()
withCliModified :: forall main. WithCli main => [Modifier] -> main -> IO ()
withCliModified [Modifier]
mods main
main = do
  [String]
args <- IO [String]
getArgs
  Modifiers
modifiers <- forall a. Result a -> IO a
handleResult ([Modifier] -> Result Modifiers
mkModifiers [Modifier]
mods)
  forall main a.
WithCli main =>
Modifiers
-> Result (Parser Unnormalized a)
-> (a -> main)
-> [String]
-> IO ()
run Modifiers
modifiers (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a phase. a -> Parser phase a
emptyParser ()) (\ () -> main
main) [String]
args

-- | Everything that can be used as a @main@ function with 'withCli' needs to
--   have an instance of 'WithCli'. You shouldn't need to implement your own
--   instances.
class WithCli main where
  run :: Modifiers -> Result (Parser Unnormalized a) -> (a -> main) -> [String] -> IO ()

instance WithCli (IO ()) where
  run :: forall a.
Modifiers
-> Result (Parser Unnormalized a)
-> (a -> IO ())
-> [String]
-> IO ()
run Modifiers
modifiers Result (Parser Unnormalized a)
mkParser a -> IO ()
mkMain [String]
args = do
    String
progName <- IO String
getProgName
    let result :: Result (IO ())
result = forall function output input.
WithCliPure function output =>
String
-> Modifiers
-> Result (Parser Unnormalized input)
-> (input -> function)
-> [String]
-> Result output
WithCli.Pure.Internal.run
          String
progName Modifiers
modifiers Result (Parser Unnormalized a)
mkParser a -> IO ()
mkMain [String]
args
    IO ()
action <- forall a. Result a -> IO a
handleResult Result (IO ())
result
    IO ()
action

instance (HasArguments a, WithCli rest) => WithCli (a -> rest) where
  run :: forall a.
Modifiers
-> Result (Parser Unnormalized a)
-> (a -> a -> rest)
-> [String]
-> IO ()
run Modifiers
modifiers Result (Parser Unnormalized a)
fa a -> a -> rest
mkMain [String]
args =
    forall main a.
WithCli main =>
Modifiers
-> Result (Parser Unnormalized a)
-> (a -> main)
-> [String]
-> IO ()
run Modifiers
modifiers (forall a b phase.
Result (Parser phase a)
-> Result (Parser phase b) -> Result (Parser phase (a, b))
combine Result (Parser Unnormalized a)
fa (forall a.
HasArguments a =>
Modifiers -> Maybe String -> Result (Parser Unnormalized a)
argumentsParser Modifiers
modifiers forall a. Maybe a
Nothing)) (\ (a
a, a
r) -> a -> a -> rest
mkMain a
a a
r) [String]
args