{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeApplications #-}
module Data.TypedEncoding.Common.Class.Decode where
import Data.TypedEncoding.Common.Types (UnexpectedDecodeEx(..))
import Data.TypedEncoding.Common.Types.Decoding
import Data.Proxy
import Data.Functor.Identity
import GHC.TypeLits
class Decode f nm alg conf str where
decoding :: Decoding f nm alg conf str
class DecodeAll f nms algs conf str where
decodings :: Decodings f nms algs conf str
instance DecodeAll f '[] '[] conf str where
decodings :: Decodings f ('[] @Symbol) ('[] @Symbol) conf str
decodings = Decodings f ('[] @Symbol) ('[] @Symbol) conf str
forall (f :: * -> *) conf str.
Decodings f ('[] @Symbol) ('[] @Symbol) conf str
ZeroD
instance (DecodeAll f nms algs conf str, Decode f nm alg conf str) => DecodeAll f (nm ': nms) (alg ': algs) conf str where
decodings :: Decodings f ((':) @Symbol nm nms) ((':) @Symbol alg algs) conf str
decodings = Decoding f nm alg conf str
-> Decodings f nms algs conf str
-> Decodings
f ((':) @Symbol nm nms) ((':) @Symbol alg algs) conf str
forall (f :: * -> *) (nm :: Symbol) (alg :: Symbol) conf str
(nms :: [Symbol]) (algs :: [Symbol]).
Decoding f nm alg conf str
-> Decodings f nms algs conf str
-> Decodings
f ((':) @Symbol nm nms) ((':) @Symbol alg algs) conf str
ConsD Decoding f nm alg conf str
forall (f :: * -> *) (nm :: Symbol) (alg :: Symbol) conf str.
Decode f nm alg conf str =>
Decoding f nm alg conf str
decoding Decodings f nms algs conf str
forall (f :: * -> *) (nms :: [Symbol]) (algs :: [Symbol]) conf str.
DecodeAll f nms algs conf str =>
Decodings f nms algs conf str
decodings
class UnexpectedDecodeErr f where
unexpectedDecodeErr :: UnexpectedDecodeEx -> f a
instance UnexpectedDecodeErr Identity where
unexpectedDecodeErr :: UnexpectedDecodeEx -> Identity a
unexpectedDecodeErr UnexpectedDecodeEx
x = [Char] -> Identity a
forall a. HasCallStack => [Char] -> a
error ([Char] -> Identity a) -> [Char] -> Identity a
forall a b. (a -> b) -> a -> b
$ UnexpectedDecodeEx -> [Char]
forall a. Show a => a -> [Char]
show UnexpectedDecodeEx
x
instance UnexpectedDecodeErr (Either UnexpectedDecodeEx) where
unexpectedDecodeErr :: UnexpectedDecodeEx -> Either UnexpectedDecodeEx a
unexpectedDecodeErr = UnexpectedDecodeEx -> Either UnexpectedDecodeEx a
forall a b. a -> Either a b
Left
asUnexpected_ :: (KnownSymbol x, UnexpectedDecodeErr f, Applicative f, Show err) => Proxy x -> Either err a -> f a
asUnexpected_ :: Proxy @Symbol x -> Either err a -> f a
asUnexpected_ Proxy @Symbol x
p (Left err
err) = UnexpectedDecodeEx -> f a
forall k (f :: k -> *) (a :: k).
UnexpectedDecodeErr @k f =>
UnexpectedDecodeEx -> f a
unexpectedDecodeErr (UnexpectedDecodeEx -> f a) -> UnexpectedDecodeEx -> f a
forall a b. (a -> b) -> a -> b
$ Proxy @Symbol x -> err -> UnexpectedDecodeEx
forall a (x :: Symbol).
(Show a, KnownSymbol x) =>
Proxy @Symbol x -> a -> UnexpectedDecodeEx
UnexpectedDecodeEx Proxy @Symbol x
p err
err
asUnexpected_ Proxy @Symbol x
_ (Right a
r) = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
asUnexpected :: forall x f err a . (KnownSymbol x, UnexpectedDecodeErr f, Applicative f, Show err) => Either err a -> f a
asUnexpected :: Either err a -> f a
asUnexpected = Proxy @Symbol x -> Either err a -> f a
forall (x :: Symbol) (f :: * -> *) err a.
(KnownSymbol x, UnexpectedDecodeErr @* f, Applicative f,
Show err) =>
Proxy @Symbol x -> Either err a -> f a
asUnexpected_ (Proxy @Symbol x
forall k (t :: k). Proxy @k t
Proxy :: Proxy x)