{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
-- {-# LANGUAGE RankNTypes #-}

-- |
-- Exception types used in /typed-encoding/
--
-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly.

module Data.TypedEncoding.Common.Types.Exceptions where


import           Data.Proxy
import           GHC.TypeLits


-- $setup
-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XAllowAmbiguousTypes
-- >>> import qualified Data.Text as T


-- | Represents errors in recovery (recreation of encoded types).
data RecreateEx where
    RecreateEx:: (Show e, KnownSymbol x) => Proxy x -> e -> RecreateEx
    RecreateExUnkStep::   (Show e) => e -> RecreateEx

instance Show RecreateEx where
    show :: RecreateEx -> String
show (RecreateEx Proxy @Symbol x
prxy e
a) = String
"(RecreateEx \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy @Symbol x -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy @Symbol x
prxy String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ e -> String
forall a. Show a => a -> String
show e
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"))"
    show (RecreateExUnkStep  e
a) = String
"(UnknownDecodeStep (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ e -> String
forall a. Show a => a -> String
show e
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"))"


recreateErrUnknown :: (Show e) => e -> RecreateEx
recreateErrUnknown :: e -> RecreateEx
recreateErrUnknown  = e -> RecreateEx
forall x. Show x => x -> RecreateEx
RecreateExUnkStep

-- instance Eq RecreateEx where
--     (RecreateEx prxy1 a1) == RecreateEx prxy2 a2 = (symbolVal prxy1) == (symbolVal prxy2)


-- | Represents errors in encoding
-- @since 0.1.0.0 
data EncodeEx where
    EncodeEx:: (Show a, KnownSymbol x) => Proxy x -> a -> EncodeEx 

instance Show EncodeEx where
    show :: EncodeEx -> String
show (EncodeEx Proxy @Symbol x
prxy a
a) = String
"(EncodeEx \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy @Symbol x -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy @Symbol x
prxy String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"))"

-- |
-- @since 0.2.2.0
asEncodeEx :: (Show a, KnownSymbol x) => Proxy x -> Either a b -> Either EncodeEx b
asEncodeEx :: Proxy @Symbol x -> Either a b -> Either EncodeEx b
asEncodeEx Proxy @Symbol x
p = (a -> Either EncodeEx b)
-> (b -> Either EncodeEx b) -> Either a b -> Either EncodeEx b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (EncodeEx -> Either EncodeEx b
forall a b. a -> Either a b
Left (EncodeEx -> Either EncodeEx b)
-> (a -> EncodeEx) -> a -> Either EncodeEx b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy @Symbol x -> a -> EncodeEx
forall a (e :: Symbol).
(Show a, KnownSymbol e) =>
Proxy @Symbol e -> a -> EncodeEx
EncodeEx Proxy @Symbol x
p) b -> Either EncodeEx b
forall a b. b -> Either a b
Right 


-- | Useful when manually recreating using recovery
-- @since 0.2.2.0
encToRecrEx :: EncodeEx ->  RecreateEx
encToRecrEx :: EncodeEx -> RecreateEx
encToRecrEx (EncodeEx Proxy @Symbol x
p a
a) = Proxy @Symbol x -> a -> RecreateEx
forall e (x :: Symbol).
(Show e, KnownSymbol x) =>
Proxy @Symbol x -> e -> RecreateEx
RecreateEx Proxy @Symbol x
p a
a

-- |
-- @since 0.2.1.0
mergeEncodeEx ::  KnownSymbol x => Proxy x -> EncodeEx -> Maybe EncodeEx -> EncodeEx
mergeEncodeEx :: Proxy @Symbol x -> EncodeEx -> Maybe EncodeEx -> EncodeEx
mergeEncodeEx Proxy @Symbol x
_ EncodeEx
ex Maybe EncodeEx
Nothing = EncodeEx
ex
mergeEncodeEx Proxy @Symbol x
p (EncodeEx Proxy @Symbol x
_ a
a) (Just (EncodeEx Proxy @Symbol x
_ a
b)) = Proxy @Symbol x -> String -> EncodeEx
forall a (e :: Symbol).
(Show a, KnownSymbol e) =>
Proxy @Symbol e -> a -> EncodeEx
EncodeEx Proxy @Symbol x
p (String -> EncodeEx) -> String -> EncodeEx
forall a b. (a -> b) -> a -> b
$ String
"Errors: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (a, a) -> String
forall a. Show a => a -> String
show (a
a,a
b)

-- |
-- @since 0.2.1.0
emptyEncErr ::  KnownSymbol x =>  Proxy x -> EncodeEx 
emptyEncErr :: Proxy @Symbol x -> EncodeEx
emptyEncErr Proxy @Symbol x
p = Proxy @Symbol x -> String -> EncodeEx
forall a (e :: Symbol).
(Show a, KnownSymbol e) =>
Proxy @Symbol e -> a -> EncodeEx
EncodeEx Proxy @Symbol x
p (String
"unexpected" :: String)

-- | Type safety over encodings makes decoding process safe.
-- However failures are still possible due to bugs or unsafe payload modifications.
-- UnexpectedDecodeEx represents such errors.
--
-- @since 0.1.0.0 
data UnexpectedDecodeEx where
    UnexpectedDecodeEx :: (Show a, KnownSymbol x) => Proxy x -> a -> UnexpectedDecodeEx

instance Show UnexpectedDecodeEx where
    show :: UnexpectedDecodeEx -> String
show (UnexpectedDecodeEx Proxy @Symbol x
prxy a
a) = String
"(UnexpectedDecodeEx \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy @Symbol x -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy @Symbol x
prxy String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"))"


-- * Base combinators that rely on types defined here

-- |
-- @since 0.2.1.0
mergeErrs :: err -> (err -> Maybe err -> err) -> Either err a -> Either err b -> Either err c
mergeErrs :: err
-> (err -> Maybe err -> err)
-> Either err a
-> Either err b
-> Either err c
mergeErrs err
_ err -> Maybe err -> err
fn (Left err
er1) (Left err
er2) = err -> Either err c
forall a b. a -> Either a b
Left (err -> Maybe err -> err
fn err
er1 (Maybe err -> err) -> Maybe err -> err
forall a b. (a -> b) -> a -> b
$ err -> Maybe err
forall a. a -> Maybe a
Just err
er2)
mergeErrs err
_ err -> Maybe err -> err
fn (Left err
er1) Either err b
_ = err -> Either err c
forall a b. a -> Either a b
Left (err -> Maybe err -> err
fn err
er1 Maybe err
forall a. Maybe a
Nothing)
mergeErrs err
_ err -> Maybe err -> err
fn Either err a
_  (Left err
er2) = err -> Either err c
forall a b. a -> Either a b
Left (err -> Maybe err -> err
fn err
er2 Maybe err
forall a. Maybe a
Nothing) 
mergeErrs err
de err -> Maybe err -> err
fn (Right a
r) (Right b
y) = err -> Either err c
forall a b. a -> Either a b
Left err
de