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

Interactive mode datatype and CLI parser.

@since 0.0.0.0
-}
module Iris.Cli.Interactive (
    InteractiveMode (..),
    interactiveModeP,
    handleInteractiveMode,
) where

import Options.Applicative ((<|>))
import qualified Options.Applicative as Opt
import System.Console.ANSI (hSupportsANSI)
import System.IO (stdin)

{- | Datatype for specifying if the terminal is interactive.

@since 0.0.0.0
-}
data InteractiveMode
    = -- | @since 0.0.0.0
      Interactive
    | -- | @since 0.0.0.0
      NonInteractive
    deriving stock
        ( Int -> InteractiveMode -> ShowS
[InteractiveMode] -> ShowS
InteractiveMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractiveMode] -> ShowS
$cshowList :: [InteractiveMode] -> ShowS
show :: InteractiveMode -> String
$cshow :: InteractiveMode -> String
showsPrec :: Int -> InteractiveMode -> ShowS
$cshowsPrec :: Int -> InteractiveMode -> ShowS
Show
          -- ^ @since 0.0.0.0
        , InteractiveMode -> InteractiveMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractiveMode -> InteractiveMode -> Bool
$c/= :: InteractiveMode -> InteractiveMode -> Bool
== :: InteractiveMode -> InteractiveMode -> Bool
$c== :: InteractiveMode -> InteractiveMode -> Bool
Eq
          -- ^ @since 0.0.0.0
        )

{- | A CLI option parser for switching to non-interactive mode
if the @--no-input@ flag is passed.

@since 0.0.0.0
-}
interactiveModeP :: Opt.Parser InteractiveMode
interactiveModeP :: Parser InteractiveMode
interactiveModeP = Parser InteractiveMode
nonInteractiveP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure InteractiveMode
Interactive
  where
    nonInteractiveP :: Opt.Parser InteractiveMode
    nonInteractiveP :: Parser InteractiveMode
nonInteractiveP =
        forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' InteractiveMode
NonInteractive forall a b. (a -> b) -> a -> b
$
            forall a. Monoid a => [a] -> a
mconcat
                [ forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"no-input"
                , forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Enter the terminal in non-interactive mode"
                ]

{- | Forces non interactive mode when the terminal is not interactive

Use this function to check whether you can get input from the terminal:

@
'handleInteractiveMode' requestedInteractiveMode
@

If the terminal is non interactive i.e. the program is run in a pipe,
interactive mode is set to false no matter what

@since 0.1.0.0
-}
handleInteractiveMode :: InteractiveMode -> IO InteractiveMode
handleInteractiveMode :: InteractiveMode -> IO InteractiveMode
handleInteractiveMode InteractiveMode
optionMode = do
    Bool
supportsANSI <- Handle -> IO Bool
hSupportsANSI Handle
stdin
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Bool
supportsANSI then InteractiveMode
optionMode else InteractiveMode
NonInteractive