packages feed

iris-0.0.0.0: src/Iris/Env.hs

{-# 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
      cliEnvSettingsCmdParser       :: Opt.Parser cmd

      -- | @since 0.0.0.0
    , cliEnvSettingsAppEnv          :: appEnv

      -- | @since 0.0.0.0
    , cliEnvSettingsHeaderDesc      :: String

      -- | @since 0.0.0.0
    , cliEnvSettingsProgDesc        :: String

      -- | @since 0.0.0.0
    , cliEnvSettingsVersionSettings :: Maybe VersionSettings

      -- | @since 0.0.0.0
    , cliEnvSettingsRequiredTools   :: [Tool cmd]
    }


{- |

@since 0.0.0.0
-}
defaultCliEnvSettings :: CliEnvSettings () ()
defaultCliEnvSettings = CliEnvSettings
    { cliEnvSettingsCmdParser       = pure ()
    , cliEnvSettingsAppEnv          = ()
    , cliEnvSettingsHeaderDesc      = "Simple CLI program"
    , cliEnvSettingsProgDesc        = "CLI tool build with iris - a Haskell CLI framework"
    , cliEnvSettingsVersionSettings = Nothing
    , 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
      cliEnvCmd              :: cmd

      -- | @since 0.0.0.0
    , cliEnvStdoutColourMode :: ColourMode

      -- | @since 0.0.0.0
    , cliEnvStderrColourMode :: ColourMode

      -- | @since 0.0.0.0
    , cliEnvAppEnv           :: appEnv

      -- | @since 0.0.0.0
    , cliEnvInteractiveMode  :: InteractiveMode
    }

{- |

@since 0.0.0.0
-}
newtype CliEnvError
    -- | @since 0.0.0.0
    = CliEnvToolError ToolCheckResult
    deriving stock
        ( Show  -- ^ @since 0.0.0.0
        )

    deriving newtype
        ( Eq  -- ^ @since 0.0.0.0
        )
{- |

@since 0.0.0.0
-}
newtype CliEnvException = CliEnvException
    { unCliEnvException :: CliEnvError
    }
    deriving stock
        ( Show  -- ^ @since 0.0.0.0
        )

    deriving newtype
        ( Eq  -- ^ @since 0.0.0.0
        )

    deriving anyclass
        ( Exception  -- ^ @since 0.0.0.0
        )

{- | 

Wrapper around @cmd@ with additional predefined fields
-}

data Cmd (cmd :: Type) = Cmd
    { cmdInteractiveMode :: InteractiveMode
    , cmdCmd :: cmd
    }

{- |

__Throws:__ 'CliEnvException'

@since 0.0.0.0
-}
mkCliEnv
    :: forall cmd appEnv
    .  CliEnvSettings cmd appEnv
    -> IO (CliEnv cmd appEnv)
mkCliEnv CliEnvSettings{..} = do
    Cmd{..} <- Opt.execParser cmdParserInfo
    stdoutColourMode <- handleColourMode stdout
    stderrColourMode <- handleColourMode stderr

    for_ cliEnvSettingsRequiredTools $ \tool ->
        checkTool cmdCmd tool >>= \case
            ToolOk  -> pure ()
            toolErr -> throwIO $ CliEnvException $ CliEnvToolError toolErr

    pure CliEnv
        { cliEnvCmd              = cmdCmd
        , cliEnvStdoutColourMode = stdoutColourMode
        , cliEnvStderrColourMode = stderrColourMode
        , cliEnvAppEnv           = cliEnvSettingsAppEnv
        , cliEnvInteractiveMode  = cmdInteractiveMode
        }
  where
    cmdParserInfo :: Opt.ParserInfo (Cmd cmd)
    cmdParserInfo = Opt.info
        ( Opt.helper
        <*> mkVersionParser cliEnvSettingsVersionSettings
        <*> cmdP
        )
        $ mconcat
            [ Opt.fullDesc
            , Opt.header cliEnvSettingsHeaderDesc
            , Opt.progDesc cliEnvSettingsProgDesc
            ]
    cmdP :: Opt.Parser (Cmd cmd)
    cmdP = do
      cmdInteractiveMode <- interactiveModeP
      cmdCmd <- cliEnvSettingsCmdParser

      pure Cmd{..}

{- | 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 = 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 getField = asksCliEnv (getField . cliEnvAppEnv)