module Ribosome.Data.SettingError where

import Data.Text.Prettyprint.Doc (Doc)
import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle)
import System.Log (Priority(NOTICE))

import Ribosome.Data.ErrorReport (ErrorReport(..))
import Ribosome.Error.Report.Class (ReportError(..))

data SettingError =
  Decode Text (Doc AnsiStyle)
  |
  Unset Text
  deriving Int -> SettingError -> ShowS
[SettingError] -> ShowS
SettingError -> String
(Int -> SettingError -> ShowS)
-> (SettingError -> String)
-> ([SettingError] -> ShowS)
-> Show SettingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SettingError] -> ShowS
$cshowList :: [SettingError] -> ShowS
show :: SettingError -> String
$cshow :: SettingError -> String
showsPrec :: Int -> SettingError -> ShowS
$cshowsPrec :: Int -> SettingError -> ShowS
Show

deepPrisms ''SettingError

instance ReportError SettingError where
  errorReport :: SettingError -> ErrorReport
errorReport (Decode Text
name Doc AnsiStyle
message) =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport (Text
"invalid setting: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) [Text
"failed to decode setting `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`", Doc AnsiStyle -> Text
forall b a. (Show a, IsString b) => a -> b
show Doc AnsiStyle
message] Priority
NOTICE
  errorReport (Unset Text
name) =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport (Text
"required setting unset: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) [Text
"unset setting: `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"] Priority
NOTICE