module CabalGild.Unstable.Type.Flag where

import qualified CabalGild.Unstable.Exception.DuplicateOption as DuplicateOption
import qualified CabalGild.Unstable.Exception.InvalidOption as InvalidOption
import qualified CabalGild.Unstable.Exception.UnexpectedArgument as UnexpectedArgument
import qualified CabalGild.Unstable.Exception.UnknownOption as UnknownOption
import qualified Control.Monad.Catch as Exception
import qualified Data.Foldable as Foldable
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
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
  = CRLF String
  | Help Bool
  | Input String
  | IO 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
      []
      [String
crlfOption]
      ((String -> Flag) -> String -> ArgDescr Flag
forall a. (String -> a) -> String -> ArgDescr a
GetOpt.ReqArg String -> Flag
CRLF String
"LENIENCY")
      String
"Sets the CRLF handling mode. Must be either 'lenient' or 'strict'.\nDefault: 'lenient'",
    String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option
      [Char
'i']
      [String
inputOption]
      ((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
      []
      [String
ioOption]
      ((String -> Flag) -> String -> ArgDescr Flag
forall a. (String -> a) -> String -> ArgDescr a
GetOpt.ReqArg String -> Flag
IO String
"FILE")
      String
"Shortcut for setting both the input and output files.",
    String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option
      [Char
'm']
      [String
modeOption]
      ((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
outputOption]
      ((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
stdinOption]
      ((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: '.'"
  ]

crlfOption :: String
crlfOption :: String
crlfOption = String
"crlf"

inputOption :: String
inputOption :: String
inputOption = String
"input"

ioOption :: String
ioOption :: String
ioOption = String
"io"

modeOption :: String
modeOption :: String
modeOption = String
"mode"

outputOption :: String
outputOption :: String
outputOption = String
"output"

stdinOption :: String
stdinOption :: String
stdinOption = String
"stdin"

-- | 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 (ZonkAny 1)) -> [String] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
Foldable.traverse_ (UnexpectedArgument -> m (ZonkAny 1)
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 (ZonkAny 1))
-> (String -> UnexpectedArgument) -> String -> m (ZonkAny 1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnexpectedArgument
UnexpectedArgument.fromString) [String]
args
  (String -> m (ZonkAny 2)) -> [String] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
Foldable.traverse_ (InvalidOption -> m (ZonkAny 2)
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 (ZonkAny 2))
-> (String -> InvalidOption) -> String -> m (ZonkAny 2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> InvalidOption
InvalidOption.fromString) [String]
errs
  (String -> m (ZonkAny 3)) -> [String] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
Foldable.traverse_ (UnknownOption -> m (ZonkAny 3)
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 (ZonkAny 3))
-> (String -> UnknownOption) -> String -> m (ZonkAny 3)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnknownOption
UnknownOption.fromString) [String]
opts
  [Flag] -> m ()
forall (m :: * -> *). MonadThrow m => [Flag] -> m ()
detectDuplicateOptions [Flag]
flgs
  [Flag] -> m [Flag]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Flag]
flgs

detectDuplicateOptions :: (Exception.MonadThrow m) => [Flag] -> m ()
detectDuplicateOptions :: forall (m :: * -> *). MonadThrow m => [Flag] -> m ()
detectDuplicateOptions =
  let toWarnings :: String -> [String] -> [DuplicateOption]
toWarnings String
o [String]
l =
        ((String, String) -> DuplicateOption)
-> [(String, String)] -> [DuplicateOption]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> String -> DuplicateOption)
-> (String, String) -> DuplicateOption
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((String -> String -> DuplicateOption)
 -> (String, String) -> DuplicateOption)
-> ((String -> String -> DuplicateOption)
    -> String -> String -> DuplicateOption)
-> (String -> String -> DuplicateOption)
-> (String, String)
-> DuplicateOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> DuplicateOption)
-> String -> String -> DuplicateOption
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((String -> String -> DuplicateOption)
 -> (String, String) -> DuplicateOption)
-> (String -> String -> DuplicateOption)
-> (String, String)
-> DuplicateOption
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> DuplicateOption
DuplicateOption.DuplicateOption String
o)
          ([(String, String)] -> [DuplicateOption])
-> ([(String, String)] -> [(String, String)])
-> [(String, String)]
-> [DuplicateOption]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> [(String, String)]
forall a. [a] -> [a]
reverse
          ([(String, String)] -> [(String, String)])
-> ([(String, String)] -> [(String, String)])
-> [(String, String)]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool) -> (String, String) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(/=))
          ([(String, String)] -> [DuplicateOption])
-> [(String, String)] -> [DuplicateOption]
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
l (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
l)
      fromFlag :: Flag -> Maybe (String, [String])
fromFlag Flag
f = case Flag
f of
        CRLF String
s -> (String, [String]) -> Maybe (String, [String])
forall a. a -> Maybe a
Just (String
crlfOption, [String
s])
        Input String
s -> (String, [String]) -> Maybe (String, [String])
forall a. a -> Maybe a
Just (String
inputOption, [String
s])
        IO String
s -> (String, [String]) -> Maybe (String, [String])
forall a. a -> Maybe a
Just (String
ioOption, [String
s])
        Mode String
s -> (String, [String]) -> Maybe (String, [String])
forall a. a -> Maybe a
Just (String
modeOption, [String
s])
        Output String
s -> (String, [String]) -> Maybe (String, [String])
forall a. a -> Maybe a
Just (String
outputOption, [String
s])
        Stdin String
s -> (String, [String]) -> Maybe (String, [String])
forall a. a -> Maybe a
Just (String
stdinOption, [String
s])
        Flag
_ -> Maybe (String, [String])
forall a. Maybe a
Nothing
   in (DuplicateOption -> m (ZonkAny 0)) -> [DuplicateOption] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
Foldable.traverse_ DuplicateOption -> m (ZonkAny 0)
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Exception.throwM
        ([DuplicateOption] -> m ())
-> ([Flag] -> [DuplicateOption]) -> [Flag] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, [String]) -> [DuplicateOption])
-> [(String, [String])] -> [DuplicateOption]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> [String] -> [DuplicateOption])
-> (String, [String]) -> [DuplicateOption]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> [String] -> [DuplicateOption]
toWarnings)
        ([(String, [String])] -> [DuplicateOption])
-> ([Flag] -> [(String, [String])]) -> [Flag] -> [DuplicateOption]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String [String] -> [(String, [String])]
forall k a. Map k a -> [(k, a)]
Map.toAscList
        (Map String [String] -> [(String, [String])])
-> ([Flag] -> Map String [String])
-> [Flag]
-> [(String, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [String] -> [String])
-> [(String, [String])] -> Map String [String]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
(<>)
        ([(String, [String])] -> Map String [String])
-> ([Flag] -> [(String, [String])])
-> [Flag]
-> Map String [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Flag -> Maybe (String, [String]))
-> [Flag] -> [(String, [String])]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe Flag -> Maybe (String, [String])
fromFlag