{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
-- |
-- Internal definition of types

module Data.TypedEncoding.Common.Types.Enc where

import           Data.Proxy
import           GHC.TypeLits

import           Data.TypedEncoding.Common.Class.Util
import           Data.TypedEncoding.Common.Types.Common

-- $setup
-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XAllowAmbiguousTypes
-- >>> import qualified Data.ByteString as B
-- >>> import qualified Data.Text as T
-- >>> import Data.Functor.Identity
-- >>> import Data.TypedEncoding
-- >>> import Data.TypedEncoding.Instances.Enc.Base64 ()
-- >>> import Data.TypedEncoding.Instances.Restriction.BoundedAlphaNums ()

-- |
-- Contains encoded data annotated by 
--
-- * @nms@ list of @Symbol@s with encoding names (encoding stack)
-- * @conf@ that can contain configuration / encoding information such as digest.
-- * @str@ the encoded data
--
--  Example: 
--
-- @
-- Enc '["r-ASCII"] () ByteString
-- @
--
-- @since 0.1.0.0
data Enc nms conf str where
    -- | 
    -- @since 0.3.0.0 renamed from MkEnc 
    --
    -- Use of this constructor should be kept to a minimum. 
    --
    -- Use of 'Data.TypedEncoding.Combinators.Unsafe.unsafeSetPayload' currently recommended
    -- for recovering 'Enc' from trusted input sources (if avoiding cost of "Data.TypedEncoding.Common.Types.Validation" is important).
    UnsafeMkEnc :: Proxy nms -> conf -> str -> Enc nms conf str
    deriving (Show, Eq)

-- |
-- >>> let disptest = UnsafeMkEnc Proxy () "hello" :: Enc '["TEST"] () T.Text
-- >>> displ disptest
-- "Enc '[TEST] () (Text hello)"
instance (SymbolList xs, Show c, Displ str) => Displ ( Enc xs c str) where
    displ (UnsafeMkEnc p c s) =
        "Enc '" ++ displ (Proxy :: Proxy xs) ++ " " ++ show c ++ " " ++ displ s

-- |
-- @since 0.1.0.0
toEncoding :: conf -> str -> Enc ('[] :: [Symbol]) conf str
toEncoding = UnsafeMkEnc Proxy

-- |
-- @since 0.1.0.0
fromEncoding :: Enc '[] conf str -> str
fromEncoding = getPayload

-- |
-- @since 0.1.0.0
getPayload :: Enc enc conf str -> str
getPayload (UnsafeMkEnc _ _ str) = str



-- |
-- Wraps the encoding function.
-- Contains type level information about the encoding name and the algorithm used. 
--
-- This type is used by programs implementing encoding instance.
-- Such program needs to define a value of this type. 
-- It also implements 'Data.TypedEncoding.Common.Class.Encode.Encode' instance that simply returns that value.
--
-- Programs using encoding can access this type using 'Data.TypedEncoding.Common.Class.Encode.Encode.encoding'
-- (from the @Encode@ typeclass) but a better (and recommended) approach is to use its plural sibling 'Encodings' 
-- defined below.
--
-- This type has 2 symbol type variables:
--
-- * @nm@  defines the encoding
-- * @alg@  defines algorithm 
--
-- These two are related, currently this library only supports 
--
-- * Names @nm@ containing ":" using format "alg:...", for example name "r-ban:999" has "r-ban" algorithm 
-- * Names without ":" require that @nm ~ alg@
--
-- Future version are likely to relax this, possibly introducing ability do define more than one algorithm
-- for given encoding. 
--
-- Using 2 variables allows us to define typeclass constraints that work
-- with definitions like @"r-ban"@ where @"r-ban:@" can be followed by arbitrary
-- string literal.
--
-- Examples: 
--
-- @
-- Encoding (Either EncodeEx) "r-ban:9" "r-ban" () String
-- @
--
-- encodes a single character @ <= 9'@
--
-- @
-- Encoding Identity "enc-B64" "enc-B64" () ByteString
-- @
--
-- Represents a /Byte 64/ encoder that can operate on any stack of previous encodings.
-- (encoding name and algorithm name are "enc-B64", there is no  
-- additional configuration @()@ needed and it runs in the @Identity@ Functor.
--
-- Similar boilerplate for /Decoding/ and /Validation/ is specified in separate modules.
--
-- @since 0.3.0.0
data Encoding f (nm :: Symbol) (alg :: Symbol) conf str where
    -- | Consider this constructor as private or use it with care
    --
    -- Defining constructor like this:
    -- @
    -- MkEncoding :: Proxy nm -> (forall (xs :: [Symbol]) . Enc xs conf str -> f (Enc (nm ': xs) conf str)) -> Encoding f nm (AlgNm nm) conf str
    -- @
    -- 
    -- would make compilation much slower
    UnsafeMkEncoding :: Proxy nm -> (forall (xs :: [Symbol]) . Enc xs conf str -> f (Enc (nm ': xs) conf str)) -> Encoding f nm alg conf str

-- | Type safe smart constructor
--
-- Adding the type family @(AlgNm nm)@ mapping to @Encoding@ constructor slows down the compilation.  
-- Using smart constructor does not have that issue.
--
-- This approach also provides more future flexibility with possibility of future overloads relaxing current 
-- limitations on @alg@ names. 
-- 
-- /Notice underscore @_@ convention, it indicates a use of @Algorithm@ @AlgNm@: compiler figures out @alg@ value. These can be slower to compile when used. /
--
-- Here are other conventions that relate to the existence of @alg@
--
-- * functions ending with: @'@, for example 'Data.TypedEncoding.Combinators.Encode.encodeF'' have @alg@
--   as first type variable in the @forall@ list.
--
-- * functions without tick tend to assume @nm ~ alg@
-- 
-- This particular function appears to not increase compilation time. 
--
-- @since 0.3.0.0
_mkEncoding :: forall f (nm :: Symbol) conf str . (forall (xs :: [Symbol]) . Enc xs conf str -> f (Enc (nm ': xs) conf str)) -> Encoding f nm (AlgNm nm) conf str
_mkEncoding = UnsafeMkEncoding Proxy

-- |
-- @since 0.3.0.0
runEncoding' :: forall alg nm f xs conf str . Encoding f nm alg conf str -> Enc xs conf str -> f (Enc (nm ': xs) conf str)
runEncoding' (UnsafeMkEncoding _ fn) = fn

-- | Same as 'runEncoding'' but compiler figures out algorithm name
--
-- Using it can slowdown compilation
--
-- This combinator has @Algorithm nm alg@ constraint (which stands for @TakeUntil ":" nm ~ alg@.
-- If rules on @alg@ are relaxed this will just return the /default/ algorithm.
--
-- If that happens @-XTypeApplications@ annotations will be needed and @_@ methods will simply 
-- use default algorithm name.
--
-- @since 0.3.0.0
_runEncoding :: forall nm f xs conf str alg . (Algorithm nm alg) => Encoding f nm alg conf str -> Enc xs conf str -> f (Enc (nm ': xs) conf str)
_runEncoding = runEncoding' @(AlgNm nm)

-- |
-- HList like construction that defines a list of @Encoding@ elements.
--
-- This type is used by programs using / manipulating encodings.
--
-- Can be easily accessed with 'Data.TypedEncoding.Common.Class.Encode.EncodeAll' constraint using
-- 'Data.TypedEncoding.Common.Class.Encode.EncodeAll.encodings'.  But could also be used by creating
-- @Encodings@ list by hand.
--
-- @since 0.3.0.0
data Encodings f (nms :: [Symbol]) (algs :: [Symbol]) conf str where
    -- | constructor is to be treated as Unsafe to Encode and Decode instance implementations
    -- particular encoding instances may expose smart constructors for limited data types
    ZeroE :: Encodings f '[] '[] conf str
    ConsE ::  Encoding f nm alg conf str -> Encodings f nms algs conf str -> Encodings f (nm ': nms) (alg ': algs) conf str

-- |
-- Runs encodings, requires -XTypeApplication annotation specifying the algorithm(s)
--
-- >>> runEncodings' @'["r-ban"] encodings . toEncoding () $ ("22") :: Either EncodeEx (Enc '["r-ban:111"] () T.Text)
-- Left (EncodeEx "r-ban:111" ("Input list has wrong size expecting 3 but length \"22\" == 2"))
--
-- @since 0.3.0.0
runEncodings' :: forall algs nms f c str . (Monad f) => Encodings f nms algs c str -> Enc ('[]::[Symbol]) c str -> f (Enc nms c str)
runEncodings' ZeroE enc0 = pure enc0
runEncodings' (ConsE fn enc) enc0 =
        let re :: f (Enc _ c str) = runEncodings' enc enc0
        in re >>= runEncoding' fn


-- | At a possibly some compilation cost, have compiler figure out algorithm names.
--
-- >>> _runEncodings encodings . toEncoding () $ ("Hello World") :: Identity (Enc '["enc-B64","enc-B64"] () B.ByteString)
-- Identity (UnsafeMkEnc Proxy () "U0dWc2JHOGdWMjl5YkdRPQ==")
-- 
-- >>> _runEncodings encodings . toEncoding () $ ("22") :: Either EncodeEx (Enc '["r-ban:111"] () T.Text)
-- Left (EncodeEx "r-ban:111" ("Input list has wrong size expecting 3 but length \"22\" == 2"))
--
-- (see also '_runEncoding')
-- @since 0.3.0.0
_runEncodings :: forall nms f c str algs . (Monad f, algs ~ AlgNmMap nms) => Encodings f nms algs c str -> Enc ('[]::[Symbol]) c str -> f (Enc nms c str)
_runEncodings = runEncodings' @(AlgNmMap nms)