{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module OptEnvConf.Check
  ( runSettingsCheck,
    runSettingsCheckOn,
    CheckResult (..),
  )
where

import qualified Data.Aeson as JSON
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import GHC.Generics (Generic)
import GHC.Stack (SrcLoc)
import OptEnvConf.Args as Args
import OptEnvConf.Capability
import OptEnvConf.EnvMap (EnvMap (..))
import OptEnvConf.Error
import OptEnvConf.Parser
import OptEnvConf.Run
import OptEnvConf.Terminal (getTerminalCapabilitiesFromHandle)
import System.Exit
import System.IO (stderr, stdout)
import Text.Colour

runSettingsCheck :: Capabilities -> Parser a -> Args -> EnvMap -> Maybe JSON.Object -> IO void
runSettingsCheck :: forall a void.
Capabilities
-> Parser a -> Args -> EnvMap -> Maybe Object -> IO void
runSettingsCheck Capabilities
capabilities Parser a
p Args
args EnvMap
envVars Maybe Object
mConfig = do
  TerminalCapabilities
stderrTc <- Handle -> IO TerminalCapabilities
getTerminalCapabilitiesFromHandle Handle
stderr
  CheckResult a
errOrSets <- Capabilities
-> TerminalCapabilities
-> Parser a
-> Args
-> EnvMap
-> Maybe Object
-> IO (CheckResult a)
forall a.
Capabilities
-> TerminalCapabilities
-> Parser a
-> Args
-> EnvMap
-> Maybe Object
-> IO (CheckResult a)
runSettingsCheckOn Capabilities
capabilities TerminalCapabilities
stderrTc Parser a
p Args
args EnvMap
envVars Maybe Object
mConfig
  case CheckResult a
errOrSets of
    CheckFailed NonEmpty ParseError
errs -> do
      TerminalCapabilities -> Handle -> [Chunk] -> IO ()
hPutChunksLocaleWith TerminalCapabilities
stderrTc Handle
stderr ([Chunk] -> IO ()) -> [Chunk] -> IO ()
forall a b. (a -> b) -> a -> b
$ NonEmpty ParseError -> [Chunk]
renderErrors NonEmpty ParseError
errs
      IO void
forall a. IO a
exitFailure
    CheckIncapable NonEmpty MissingCapability
missingCaps -> do
      TerminalCapabilities
tc <- Handle -> IO TerminalCapabilities
getTerminalCapabilitiesFromHandle Handle
stdout
      TerminalCapabilities -> Handle -> [Chunk] -> IO ()
hPutChunksLocaleWith TerminalCapabilities
tc Handle
stdout [Chunk
"Could not complete parsing settings because of missing capabilities, but no errors were found so far."]
      TerminalCapabilities -> Handle -> [Chunk] -> IO ()
hPutChunksLocaleWith TerminalCapabilities
stderrTc Handle
stderr ([Chunk] -> IO ()) -> [Chunk] -> IO ()
forall a b. (a -> b) -> a -> b
$ NonEmpty MissingCapability -> [Chunk]
renderMissingCapabilities NonEmpty MissingCapability
missingCaps
      IO void
forall a. IO a
exitSuccess
    CheckSucceeded a
_ -> do
      TerminalCapabilities
tc <- Handle -> IO TerminalCapabilities
getTerminalCapabilitiesFromHandle Handle
stdout
      TerminalCapabilities -> Handle -> [Chunk] -> IO ()
hPutChunksLocaleWith TerminalCapabilities
tc Handle
stdout [Chunk
"Settings parsed successfully."]
      IO void
forall a. IO a
exitSuccess

renderMissingCapabilities :: NonEmpty MissingCapability -> [Chunk]
renderMissingCapabilities :: NonEmpty MissingCapability -> [Chunk]
renderMissingCapabilities = NonEmpty ParseError -> [Chunk]
renderErrors (NonEmpty ParseError -> [Chunk])
-> (NonEmpty MissingCapability -> NonEmpty ParseError)
-> NonEmpty MissingCapability
-> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MissingCapability -> ParseError)
-> NonEmpty MissingCapability -> NonEmpty ParseError
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map MissingCapability -> ParseError
capabilityErorr
  where
    capabilityErorr :: MissingCapability -> ParseError
capabilityErorr (MissingCapability Maybe SrcLoc
mLoc Capability
cap) =
      Maybe SrcLoc -> ParseErrorMessage -> ParseError
ParseError Maybe SrcLoc
mLoc (ParseErrorMessage -> ParseError)
-> ParseErrorMessage -> ParseError
forall a b. (a -> b) -> a -> b
$ Capability -> ParseErrorMessage
ParseErrorMissingCapability Capability
cap

