module ServantSerf.Type.Context where

import qualified Control.Monad.Catch as Exception
import qualified ServantSerf.Exception.ExtraArgument as ExtraArgument
import qualified ServantSerf.Exception.InvalidOption as InvalidOption
import qualified ServantSerf.Exception.MissingArgument as MissingArgument
import qualified ServantSerf.Exception.UnknownOption as UnknownOption
import qualified ServantSerf.Type.Config as Config
import qualified ServantSerf.Type.Flag as Flag
import qualified System.Console.GetOpt as Console

data Context = Context
  { Context -> Config
config :: Config.Config
  , Context -> FilePath
input :: FilePath
  , Context -> FilePath
output :: FilePath
  , Context -> FilePath
source :: FilePath
  }
  deriving (Context -> Context -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq, Int -> Context -> ShowS
[Context] -> ShowS
Context -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> FilePath
$cshow :: Context -> FilePath
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show)

fromArguments :: Exception.MonadThrow m => [String] -> m Context
fromArguments :: forall (m :: * -> *). MonadThrow m => [FilePath] -> m Context
fromArguments [FilePath]
arguments = do
  let
    ([Flag]
fs, [FilePath]
as, [FilePath]
us, [FilePath]
is) = forall a.
ArgOrder a
-> [OptDescr a]
-> [FilePath]
-> ([a], [FilePath], [FilePath], [FilePath])
Console.getOpt' forall a. ArgOrder a
Console.Permute [OptDescr Flag]
Flag.options [FilePath]
arguments
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Exception.throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> UnknownOption
UnknownOption.UnknownOption) [FilePath]
us
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Exception.throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> InvalidOption
InvalidOption.InvalidOption) [FilePath]
is
  Config
c <- forall (t :: * -> *) (m :: * -> *).
(Foldable t, MonadThrow m) =>
t Flag -> m Config
Config.fromFlags [Flag]
fs
  case [FilePath]
as of
    [] -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Exception.throwM forall a b. (a -> b) -> a -> b
$ FilePath -> MissingArgument
MissingArgument.MissingArgument FilePath
"SOURCE"
    [FilePath
_] -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Exception.throwM forall a b. (a -> b) -> a -> b
$ FilePath -> MissingArgument
MissingArgument.MissingArgument FilePath
"INPUT"
    [FilePath
_, FilePath
_] -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Exception.throwM forall a b. (a -> b) -> a -> b
$ FilePath -> MissingArgument
MissingArgument.MissingArgument FilePath
"OUTPUT"
    FilePath
s : FilePath
i : FilePath
o : [FilePath]
xs -> do
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Exception.throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ExtraArgument
ExtraArgument.ExtraArgument) [FilePath]
xs
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Context { config :: Config
config = Config
c, input :: FilePath
input = FilePath
i, output :: FilePath
output = FilePath
o, source :: FilePath
source = FilePath
s }