{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ConstraintKinds #-}
module Data.TypedEncoding.Pkg.Encoding.Conv where
import qualified Data.TypedEncoding.Instances.Support as Typed
import qualified Data.Encoding as Encoding
import GHC.TypeLits
import Data.Proxy
import qualified Data.List as L
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
type family IsDynEnc (s :: Symbol) :: Bool where
IsDynEnc s = Typed.AcceptEq ('Text "Not encoding restriction " ':<>: ShowType s ) (CmpSymbol (Typed.TakeUntil s ":") "enc-pkg/encoding")
type DynEnc s = (KnownSymbol s, IsDynEnc s ~ 'True)
encodeStrictByteStringExplicit :: forall s xs c .
(
DynEnc s
, Typed.Algorithm s "enc-pkg/encoding"
) =>
Typed.Enc xs c String -> Either Typed.EncodeEx (Typed.Enc (s ': xs) c B.ByteString)
encodeStrictByteStringExplicit s =
do
enc <- Typed.asEncodeEx p . exferDynEncoding $ p
Typed.withUnsafeCoerceF (Typed.asEncodeEx p . Encoding.encodeStrictByteStringExplicit enc) s
where
p = Proxy :: Proxy s
encodeLazyByteStringExplicit :: forall s xs c .
(
DynEnc s
, Typed.Algorithm s "enc-pkg/encoding"
) =>
Typed.Enc xs c String -> Either Typed.EncodeEx (Typed.Enc (s ': xs) c BL.ByteString)
encodeLazyByteStringExplicit s =
do
enc <- Typed.asEncodeEx p $ exferDynEncoding p
Typed.withUnsafeCoerceF (Typed.asEncodeEx p . Encoding.encodeLazyByteStringExplicit enc) s
where
p = Proxy :: Proxy s
encodeStringExplicit :: forall s xs c .
(
DynEnc s
, Typed.Algorithm s "enc-pkg/encoding"
) =>
Typed.Enc xs c String -> Either Typed.EncodeEx (Typed.Enc (s ': xs) c String)
encodeStringExplicit s =
do
enc <- Typed.asEncodeEx p $ exferDynEncoding p
Typed.withUnsafeCoerceF (Typed.asEncodeEx p . Encoding.encodeStringExplicit enc) s
where
p = Proxy :: Proxy s
encString :: forall s xs c .
(
DynEnc s
, Typed.Algorithm s "enc-pkg/encoding"
) =>
Typed.Encoding (Either Typed.EncodeEx) s "enc-pkg/encoding" c String
encString = Typed._mkEncoding encodeStringExplicit
decodeStrictByteStringExplicit :: forall s xs f c .
(Typed.UnexpectedDecodeErr f
, Monad f
, DynEnc s
, Typed.Algorithm s "enc-pkg/encoding"
) =>
Typed.Enc (s ': xs) c B.ByteString -> f (Typed.Enc xs c String)
decodeStrictByteStringExplicit x =
do
enc <- Typed.asUnexpected @s . exferDynEncoding $ p
Typed.withUnsafeCoerceF (Typed.asUnexpected @s . Encoding.decodeStrictByteStringExplicit enc) x
where p = Proxy :: Proxy s
decodeLazyByteStringExplicit :: forall s xs f c .
(Typed.UnexpectedDecodeErr f
, Monad f
, DynEnc s
, Typed.Algorithm s "enc-pkg/encoding"
) =>
Typed.Enc (s ': xs) c BL.ByteString -> f (Typed.Enc xs c String)
decodeLazyByteStringExplicit x =
do
enc <- Typed.asUnexpected @s . exferDynEncoding $ p
Typed.withUnsafeCoerceF (Typed.asUnexpected @s . Encoding.decodeLazyByteStringExplicit enc) x
where p = Proxy :: Proxy s
decodeStringExplicit :: forall s xs f c .
(Typed.UnexpectedDecodeErr f
, Monad f
, DynEnc s
, Typed.Algorithm s "enc-pkg/encoding"
) =>
Typed.Enc (s ': xs) c String -> f (Typed.Enc xs c String)
decodeStringExplicit x =
do
enc <- Typed.asUnexpected @s . exferDynEncoding $ p
Typed.withUnsafeCoerceF (Typed.asUnexpected @s . Encoding.decodeStringExplicit enc) x
where p = Proxy :: Proxy s
decString :: forall s xs f c .
(Typed.UnexpectedDecodeErr f
, Monad f
, DynEnc s
, Typed.Algorithm s "enc-pkg/encoding"
) =>
Typed.Decoding f s "enc-pkg/encoding" c String
decString = Typed.mkDecoding decodeStringExplicit
getDynEncoding :: forall s xs c str. (DynEnc s) => Typed.Enc (s ': xs) c str -> Encoding.DynEncoding
getDynEncoding _ = Encoding.encodingFromString nm
where
p = Proxy :: Proxy s
nm = L.drop 8 . symbolVal $ p
exferDynEncoding :: (KnownSymbol s, DynEnc s) => Proxy s -> Either String Encoding.DynEncoding
exferDynEncoding p = explainMaybe ("Invalid encoding " ++ nm) . Encoding.encodingFromStringExplicit $ nm
where
nm = L.drop 17 . symbolVal $ p
explainMaybe _ (Just x) = Right x
explainMaybe msg Nothing = Left msg