{-# language OverloadedStrings #-}
{-# language ScopedTypeVariables #-}

{-|
Module      : Data.Sv.Decode.Error
Copyright   : (C) CSIRO 2017-2019
License     : BSD3
Maintainer  : George Wilson <george.wilson@data61.csiro.au>
Stability   : experimental
Portability : non-portable
-}

module Data.Sv.Decode.Error (
  DecodeError (..)
, DecodeErrors (..)

-- * Convenience constructors
, decodeError
, unexpectedEndOfRow
, expectedEndOfRow
, unknownCategoricalValue
, missingColumn
, missingHeader
, badConfig
, badParse
, badDecode

-- * Display
, displayErrors
, displayErrors'
, dieOnError
, dieOnError'

-- * Conversions
, validateEither
, validateEitherWith
, validateMaybe
, validateTrifectaResult

-- * Re-exports from @validation@
, bindValidation
) where

import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as Char8
import Data.Foldable (toList)
import Data.List (intersperse)
import Data.Semigroup (Semigroup ((<>)))
import Data.Semigroup.Foldable (Foldable1 (foldMap1))
import Data.String (IsString)
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.IO as LT
import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as Builder
import Data.Validation (Validation (Failure), bindValidation)
import Data.Vector (Vector)
import qualified Text.Trifecta.Result as Trifecta
import System.Exit (exitFailure)

import Data.Sv.Decode.Type

-- | Build a failing 'DecodeValidation'
decodeError :: DecodeError e -> DecodeValidation e a
decodeError = Failure . DecodeErrors . pure

-- | Fail with 'UnexpectedEndOfRow'
unexpectedEndOfRow :: DecodeValidation e a
unexpectedEndOfRow = decodeError UnexpectedEndOfRow

-- | Fail with 'ExpectedEndOfRow'. This takes the rest of the row, so that it
-- can be displayed to the user.
expectedEndOfRow :: Vector e -> DecodeValidation e a
expectedEndOfRow = decodeError . ExpectedEndOfRow

-- | Fail with 'UnknownCategoricalValue'.
-- It takes the unknown value and the list of good categorical values.
--
-- This mostly exists to be used by the 'Data.Sv.Decode.categorical' function.
unknownCategoricalValue :: e -> [[e]] -> DecodeValidation e a
unknownCategoricalValue unknown valids =
  decodeError (UnknownCategoricalValue unknown valids)

-- | Fail with 'MissingColumn' with the given column name. This is for when a
-- 'NameDecode' looks for a column that doesn't exist.
missingColumn :: e -> DecodeValidation e a
missingColumn = decodeError . MissingColumn

-- | Fail with 'MissingHeader'. This is for when the user asks for a header but
-- the input document is completely empty (that is, it has nothing that could be
-- considered a header).
missingHeader :: DecodeValidation e a
missingHeader = decodeError MissingHeader

-- | Fail with 'badConfig'. This is for when the user has asked for something
-- impossible, like to decode a CSV by column name while asserting there's no
-- header.
badConfig :: e -> DecodeValidation e a
badConfig = decodeError . BadConfig

-- | Fail with 'BadParse' with the given message. This is for when the parse
-- step fails, and decoding does not even begin.
badParse :: e -> DecodeValidation e a
badParse = decodeError . BadParse

-- | Fail with 'BadDecode' with the given message. This is something of a
-- generic error for when decoding a field goes wrong.
badDecode :: e -> DecodeValidation e a
badDecode = decodeError . BadDecode

-- | Build a 'DecodeValidation' from an 'Either'
validateEither :: Either (DecodeError e) a -> DecodeValidation e a
validateEither = validateEitherWith id

-- | Build a 'DecodeValidation' from an 'Either', given a function to build the error.
validateEitherWith :: (e -> DecodeError e') -> Either e a -> DecodeValidation e' a
validateEitherWith f = either (decodeError . f) pure

-- | Build a 'DecodeValidation' from a 'Maybe'. You have to supply an error
-- to use in the 'Nothing' case
validateMaybe :: DecodeError e -> Maybe b -> DecodeValidation e b
validateMaybe e = maybe (decodeError e) pure

-- | Convert a "Text.Trifecta" 'Text.Trifecta.Result' to a 'DecodeValidation'
validateTrifectaResult :: (String -> DecodeError e) -> Trifecta.Result a -> DecodeValidation e a
validateTrifectaResult f =
  validateEitherWith f . trifectaResultToEither
    where
      trifectaResultToEither r = case r of
        Trifecta.Failure e -> Left . show . Trifecta._errDoc $ e
        Trifecta.Success a -> Right a

-- | Pretty print errors as a string. Each error is on its own line.
displayErrors :: DecodeErrors ByteString -> LT.Text
displayErrors = displayErrors' buildBytestring

-- | Pretty print errors as a string. Each error is on its own line.
--
-- This version lets you work with any 'String' type in your errors.
displayErrors' :: forall e. (e -> Builder) -> DecodeErrors e -> LT.Text
displayErrors' build (DecodeErrors errs) =
  let
    indent :: Builder -> Builder
    indent x = "  " <> x

    displayErr :: DecodeError e -> Builder
    displayErr e = indent $ case e of
      BadParse msg -> "Parsing the document failed. The error was: " <> build msg
      UnexpectedEndOfRow -> "Expected more fields, but the row ended."
      ExpectedEndOfRow extras ->
        "Expected fewer fields in the row. The extra fields contained: " <>
          commaSep (bquote <$> toList extras)
      UnknownCategoricalValue found required ->
        "Unknown categorical value found: " <> bquote found <> ". Expected one of: " <>
          (commaSep . fmap bquote . mconcat) required
      MissingColumn name -> "Could not find required column " <> bquote name
      MissingHeader -> "A header row was required, but one was not found."
      BadConfig msg -> "sv was misconfigured: " <> build msg
      BadDecode msg -> "Decoding a field failed: " <> build msg

    displayAndCount = count . displayErr
    Counted body c = foldMap1 displayAndCount errs
    spaceSep = mconcat . intersperse " "
    commaSep = mconcat . intersperse ", "
    quote s = "\"" <> s <> "\""
    bquote = quote . build
    pluralise n s =
      if n == 1
      then s
      else Builder.fromString (show n) <> " " <> s <> "s"
    heading = spaceSep ["The following", pluralise c "error", "occurred:"]
  in
    Builder.toLazyText $ heading <> "\n" <> body

-- | If the 'DecodeValidation' is a 'Failure', print a pretty error message
-- and call 'exitFailure'
dieOnError :: DecodeValidation ByteString a -> IO a
dieOnError = dieOnError' buildBytestring

-- | If the 'DecodeValidation' is a 'Failure', print a pretty error message
-- and call 'exitFailure'
--
-- This version lets you work with different String types.
dieOnError' :: (e -> Builder) -> DecodeValidation e a -> IO a
dieOnError' build e = case e of
  Failure errs -> do
    LT.putStrLn $ displayErrors' build errs
    exitFailure
  Success a -> pure a

---- internal

buildBytestring :: ByteString -> Builder
buildBytestring bs = case T.decodeUtf8' bs of
  Left  _ -> Builder.fromString $ Char8.unpack bs
  Right b -> Builder.fromText b

data Counted e = Counted e Integer

count :: e -> Counted e
count e = Counted e 1

instance (Semigroup e, IsString e) => Semigroup (Counted e) where
  Counted b c <> Counted b' c' =
    Counted (b <> "\n" <> b') (c+c')