{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE RankNTypes #-}

-- |
-- Module defines 'CheckedEnc' - untyped ADT version of 'Enc'
--
-- A more dependently typed approach would be to define SomeEnc GADT
-- that accepts some @Enc '[..]@ in its constructor.  The approach here
-- turns out to be isomorphic to @SomeEnc@ approach.  Both, however, yield
-- somewhat different programming.  
--
-- Post v0.4 /typed-encoding/ does not support @SomeEnc@ and it remains only as an /Example/.
-- 
-- See "Examples.TypedEncoding.SomeEnc".
--
-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly.


module Data.TypedEncoding.Common.Types.CheckedEnc where

import           Data.TypedEncoding.Common.Types.Enc
import           Data.TypedEncoding.Common.Types.Common
import           Data.TypedEncoding.Common.Class.Common
import           Data.Proxy

-- $setup
-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XAllowAmbiguousTypes
-- >>> import qualified Data.Text as T
-- >>> import  Data.TypedEncoding.Combinators.Unsafe (unsafeSetPayload)


-- * Untyped Enc


-- | Represents some validated encoded string. 
--
-- @CheckedEnc@ is untyped version of 'Data.TypedEncoding.Common.Types.Enc.Enc'. 
-- @CheckedEnc@ contains verified encoded data, encoding is visible
-- at the value level only.
--
-- @since 0.2.0.0 
data CheckedEnc conf str = UnsafeMkCheckedEnc [EncAnn] conf str -- ^ @since 0.3.0.0
                                                                -- Constructor renamed from previous versions
                                                                -- This constructor is considered unsafe as pattern matching on it and
                                                                -- using it allows access to the encoded payload.
     deriving (Int -> CheckedEnc conf str -> ShowS
[CheckedEnc conf str] -> ShowS
CheckedEnc conf str -> String
(Int -> CheckedEnc conf str -> ShowS)
-> (CheckedEnc conf str -> String)
-> ([CheckedEnc conf str] -> ShowS)
-> Show (CheckedEnc conf str)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall conf str.
(Show conf, Show str) =>
Int -> CheckedEnc conf str -> ShowS
forall conf str.
(Show conf, Show str) =>
[CheckedEnc conf str] -> ShowS
forall conf str.
(Show conf, Show str) =>
CheckedEnc conf str -> String
showList :: [CheckedEnc conf str] -> ShowS
$cshowList :: forall conf str.
(Show conf, Show str) =>
[CheckedEnc conf str] -> ShowS
show :: CheckedEnc conf str -> String
$cshow :: forall conf str.
(Show conf, Show str) =>
CheckedEnc conf str -> String
showsPrec :: Int -> CheckedEnc conf str -> ShowS
$cshowsPrec :: forall conf str.
(Show conf, Show str) =>
Int -> CheckedEnc conf str -> ShowS
Show, CheckedEnc conf str -> CheckedEnc conf str -> Bool
(CheckedEnc conf str -> CheckedEnc conf str -> Bool)
-> (CheckedEnc conf str -> CheckedEnc conf str -> Bool)
-> Eq (CheckedEnc conf str)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall conf str.
(Eq conf, Eq str) =>
CheckedEnc conf str -> CheckedEnc conf str -> Bool
/= :: CheckedEnc conf str -> CheckedEnc conf str -> Bool
$c/= :: forall conf str.
(Eq conf, Eq str) =>
CheckedEnc conf str -> CheckedEnc conf str -> Bool
== :: CheckedEnc conf str -> CheckedEnc conf str -> Bool
$c== :: forall conf str.
(Eq conf, Eq str) =>
CheckedEnc conf str -> CheckedEnc conf str -> Bool
Eq) 

-- |
-- @since 0.2.0.0
unsafeCheckedEnc:: [EncAnn] -> c -> s -> CheckedEnc c s
unsafeCheckedEnc :: [String] -> c -> s -> CheckedEnc c s
unsafeCheckedEnc = [String] -> c -> s -> CheckedEnc c s
forall conf str. [String] -> conf -> str -> CheckedEnc conf str
UnsafeMkCheckedEnc

-- |
-- @since 0.2.0.0
getCheckedPayload :: CheckedEnc conf str -> str
getCheckedPayload :: CheckedEnc conf str -> str
getCheckedPayload = ([String], str) -> str
forall a b. (a, b) -> b
snd (([String], str) -> str)
-> (CheckedEnc conf str -> ([String], str))
-> CheckedEnc conf str
-> str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckedEnc conf str -> ([String], str)
forall conf str. CheckedEnc conf str -> ([String], str)
getCheckedEncPayload

-- |
-- @since 0.2.0.0
getCheckedEncPayload :: CheckedEnc conf str -> ([EncAnn], str) 
getCheckedEncPayload :: CheckedEnc conf str -> ([String], str)
getCheckedEncPayload (UnsafeMkCheckedEnc [String]
t conf
_ str
s) = ([String]
t,str
s)

-- |
-- @since 0.2.0.0
toCheckedEnc :: forall xs c str . (SymbolList xs) => Enc xs c str -> CheckedEnc c str 
toCheckedEnc :: Enc @[Symbol] xs c str -> CheckedEnc c str
toCheckedEnc (UnsafeMkEnc Proxy @[Symbol] xs
p c
c str
s) = 
        [String] -> c -> str -> CheckedEnc c str
forall conf str. [String] -> conf -> str -> CheckedEnc conf str
UnsafeMkCheckedEnc (SymbolList xs => [String]
forall (xs :: [Symbol]). SymbolList xs => [String]
symbolVals @xs) c
c str
s   

-- |
-- @since 0.2.0.0
fromCheckedEnc :: forall xs c str . SymbolList xs => CheckedEnc c str -> Maybe (Enc xs c str)
fromCheckedEnc :: CheckedEnc c str -> Maybe (Enc @[Symbol] xs c str)
fromCheckedEnc (UnsafeMkCheckedEnc [String]
xs c
c str
s) = 
    let p :: Proxy @[Symbol] xs
p = Proxy @[Symbol] xs
forall k (t :: k). Proxy @k t
Proxy :: Proxy xs
    in if SymbolList xs => [String]
forall (xs :: [Symbol]). SymbolList xs => [String]
symbolVals @xs [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String]
xs
       then Enc @[Symbol] xs c str -> Maybe (Enc @[Symbol] xs c str)
forall a. a -> Maybe a
Just (Enc @[Symbol] xs c str -> Maybe (Enc @[Symbol] xs c str))
-> Enc @[Symbol] xs c str -> Maybe (Enc @[Symbol] xs c str)
forall a b. (a -> b) -> a -> b
$ Proxy @[Symbol] xs -> c -> str -> Enc @[Symbol] xs c str
forall k (nms :: k) conf str.
Proxy @k nms -> conf -> str -> Enc @k nms conf str
UnsafeMkEnc Proxy @[Symbol] xs
p c
c str
s
       else Maybe (Enc @[Symbol] xs c str)
forall a. Maybe a
Nothing

------------------------

-- |
-- >>> let encsometest = UnsafeMkCheckedEnc ["TEST"] () $ T.pack "hello"
-- >>> procToCheckedEncFromCheckedEnc @'["TEST"] encsometest
-- True
-- >>> procToCheckedEncFromCheckedEnc @'["TEST1"] encsometest
-- False
procToCheckedEncFromCheckedEnc :: forall xs c str . (SymbolList xs, Eq c, Eq str) => CheckedEnc c str -> Bool
procToCheckedEncFromCheckedEnc :: CheckedEnc c str -> Bool
procToCheckedEncFromCheckedEnc CheckedEnc c str
x = (Maybe (CheckedEnc c str) -> Maybe (CheckedEnc c str) -> Bool
forall a. Eq a => a -> a -> Bool
== CheckedEnc c str -> Maybe (CheckedEnc c str)
forall a. a -> Maybe a
Just CheckedEnc c str
x) (Maybe (CheckedEnc c str) -> Bool)
-> (CheckedEnc c str -> Maybe (CheckedEnc c str))
-> CheckedEnc c str
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Enc @[Symbol] xs c str -> CheckedEnc c str)
-> Maybe (Enc @[Symbol] xs c str) -> Maybe (CheckedEnc c str)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (xs :: [Symbol]) c str.
SymbolList xs =>
Enc @[Symbol] xs c str -> CheckedEnc c str
forall c str.
SymbolList xs =>
Enc @[Symbol] xs c str -> CheckedEnc c str
toCheckedEnc @xs) (Maybe (Enc @[Symbol] xs c str) -> Maybe (CheckedEnc c str))
-> (CheckedEnc c str -> Maybe (Enc @[Symbol] xs c str))
-> CheckedEnc c str
-> Maybe (CheckedEnc c str)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckedEnc c str -> Maybe (Enc @[Symbol] xs c str)
forall (xs :: [Symbol]) c str.
SymbolList xs =>
CheckedEnc c str -> Maybe (Enc @[Symbol] xs c str)
fromCheckedEnc (CheckedEnc c str -> Bool) -> CheckedEnc c str -> Bool
forall a b. (a -> b) -> a -> b
$ CheckedEnc c str
x

