{-# LANGUAGE DeriveFunctor #-}
-- | Types and typeclass for errors in Waargonaut decoding.
module Waargonaut.Decode.Error
  ( DecodeError (..)
  , AsDecodeError (..)
  , Err (..)
  ) where

import           Control.Lens                 (Prism')
import qualified Control.Lens                 as L

import           GHC.Word                     (Word64)

import           HaskellWorks.Data.Json.Standard.Cursor.Type  (JsonType)

import           Data.Text                    (Text)

import           Waargonaut.Decode.ZipperMove (ZipperMove)

import           Waargonaut.Types             (JNumber)

-- | Convenience Error structure for the separate parsing/decoding phases. For
-- when things really aren't that complicated.
data Err c e
  = Parse e
  | Decode (DecodeError, c)
  deriving (Int -> Err c e -> ShowS
[Err c e] -> ShowS
Err c e -> String
(Int -> Err c e -> ShowS)
-> (Err c e -> String) -> ([Err c e] -> ShowS) -> Show (Err c e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c e. (Show e, Show c) => Int -> Err c e -> ShowS
forall c e. (Show e, Show c) => [Err c e] -> ShowS
forall c e. (Show e, Show c) => Err c e -> String
showList :: [Err c e] -> ShowS
$cshowList :: forall c e. (Show e, Show c) => [Err c e] -> ShowS
show :: Err c e -> String
$cshow :: forall c e. (Show e, Show c) => Err c e -> String
showsPrec :: Int -> Err c e -> ShowS
$cshowsPrec :: forall c e. (Show e, Show c) => Int -> Err c e -> ShowS
Show, Err c e -> Err c e -> Bool
(Err c e -> Err c e -> Bool)
-> (Err c e -> Err c e -> Bool) -> Eq (Err c e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c e. (Eq e, Eq c) => Err c e -> Err c e -> Bool
/= :: Err c e -> Err c e -> Bool
$c/= :: forall c e. (Eq e, Eq c) => Err c e -> Err c e -> Bool
== :: Err c e -> Err c e -> Bool
$c== :: forall c e. (Eq e, Eq c) => Err c e -> Err c e -> Bool
Eq, a -> Err c b -> Err c a
(a -> b) -> Err c a -> Err c b
(forall a b. (a -> b) -> Err c a -> Err c b)
-> (forall a b. a -> Err c b -> Err c a) -> Functor (Err c)
forall a b. a -> Err c b -> Err c a
forall a b. (a -> b) -> Err c a -> Err c b
forall c a b. a -> Err c b -> Err c a
forall c a b. (a -> b) -> Err c a -> Err c b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Err c b -> Err c a
$c<$ :: forall c a b. a -> Err c b -> Err c a
fmap :: (a -> b) -> Err c a -> Err c b
$cfmap :: forall c a b. (a -> b) -> Err c a -> Err c b
Functor)

-- |
-- Set of errors that may occur during the decode phase.
--
data DecodeError
  = ConversionFailure Text
  | TypeMismatch JsonType
  | KeyDecodeFailed
  | KeyNotFound Text
  | FailedToMove ZipperMove
  | NumberOutOfBounds JNumber
  | InputOutOfBounds Word64
  | ParseFailed Text
  deriving (Int -> DecodeError -> ShowS
[DecodeError] -> ShowS
DecodeError -> String
(Int -> DecodeError -> ShowS)
-> (DecodeError -> String)
-> ([DecodeError] -> ShowS)
-> Show DecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecodeError] -> ShowS
$cshowList :: [DecodeError] -> ShowS
show :: DecodeError -> String
$cshow :: DecodeError -> String
showsPrec :: Int -> DecodeError -> ShowS
$cshowsPrec :: Int -> DecodeError -> ShowS
Show, DecodeError -> DecodeError -> Bool
(DecodeError -> DecodeError -> Bool)
-> (DecodeError -> DecodeError -> Bool) -> Eq DecodeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecodeError -> DecodeError -> Bool
$c/= :: DecodeError -> DecodeError -> Bool
== :: DecodeError -> DecodeError -> Bool
$c== :: DecodeError -> DecodeError -> Bool
Eq)

-- | Describes the sorts of errors that may be treated as a 'DecodeError', for use with 'Control.Lens.Prism's.
class AsDecodeError r where
  _DecodeError       :: Prism' r DecodeError
  _ConversionFailure :: Prism' r Text
  _TypeMismatch      :: Prism' r JsonType
  _KeyDecodeFailed   :: Prism' r ()
  _KeyNotFound       :: Prism' r Text
  _FailedToMove      :: Prism' r ZipperMove
  _NumberOutOfBounds :: Prism' r JNumber
  _InputOutOfBounds  :: Prism' r Word64
  _ParseFailed       :: Prism' r Text

  _ConversionFailure = p DecodeError (f DecodeError) -> p r (f r)
forall r. AsDecodeError r => Prism' r DecodeError
_DecodeError (p DecodeError (f DecodeError) -> p r (f r))
-> (p Text (f Text) -> p DecodeError (f DecodeError))
-> p Text (f Text)
-> p r (f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Text (f Text) -> p DecodeError (f DecodeError)
forall r. AsDecodeError r => Prism' r Text
_ConversionFailure
  _TypeMismatch      = p DecodeError (f DecodeError) -> p r (f r)
forall r. AsDecodeError r => Prism' r DecodeError
_DecodeError (p DecodeError (f DecodeError) -> p r (f r))
-> (p JsonType (f JsonType) -> p DecodeError (f DecodeError))
-> p JsonType (f JsonType)
-> p r (f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p JsonType (f JsonType) -> p DecodeError (f DecodeError)
forall r. AsDecodeError r => Prism' r JsonType
_TypeMismatch
  _KeyDecodeFailed   = p DecodeError (f DecodeError) -> p r (f r)
forall r. AsDecodeError r => Prism' r DecodeError
_DecodeError (p DecodeError (f DecodeError) -> p r (f r))
-> (p () (f ()) -> p DecodeError (f DecodeError))
-> p () (f ())
-> p r (f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p DecodeError (f DecodeError)
forall r. AsDecodeError r => Prism' r ()
_KeyDecodeFailed
  _KeyNotFound       = p DecodeError (f DecodeError) -> p r (f r)
forall r. AsDecodeError r => Prism' r DecodeError
_DecodeError (p DecodeError (f DecodeError) -> p r (f r))
-> (p Text (f Text) -> p DecodeError (f DecodeError))
-> p Text (f Text)
-> p r (f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Text (f Text) -> p DecodeError (f DecodeError)
forall r. AsDecodeError r => Prism' r Text
_KeyNotFound
  _FailedToMove      = p DecodeError (f DecodeError) -> p r (f r)
forall r. AsDecodeError r => Prism' r DecodeError
_DecodeError (p DecodeError (f DecodeError) -> p r (f r))
-> (p ZipperMove (f ZipperMove) -> p DecodeError (f DecodeError))
-> p ZipperMove (f ZipperMove)
-> p r (f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p ZipperMove (f ZipperMove) -> p DecodeError (f DecodeError)
forall r. AsDecodeError r => Prism' r ZipperMove
_FailedToMove
  _NumberOutOfBounds = p DecodeError (f DecodeError) -> p r (f r)
forall r. AsDecodeError r => Prism' r DecodeError
_DecodeError (p DecodeError (f DecodeError) -> p r (f r))
-> (p JNumber (f JNumber) -> p DecodeError (f DecodeError))
-> p JNumber (f JNumber)
-> p r (f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p JNumber (f JNumber) -> p DecodeError (f DecodeError)
forall r. AsDecodeError r => Prism' r JNumber
_NumberOutOfBounds
  _InputOutOfBounds  = p DecodeError (f DecodeError) -> p r (f r)
forall r. AsDecodeError r => Prism' r DecodeError
_DecodeError (p DecodeError (f DecodeError) -> p r (f r))
-> (p Word64 (f Word64) -> p DecodeError (f DecodeError))
-> p Word64 (f Word64)
-> p r (f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Word64 (f Word64) -> p DecodeError (f DecodeError)
forall r. AsDecodeError r => Prism' r Word64
_InputOutOfBounds
  _ParseFailed       = p DecodeError (f DecodeError) -> p r (f r)
forall r. AsDecodeError r => Prism' r DecodeError
_DecodeError (p DecodeError (f DecodeError) -> p r (f r))
-> (p Text (f Text) -> p DecodeError (f DecodeError))
-> p Text (f Text)
-> p r (f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Text (f Text) -> p DecodeError (f DecodeError)
forall r. AsDecodeError r => Prism' r Text
_ParseFailed

instance AsDecodeError DecodeError where
  _DecodeError :: p DecodeError (f DecodeError) -> p DecodeError (f DecodeError)
_DecodeError = p DecodeError (f DecodeError) -> p DecodeError (f DecodeError)
forall a. a -> a
id

  _ConversionFailure :: p Text (f Text) -> p DecodeError (f DecodeError)
_ConversionFailure
    = (Text -> DecodeError)
-> (DecodeError -> Either DecodeError Text)
-> Prism' DecodeError Text
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
L.prism Text -> DecodeError
ConversionFailure
        (\DecodeError
x -> case DecodeError
x of
            ConversionFailure Text
y -> Text -> Either DecodeError Text
forall a b. b -> Either a b
Right Text
y
            DecodeError
_                   -> DecodeError -> Either DecodeError Text
forall a b. a -> Either a b
Left DecodeError
x
        )

  _TypeMismatch :: p JsonType (f JsonType) -> p DecodeError (f DecodeError)
_TypeMismatch
    = (JsonType -> DecodeError)
-> (DecodeError -> Either DecodeError JsonType)
-> Prism' DecodeError JsonType
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
L.prism JsonType -> DecodeError
TypeMismatch
        (\DecodeError
x -> case DecodeError
x of
            TypeMismatch JsonType
y -> JsonType -> Either DecodeError JsonType
forall a b. b -> Either a b
Right JsonType
y
            DecodeError
_              -> DecodeError -> Either DecodeError JsonType
forall a b. a -> Either a b
Left DecodeError
x
        )

  _KeyDecodeFailed :: p () (f ()) -> p DecodeError (f DecodeError)
_KeyDecodeFailed
    = (() -> DecodeError)
-> (DecodeError -> Either DecodeError ()) -> Prism' DecodeError ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
L.prism (DecodeError -> () -> DecodeError
forall a b. a -> b -> a
const DecodeError
KeyDecodeFailed)
        (\DecodeError
x -> case DecodeError
x of
            DecodeError
KeyDecodeFailed -> () -> Either DecodeError ()
forall a b. b -> Either a b
Right ()
            DecodeError
_               -> DecodeError -> Either DecodeError ()
forall a b. a -> Either a b
Left DecodeError
x
        )

  _KeyNotFound :: p Text (f Text) -> p DecodeError (f DecodeError)
_KeyNotFound
    = (Text -> DecodeError)
-> (DecodeError -> Either DecodeError Text)
-> Prism' DecodeError Text
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
L.prism Text -> DecodeError
KeyNotFound
        (\DecodeError
x -> case DecodeError
x of
            KeyNotFound Text
y -> Text -> Either DecodeError Text
forall a b. b -> Either a b
Right Text
y
            DecodeError
_             -> DecodeError -> Either DecodeError Text
forall a b. a -> Either a b
Left DecodeError
x
        )

  _FailedToMove :: p ZipperMove (f ZipperMove) -> p DecodeError (f DecodeError)
_FailedToMove
    = (ZipperMove -> DecodeError)
-> (DecodeError -> Either DecodeError ZipperMove)
-> Prism' DecodeError ZipperMove
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
L.prism ZipperMove -> DecodeError
FailedToMove
        (\DecodeError
x -> case DecodeError
x of
            FailedToMove ZipperMove
y -> ZipperMove -> Either DecodeError ZipperMove
forall a b. b -> Either a b
Right ZipperMove
y
            DecodeError
_              -> DecodeError -> Either DecodeError ZipperMove
forall a b. a -> Either a b
Left DecodeError
x
        )

  _NumberOutOfBounds :: p JNumber (f JNumber) -> p DecodeError (f DecodeError)
_NumberOutOfBounds
    = (JNumber -> DecodeError)
-> (DecodeError -> Either DecodeError JNumber)
-> Prism' DecodeError JNumber
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
L.prism JNumber -> DecodeError
NumberOutOfBounds
        (\DecodeError
x -> case DecodeError
x of
            NumberOutOfBounds JNumber
y -> JNumber -> Either DecodeError JNumber
forall a b. b -> Either a b
Right JNumber
y
            DecodeError
_                   -> DecodeError -> Either DecodeError JNumber
forall a b. a -> Either a b
Left DecodeError
x
        )

  _InputOutOfBounds :: p Word64 (f Word64) -> p DecodeError (f DecodeError)
_InputOutOfBounds
    = (Word64 -> DecodeError)
-> (DecodeError -> Either DecodeError Word64)
-> Prism' DecodeError Word64
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
L.prism Word64 -> DecodeError
InputOutOfBounds
      (\DecodeError
x -> case DecodeError
x of
          InputOutOfBounds Word64
y -> Word64 -> Either DecodeError Word64
forall a b. b -> Either a b
Right Word64
y
          DecodeError
_                  -> DecodeError -> Either DecodeError Word64
forall a b. a -> Either a b
Left DecodeError
x
      )

  _ParseFailed :: p Text (f Text) -> p DecodeError (f DecodeError)
_ParseFailed
    = (Text -> DecodeError)
-> (DecodeError -> Either DecodeError Text)
-> Prism' DecodeError Text
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
L.prism Text -> DecodeError
ParseFailed
        (\DecodeError
x -> case DecodeError
x of
            ParseFailed Text
y -> Text -> Either DecodeError Text
forall a b. b -> Either a b
Right Text
y
            DecodeError
_             -> DecodeError -> Either DecodeError Text
forall a b. a -> Either a b
Left DecodeError
x
        )