{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ApplicativeDo #-}

{- |
Module                  : Iris.Env
Copyright               : (c) 2022 Dmitrii Kovanikov
SPDX-License-Identifier : MPL-2.0
Maintainer              : Dmitrii Kovanikov <kovanikov@gmail.com>
Stability               : Experimental
Portability             : Portable

Environment of a CLI app.

@since 0.0.0.0
-}


module Iris.Env
    ( -- * Settings for the CLI app
      CliEnvSettings (..)
    , defaultCliEnvSettings

      -- * CLI application environment
      -- ** Constructing
    , CliEnv (..)
    , CliEnvException (..)
    , CliEnvError (..)
    , mkCliEnv

      -- ** Querying
    , asksCliEnv
    , asksAppEnv
    ) where

import Control.Exception (Exception, throwIO)
import Control.Monad.Reader (MonadReader, asks)
import Data.Foldable (for_)
import Data.Kind (Type)
import System.IO (stderr, stdout)

import Iris.Cli.Version (VersionSettings, mkVersionParser)
import Iris.Cli.Interactive (InteractiveMode, interactiveModeP)
import Iris.Colour.Mode (ColourMode, handleColourMode)
import Iris.Tool (Tool, ToolCheckResult (..), checkTool)

import qualified Options.Applicative as Opt


{- |

@since 0.0.0.0
-}
data CliEnvSettings (cmd :: Type) (appEnv :: Type) = CliEnvSettings
    {  -- | @since 0.0.0.0
      forall cmd appEnv. CliEnvSettings cmd appEnv -> Parser cmd
cliEnvSettingsCmdParser       :: Opt.Parser cmd

      -- | @since 0.0.0.0
    , forall cmd appEnv. CliEnvSettings cmd appEnv -> appEnv
cliEnvSettingsAppEnv          :: appEnv

      -- | @since 0.0.0.0
    , forall cmd appEnv. CliEnvSettings cmd appEnv -> String
cliEnvSettingsHeaderDesc      :: String

      -- | @since 0.0.0.0
    , forall cmd appEnv. CliEnvSettings cmd appEnv -> String
cliEnvSettingsProgDesc        :: String

      -- | @since 0.0.0.0
    , forall cmd appEnv.
CliEnvSettings cmd appEnv -> Maybe VersionSettings
cliEnvSettingsVersionSettings :: Maybe VersionSettings

      -- | @since 0.0.0.0
    , forall cmd appEnv. CliEnvSettings cmd appEnv -> [Tool cmd]
cliEnvSettingsRequiredTools   :: [Tool cmd]
    }


{- |

@since 0.0.0.0
-}
defaultCliEnvSettings :: CliEnvSettings () ()
defaultCliEnvSettings :: CliEnvSettings () ()
defaultCliEnvSettings = CliEnvSettings
    { cliEnvSettingsCmdParser :: Parser ()
cliEnvSettingsCmdParser       = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    , cliEnvSettingsAppEnv :: ()
cliEnvSettingsAppEnv          = ()
    , cliEnvSettingsHeaderDesc :: String
cliEnvSettingsHeaderDesc      = String
"Simple CLI program"
    , cliEnvSettingsProgDesc :: String
cliEnvSettingsProgDesc        = String
"CLI tool build with iris - a Haskell CLI framework"
    , cliEnvSettingsVersionSettings :: Maybe VersionSettings
cliEnvSettingsVersionSettings = forall a. Maybe a
Nothing
    , cliEnvSettingsRequiredTools :: [Tool ()]
cliEnvSettingsRequiredTools   = []
    }


{- | CLI application environment. It contains default settings for
every CLI app and parameter

Has the following type parameters:

* @cmd@ — application commands
* @appEnv@ — application-specific environment; use @()@ if you don't
  have custom app environment

@since 0.0.0.0
-}
data CliEnv (cmd :: Type) (appEnv :: Type) = CliEnv
    { -- | @since 0.0.0.0
      forall cmd appEnv. CliEnv cmd appEnv -> cmd
cliEnvCmd              :: cmd

      -- | @since 0.0.0.0
    , forall cmd appEnv. CliEnv cmd appEnv -> ColourMode
cliEnvStdoutColourMode :: ColourMode

      -- | @since 0.0.0.0
    , forall cmd appEnv. CliEnv cmd appEnv -> ColourMode
cliEnvStderrColourMode :: ColourMode

      -- | @since 0.0.0.0
    , forall cmd appEnv. CliEnv cmd appEnv -> appEnv
cliEnvAppEnv           :: appEnv

      -- | @since 0.0.0.0
    , forall cmd appEnv. CliEnv cmd appEnv -> InteractiveMode
cliEnvInteractiveMode  :: InteractiveMode
    }

{- |

@since 0.0.0.0
-}
newtype CliEnvError
    -- | @since 0.0.0.0
    = CliEnvToolError ToolCheckResult
    deriving stock
        ( Int -> CliEnvError -> ShowS
[CliEnvError] -> ShowS
CliEnvError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CliEnvError] -> ShowS
$cshowList :: [CliEnvError] -> ShowS
show :: CliEnvError -> String
$cshow :: CliEnvError -> String
showsPrec :: Int -> CliEnvError -> ShowS
$cshowsPrec :: Int -> CliEnvError -> ShowS
Show  -- ^ @since 0.0.0.0
        )

    deriving newtype
        ( CliEnvError -> CliEnvError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CliEnvError -> CliEnvError -> Bool
$c/= :: CliEnvError -> CliEnvError -> Bool
== :: CliEnvError -> CliEnvError -> Bool
$c== :: CliEnvError -> CliEnvError -> Bool
Eq  -- ^ @since 0.0.0.0
        )
{- |

@since 0.0.0.0
-}
newtype CliEnvException = CliEnvException
    { CliEnvException -> CliEnvError
unCliEnvException :: CliEnvError
    }
    deriving stock
        ( Int -> CliEnvException -> ShowS
[CliEnvException] -> ShowS
CliEnvException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CliEnvException] -> ShowS
$cshowList :: [CliEnvException] -> ShowS
show :: CliEnvException -> String
$cshow :: CliEnvException -> String
showsPrec :: Int -> CliEnvException -> ShowS
$cshowsPrec :: Int -> CliEnvException -> ShowS
Show  -- ^ @since 0.0.0.0
        )

    deriving newtype
        ( CliEnvException -> CliEnvException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CliEnvException -> CliEnvException -> Bool
$c/= :: CliEnvException -> CliEnvException -> Bool
== :: CliEnvException -> CliEnvException -> Bool
$c== :: CliEnvException -> CliEnvException -> Bool
Eq  -- ^ @since 0.0.0.0
        )

    deriving anyclass
        ( Show CliEnvException
Typeable CliEnvException
SomeException -> Maybe CliEnvException
CliEnvException -> String
CliEnvException -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: CliEnvException -> String
$cdisplayException :: CliEnvException -> String
fromException :: SomeException -> Maybe CliEnvException
$cfromException :: SomeException -> Maybe CliEnvException
toException :: CliEnvException -> SomeException
$ctoException :: CliEnvException -> SomeException
Exception  -- ^ @since 0.0.0.0
        )