data CheckResult a
  = -- | Check succeeded
    CheckSucceeded a
  | -- | Check could not be completed because of missing capability
    CheckIncapable (NonEmpty MissingCapability)
  | -- | Check failed with parse errors
    CheckFailed (NonEmpty ParseError)
  deriving (Int -> CheckResult a -> ShowS
[CheckResult a] -> ShowS
CheckResult a -> String
(Int -> CheckResult a -> ShowS)
-> (CheckResult a -> String)
-> ([CheckResult a] -> ShowS)
-> Show (CheckResult a)
forall a. Show a => Int -> CheckResult a -> ShowS
forall a. Show a => [CheckResult a] -> ShowS
forall a. Show a => CheckResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> CheckResult a -> ShowS
showsPrec :: Int -> CheckResult a -> ShowS
$cshow :: forall a. Show a => CheckResult a -> String
show :: CheckResult a -> String
$cshowList :: forall a. Show a => [CheckResult a] -> ShowS
showList :: [CheckResult a] -> ShowS
Show, (forall x. CheckResult a -> Rep (CheckResult a) x)
-> (forall x. Rep (CheckResult a) x -> CheckResult a)
-> Generic (CheckResult a)
forall x. Rep (CheckResult a) x -> CheckResult a
forall x. CheckResult a -> Rep (CheckResult a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (CheckResult a) x -> CheckResult a
forall a x. CheckResult a -> Rep (CheckResult a) x
$cfrom :: forall a x. CheckResult a -> Rep (CheckResult a) x
from :: forall x. CheckResult a -> Rep (CheckResult a) x
$cto :: forall a x. Rep (CheckResult a) x -> CheckResult a
to :: forall x. Rep (CheckResult a) x -> CheckResult a
Generic, (forall a b. (a -> b) -> CheckResult a -> CheckResult b)
-> (forall a b. a -> CheckResult b -> CheckResult a)
-> Functor CheckResult
forall a b. a -> CheckResult b -> CheckResult a
forall a b. (a -> b) -> CheckResult a -> CheckResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> CheckResult a -> CheckResult b
fmap :: forall a b. (a -> b) -> CheckResult a -> CheckResult b
$c<$ :: forall a b. a -> CheckResult b -> CheckResult a
<$ :: forall a b. a -> CheckResult b -> CheckResult a
Functor)

data MissingCapability
  = MissingCapability
      -- Where the capability was needed
      !(Maybe SrcLoc)
      -- Where the capability was needed
      !Capability
  deriving (Int -> MissingCapability -> ShowS
[MissingCapability] -> ShowS
MissingCapability -> String
(Int -> MissingCapability -> ShowS)
-> (MissingCapability -> String)
-> ([MissingCapability] -> ShowS)
-> Show MissingCapability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MissingCapability -> ShowS
showsPrec :: Int -> MissingCapability -> ShowS
$cshow :: MissingCapability -> String
show :: MissingCapability -> String
$cshowList :: [MissingCapability] -> ShowS
showList :: [MissingCapability] -> ShowS
Show, (forall x. MissingCapability -> Rep MissingCapability x)
-> (forall x. Rep MissingCapability x -> MissingCapability)
-> Generic MissingCapability
forall x. Rep MissingCapability x -> MissingCapability
forall x. MissingCapability -> Rep MissingCapability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MissingCapability -> Rep MissingCapability x
from :: forall x. MissingCapability -> Rep MissingCapability x
$cto :: forall x. Rep MissingCapability x -> MissingCapability
to :: forall x. Rep MissingCapability x -> MissingCapability
Generic)

runSettingsCheckOn ::
  Capabilities ->
  -- DebugMode, always on
  TerminalCapabilities ->
  Parser a ->
  Args ->
  EnvMap ->
  Maybe JSON.Object ->
  IO (CheckResult a)
runSettingsCheckOn :: forall a.
Capabilities
-> TerminalCapabilities
-> Parser a
-> Args
-> EnvMap
-> Maybe Object
-> IO (CheckResult a)
runSettingsCheckOn Capabilities
capabilities TerminalCapabilities
debugMode Parser a
p Args
args EnvMap
envVars Maybe Object
mConfig = do
  Either (NonEmpty ParseError) a
errOrSets <- Capabilities
-> Maybe TerminalCapabilities
-> Parser a
-> Args
-> EnvMap
-> Maybe Object
-> IO (Either (NonEmpty ParseError) a)
forall a.
Capabilities
-> Maybe TerminalCapabilities
-> Parser a
-> Args
-> EnvMap
-> Maybe Object
-> IO (Either (NonEmpty ParseError) a)
runParserOn Capabilities
capabilities (TerminalCapabilities -> Maybe TerminalCapabilities
forall a. a -> Maybe a
Just TerminalCapabilities
debugMode) Parser a
p Args
args EnvMap
envVars Maybe Object
mConfig
  CheckResult a -> IO (CheckResult a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CheckResult a -> IO (CheckResult a))
-> CheckResult a -> IO (CheckResult a)
forall a b. (a -> b) -> a -> b
$ case Either (NonEmpty ParseError) a
errOrSets of
    Right a
a -> a -> CheckResult a
forall a. a -> CheckResult a
CheckSucceeded a
a
    Left NonEmpty ParseError
errs ->
      -- If all the errors are missing capability errors, return
      -- CheckIncapable, otherwise CheckFailed
      let mMissingCaps :: Maybe (NonEmpty MissingCapability)
mMissingCaps =
            -- This MUST be mapM instead of mapMaybe because we need to ensure
            -- ALL errors are missing capability errors
            (ParseError -> Maybe MissingCapability)
-> NonEmpty ParseError -> Maybe (NonEmpty MissingCapability)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM
              ( \case
                  ParseError Maybe SrcLoc
mLoc (ParseErrorMissingCapability Capability
cap) -> MissingCapability -> Maybe MissingCapability
forall a. a -> Maybe a
Just (Maybe SrcLoc -> Capability -> MissingCapability
MissingCapability Maybe SrcLoc
mLoc Capability
cap)
                  ParseError
_ -> Maybe MissingCapability
forall a. Maybe a
Nothing
              )
              NonEmpty ParseError
errs
       in case Maybe (NonEmpty MissingCapability)
mMissingCaps of
            Just NonEmpty MissingCapability
ne -> NonEmpty MissingCapability -> CheckResult a
forall a. NonEmpty MissingCapability -> CheckResult a
CheckIncapable NonEmpty MissingCapability
ne
            Maybe (NonEmpty MissingCapability)
Nothing -> NonEmpty ParseError -> CheckResult a
forall a. NonEmpty ParseError -> CheckResult a
CheckFailed NonEmpty ParseError
errs