-- |
-- >>> let enctest = unsafeSetPayload () "hello" :: Enc '["TEST"] () T.Text
-- >>> procFromCheckedEncToCheckedEnc enctest
-- True
procFromCheckedEncToCheckedEnc :: forall xs c str . (SymbolList xs, Eq c, Eq str) => Enc xs c str -> Bool
procFromCheckedEncToCheckedEnc :: Enc @[Symbol] xs c str -> Bool
procFromCheckedEncToCheckedEnc Enc @[Symbol] xs c str
x = (Maybe (Enc @[Symbol] xs c str)
-> Maybe (Enc @[Symbol] xs c str) -> Bool
forall a. Eq a => a -> a -> Bool
== Enc @[Symbol] xs c str -> Maybe (Enc @[Symbol] xs c str)
forall a. a -> Maybe a
Just Enc @[Symbol] xs c str
x) (Maybe (Enc @[Symbol] xs c str) -> Bool)
-> (Enc @[Symbol] xs c str -> Maybe (Enc @[Symbol] xs c str))
-> Enc @[Symbol] xs c str
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckedEnc c str -> Maybe (Enc @[Symbol] xs c str)
forall (xs :: [Symbol]) c str.
SymbolList xs =>
CheckedEnc c str -> Maybe (Enc @[Symbol] xs c str)
fromCheckedEnc (CheckedEnc c str -> Maybe (Enc @[Symbol] xs c str))
-> (Enc @[Symbol] xs c str -> CheckedEnc c str)
-> Enc @[Symbol] xs c str
-> Maybe (Enc @[Symbol] xs c str)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enc @[Symbol] xs c str -> CheckedEnc c str
forall (xs :: [Symbol]) c str.
SymbolList xs =>
Enc @[Symbol] xs c str -> CheckedEnc c str
toCheckedEnc (Enc @[Symbol] xs c str -> Bool) -> Enc @[Symbol] xs c str -> Bool
forall a b. (a -> b) -> a -> b
$ Enc @[Symbol] xs c str
x

-- |
-- >>> displ $ unsafeCheckedEnc ["TEST"] () ("hello" :: T.Text)
-- "UnsafeMkCheckedEnc [TEST] () (Text hello)"
instance (Show c, Displ str) => Displ (CheckedEnc c str) where
    displ :: CheckedEnc c str -> String
displ (UnsafeMkCheckedEnc [String]
xs c
c str
s) = 
        String
"UnsafeMkCheckedEnc " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall x. Displ x => x -> String
displ [String]
xs  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ c -> String
forall a. Show a => a -> String
show c
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ str -> String
forall x. Displ x => x -> String
displ str
s