Types.hs

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

-- |
-- Internal definition of types

module Data.TypedEncoding.Internal.Types (
        module Data.TypedEncoding.Internal.Types
        -- * Main encoding type and basic combinators.
        , module Data.TypedEncoding.Internal.Types.Enc
        -- * Untyped version and existentially quantified versions of Enc
        , module Data.TypedEncoding.Internal.Types.CheckedEnc
        -- * Not verified encoded data
        , module Data.TypedEncoding.Internal.Types.UncheckedEnc
        -- * Commmon types
        , module Data.TypedEncoding.Internal.Types.Common
    ) where

import           Data.TypedEncoding.Internal.Types.Enc
import           Data.TypedEncoding.Internal.Types.CheckedEnc
import           Data.TypedEncoding.Internal.Types.UncheckedEnc
import           Data.TypedEncoding.Internal.Types.Common


import           Data.Proxy
-- import           Data.Functor.Identity
import           GHC.TypeLits
-- import           Data.TypedEncoding.Internal.Class.Util

-- $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 prxy a) = "(RecreateEx \"" ++ symbolVal prxy ++ "\" (" ++ show a ++ "))"
    show (RecreateExUnkStep  a) = "(UnknownDecodeStep (" ++ show a ++ "))"


recreateErrUnknown :: (Show e) => e -> RecreateEx
recreateErrUnknown  = RecreateExUnkStep

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


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

instance Show EncodeEx where
    show (EncodeEx prxy a) = "(EncodeEx \"" ++ symbolVal prxy ++ "\" (" ++ show a ++ "))"


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

instance Show UnexpectedDecodeEx where
    show (UnexpectedDecodeEx prxy a) = "(UnexpectedDecodeEx \"" ++ symbolVal prxy ++ "\" (" ++ show a ++ "))"


-- * Base combinators that rely on types defined here

-- TODO could this type be more precise?
implEncodeF_ :: (Show err, KnownSymbol x) => Proxy x -> (str -> Either err str) ->  Enc enc1 conf str -> Either EncodeEx (Enc enc2 conf str) 
implEncodeF_ p f = implTranF (either (Left . EncodeEx p) Right . f) 

implEncodeF :: forall x enc1 enc2 err conf str . 
              (Show err, KnownSymbol x) 
              => (str -> Either err str) ->  Enc enc1 conf str -> Either EncodeEx (Enc enc2 conf str) 
implEncodeF = implEncodeF_ (Proxy :: Proxy x)

implEncodeF_' :: (Show err, KnownSymbol x) => Proxy x -> (conf -> str -> Either err str) ->  Enc enc1 conf str -> Either EncodeEx (Enc enc2 conf str) 
implEncodeF_' p f = implTranF' (\c -> either (Left . EncodeEx p) Right . f c)