{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
module Data.TypedEncoding.Instances.Support.Helpers where
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
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
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
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)
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)
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
verifyDynEnc :: forall s str err1 err2 dec a. (KnownSymbol s, Show err1, Show err2) =>
Proxy s
-> (Proxy s -> Either err1 dec)
-> (dec -> str -> Either err2 a)
-> str
-> 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