module ServantSerf.Type.Config where

import qualified Control.Monad as Monad
import qualified Control.Monad.Catch as Exception
import qualified ServantSerf.Exception.InvalidDepth as InvalidDepth
import qualified ServantSerf.Exception.InvalidModuleName as InvalidModuleName
import qualified ServantSerf.Type.Depth as Depth
import qualified ServantSerf.Type.Flag as Flag
import qualified ServantSerf.Type.ModuleName as ModuleName

data Config = Config
  { Config -> String
apiName :: String,
    Config -> Depth
depth :: Depth.Depth,
    Config -> String
excludeSuffix :: String,
    Config -> Bool
help :: Bool,
    Config -> Maybe ModuleName
moduleName :: Maybe ModuleName.ModuleName,
    Config -> String
serverName :: String,
    Config -> Bool
version :: Bool
  }
  deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
/= :: Config -> Config -> Bool
Eq, Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Config -> ShowS
showsPrec :: Int -> Config -> ShowS
$cshow :: Config -> String
show :: Config -> String
$cshowList :: [Config] -> ShowS
showList :: [Config] -> ShowS
Show)

fromFlags :: (Foldable t, Exception.MonadThrow m) => t Flag.Flag -> m Config
fromFlags :: forall (t :: * -> *) (m :: * -> *).
(Foldable t, MonadThrow m) =>
t Flag -> m Config
fromFlags = (Config -> Flag -> m Config) -> Config -> t Flag -> m Config
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Monad.foldM Config -> Flag -> m Config
forall (m :: * -> *). MonadThrow m => Config -> Flag -> m Config
applyFlag Config
initial

applyFlag :: (Exception.MonadThrow m) => Config -> Flag.Flag -> m Config
applyFlag :: forall (m :: * -> *). MonadThrow m => Config -> Flag -> m Config
applyFlag Config
config Flag
flag = case Flag
flag of
  Flag.ApiName String
x -> Config -> m Config
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config {apiName = x}
  Flag.Depth String
x -> case String -> Maybe Depth
Depth.fromString String
x of
    Maybe Depth
Nothing -> InvalidDepth -> m Config
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Exception.throwM (InvalidDepth -> m Config) -> InvalidDepth -> m Config
forall a b. (a -> b) -> a -> b
$ String -> InvalidDepth
InvalidDepth.InvalidDepth String
x
    Just Depth
y -> Config -> m Config
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config {depth = y}
  Flag.ExcludeSuffix String
x -> Config -> m Config
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config {excludeSuffix = x}
  Flag
Flag.Help -> Config -> m Config
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config {help = True}
  Flag.ModuleName String
x -> case String -> Maybe ModuleName
ModuleName.fromString String
x of
    Maybe ModuleName
Nothing -> InvalidModuleName -> m Config
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Exception.throwM (InvalidModuleName -> m Config) -> InvalidModuleName -> m Config
forall a b. (a -> b) -> a -> b
$ String -> InvalidModuleName
InvalidModuleName.InvalidModuleName String
x
    Just ModuleName
y -> Config -> m Config
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config {moduleName = Just y}
  Flag.ServerName String
x -> Config -> m Config
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config {serverName = x}
  Flag
Flag.Version -> Config -> m Config
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config {version = True}

initial :: Config
initial :: Config
initial =
  Config
    { apiName :: String
apiName = String
"API",
      depth :: Depth
depth = Depth
Depth.Deep,
      excludeSuffix :: String
excludeSuffix = String
"",
      help :: Bool
help = Bool
False,
      moduleName :: Maybe ModuleName
moduleName = Maybe ModuleName
forall a. Maybe a
Nothing,
      serverName :: String
serverName = String
"server",
      version :: Bool
version = Bool
False
    }