{- | 

Wrapper around @cmd@ with additional predefined fields
-}

data Cmd (cmd :: Type) = Cmd
    { forall cmd. Cmd cmd -> InteractiveMode
cmdInteractiveMode :: InteractiveMode
    , forall cmd. Cmd cmd -> cmd
cmdCmd :: cmd
    }

{- |

__Throws:__ 'CliEnvException'

@since 0.0.0.0
-}
mkCliEnv
    :: forall cmd appEnv
    .  CliEnvSettings cmd appEnv
    -> IO (CliEnv cmd appEnv)
mkCliEnv :: forall cmd appEnv.
CliEnvSettings cmd appEnv -> IO (CliEnv cmd appEnv)
mkCliEnv CliEnvSettings{appEnv
String
[Tool cmd]
Maybe VersionSettings
Parser cmd
cliEnvSettingsRequiredTools :: [Tool cmd]
cliEnvSettingsVersionSettings :: Maybe VersionSettings
cliEnvSettingsProgDesc :: String
cliEnvSettingsHeaderDesc :: String
cliEnvSettingsAppEnv :: appEnv
cliEnvSettingsCmdParser :: Parser cmd
cliEnvSettingsRequiredTools :: forall cmd appEnv. CliEnvSettings cmd appEnv -> [Tool cmd]
cliEnvSettingsVersionSettings :: forall cmd appEnv.
CliEnvSettings cmd appEnv -> Maybe VersionSettings
cliEnvSettingsProgDesc :: forall cmd appEnv. CliEnvSettings cmd appEnv -> String
cliEnvSettingsHeaderDesc :: forall cmd appEnv. CliEnvSettings cmd appEnv -> String
cliEnvSettingsAppEnv :: forall cmd appEnv. CliEnvSettings cmd appEnv -> appEnv
cliEnvSettingsCmdParser :: forall cmd appEnv. CliEnvSettings cmd appEnv -> Parser cmd
..} = do
    Cmd{cmd
InteractiveMode
cmdCmd :: cmd
cmdInteractiveMode :: InteractiveMode
cmdCmd :: forall cmd. Cmd cmd -> cmd
cmdInteractiveMode :: forall cmd. Cmd cmd -> InteractiveMode
..} <- forall a. ParserInfo a -> IO a
Opt.execParser ParserInfo (Cmd cmd)
cmdParserInfo
    ColourMode
