{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- {-# LANGUAGE AllowAmbiguousTypes #-}
-- {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}

-- | Various helper functions.
-- There are mostly for for creating @ToEncString@ and @FromEncString@ instances

module Data.TypedEncoding.Instances.Support.Helpers where

-- import           Data.String
import           Data.Proxy
import           Text.Read
import           Data.TypedEncoding.Common.Types
import           Data.TypedEncoding.Combinators.Unsafe
import           Data.TypedEncoding.Common.Class.IsStringR 
import           GHC.TypeLits


-- $setup
-- >>> :set -XTypeApplications
-- >>> import qualified Data.Text as T
-- >>> import           Data.Word


-- * Composite encodings from 'Foldable' 'Functor' types

-- | allows to fold payload in Enc to create another Enc, assumes homogeneous input encodings.
-- This yields not a type safe code, better implementation code should use fixed size
-- dependently typed @Vect n@ or some @HList@ like foldable.
--
-- @since 0.2.0.0
foldEnc :: forall (xs2 :: [Symbol]) (xs1 :: [Symbol]) f c s1 s2 
           . (Foldable f, Functor f) 
           => c -> (s1 -> s2 -> s2) -> s2 -> f (Enc xs1 c s1) -> Enc xs2 c s2
foldEnc :: c
-> (s1 -> s2 -> s2)
-> s2
-> f (Enc @[Symbol] xs1 c s1)
-> Enc @[Symbol] xs2 c s2
foldEnc c
c s1 -> s2 -> s2
f s2
sinit = c -> s2 -> Enc @[Symbol] xs2 c s2
forall k conf str (enc :: k). conf -> str -> Enc @k enc conf str
unsafeSetPayload c
c (s2 -> Enc @[Symbol] xs2 c s2)
-> (f (Enc @[Symbol] xs1 c s1) -> s2)
-> f (Enc @[Symbol] xs1 c s1)
-> Enc @[Symbol] xs2 c s2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s1 -> s2 -> s2) -> s2 -> f s1 -> s2
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr s1 -> s2 -> s2
f s2
sinit (f s1 -> s2)
-> (f (Enc @[Symbol] xs1 c s1) -> f s1)
-> f (Enc @[Symbol] xs1 c s1)
-> s2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Enc @[Symbol] xs1 c s1 -> s1)
-> f (Enc @[Symbol] xs1 c s1) -> f s1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Enc @[Symbol] xs1 c s1 -> s1
forall k (enc :: k) conf str. Enc @k enc conf str -> str
getPayload 


-- | Similar to 'foldEnc', works with untyped 'CheckedEnc'
--
-- @since 0.2.0.0
foldCheckedEnc :: forall (xs2 :: [Symbol]) f c s1 s2 
             . (Foldable f, Functor f) 
             => c -> ([EncAnn] -> s1 -> s2 -> s2) -> s2 -> f (CheckedEnc c s1) -> Enc xs2 c s2
