{- |
Copyright: (c) 2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

@stan@ configuration pretty printing helper functions.
-}

module Stan.Config.Pretty
    ( ConfigAction (..)
    , prettyConfigAction
    , configActionClass
    , configActionColour
    , prettyConfigCli

    , configToTriples
    ) where

import Colourista (bold, formatWith, green, magenta, red, yellow)

import Stan.Category (Category (..))
import Stan.Config (Check (..), CheckFilter (..), CheckType (..), Config, ConfigP (..), Scope (..))
import Stan.Core.Id (Id (..))


data ConfigAction
    = RemoveAction
    | IncludeAction
    | ExcludeAction
    | IgnoreAction
    deriving stock (Int -> ConfigAction -> ShowS
[ConfigAction] -> ShowS
ConfigAction -> String
(Int -> ConfigAction -> ShowS)
-> (ConfigAction -> String)
-> ([ConfigAction] -> ShowS)
-> Show ConfigAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigAction] -> ShowS
$cshowList :: [ConfigAction] -> ShowS
show :: ConfigAction -> String
$cshow :: ConfigAction -> String
showsPrec :: Int -> ConfigAction -> ShowS
$cshowsPrec :: Int -> ConfigAction -> ShowS
Show, ConfigAction -> ConfigAction -> Bool
(ConfigAction -> ConfigAction -> Bool)
-> (ConfigAction -> ConfigAction -> Bool) -> Eq ConfigAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigAction -> ConfigAction -> Bool
$c/= :: ConfigAction -> ConfigAction -> Bool
== :: ConfigAction -> ConfigAction -> Bool
$c== :: ConfigAction -> ConfigAction -> Bool
Eq)

prettyConfigAction :: ConfigAction -> Text
prettyConfigAction :: ConfigAction -> Text
prettyConfigAction = \case
    RemoveAction  -> "— Remove "
    IncludeAction -> "∪ Include"
    ExcludeAction -> "∩ Exclude"
    IgnoreAction  -> "✖ Ignore "

configActionClass :: ConfigAction -> Text
configActionClass :: ConfigAction -> Text
configActionClass = \case
    RemoveAction  -> "remove"
    IncludeAction -> "include"
    ExcludeAction -> "exclude"
    IgnoreAction  -> "ignore"

configActionColour :: ConfigAction -> Text
configActionColour :: ConfigAction -> Text
configActionColour = \case
    RemoveAction  -> Text
forall str. IsString str => str
red
    IncludeAction -> Text
forall str. IsString str => str
green
    ExcludeAction -> Text
forall str. IsString str => str
yellow
    IgnoreAction  -> Text
forall str. IsString str => str
magenta

configToTriples :: Config -> [(ConfigAction, Text, Text)]
configToTriples :: Config -> [(ConfigAction, Text, Text)]
configToTriples ConfigP{..} =
       (Scope -> (ConfigAction, Text, Text))
-> [Scope] -> [(ConfigAction, Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((ConfigAction
RemoveAction, "", ) (Text -> (ConfigAction, Text, Text))
-> (Scope -> Text) -> Scope -> (ConfigAction, Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope -> Text
prettyScope) [Scope]
'Final ::- [Scope]
configRemoved
    [(ConfigAction, Text, Text)]
-> [(ConfigAction, Text, Text)] -> [(ConfigAction, Text, Text)]
forall a. [a] -> [a] -> [a]
++ (Check -> (ConfigAction, Text, Text))
-> [Check] -> [(ConfigAction, Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map Check -> (ConfigAction, Text, Text)
checkToTriple [Check]
'Final ::- [Check]
configChecks
    [(ConfigAction, Text, Text)]
-> [(ConfigAction, Text, Text)] -> [(ConfigAction, Text, Text)]
forall a. [a] -> [a] -> [a]
++ (Id Observation -> (ConfigAction, Text, Text))
-> [Id Observation] -> [(ConfigAction, Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((ConfigAction
IgnoreAction, , "") (Text -> (ConfigAction, Text, Text))
-> (Id Observation -> Text)
-> Id Observation
-> (ConfigAction, Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id Observation -> Text
forall a. Id a -> Text
unId) [Id Observation]
'Final ::- [Id Observation]
configIgnored

checkToTriple :: Check -> (ConfigAction, Text, Text)
checkToTriple :: Check -> (ConfigAction, Text, Text)
checkToTriple Check{..} =
    ( CheckType -> ConfigAction
checkTypeToAction CheckType
checkType
    , CheckFilter -> Text
prettyFilter CheckFilter
checkFilter
    , Scope -> Text
prettyScope Scope
checkScope
    )

checkTypeToAction :: CheckType -> ConfigAction
checkTypeToAction :: CheckType -> ConfigAction
checkTypeToAction = \case
    Include -> ConfigAction
IncludeAction
    Exclude -> ConfigAction
ExcludeAction

prettyFilter :: CheckFilter -> Text
prettyFilter :: CheckFilter -> Text
prettyFilter = \case
    CheckInspection ins :: Id Inspection
ins -> "ID: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Id Inspection -> Text
forall a. Id a -> Text
unId Id Inspection
ins
    CheckSeverity sev :: Severity
sev -> "Severity: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Severity -> Text
forall b a. (Show a, IsString b) => a -> b
show Severity
sev
    CheckCategory cat :: Category
cat -> "Category: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Category -> Text
unCategory Category
cat
    CheckAll -> "All inspections"

prettyScope :: Scope -> Text
prettyScope :: Scope -> Text
prettyScope = \case
    ScopeFile fp :: String
fp -> "File: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
fp
    ScopeDirectory dir :: String
dir -> "Directory: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
dir
    ScopeAll -> "All files"

prettyConfigCli :: Config -> Text
prettyConfigCli :: Config -> Text
prettyConfigCli = [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ([Text] -> Text) -> (Config -> [Text]) -> Config -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ConfigAction, Text, Text) -> [Text])
-> [(ConfigAction, Text, Text)] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ConfigAction, Text, Text) -> [Text]
action ([(ConfigAction, Text, Text)] -> [Text])
-> (Config -> [(ConfigAction, Text, Text)]) -> Config -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> [(ConfigAction, Text, Text)]
configToTriples
  where
    action :: (ConfigAction, Text, Text) -> [Text]
    action :: (ConfigAction, Text, Text) -> [Text]
action (act :: ConfigAction
act, check :: Text
check, scope :: Text
scope) =
          [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [ConfigAction -> Text
configActionColour ConfigAction
act, Text
forall str. IsString str => str
bold] (ConfigAction -> Text
prettyConfigAction ConfigAction
act)
        Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:  [ "    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
check | Text
check Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= ""]
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ "    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
scope | Text
scope Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= ""]