{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module OptEnvConf.Error where

import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Map (Map)
import qualified Data.Map as M
import qualified Data.Text as T
import GHC.Stack (SrcLoc)
import OptEnvConf.Doc
import OptEnvConf.Output
import OptEnvConf.Setting
import Text.Colour

data ParseError = ParseError
  { ParseError -> Maybe SrcLoc
parseErrorSrcLoc :: !(Maybe SrcLoc),
    ParseError -> ParseErrorMessage
parseErrorMessage :: !ParseErrorMessage
  }
  deriving (Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
(Int -> ParseError -> ShowS)
-> (ParseError -> String)
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseError -> ShowS
showsPrec :: Int -> ParseError -> ShowS
$cshow :: ParseError -> String
show :: ParseError -> String
$cshowList :: [ParseError] -> ShowS
showList :: [ParseError] -> ShowS
Show)

data ParseErrorMessage
  = ParseErrorEmpty
  | ParseErrorEmptySetting
  | ParseErrorNoReaders
  | ParseErrorCheckFailed !Bool !String
  | ParseErrorMissingArgument !(Maybe OptDoc)
  | ParseErrorArgumentRead !(Maybe OptDoc) !(NonEmpty String)
  | ParseErrorMissingOption !(Maybe OptDoc)
  | ParseErrorOptionRead !(Maybe OptDoc) !(NonEmpty String)
  | ParseErrorMissingEnvVar !(Maybe EnvDoc)
  | ParseErrorEnvRead !(Maybe EnvDoc) !(NonEmpty String)
  | ParseErrorMissingSwitch !(Maybe OptDoc)
  | ParseErrorMissingConfVal !(Maybe ConfDoc)
  | ParseErrorConfigRead !(Maybe ConfDoc) !String
  | ParseErrorMissingCommand ![CommandDoc ()]
  | ParseErrorUnrecognisedCommand !String ![CommandDoc ()]
  | ParseErrorAllOrNothing !(Map SettingHash SrcLoc)
  | ParseErrorUnrecognised !(NonEmpty String)
  deriving (Int -> ParseErrorMessage -> ShowS
[ParseErrorMessage] -> ShowS
ParseErrorMessage -> String
(Int -> ParseErrorMessage -> ShowS)
-> (ParseErrorMessage -> String)
-> ([ParseErrorMessage] -> ShowS)
-> Show ParseErrorMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseErrorMessage -> ShowS
showsPrec :: Int -> ParseErrorMessage -> ShowS
$cshow :: ParseErrorMessage -> String
show :: ParseErrorMessage -> String
$cshowList :: [ParseErrorMessage] -> ShowS
showList :: [ParseErrorMessage] -> ShowS
Show)

-- | Whether the other side of an 'Alt' should be tried if we find this error.
errorIsForgivable :: ParseError -> Bool
errorIsForgivable :: ParseError -> Bool
errorIsForgivable = ParseErrorMessage -> Bool
errorMessageIsForgivable (ParseErrorMessage -> Bool)
-> (ParseError -> ParseErrorMessage) -> ParseError -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> ParseErrorMessage
parseErrorMessage

errorMessageIsForgivable :: ParseErrorMessage -> Bool
errorMessageIsForgivable :: ParseErrorMessage -> Bool
errorMessageIsForgivable = \case
  ParseErrorMessage
ParseErrorEmpty -> Bool
True
  ParseErrorMessage
ParseErrorEmptySetting -> Bool
False
  ParseErrorMessage
ParseErrorNoReaders -> Bool
False
  ParseErrorCheckFailed Bool
forgivable String
_ -> Bool
forgivable
  ParseErrorMissingArgument Maybe OptDoc
_ -> Bool
True
  ParseErrorArgumentRead Maybe OptDoc
_ NonEmpty String
_ -> Bool
False
  ParseErrorMissingSwitch Maybe OptDoc
_ -> Bool
True
  ParseErrorOptionRead Maybe OptDoc
_ NonEmpty String
_ -> Bool
False
  ParseErrorMissingOption Maybe OptDoc
_ -> Bool
True
  ParseErrorMissingEnvVar Maybe EnvDoc
_ -> Bool
True
  ParseErrorEnvRead Maybe EnvDoc
_ NonEmpty String
_ -> Bool
False
  ParseErrorMissingConfVal Maybe ConfDoc
_ -> Bool
True
  ParseErrorConfigRead Maybe ConfDoc
_ String
_ -> Bool
False
  ParseErrorMissingCommand [CommandDoc ()]
cs -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [CommandDoc ()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CommandDoc ()]
cs
  ParseErrorUnrecognisedCommand String
_ [CommandDoc ()]
_ -> Bool
False
  ParseErrorAllOrNothing Map SettingHash SrcLoc
_ -> Bool
False
  ParseErrorUnrecognised NonEmpty String
_ -> Bool
False

eraseErrorSrcLocs :: (Functor f) => f ParseError -> f ParseError
eraseErrorSrcLocs :: forall (f :: * -> *). Functor f => f ParseError -> f ParseError
eraseErrorSrcLocs = (ParseError -> ParseError) -> f ParseError -> f ParseError
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseError -> ParseError
eraseErrorSrcLoc

eraseErrorSrcLoc :: ParseError -> ParseError
eraseErrorSrcLoc :: ParseError -> ParseError
eraseErrorSrcLoc ParseError
pe = ParseError
pe {parseErrorSrcLoc = Nothing}

renderErrors :: NonEmpty ParseError -> [Chunk]
renderErrors :: NonEmpty ParseError -> [Chunk]
renderErrors = [[Chunk]] -> [Chunk]
unlinesChunks ([[Chunk]] -> [Chunk])
-> (NonEmpty ParseError -> [[Chunk]])
-> NonEmpty ParseError
-> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseError -> [[Chunk]]) -> [ParseError] -> [[Chunk]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ParseError -> [[Chunk]]
renderError ([ParseError] -> [[Chunk]])
-> (NonEmpty ParseError -> [ParseError])
-> NonEmpty ParseError
-> [[Chunk]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ParseError -> [ParseError]
forall a. NonEmpty a -> [a]
NE.toList

renderError :: ParseError -> [[Chunk]]
renderError :: ParseError -> [[Chunk]]
renderError ParseError {Maybe SrcLoc
ParseErrorMessage
parseErrorSrcLoc :: ParseError -> Maybe SrcLoc
parseErrorMessage :: ParseError -> ParseErrorMessage
parseErrorSrcLoc :: Maybe SrcLoc
parseErrorMessage :: ParseErrorMessage
..} =
  [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ case ParseErrorMessage
parseErrorMessage of
        ParseErrorMessage
ParseErrorEmpty ->
          [[Chunk
"Hit the 'empty' case of the Parser type, this should not happen."]]
        ParseErrorMessage
ParseErrorEmptySetting ->
          [[Chunk
"This setting has not been configured to be able to parse anything."]]
        ParseErrorMessage
ParseErrorNoReaders ->
          [ [Chunk
"No readers were configured for an argument, option, or env."],
            [Chunk
"You should not be seeing this error because the linting phase should have caught it."]
          ]
        ParseErrorCheckFailed Bool
_ String
err ->
          [[Chunk
"Check failed: "], [Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err]]
        ParseErrorMissingArgument Maybe OptDoc
o ->
          [ Chunk
"Missing argument: "
              Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [[Chunk]] -> [Chunk]
unwordsChunks ([[Chunk]] -> (OptDoc -> [[Chunk]]) -> Maybe OptDoc -> [[Chunk]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] OptDoc -> [[Chunk]]
renderOptDocLong Maybe OptDoc
o)
          ]
        ParseErrorArgumentRead Maybe OptDoc
md NonEmpty String
errs ->
          [Chunk
"Failed to read argument: "]
            [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: [[Chunk]] -> [Chunk]
unwordsChunks ([[Chunk]] -> (OptDoc -> [[Chunk]]) -> Maybe OptDoc -> [[Chunk]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] OptDoc -> [[Chunk]]
renderOptDocLong Maybe OptDoc
md)
            [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: (String -> [Chunk]) -> [String] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map (\String
err -> [Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err]) (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty String
errs)
        ParseErrorMissingOption Maybe OptDoc
o ->
          [Chunk
"Missing option: " Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [[Chunk]] -> [Chunk]
unwordsChunks ([[Chunk]] -> (OptDoc -> [[Chunk]]) -> Maybe OptDoc -> [[Chunk]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] OptDoc -> [[Chunk]]
renderOptDocLong Maybe OptDoc
o)]
        ParseErrorMissingSwitch Maybe OptDoc
o ->
          [Chunk
"Missing switch: " Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [[Chunk]] -> [Chunk]
unwordsChunks ([[Chunk]] -> (OptDoc -> [[Chunk]]) -> Maybe OptDoc -> [[Chunk]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] OptDoc -> [[Chunk]]
renderOptDocLong Maybe OptDoc
o)]
        ParseErrorOptionRead Maybe OptDoc
md NonEmpty String
errs ->
          [Chunk
"Failed to read option: "]
            [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: [[Chunk]] -> [Chunk]
unwordsChunks ([[Chunk]] -> (OptDoc -> [[Chunk]]) -> Maybe OptDoc -> [[Chunk]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] OptDoc -> [[Chunk]]
renderOptDocLong Maybe OptDoc
md)
            [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: (String -> [Chunk]) -> [String] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map (\String
err -> [Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err]) (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty String
errs)
        ParseErrorMissingEnvVar Maybe EnvDoc
md ->
          [Chunk
"Missing env var: "]
            [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: [[Chunk]] -> (EnvDoc -> [[Chunk]]) -> Maybe EnvDoc -> [[Chunk]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] EnvDoc -> [[Chunk]]
renderEnvDoc Maybe EnvDoc
md
        ParseErrorEnvRead Maybe EnvDoc
md NonEmpty String
errs ->
          [Chunk
"Failed to read env var: "]
            [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: [[Chunk]] -> (EnvDoc -> [[Chunk]]) -> Maybe EnvDoc -> [[Chunk]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] EnvDoc -> [[Chunk]]
renderEnvDoc Maybe EnvDoc
md
            [[Chunk]] -> [[Chunk]] -> [[Chunk]]
forall a. [a] -> [a] -> [a]
++ (String -> [Chunk]) -> [String] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map (\String
err -> [Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err]) (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty String
errs)
        ParseErrorMissingConfVal Maybe ConfDoc
md ->
          [Chunk
"Missing config value: "] [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: [[Chunk]] -> (ConfDoc -> [[Chunk]]) -> Maybe ConfDoc -> [[Chunk]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ConfDoc -> [[Chunk]]
renderConfDoc Maybe ConfDoc
md
        ParseErrorConfigRead Maybe ConfDoc
md String
s ->
          [Chunk
"Failed to parse configuration: "]
            [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: [[Chunk]] -> (ConfDoc -> [[Chunk]]) -> Maybe ConfDoc -> [[Chunk]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ConfDoc -> [[Chunk]]
renderConfDoc Maybe ConfDoc
md
            [[Chunk]] -> [[Chunk]] -> [[Chunk]]
forall a. [a] -> [a] -> [a]
++ [[Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s]]
        ParseErrorMissingCommand [CommandDoc ()]
cs ->
          [Chunk
"Missing command, available commands:"]
            [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: [CommandDoc ()] -> [[Chunk]]
forall a. [CommandDoc a] -> [[Chunk]]
availableCommandsLines [CommandDoc ()]
cs
        ParseErrorUnrecognisedCommand String
c [CommandDoc ()]
cs ->
          [ [Colour -> Chunk -> Chunk
fore Colour
red Chunk
"Unrecognised command: ", Colour -> Chunk -> Chunk
fore Colour
yellow (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (String -> Text
T.pack String
c)],
            [Colour -> Chunk -> Chunk
fore Colour
blue Chunk
"available commands:"]
          ]
            [[Chunk]] -> [[Chunk]] -> [[Chunk]]
forall a. [a] -> [a] -> [a]
++ [CommandDoc ()] -> [[Chunk]]
forall a. [CommandDoc a] -> [[Chunk]]
availableCommandsLines [CommandDoc ()]
cs
        ParseErrorAllOrNothing Map SettingHash SrcLoc
locs ->
          [ [Chunk
"You are seeing this error because at least one, but not all, of the settings in an allOrNothing (or subSettings) parser have been defined."],
            [Chunk
"The following settings have been parsed:"]
          ]
            [[Chunk]] -> [[Chunk]] -> [[Chunk]]
forall a. [a] -> [a] -> [a]
++ (SrcLoc -> [Chunk]) -> [SrcLoc] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map (Chunk -> [Chunk]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chunk -> [Chunk]) -> (SrcLoc -> Chunk) -> SrcLoc -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcLoc -> Chunk
srcLocChunk) (Map SettingHash SrcLoc -> [SrcLoc]
forall k a. Map k a -> [a]
M.elems Map SettingHash SrcLoc
locs)
        ParseErrorUnrecognised NonEmpty String
leftovers ->
          [Chunk
"Unrecognised args: " Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [[Chunk]] -> [Chunk]
unwordsChunks ((String -> [Chunk]) -> [String] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map (Chunk -> [Chunk]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chunk -> [Chunk]) -> (String -> Chunk) -> String -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk (Text -> Chunk) -> (String -> Text) -> String -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty String
leftovers))],
      [[Chunk]] -> (SrcLoc -> [[Chunk]]) -> Maybe SrcLoc -> [[Chunk]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ([Chunk] -> [[Chunk]]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Chunk] -> [[Chunk]])
-> (SrcLoc -> [Chunk]) -> SrcLoc -> [[Chunk]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chunk
"see " Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:) ([Chunk] -> [Chunk]) -> (SrcLoc -> [Chunk]) -> SrcLoc -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> [Chunk]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chunk -> [Chunk]) -> (SrcLoc -> Chunk) -> SrcLoc -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcLoc -> Chunk
srcLocChunk) Maybe SrcLoc
parseErrorSrcLoc
    ]

availableCommandsLines :: [CommandDoc a] -> [[Chunk]]
availableCommandsLines :: forall a. [CommandDoc a] -> [[Chunk]]
availableCommandsLines = (CommandDoc a -> [Chunk]) -> [CommandDoc a] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map ((CommandDoc a -> [Chunk]) -> [CommandDoc a] -> [[Chunk]])
-> (CommandDoc a -> [Chunk]) -> [CommandDoc a] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ \CommandDoc {String
AnyDocs a
commandDocArgument :: String
commandDocHelp :: String
commandDocs :: AnyDocs a
commandDocArgument :: forall a. CommandDoc a -> String
commandDocHelp :: forall a. CommandDoc a -> String
commandDocs :: forall a. CommandDoc a -> AnyDocs a
..} ->
  [ String -> Chunk
commandChunk String
commandDocArgument,
    Chunk
": ",
    String -> Chunk
helpChunk String
commandDocHelp
  ]