foldCheckedEnc :: c
-> ([EncAnn] -> s1 -> s2 -> s2)
-> s2
-> f (CheckedEnc c s1)
-> Enc @[Symbol] xs2 c s2
foldCheckedEnc c
c [EncAnn] -> s1 -> s2 -> s2
f s2
sinit = c -> s2 -> Enc @[Symbol] xs2 c s2
forall k conf str (enc :: k). conf -> str -> Enc @k enc conf str
unsafeSetPayload c
c (s2 -> Enc @[Symbol] xs2 c s2)
-> (f (CheckedEnc c s1) -> s2)
-> f (CheckedEnc c s1)
-> Enc @[Symbol] xs2 c s2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([EncAnn], s1) -> s2 -> s2) -> s2 -> f ([EncAnn], s1) -> s2
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (([EncAnn] -> s1 -> s2 -> s2) -> ([EncAnn], s1) -> s2 -> s2
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [EncAnn] -> s1 -> s2 -> s2
f) s2
sinit (f ([EncAnn], s1) -> s2)
-> (f (CheckedEnc c s1) -> f ([EncAnn], s1))
-> f (CheckedEnc c s1)
-> s2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CheckedEnc c s1 -> ([EncAnn], s1))
-> f (CheckedEnc c s1) -> f ([EncAnn], s1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CheckedEnc c s1 -> ([EncAnn], s1)
forall conf str. CheckedEnc conf str -> ([EncAnn], str)
getCheckedEncPayload



-- * Composite encoding: Recreate and Encode helpers

-- | Splits composite payload into homogeneous chunks
--
-- @since 0.2.0.0
splitPayload :: forall (xs2 :: [Symbol]) (xs1 :: [Symbol]) c s1 s2 . 
             (s1 -> [s2]) 
             -> Enc xs1 c s1 
             -> [Enc xs2 c s2]
splitPayload :: (s1 -> [s2]) -> Enc @[Symbol] xs1 c s1 -> [Enc @[Symbol] xs2 c s2]
splitPayload s1 -> [s2]
f (UnsafeMkEnc Proxy @[Symbol] xs1
_ c
c s1
s1) = (s2 -> Enc @[Symbol] xs2 c s2) -> [s2] -> [Enc @[Symbol] xs2 c s2]
forall a b. (a -> b) -> [a] -> [b]
map (Proxy @[Symbol] xs2 -> c -> s2 -> Enc @[Symbol] xs2 c s2
forall k (nms :: k) conf str.
Proxy @k nms -> conf -> str -> Enc @k nms conf str
UnsafeMkEnc Proxy @[Symbol] xs2
forall k (t :: k). Proxy @k t
Proxy c
c) (s1 -> [s2]
f s1
s1)
   
-- | Untyped version of 'splitPayload'
--
-- (renamed from @splitCheckedPayload@ in previous versions)
-- @since 0.5.0.0
splitCheckedPayload :: forall c s1 s2 . 
             ([EncAnn] -> s1 -> [([EncAnn], s2)]) 
             -> CheckedEnc c s1 
             -> [CheckedEnc c s2]
splitCheckedPayload :: ([EncAnn] -> s1 -> [([EncAnn], s2)])
-> CheckedEnc c s1 -> [CheckedEnc c s2]
splitCheckedPayload [EncAnn] -> s1 -> [([EncAnn], s2)]
f (UnsafeMkCheckedEnc [EncAnn]
ann1 c
c s1
s1) = (([EncAnn], s2) -> CheckedEnc c s2)
-> [([EncAnn], s2)] -> [CheckedEnc c s2]
forall a b. (a -> b) -> [a] -> [b]
map (\([EncAnn]
ann2, s2
s2) -> [EncAnn] -> c -> s2 -> CheckedEnc c s2
forall conf str. [EncAnn] -> conf -> str -> CheckedEnc conf str
UnsafeMkCheckedEnc [EncAnn]
ann2 c
c s2
s2) ([EncAnn] -> s1 -> [([EncAnn], s2)]
f [EncAnn]
ann1 s1
s1)


-- * Utility combinators 

-- | sometimes show . read is not identity, eg. Word8:
--
-- >>> read "256" :: Word8
-- 0
--
-- >>> verifyWithRead @Word8 "Word8-decimal" (T.pack "256")
-- Left "Payload does not satisfy format Word8-decimal: 256"
--
-- >>> verifyWithRead @Word8 "Word8-decimal" (T.pack "123")
-- Right "123"
--
-- @since 0.2.0.0
verifyWithRead :: forall a str . (IsStringR str, Read a, Show a) => String -> str -> Either String str
verifyWithRead :: EncAnn -> str -> Either EncAnn str
verifyWithRead EncAnn
msg str
x = 
    let s :: EncAnn
s = str -> EncAnn
forall a. IsStringR a => a -> EncAnn
toString str
x
        Maybe a
a :: Maybe a = EncAnn -> Maybe a
forall a. Read a => EncAnn -> Maybe a
readMaybe EncAnn
s
        check :: Bool
check = (a -> EncAnn
forall a. Show a => a -> EncAnn
show (a -> EncAnn) -> Maybe a -> Maybe EncAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
a) Maybe EncAnn -> Maybe EncAnn -> Bool
forall a. Eq a => a -> a -> Bool
== EncAnn -> Maybe EncAnn
forall a. a -> Maybe a
Just EncAnn
s 
    in if Bool
check
       then str -> Either EncAnn str
forall a b. b -> Either a b
Right str
x
       else EncAnn -> Either EncAnn str
forall a b. a -> Either a b
Left (EncAnn -> Either EncAnn str) -> EncAnn -> Either EncAnn str
forall a b. (a -> b) -> a -> b
$ EncAnn
"Payload does not satisfy format " EncAnn -> EncAnn -> EncAnn
forall a. [a] -> [a] -> [a]
++ EncAnn
msg EncAnn -> EncAnn -> EncAnn
forall a. [a] -> [a] -> [a]
++ EncAnn
": " EncAnn -> EncAnn -> EncAnn
forall a. [a] -> [a] -> [a]
++ EncAnn
s    


-- | Convenience function for checking if @str@ decodes without error
-- using @dec@ encoding markers and decoders that can pick decoder based
-- on that marker
--
-- @since 0.3.0.0
verifyDynEnc :: forall s str err1 err2 dec a. (KnownSymbol s, Show err1, Show err2) => 
                  Proxy s   -- ^ proxy defining encoding annotation
                  -> (Proxy s -> Either err1 dec)  -- ^ finds encoding marker @dec@ for given annotation or fails
                  -> (dec -> str -> Either err2 a)  -- ^ decoder based on @dec@ marker
                  -> str                            -- ^ input
                  -> Either EncodeEx str
verifyDynEnc :: Proxy @Symbol s
-> (Proxy @Symbol s -> Either err1 dec)
-> (dec -> str -> Either err2 a)
-> str
-> Either EncodeEx str
verifyDynEnc Proxy @Symbol s
p Proxy @Symbol s -> Either err1 dec
findenc dec -> str -> Either err2 a
decoder str
str = 
  do
    dec
enc <- Proxy @Symbol s -> Either err1 dec -> Either EncodeEx dec
forall a (x :: Symbol) b.
(Show a, KnownSymbol x) =>
Proxy @Symbol x -> Either a b -> Either EncodeEx b
asEncodeEx Proxy @Symbol s
p (Either err1 dec -> Either EncodeEx dec)
-> (Proxy @Symbol s -> Either err1 dec)
-> Proxy @Symbol s
-> Either EncodeEx dec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy @Symbol s -> Either err1 dec
findenc (Proxy @Symbol s -> Either EncodeEx dec)
-> Proxy @Symbol s -> Either EncodeEx dec
forall a b. (a -> b) -> a -> b
$ Proxy @Symbol s
p
    case dec -> str -> Either err2 a
decoder dec
enc str
str of
      Left err2
err -> EncodeEx -> Either EncodeEx str
forall a b. a -> Either a b
Left (EncodeEx -> Either EncodeEx str)
-> EncodeEx -> Either EncodeEx str
forall a b. (a -> b) -> a -> b
$ Proxy @Symbol s -> err2 -> EncodeEx
forall a (x :: Symbol).
(Show a, KnownSymbol x) =>
Proxy @Symbol x -> a -> EncodeEx
EncodeEx Proxy @Symbol s
p err2
err
      Right a
r -> str -> Either EncodeEx str
forall a b. b -> Either a b
Right str
str