module CabalGild.Type.Flag where

import qualified CabalGild.Exception.InvalidOption as InvalidOption
import qualified CabalGild.Exception.UnexpectedArgument as UnexpectedArgument
import qualified CabalGild.Exception.UnknownOption as UnknownOption
import qualified Control.Monad.Catch as Exception
import qualified System.Console.GetOpt as GetOpt

-- | A flag, which represents a command line option. The values associated with
-- the flags are typically not parsed. These just handle the structure of
-- command line options.
data Flag
  = Help Bool
  | Input String
  | Mode String
  | Output String
  | Stdin String
  | Version Bool
  deriving (Flag -> Flag -> Bool
(Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> Eq Flag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
/= :: Flag -> Flag -> Bool
Eq, Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> String
(Int -> Flag -> ShowS)
-> (Flag -> String) -> ([Flag] -> ShowS) -> Show Flag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Flag -> ShowS
showsPrec :: Int -> Flag -> ShowS
$cshow :: Flag -> String
show :: Flag -> String
$cshowList :: [Flag] -> ShowS
showList :: [Flag] -> ShowS
Show)

-- | The command line options the correspond to the flags.
options :: [GetOpt.OptDescr Flag]
options :: [OptDescr Flag]
options =
  [ String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option
      [Char
'h', Char
'?']
      [String
"help"]
      (Flag -> ArgDescr Flag
forall a. a -> ArgDescr a
GetOpt.NoArg (Flag -> ArgDescr Flag) -> Flag -> ArgDescr Flag
forall a b. (a -> b) -> a -> b
$ Bool -> Flag
Help Bool
True)
      String
"Shows this help message.",
    String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option
      []
      [String
"no-help"]
      (Flag -> ArgDescr Flag
forall a. a -> ArgDescr a
GetOpt.NoArg (Flag -> ArgDescr Flag) -> Flag -> ArgDescr Flag
forall a b. (a -> b) -> a -> b
$ Bool -> Flag
Help Bool
False)
      String
"",
    String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option
      [Char
'v']
      [String
"version"]
      (Flag -> ArgDescr Flag
forall a. a -> ArgDescr a
GetOpt.NoArg (Flag -> ArgDescr Flag) -> Flag -> ArgDescr Flag
forall a b. (a -> b) -> a -> b
$ Bool -> Flag
Version Bool
True)
      String
"Shows the version number.",
    String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option
      []
      [String
"no-version"]
      (Flag -> ArgDescr Flag
forall a. a -> ArgDescr a
GetOpt.NoArg (Flag -> ArgDescr Flag) -> Flag -> ArgDescr Flag
forall a b. (a -> b) -> a -> b
$ Bool -> Flag
Version Bool
False)
      String
"",
    String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option
      [Char
'i']
      [String
"input"]
      ((String -> Flag) -> String -> ArgDescr Flag
forall a. (String -> a) -> String -> ArgDescr a
GetOpt.ReqArg String -> Flag
Input String
"FILE")
      String
"Sets the input file. Use '-' for standard input (STDIN).\nDefault: '-'",
    String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option
      [Char
'm']
      [String
"mode"]
      ((String -> Flag) -> String -> ArgDescr Flag
forall a. (String -> a) -> String -> ArgDescr a
GetOpt.ReqArg String -> Flag
Mode String
"MODE")
      String
"Sets the mode. Must be either 'check' or 'format'.\nDefault: 'format'",
    String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option
      [Char
'o']
      [String
"output"]
      ((String -> Flag) -> String -> ArgDescr Flag
forall a. (String -> a) -> String -> ArgDescr a
GetOpt.ReqArg String -> Flag
Output String
"FILE")
      String
"Sets the output file. Use '-' for standard output (STDOUT).\nDefault: '-'",
    String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option
      [Char
's']
      [String
"stdin"]
      ((String -> Flag) -> String -> ArgDescr Flag
forall a. (String -> a) -> String -> ArgDescr a
GetOpt.ReqArg String -> Flag
Stdin String
"FILE")
      String
"Sets the path to the input file when using STDIN.\nDefault: '.'"
  ]

-- | Converts a list of command line arguments into a list of flags. If there
-- are any unexpected arguments, invalid options, or unknown options, an
-- exception will be thrown.
fromArguments :: (Exception.MonadThrow m) => [String] -> m [Flag]
fromArguments :: forall (m :: * -> *). MonadThrow m => [String] -> m [Flag]
fromArguments [String]
arguments = do
  let ([Flag]
flgs, [String]
args, [String]
opts, [String]
errs) = ArgOrder Flag
-> [OptDescr Flag]
-> [String]
-> ([Flag], [String], [String], [String])
forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
GetOpt.getOpt' ArgOrder Flag
forall a. ArgOrder a
GetOpt.Permute [OptDescr Flag]
options [String]
arguments
  (String -> m Any) -> [String] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (UnexpectedArgument -> m Any
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Exception.throwM (UnexpectedArgument -> m Any)
-> (String -> UnexpectedArgument) -> String -> m Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnexpectedArgument
UnexpectedArgument.fromString) [String]
args
  (String -> m Any) -> [String] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (InvalidOption -> m Any
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Exception.throwM (InvalidOption -> m Any)
-> (String -> InvalidOption) -> String -> m Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> InvalidOption
InvalidOption.fromString) [String]
errs
  (String -> m Any) -> [String] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (UnknownOption -> m Any
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Exception.throwM (UnknownOption -> m Any)
-> (String -> UnknownOption) -> String -> m Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnknownOption
UnknownOption.fromString) [String]
opts
  [Flag] -> m [Flag]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Flag]
flgs