{-# 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 #-}
-- |
-- Contains main @Enc@ type that carries encoded payload as well as
-- @Encoding@ and @Encodings@ types contains encoding functions.
-- This module also contains basic combinators for these types.
--
-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly.

module Data.TypedEncoding.Common.Types.Enc where

import           Data.Proxy
import           GHC.TypeLits

import           Data.TypedEncoding.Common.Class.Common
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 (encFBan)

-- |
-- 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)

-- TODO should Enc be a Functor in conf?

-- |
-- >>> 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

-- |
-- @since 0.5.2.0
getContent :: Enc enc conf str -> (conf, str)
getContent (UnsafeMkEnc _ c str) = (c, 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.
--
-- This existential definition is intended for clarity. /typed-encoding/ supports type level lists of encodings
-- and each encoding should not know what encodings have already been applied.
--
-- However, this construction is mostly equivalent to storing a simple one level encoding function 
-- @Enc ('[]:: [Symbol]) conf str -> f (Enc '[nm] conf str)@ 
-- (see '_mkEncoding1' and 'runEncoding1'' below).  
--
-- Examples: 
--
-- @
-- Encoding (Either EncodeEx) "r-ban:9" "r-ban" () String
-- @
--
-- encodes a single character @ <= 9'@
--
-- @
-- Encoding Identity "enc-B64" "enc-B64" () ByteString
-- @
--
-- Represents a /Base 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

-- |
-- Defines encoding by only specifying a simple one level encoding function. 
-- This typically is not used in constructing encodings as there are more convenient combinators for doing this
-- (e.g. in "Data.TypedEncoding.Instances.Support").
-- It is here for completeness to show that the @Encoding@ definition is a bit overdone.
-- 
-- @since 0.5.2.0
_mkEncoding1 :: forall f (nm :: Symbol) conf str .
        Functor f  => (Enc ('[]:: [Symbol]) conf str -> f (Enc '[nm] conf str)) -> Encoding f nm (AlgNm nm) conf str
_mkEncoding1 fn = UnsafeMkEncoding Proxy (fmap (mkenc Proxy . getContent) . fn . mkenc Proxy . getContent)
  where
      mkenc p (c,s) = UnsafeMkEnc p c s

-- |
-- @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

-- |
-- Version of @runEncoding'@ function specialized to empty encoding
--
-- @since 0.5.2.0
runEncoding1' :: forall alg nm f  conf str . Encoding f nm alg conf str -> Enc ('[] :: [Symbol]) conf str -> f (Enc '[nm] conf str)
runEncoding1'  = runEncoding' @alg @nm @f @'[]

-- | Same as 'runEncoding'' but compiler figures out algorithm name
--
-- Using it can slowdown compilation
--
-- This combinator has @Algorithm nm alg@ constraint (which currently stands for @TakeUntil ":" nm ~ alg@.
--
-- @runEncoding@ functions are typically not used directly, @runEncodings@ functions defined below or @encodeAll@ 
-- functions are used instead.  
--
-- In the following example (and other examples) we use displ convenience function that provides String display of the encoding.
-- The @"r-ban:111"@ allows only strings with 3 characters satisfying alphanumeric bound of '1'
--
-- >>> fmap displ (_runEncoding encFBan $ toEncoding () "000" :: Either EncodeEx (Enc '["r-ban:111"] () T.Text))
-- Right "Enc '[r-ban:111] () (Text 000)"
--
-- @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
    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

infixr 5 -:-
(-:-) ::  Encoding f nm alg conf str -> Encodings f nms algs conf str -> Encodings f (nm ': nms) (alg ': algs) conf str
(-:-) = ConsE

-- |
-- Runs encodings, requires -XTypeApplication annotation specifying the algorithm(s)
--
-- >>> runEncodings' @'["r-ban"] (encFBan -:- ZeroE) . toEncoding () $ "000" :: Either EncodeEx (Enc '["r-ban:111"] () T.Text)
-- Right (UnsafeMkEnc Proxy () "000")
--
-- Polymorphic access to encodings is provided by @EncodeAll@ typeclass so we can simply write:
--
-- >>> 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"))
--
-- This library also offers backward compatible equivalents @encodeFAll@ to @runEncodings@ functions 
-- (see "Data.TypedEncoding.Combinators.Encode") which are basically equivalent to something like
-- @
-- runEncoding' encoding
-- @
--
-- >>> encodeFAll' @'["r-ban"] . toEncoding () $ "111" :: Either EncodeEx (Enc '["r-ban:111"] () T.Text)
-- Right (UnsafeMkEnc Proxy () "111")
--
-- >>> fmap displ . encodeFAll' @'["r-ban"] @'["r-ban:111"] @(Either EncodeEx) @() @T.Text . toEncoding () $ "111"
-- Right "Enc '[r-ban:111] () (Text 111)"
--
-- @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)