stdoutColourMode <- Handle -> IO ColourMode
handleColourMode Handle
stdout
    ColourMode
stderrColourMode <- Handle -> IO ColourMode
handleColourMode Handle
stderr

    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Tool cmd]
cliEnvSettingsRequiredTools forall a b. (a -> b) -> a -> b
$ \Tool cmd
tool ->
        forall cmd. cmd -> Tool cmd -> IO ToolCheckResult
checkTool cmd
cmdCmd Tool cmd
tool forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            ToolCheckResult
ToolOk  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            ToolCheckResult
toolErr -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ CliEnvError -> CliEnvException
CliEnvException forall a b. (a -> b) -> a -> b
$ ToolCheckResult -> CliEnvError
CliEnvToolError ToolCheckResult
toolErr

    pure CliEnv
        { cliEnvCmd :: cmd
cliEnvCmd              = cmd
cmdCmd
        , cliEnvStdoutColourMode :: ColourMode
cliEnvStdoutColourMode = ColourMode
stdoutColourMode
        , cliEnvStderrColourMode :: ColourMode
cliEnvStderrColourMode = ColourMode
stderrColourMode
        , cliEnvAppEnv :: appEnv
cliEnvAppEnv           = appEnv
cliEnvSettingsAppEnv
        , cliEnvInteractiveMode :: InteractiveMode
cliEnvInteractiveMode  = InteractiveMode
cmdInteractiveMode
        }
  where
    cmdParserInfo :: Opt.ParserInfo (Cmd cmd)
    cmdParserInfo :: ParserInfo (Cmd cmd)
cmdParserInfo = forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
        ( forall a. Parser (a -> a)
Opt.helper
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Maybe VersionSettings -> Parser (a -> a)
mkVersionParser Maybe VersionSettings
cliEnvSettingsVersionSettings
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Cmd cmd)
cmdP
        )
        forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
            [ forall a. InfoMod a
Opt.fullDesc
            , forall a. String -> InfoMod a
Opt.header String
cliEnvSettingsHeaderDesc
            , forall a. String -> InfoMod a
Opt.progDesc String
cliEnvSettingsProgDesc
            ]
    cmdP :: Opt.Parser (Cmd cmd)
    cmdP :: Parser (Cmd cmd)
cmdP = do
      InteractiveMode
cmdInteractiveMode <- Parser InteractiveMode
interactiveModeP
      cmd
cmdCmd <- Parser cmd
cliEnvSettingsCmdParser

      pure Cmd{cmd
InteractiveMode
cmdCmd :: cmd
cmdInteractiveMode :: InteractiveMode
cmdCmd :: cmd
cmdInteractiveMode :: InteractiveMode
..}

{- | Get a field from the global environment 'CliEnv'.

@since 0.0.0.0
-}
asksCliEnv
    :: MonadReader (CliEnv cmd appEnv) m
    => (CliEnv cmd appEnv -> field)
    -> m field
asksCliEnv :: forall cmd appEnv (m :: * -> *) field.
MonadReader (CliEnv cmd appEnv) m =>
(CliEnv cmd appEnv -> field) -> m field
asksCliEnv = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks

{- | Get a field from custom application-specific environment
@appEnv@.

@since 0.0.0.0
-}
asksAppEnv
    :: MonadReader (CliEnv cmd appEnv) m
    => (appEnv -> field)
    -> m field
asksAppEnv :: forall cmd appEnv (m :: * -> *) field.
MonadReader (CliEnv cmd appEnv) m =>
(appEnv -> field) -> m field
asksAppEnv appEnv -> field
getField = forall cmd appEnv (m :: * -> *) field.
MonadReader (CliEnv cmd appEnv) m =>
(CliEnv cmd appEnv -> field) -> m field
asksCliEnv (appEnv -> field
getField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cmd appEnv. CliEnv cmd appEnv -> appEnv
cliEnvAppEnv)