{-# 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 #-}
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
data Enc nms conf str where
UnsafeMkEnc :: Proxy nms -> conf -> str -> Enc nms conf str
deriving (Int -> Enc @k nms conf str -> ShowS
[Enc @k nms conf str] -> ShowS
Enc @k nms conf str -> String
(Int -> Enc @k nms conf str -> ShowS)
-> (Enc @k nms conf str -> String)
-> ([Enc @k nms conf str] -> ShowS)
-> Show (Enc @k nms conf str)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (nms :: k) conf str.
(Show conf, Show str) =>
Int -> Enc @k nms conf str -> ShowS
forall k (nms :: k) conf str.
(Show conf, Show str) =>
[Enc @k nms conf str] -> ShowS
forall k (nms :: k) conf str.
(Show conf, Show str) =>
Enc @k nms conf str -> String
showList :: [Enc @k nms conf str] -> ShowS
$cshowList :: forall k (nms :: k) conf str.
(Show conf, Show str) =>
[Enc @k nms conf str] -> ShowS
show :: Enc @k nms conf str -> String
$cshow :: forall k (nms :: k) conf str.
(Show conf, Show str) =>
Enc @k nms conf str -> String
showsPrec :: Int -> Enc @k nms conf str -> ShowS
$cshowsPrec :: forall k (nms :: k) conf str.
(Show conf, Show str) =>
Int -> Enc @k nms conf str -> ShowS
Show, Enc @k nms conf str -> Enc @k nms conf str -> Bool
(Enc @k nms conf str -> Enc @k nms conf str -> Bool)
-> (Enc @k nms conf str -> Enc @k nms conf str -> Bool)
-> Eq (Enc @k nms conf str)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (nms :: k) conf str.
(Eq conf, Eq str) =>
Enc @k nms conf str -> Enc @k nms conf str -> Bool
/= :: Enc @k nms conf str -> Enc @k nms conf str -> Bool
$c/= :: forall k (nms :: k) conf str.
(Eq conf, Eq str) =>
Enc @k nms conf str -> Enc @k nms conf str -> Bool
== :: Enc @k nms conf str -> Enc @k nms conf str -> Bool
$c== :: forall k (nms :: k) conf str.
(Eq conf, Eq str) =>
Enc @k nms conf str -> Enc @k nms conf str -> Bool
Eq)
instance (SymbolList xs, Show c, Displ str) => Displ ( Enc xs c str) where
displ :: Enc @[Symbol] xs c str -> String
displ (UnsafeMkEnc Proxy @[Symbol] xs
p c
c str
s) =
String
"Enc '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy @[Symbol] xs -> String
forall x. Displ x => x -> String
displ (Proxy @[Symbol] xs
forall k (t :: k). Proxy @k t
Proxy :: Proxy xs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ c -> String
forall a. Show a => a -> String
show c
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ str -> String
forall x. Displ x => x -> String
displ str
s
toEncoding :: conf -> str -> Enc ('[] :: [Symbol]) conf str
toEncoding :: conf -> str -> Enc @[Symbol] ('[] @Symbol) conf str
toEncoding = Proxy @[Symbol] ('[] @Symbol)
-> conf -> str -> Enc @[Symbol] ('[] @Symbol) conf str
forall k (nms :: k) conf str.
Proxy @k nms -> conf -> str -> Enc @k nms conf str
UnsafeMkEnc Proxy @[Symbol] ('[] @Symbol)
forall k (t :: k). Proxy @k t
Proxy
fromEncoding :: Enc '[] conf str -> str
fromEncoding :: Enc @[k] ('[] @k) conf str -> str
fromEncoding = Enc @[k] ('[] @k) conf str -> str
forall k (enc :: k) conf str. Enc @k enc conf str -> str
getPayload
getPayload :: Enc enc conf str -> str
getPayload :: Enc @k enc conf str -> str
getPayload (UnsafeMkEnc Proxy @k enc
_ conf
_ str
str) = str
str
getContent :: Enc enc conf str -> (conf, str)
getContent :: Enc @k enc conf str -> (conf, str)
getContent (UnsafeMkEnc Proxy @k enc
_ conf
c str
str) = (conf
c, str
str)
data Encoding f (nm :: Symbol) (alg :: Symbol) conf str where
UnsafeMkEncoding :: Proxy nm -> (forall (xs :: [Symbol]) . Enc xs conf str -> f (Enc (nm ': xs) conf str)) -> Encoding f nm alg conf str
_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 :: (forall (xs :: [Symbol]).
Enc @[Symbol] xs conf str
-> f (Enc @[Symbol] ((':) @Symbol nm xs) conf str))
-> Encoding f nm (AlgNm nm) conf str
_mkEncoding = Proxy @Symbol nm
-> (forall (xs :: [Symbol]).
Enc @[Symbol] xs conf str
-> f (Enc @[Symbol] ((':) @Symbol nm xs) conf str))
-> Encoding f nm (Concat (LTakeUntil (ToList1 nm "") ":")) conf str
forall (nm :: Symbol) conf str (f :: * -> *) (alg :: Symbol).
Proxy @Symbol nm
-> (forall (xs :: [Symbol]).
Enc @[Symbol] xs conf str
-> f (Enc @[Symbol] ((':) @Symbol nm xs) conf str))
-> Encoding f nm alg conf str
UnsafeMkEncoding Proxy @Symbol nm
forall k (t :: k). Proxy @k t
Proxy
_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 :: (Enc @[Symbol] ('[] @Symbol) conf str
-> f (Enc @[Symbol] ((':) @Symbol nm ('[] @Symbol)) conf str))
-> Encoding f nm (AlgNm nm) conf str
_mkEncoding1 Enc @[Symbol] ('[] @Symbol) conf str
-> f (Enc @[Symbol] ((':) @Symbol nm ('[] @Symbol)) conf str)
fn = Proxy @Symbol nm
-> (forall (xs :: [Symbol]).
Enc @[Symbol] xs conf str
-> f (Enc @[Symbol] ((':) @Symbol nm xs) conf str))
-> Encoding f nm (Concat (LTakeUntil (ToList1 nm "") ":")) conf str
forall (nm :: Symbol) conf str (f :: * -> *) (alg :: Symbol).
Proxy @Symbol nm
-> (forall (xs :: [Symbol]).
Enc @[Symbol] xs conf str
-> f (Enc @[Symbol] ((':) @Symbol nm xs) conf str))
-> Encoding f nm alg conf str
UnsafeMkEncoding Proxy @Symbol nm
forall k (t :: k). Proxy @k t
Proxy ((Enc @[Symbol] ((':) @Symbol nm ('[] @Symbol)) conf str
-> Enc @[Symbol] ((':) @Symbol nm xs) conf str)
-> f (Enc @[Symbol] ((':) @Symbol nm ('[] @Symbol)) conf str)
-> f (Enc @[Symbol] ((':) @Symbol nm xs) conf str)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Proxy @[Symbol] ((':) @Symbol nm xs)
-> (conf, str) -> Enc @[Symbol] ((':) @Symbol nm xs) conf str
forall k (nms :: k) conf str.
Proxy @k nms -> (conf, str) -> Enc @k nms conf str
mkenc Proxy @[Symbol] ((':) @Symbol nm xs)
forall k (t :: k). Proxy @k t
Proxy ((conf, str) -> Enc @[Symbol] ((':) @Symbol nm xs) conf str)
-> (Enc @[Symbol] ((':) @Symbol nm ('[] @Symbol)) conf str
-> (conf, str))
-> Enc @[Symbol] ((':) @Symbol nm ('[] @Symbol)) conf str
-> Enc @[Symbol] ((':) @Symbol nm xs) conf str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enc @[Symbol] ((':) @Symbol nm ('[] @Symbol)) conf str
-> (conf, str)
forall k (enc :: k) conf str. Enc @k enc conf str -> (conf, str)
getContent) (f (Enc @[Symbol] ((':) @Symbol nm ('[] @Symbol)) conf str)
-> f (Enc @[Symbol] ((':) @Symbol nm xs) conf str))
-> (Enc @[Symbol] xs conf str
-> f (Enc @[Symbol] ((':) @Symbol nm ('[] @Symbol)) conf str))
-> Enc @[Symbol] xs conf str
-> f (Enc @[Symbol] ((':) @Symbol nm xs) conf str)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enc @[Symbol] ('[] @Symbol) conf str
-> f (Enc @[Symbol] ((':) @Symbol nm ('[] @Symbol)) conf str)
fn (Enc @[Symbol] ('[] @Symbol) conf str
-> f (Enc @[Symbol] ((':) @Symbol nm ('[] @Symbol)) conf str))
-> (Enc @[Symbol] xs conf str
-> Enc @[Symbol] ('[] @Symbol) conf str)
-> Enc @[Symbol] xs conf str
-> f (Enc @[Symbol] ((':) @Symbol nm ('[] @Symbol)) conf str)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy @[Symbol] ('[] @Symbol)
-> (conf, str) -> Enc @[Symbol] ('[] @Symbol) conf str
forall k (nms :: k) conf str.
Proxy @k nms -> (conf, str) -> Enc @k nms conf str
mkenc Proxy @[Symbol] ('[] @Symbol)
forall k (t :: k). Proxy @k t
Proxy ((conf, str) -> Enc @[Symbol] ('[] @Symbol) conf str)
-> (Enc @[Symbol] xs conf str -> (conf, str))
-> Enc @[Symbol] xs conf str
-> Enc @[Symbol] ('[] @Symbol) conf str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enc @[Symbol] xs conf str -> (conf, str)
forall k (enc :: k) conf str. Enc @k enc conf str -> (conf, str)
getContent)
where
mkenc :: Proxy @k nms -> (conf, str) -> Enc @k nms conf str
mkenc Proxy @k nms
p (conf
c,str
s) = Proxy @k nms -> conf -> str -> Enc @k nms conf str
forall k (nms :: k) conf str.
Proxy @k nms -> conf -> str -> Enc @k nms conf str
UnsafeMkEnc Proxy @k nms
p conf
c str
s
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' :: Encoding f nm alg conf str
-> Enc @[Symbol] xs conf str
-> f (Enc @[Symbol] ((':) @Symbol nm xs) conf str)
runEncoding' (UnsafeMkEncoding Proxy @Symbol nm
_ forall (xs :: [Symbol]).
Enc @[Symbol] xs conf str
-> f (Enc @[Symbol] ((':) @Symbol nm xs) conf str)
fn) = Enc @[Symbol] xs conf str
-> f (Enc @[Symbol] ((':) @Symbol nm xs) conf str)
forall (xs :: [Symbol]).
Enc @[Symbol] xs conf str
-> f (Enc @[Symbol] ((':) @Symbol nm xs) conf str)
fn
runEncoding1' :: forall alg nm f conf str . Encoding f nm alg conf str -> Enc ('[] :: [Symbol]) conf str -> f (Enc '[nm] conf str)
runEncoding1' :: Encoding f nm alg conf str
-> Enc @[Symbol] ('[] @Symbol) conf str
-> f (Enc @[Symbol] ((':) @Symbol nm ('[] @Symbol)) conf str)
runEncoding1' = forall conf str.
Encoding f nm alg conf str
-> Enc @[Symbol] ('[] @Symbol) conf str
-> f (Enc @[Symbol] ((':) @Symbol nm ('[] @Symbol)) conf str)
forall (alg :: Symbol) (nm :: Symbol) (f :: * -> *)
(xs :: [Symbol]) conf str.
Encoding f nm alg conf str
-> Enc @[Symbol] xs conf str
-> f (Enc @[Symbol] ((':) @Symbol nm xs) conf str)
runEncoding' @alg @nm @f @'[]
_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 :: Encoding f nm alg conf str
-> Enc @[Symbol] xs conf str
-> f (Enc @[Symbol] ((':) @Symbol nm xs) conf str)
_runEncoding = forall (alg :: Symbol) (nm :: Symbol) (f :: * -> *)
(xs :: [Symbol]) conf str.
Encoding f nm alg conf str
-> Enc @[Symbol] xs conf str
-> f (Enc @[Symbol] ((':) @Symbol nm xs) conf str)
forall (nm :: Symbol) (f :: * -> *) (xs :: [Symbol]) conf str.
Encoding f nm (AlgNm nm) conf str
-> Enc @[Symbol] xs conf str
-> f (Enc @[Symbol] ((':) @Symbol nm xs) conf str)
runEncoding' @(AlgNm nm)
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
-:- :: Encoding f nm alg conf str
-> Encodings f nms algs conf str
-> Encodings
f ((':) @Symbol nm nms) ((':) @Symbol alg algs) conf str
(-:-) = Encoding f nm alg conf str
-> Encodings f nms algs conf str
-> Encodings
f ((':) @Symbol nm nms) ((':) @Symbol alg algs) conf str
forall (f :: * -> *) (nm :: Symbol) (alg :: Symbol) conf str
(nms :: [Symbol]) (algs :: [Symbol]).
Encoding f nm alg conf str
-> Encodings f nms algs conf str
-> Encodings
f ((':) @Symbol nm nms) ((':) @Symbol alg algs) conf str
ConsE
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' :: Encodings f nms algs c str
-> Enc @[Symbol] ('[] @Symbol) c str -> f (Enc @[Symbol] nms c str)
runEncodings' Encodings f nms algs c str
ZeroE Enc @[Symbol] ('[] @Symbol) c str
enc0 = Enc @[Symbol] ('[] @Symbol) c str
-> f (Enc @[Symbol] ('[] @Symbol) c str)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Enc @[Symbol] ('[] @Symbol) c str
enc0
runEncodings' (ConsE Encoding f nm alg c str
fn Encodings f nms algs c str
enc) Enc @[Symbol] ('[] @Symbol) c str
enc0 =
let f (Enc @[Symbol] nms c str)
re :: f (Enc _ c str) = Encodings f nms algs c str
-> Enc @[Symbol] ('[] @Symbol) c str -> f (Enc @[Symbol] nms c str)
forall (algs :: [Symbol]) (nms :: [Symbol]) (f :: * -> *) c str.
Monad f =>
Encodings f nms algs c str
-> Enc @[Symbol] ('[] @Symbol) c str -> f (Enc @[Symbol] nms c str)
runEncodings' Encodings f nms algs c str
enc Enc @[Symbol] ('[] @Symbol) c str
enc0
in f (Enc @[Symbol] nms c str)
re f (Enc @[Symbol] nms c str)
-> (Enc @[Symbol] nms c str
-> f (Enc @[Symbol] ((':) @Symbol nm nms) c str))
-> f (Enc @[Symbol] ((':) @Symbol nm nms) c str)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Encoding f nm alg c str
-> Enc @[Symbol] nms c str
-> f (Enc @[Symbol] ((':) @Symbol nm nms) c str)
forall (alg :: Symbol) (nm :: Symbol) (f :: * -> *)
(xs :: [Symbol]) conf str.
Encoding f nm alg conf str
-> Enc @[Symbol] xs conf str
-> f (Enc @[Symbol] ((':) @Symbol nm xs) conf str)
runEncoding' Encoding f nm alg c str
fn
_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 :: Encodings f nms algs c str
-> Enc @[Symbol] ('[] @Symbol) c str -> f (Enc @[Symbol] nms c str)
_runEncodings = forall (algs :: [Symbol]) (nms :: [Symbol]) (f :: * -> *) c str.
Monad f =>
Encodings f nms algs c str
-> Enc @[Symbol] ('[] @Symbol) c str -> f (Enc @[Symbol] nms c str)
forall (nms :: [Symbol]) (f :: * -> *) c str.
Monad f =>
Encodings f nms (AlgNmMap nms) c str
-> Enc @[Symbol] ('[] @Symbol) c str -> f (Enc @[Symbol] nms c str)
runEncodings' @(AlgNmMap nms)