{-# LANGUAGE DeriveAnyClass #-}

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

Core error types, including 'TomlDecodeError' and 'LoadTomlException'.

@since 1.3.0.0
-}

module Toml.Codec.Error
    ( TomlDecodeError (..)
    , prettyTomlDecodeErrors
    , prettyTomlDecodeError

    , LoadTomlException (..)
    ) where

import Control.DeepSeq (NFData)
import Control.Exception (Exception)
import Data.Text (Text)
import GHC.Generics (Generic)

import Toml.Codec.BiMap (TomlBiMapError, prettyBiMapError)
import Toml.Parser (TomlParseError (..))
import Toml.Type.Key (Key (..))
import Toml.Type.Printer (prettyKey)

import qualified Data.Text as Text


{- | Type of exception for converting from TOML to user custom data type.

@since 1.3.0.0
-}
data TomlDecodeError
    = BiMapError !Key !TomlBiMapError
    | KeyNotFound !Key  -- ^ No such key
    | TableNotFound !Key  -- ^ No such table
    | TableArrayNotFound !Key
      {- ^ No such table array

      @since 1.3.0.0
      -}
    | ParseError !TomlParseError  -- ^ Exception during parsing
    deriving stock (Int -> TomlDecodeError -> ShowS
[TomlDecodeError] -> ShowS
TomlDecodeError -> String
(Int -> TomlDecodeError -> ShowS)
-> (TomlDecodeError -> String)
-> ([TomlDecodeError] -> ShowS)
-> Show TomlDecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TomlDecodeError] -> ShowS
$cshowList :: [TomlDecodeError] -> ShowS
show :: TomlDecodeError -> String
$cshow :: TomlDecodeError -> String
showsPrec :: Int -> TomlDecodeError -> ShowS
$cshowsPrec :: Int -> TomlDecodeError -> ShowS
Show, TomlDecodeError -> TomlDecodeError -> Bool
(TomlDecodeError -> TomlDecodeError -> Bool)
-> (TomlDecodeError -> TomlDecodeError -> Bool)
-> Eq TomlDecodeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TomlDecodeError -> TomlDecodeError -> Bool
$c/= :: TomlDecodeError -> TomlDecodeError -> Bool
== :: TomlDecodeError -> TomlDecodeError -> Bool
$c== :: TomlDecodeError -> TomlDecodeError -> Bool
Eq, (forall x. TomlDecodeError -> Rep TomlDecodeError x)
-> (forall x. Rep TomlDecodeError x -> TomlDecodeError)
-> Generic TomlDecodeError
forall x. Rep TomlDecodeError x -> TomlDecodeError
forall x. TomlDecodeError -> Rep TomlDecodeError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TomlDecodeError x -> TomlDecodeError
$cfrom :: forall x. TomlDecodeError -> Rep TomlDecodeError x
Generic)
    deriving anyclass (TomlDecodeError -> ()
(TomlDecodeError -> ()) -> NFData TomlDecodeError
forall a. (a -> ()) -> NFData a
rnf :: TomlDecodeError -> ()
$crnf :: TomlDecodeError -> ()
NFData)

{- | Converts 'TomlDecodeError's into pretty human-readable text.

@since 1.3.0.0
-}
prettyTomlDecodeErrors :: [TomlDecodeError] -> Text
prettyTomlDecodeErrors :: [TomlDecodeError] -> Text
prettyTomlDecodeErrors errs :: [TomlDecodeError]
errs = [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    ("tomland errors number: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [TomlDecodeError] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TomlDecodeError]
errs))
    Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (TomlDecodeError -> Text) -> [TomlDecodeError] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map TomlDecodeError -> Text
prettyTomlDecodeError [TomlDecodeError]
errs

{- | Converts 'TomlDecodeError' into pretty human-readable text.

@since 1.3.0.0
-}
prettyTomlDecodeError :: TomlDecodeError -> Text
prettyTomlDecodeError :: TomlDecodeError -> Text
prettyTomlDecodeError de :: TomlDecodeError
de = "tomland decode error:  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case TomlDecodeError
de of
    BiMapError name :: Key
name biError :: TomlBiMapError
biError -> "BiMap error in key '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
prettyKey Key
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' : "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TomlBiMapError -> Text
prettyBiMapError TomlBiMapError
biError
    KeyNotFound name :: Key
name -> "Key " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
prettyKey Key
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " is not found"
    TableNotFound name :: Key
name -> "Table [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
prettyKey Key
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "] is not found"
    TableArrayNotFound name :: Key
name -> "Table array [[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
prettyKey Key
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]] is not found"
    ParseError (TomlParseError msg :: Text
msg) ->
        "Parse error during conversion from TOML to custom user type: \n  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg

{- | File loading error data type.

@since 0.3.1
-}
data LoadTomlException = LoadTomlException !FilePath !Text

-- | @since 0.3.1
instance Show LoadTomlException where
    show :: LoadTomlException -> String
show (LoadTomlException filePath :: String
filePath msg :: Text
msg) = "Couldnt parse file " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filePath String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
msg

-- | @since 0.3.1
instance Exception LoadTomlException