module Imp.Type.Flag where

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

data Flag
  = Alias String
  | Help Bool
  | Package 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)

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
"Prints this help message then exits.",
    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
"Prints the version number then exits.",
    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
"alias"]
      ((String -> Flag) -> String -> ArgDescr Flag
forall a. (String -> a) -> String -> ArgDescr a
GetOpt.ReqArg String -> Flag
Alias String
"SOURCE:TARGET")
      String
"Adds a new alias, allowing TARGET to be used in place of SOURCE. \
      \For example `--alias=Data.String:String` allows `String.words` to mean `Data.String.words`. \
      \Later aliases will overwrite earlier ones.",
    String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option
      []
      [String
"package"]
      ((String -> Flag) -> String -> ArgDescr Flag
forall a. (String -> a) -> String -> ArgDescr a
GetOpt.ReqArg String -> Flag
Package String
"MODULE:PACKAGE")
      String
"Specifies that MODULE should be imported from PACKAGE. \
      \For example `--package=Data.Semver:semver` will import the `Data.SemVer` module from the `semver` package. \
      \Note that using this option requires you to enable the `PackageImports` language extension. \
      \Later packages will overwrite earlier ones."
  ]

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.new) [String]
args
  (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.new) [String]
opts
  (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.new) [String]
errs
  [Flag] -> m [Flag]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Flag]
flgs