packages feed

typed-encoding 0.2.2.0 → 0.3.0.0

raw patch · 83 files changed

+3653/−2838 lines, 83 files

Files

ChangeLog.md view
@@ -2,17 +2,39 @@  ## Anticipated future breaking changes -- ByteString / Text conversion functions in `Data.TypedEncoding.Instances.Restriction.ASCII`, -  `Data.TypedEncoding.Instances.Restriction.ASCII` and `Data.TypedEncoding.Instances.Enc.Base64`-  are now deprecated and will be removed.-- `EncodeFAll`, `DecodeFAll`, `RecreateFAll`, `EncodeF`, etc do not work well with more open -   encoding  annotation such as `"r-ban:soething"` they will be either changed or deprecated / replaced with constructions similar to `Encoder` in `Data.TypedEncoding.Internal.Class.Encoder`. - `Data.TypedEncoding.Internal.Class.IsStringR` expected to be be changed / replaced-- functions used to create encoding instances or encoding combinators (e.g. `implEncodeP`) will get more constraints. -- (never ending) rework of internal module stucture to make it easier to navigate -- Instance and Combinator modules will be merged.-- Displ String instance (used in examples, will be made consistent with Text and ByteString) - (post 0.3) "enc-B64" will be moved to a different package (more distant goal)++## 0.3++- Breaking: Numerous changes on the implementation side, new version should be largely compatible on the call site except+    for small differences in constraints and order for type variables (if `-XTypeApplications` is used).+    See [v3 migration guide](https://github.com/rpeszek/typed-encoding/blob/master/doc/v3ConversionGuide.md).+  - `EncodeFAll`, `DecodeFAll`, `RecreateFAll`, `EncodeF`, `DecodeF`, `RecreateF` replaced with+     `EncodeAll`, `DecodeAll`, `ValidateAll`, `Encode`, `Decode`, `Validate`.+  - functions used to create encoding instances or encoding combinators (e.g. `implEncodeP`) are now more precisely typed+  - `Displ String` instance (used in examples, has been made consistent with Text and ByteString)+  - Modules under `Data.TypedEncoding.Combinators` merged into `Data.TypedEncoding.Instances`.+  - Modules under `Data.TypedEncoding.Internal` have been reorganized and moved outside of `Internal`. Various  changes that make the library easier to navigate. +    for better navigation and discovery.+  - some previously exported combinators (e.g. `implTranF`) have moved to `Data.TypedEncoding.Instances.Support.Unsafe` +  - `ToEncString`, `FromEncString` have more type variables and function name but backward compatible functions+    have been provided.  +  - `Superset` typeclass removed, replaced with `IsSuperset` type family.+  - Minor changes in `forall` variable order in combinators for `"r-bool:"` encodings.+  - `Encoder` type removed, replaced by `Encodings`.+  - `checkWithValidationsEnc` combinator renamed to `check`+  - (Considered private) `MkCheckedEnc` constructor became `UnsafeMkCheckedEnc`+  - (Considered private) `MkEnc` constructor became `UnsafeMkEnc`+ +- new functionality+  - new types and typeclasses are based on both encoding name and algorithm name allowing+    typeclass definitions for open encodings like `"r-ban:"` that can contain arbitrary symbol literals. +  - new set of combinators grouped into `_` (compiler decided algorithm), `'` (program specifies algorithm), and+    `algorithm name ~ encoding name` categories  +  - `above` combinator subsumes partial encoding / decoding combinators +  - `EncodingSuperset` class added+  ## 0.2.2
README.md view
@@ -63,7 +63,6 @@  Please see `Examples.TypedEncoding` it the module list. - ## Other encoding packages  My approach will be to write specific encodings (e.g. _HTTP_) or wrap encodings from other packages using separate "bridge" projects.@@ -76,15 +75,16 @@  - [typed-encoding-encoding](https://github.com/rpeszek/typed-encoding-encoding) bridges [encoding](https://github.com/dmwit/encoding) package -## Plans, some TODOs+## News  -- lensifying conversions -- better implementation type safety+- v0.3 has numerous changes and improvements.   ## Tested with+ - stack (1.9.3) lts-14.27 (ghc-8.6.5) - needs ghc >= 8.2.2, base >=4.10 for GHC.TypeLits support  ## Known issues+ - running test suite: cabal has problems with doctest, use stack      https://github.com/haskell/cabal/issues/6087
src/Data/TypedEncoding.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE DataKinds #-}  -- | -- = Overview@@ -35,7 +33,7 @@ -- -- * /encoding/ -- * /decoding/--- * /recreation/ (verification of existing payload)+-- * /validation (recreation)/ (verification of existing payload) -- * type conversions between encoded types -- -- of string-like data (@ByteString@, @Text@) that is subject of some@@ -55,24 +53,24 @@ -- == "r-" restriction / predicate -- -- * /encoding/ is a partial identity--- * /recreation/ is a partial identity (matching encoding)+-- * /validation/ is a partial identity (matching encoding) -- * /decoding/ is identity ----- Examples: @"r-UTF8"@, @"r-ASCII"@, upper alpha-numeric bound /r-ban/ restrictions like @"r-999-999-9999"@+-- Examples: @"r-UTF8"@, @"r-ASCII"@, upper alpha-numeric bound /r-ban/ restrictions like @"r-ban:999-999-9999"@ -- -- == "do-" transformations -- -- * /encoding/ applies transformation to the string (could be partial) -- * /decoding/ - typically none--- * /recreation/ - typically none but, if present, verifies the payload has expected data (e.g. only uppercase chars for "do-UPPER")+-- * /validation/ - typically none but, if present, verifies the payload has expected data (e.g. only uppercase chars for "do-UPPER") -- -- Examples: @"do-UPPER"@, @"do-lower"@, @"do-reverse"@ -- -- == "enc-" data encoding that is not "r-" -- -- * /encoding/ applies encoding transformation to the string (could be partial)--- * /decoding/ reverses the transformation (can be used as pure function)--- * /recreation/ verifies that the payload has correctly encoded data+-- * /decoding/ reverses the transformation (can be now be used as pure function)+-- * /validation/ verifies that the payload has correctly encoded data -- -- Examples: @"enc-B64"@ -- @@ -84,39 +82,26 @@ -- -- Examples:  ----- @"boolOr:(r-ban:FFFFFFFF-FFFF-FFFF-FFFF-FFFFFFFFFFFF)(r-ban:FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)"@ +-- @"boolOr:(r-ban:999-999-9999)(r-ban:(999) 999-9999)"@  -- -- "@boolNot:(r-ASCII)" -- ----- = Usage+-- = Call Site Usage -- -- To use this library import this module and one or more /instance/ or /combinator/ module. -- -- Here is list of instance modules available in typed-encoding library itself -- -- * "Data.TypedEncoding.Instances.Enc.Base64"--- * "Data.TypedEncoding.Instances.Restriction.Common" +-- * "Data.TypedEncoding.Instances.Restriction.Misc" (replaces @Common@ from v0.2) -- * "Data.TypedEncoding.Instances.Restriction.ASCII"  -- * "Data.TypedEncoding.Instances.Restriction.UTF8" +-- * "Data.TypedEncoding.Instances.Restriction.Bool" (experimental / early alpha version, moved from @Combinators@ to @Instances@ in v0.3)+-- * "Data.TypedEncoding.Instances.Restriction.BoundedAlphaNums" (moved from @Combinators@ to @Instances@ in v0.3) -- * "Data.TypedEncoding.Instances.Do.Sample" --- * "Data.TypedEncoding.Instances.ToEncString.Common"  -- --- This list is not intended to be exhaustive, rather separate libraries--- can provide instances for other encodings and transformations.------ To implement a new encoding import this module and------ * "Data.TypedEncoding.Instances.Support"------ Defining annotations with combinators is an alternative to using typeclass instances. ------ Combinator modules with be merged with Instances modules in the future.------ Included combinator modules:------ * "Data.TypedEncoding.Combinators.Restriction.Bool"--- * "Data.TypedEncoding.Combinators.Restriction.BoundedAlphaNums"+-- ... and needed conversions.  -- -- Conversion combinator module structure is similar to one found in @text@ and @bytestring@ packages -- And can be found (since 0.2.2) in@@ -128,49 +113,84 @@ -- * "Data.TypedEncoding.Conv.ByteString.Char8" -- * "Data.TypedEncoding.Conv.ByteString.Lazy.Char8" --+-- This list is not intended to be exhaustive, rather separate libraries+-- can provide instances for other encodings and transformations. --+-- = New encoding instance creation+--+-- To implement a new encoding import+--+-- * "Data.TypedEncoding.Instances.Support"+-- -- = Examples -- -- Examples of how to use this library are included in -- -- * "Examples.TypedEncoding"     module Data.TypedEncoding (-    module Data.TypedEncoding-    -- * Classes-    , module Data.TypedEncoding.Internal.Class-    -- * Encoding class and Encoder (replaces EncodeFAll)-    , module Data.TypedEncoding.Internal.Class.Encoder-    -- * Combinators-    , module Data.TypedEncoding.Internal.Combinators-    -- * Types-    , Enc-    , CheckedEnc-    , EncodeEx(..)-    , RecreateEx(..)-    , UnexpectedDecodeEx(..)-    , EncAnn -    -- * Existentially quantified version of @Enc@ and basic combinators-    , module Data.TypedEncoding.Internal.Types.SomeEnc-    -- * Types and combinators for not verfied encoding -    , module Data.TypedEncoding.Internal.Types.UncheckedEnc-    -- * Basic @Enc@ Combinators-    , getPayload -    , unsafeSetPayload-    , fromEncoding+  +    -- * @Enc@ and basic combinators+    Enc     , toEncoding-    -- * Basic @CheckedEnc@ Combinators  -    , unsafeCheckedEnc-    , getCheckedPayload-    , getCheckedEncPayload-    , toCheckedEnc-    , fromCheckedEnc-    -- * Other Basic Combinators     -    , recreateErrUnknown+    , fromEncoding+    , getPayload++    -- * Existentially quantified and untyped versions of @Enc@+    , module Data.TypedEncoding.Common.Types.SomeEnc+    , module  Data.TypedEncoding.Common.Types.CheckedEnc++    -- * @Encoding@ and basic combinators+    , Encoding (..)+    , _mkEncoding+    , runEncoding'+    , _runEncoding +  +    -- * List of encodings+    , Encodings (..)+    , runEncodings'+    , _runEncodings++    -- * Similar to @Encoding@ and @Encodings@ but cover /Decoding/ and /Validation/+    , module Data.TypedEncoding.Common.Types.Decoding+    , module Data.TypedEncoding.Common.Types.Validation++    -- * @UncheckedEnc@ is an /untyped/ version of Enc that represents not validated encoding      +    , module Data.TypedEncoding.Common.Types.UncheckedEnc+ +    -- * Classes+    , module Data.TypedEncoding.Common.Class+  +      -- * Combinators+    , module Data.TypedEncoding.Combinators.Common+    , module Data.TypedEncoding.Combinators.Encode+    , module Data.TypedEncoding.Combinators.Decode+    , module Data.TypedEncoding.Combinators.Validate+    , module Data.TypedEncoding.Combinators.Unsafe+    , module Data.TypedEncoding.Combinators.ToEncStr+    , module Data.TypedEncoding.Combinators.Promotion++    -- * Exceptions +    , module Data.TypedEncoding.Common.Types.Exceptions++    -- * Other+    , module Data.TypedEncoding.Common.Types.Common+  ) where -import           Data.TypedEncoding.Internal.Types-import           Data.TypedEncoding.Internal.Types.SomeEnc-import           Data.TypedEncoding.Internal.Types.UncheckedEnc-import           Data.TypedEncoding.Internal.Class-import           Data.TypedEncoding.Internal.Combinators-import           Data.TypedEncoding.Internal.Class.Encoder+import           Data.TypedEncoding.Common.Types.Enc+import           Data.TypedEncoding.Common.Types.Decoding+import           Data.TypedEncoding.Common.Types.Validation++import           Data.TypedEncoding.Common.Types.Common+import           Data.TypedEncoding.Common.Types.CheckedEnc+import           Data.TypedEncoding.Common.Types.SomeEnc+import           Data.TypedEncoding.Common.Types.UncheckedEnc+import           Data.TypedEncoding.Common.Types.Exceptions+import           Data.TypedEncoding.Common.Class+import           Data.TypedEncoding.Combinators.Common+import           Data.TypedEncoding.Combinators.Encode+import           Data.TypedEncoding.Combinators.Decode+import           Data.TypedEncoding.Combinators.Validate+import           Data.TypedEncoding.Combinators.Unsafe+import           Data.TypedEncoding.Combinators.ToEncStr+import           Data.TypedEncoding.Combinators.Promotion
+ src/Data/TypedEncoding/Combinators/Common.hs view
@@ -0,0 +1,52 @@++{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+-- {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}++-- | Combinators reexported in Data.TypedEncoding+module Data.TypedEncoding.Combinators.Common where++import           Data.TypedEncoding.Common.Types+import           Data.TypedEncoding.Combinators.Unsafe+import           Data.TypedEncoding.Common.Class.Util (Append)+import           GHC.TypeLits+import           Data.Proxy++-- $setup+-- >>> :set -XTypeApplications+-- >>> import qualified Data.Text as T+-- >>> import           Data.Word+++-- * Partial application of encoding / decoding / recreation++-- | Any valid transformation of encodings (encoding / decoding / recreation) can be +-- replayed on top of another encoding stack. +--+-- This subsumes various /encodePart, decodePart, recreatePart/ combinators.+aboveF :: forall (ts :: [Symbol]) xs ys f c str . (Functor f) =>+           (Enc xs c str -> f (Enc ys c str)) +           -> Enc (Append xs ts) c str -> f (Enc (Append ys ts) c str)+aboveF fn (UnsafeMkEnc _ conf str) = +    let re :: f (Enc ys c str) = fn $ UnsafeMkEnc Proxy conf str+    in  UnsafeMkEnc Proxy conf . getPayload <$> re+++above :: forall (ts :: [Symbol]) xs ys c str . +           (Enc xs c str -> Enc ys c str) +           -> Enc (Append xs ts) c str -> Enc (Append ys ts) c str+above fn (UnsafeMkEnc _ conf str) = +    let re ::Enc ys c str = fn $ UnsafeMkEnc Proxy conf str+    in  UnsafeMkEnc Proxy conf . getPayload $ re+++-- * Other ++getTransformF :: forall e1 e2 f c s1 s2 . Functor f => (Enc e1 c s1 -> f (Enc e2 c s2)) -> c -> s1 -> f s2+getTransformF fn c str = getPayload <$> fn (unsafeSetPayload c str)++
+ src/Data/TypedEncoding/Combinators/Decode.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}++-- | Combinators reexported in Data.TypedEncoding+module Data.TypedEncoding.Combinators.Decode where++import           Data.TypedEncoding.Common.Types.Enc+import           Data.TypedEncoding.Common.Types.Decoding+import           Data.TypedEncoding.Combinators.Common++import           Data.TypedEncoding.Common.Class.Util+import           Data.TypedEncoding.Common.Class.Decode+import           Data.Functor.Identity+import           GHC.TypeLits+++-- * Convenience combinators which mimic pre-v0.3 type signatures. These assume that @algs@ are the same as @nms@++decodeF :: forall nm xs f c str . (Decode f nm nm c str) => Enc (nm ': xs) c str -> f (Enc xs c str)+decodeF = decodeF' @nm @nm++decodeFAll :: forall nms f c str . (Monad f,  DecodeAll f nms nms c str) => +               Enc nms c str+               -> f (Enc ('[]::[Symbol]) c str)  +decodeFAll = decodeFAll' @nms @nms ++-- | +-- +decodeAll :: forall nms c str . (DecodeAll Identity nms nms c str) =>+               Enc nms c str +               -> Enc ('[]::[Symbol]) c str +decodeAll = decodeAll' @nms @nms  ++decodeFPart :: forall xs xsf f c str . (Monad f, DecodeAll f xs xs c str) => Enc (Append xs xsf) c str -> f (Enc xsf c str)+decodeFPart = decodeFPart' @xs @xs ++decodePart :: forall xs xsf c str . (DecodeAll Identity xs xs c str) => Enc (Append xs xsf) c str -> Enc xsf c str   +decodePart = decodePart' @xs @xs  ++++-- * Convenience combinators which mimic pre-v0.3 type signatures. These do not try to figure out @algs@ or assume much about them++decodeF' :: forall alg nm xs f c str . (Decode f nm alg c str) => Enc (nm ': xs) c str -> f (Enc xs c str)+decodeF' = runDecoding (decoding @f @nm @alg)++decodeFAll' :: forall algs nms f c str . (Monad f,  DecodeAll f nms algs c str) => +               Enc nms c str+               -> f (Enc ('[]::[Symbol]) c str)  +decodeFAll' = runDecodings @algs @nms @f decodings ++-- | +-- +decodeAll' :: forall algs nms c str . (DecodeAll Identity nms algs c str) =>+               Enc nms c str +               -> Enc ('[]::[Symbol]) c str +decodeAll' = runIdentity . decodeFAll' @algs ++decodeFPart' :: forall algs xs xsf f c str . (Monad f, DecodeAll f xs algs c str) => Enc (Append xs xsf) c str -> f (Enc xsf c str)+decodeFPart' = aboveF @xsf @xs @'[] (decodeFAll' @algs)  +-- decodeFPart' (UnsafeMkEnc _ conf str) =   +--     let re :: f (Enc '[] c str) = decodeFAll' @algs @xs $ UnsafeMkEnc Proxy conf str+--     in  UnsafeMkEnc Proxy conf . getPayload <$> re++decodePart' :: forall algs xs xsf c str . (DecodeAll Identity xs algs c str) => Enc (Append xs xsf) c str -> Enc xsf c str   +decodePart' = runIdentity . decodeFPart' @algs @xs++
+ src/Data/TypedEncoding/Combinators/Encode.hs view
@@ -0,0 +1,68 @@++{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}++module Data.TypedEncoding.Combinators.Encode where++import           Data.TypedEncoding.Common.Types.Enc+import           Data.TypedEncoding.Common.Class.Util -- Append+import           Data.TypedEncoding.Combinators.Common+import           Data.TypedEncoding.Common.Class.Encode+import           GHC.TypeLits+import           Data.Functor.Identity+++-- * Convenience combinators which mimic pre-v0.3 type signatures. These assume that @algs@ are the same as @nms@++encodeF :: forall nm xs f c str . Encode f nm nm c str => Enc xs c str -> f (Enc (nm ': xs) c str)+encodeF = encodeF' @nm @nm++encodeFAll :: forall nms f c str . (Monad f,  EncodeAll f nms nms c str) =>  +               Enc ('[]::[Symbol]) c str +               -> f (Enc nms c str)  +encodeFAll = encodeFAll' @nms @nms++encodeAll :: forall nms c str . (EncodeAll Identity nms nms c str) =>+               Enc ('[]::[Symbol]) c str +               -> Enc nms c str +encodeAll = encodeAll' @nms @nms ++encodeFPart :: forall xs xsf f c str . (Monad f, EncodeAll f xs xs c str) => Enc xsf c str -> f (Enc (Append xs xsf) c str)+encodeFPart = encodeFPart' @xs @xs++encodePart :: forall xs xsf c str . (EncodeAll Identity xs xs c str) => Enc xsf c str -> Enc (Append xs xsf) c str   +encodePart = encodePart' @xs @xs+++-- * Convenience combinators which mimic pre-v0.3 type signatures. These do not try to figure out @algs@ or assume much about them++encodeF' :: forall alg nm xs f c str . (Encode f nm alg c str) => Enc xs c str -> f (Enc (nm ': xs) c str)+encodeF' = runEncoding' (encoding @f @nm @alg)++encodeFAll' :: forall algs nms f c str . (Monad f,  EncodeAll f nms algs c str) =>  +               Enc ('[]::[Symbol]) c str +               -> f (Enc nms c str)  +encodeFAll' = runEncodings' @algs @nms @f encodings ++-- | +-- +encodeAll' :: forall algs nms c str . (EncodeAll Identity nms algs c str) =>+               Enc ('[]::[Symbol]) c str +               -> Enc nms c str +encodeAll' = runIdentity . encodeFAll' @algs ++encodeFPart' :: forall algs xs xsf f c str . (Monad f, EncodeAll f xs algs c str) => Enc xsf c str -> f (Enc (Append xs xsf) c str)+encodeFPart' = aboveF @xsf @'[] @xs (encodeFAll' @algs) +-- encodeFPart' (UnsafeMkEnc _ conf str) =  +--     let re :: f (Enc xs c str) = encodeFAll' @algs $ UnsafeMkEnc Proxy conf str+--     in  UnsafeMkEnc Proxy conf . getPayload <$> re++encodePart' :: forall algs xs xsf c str . (EncodeAll Identity xs algs c str) => Enc xsf c str -> Enc (Append xs xsf) c str   +encodePart' = runIdentity . encodeFPart' @algs @xs
+ src/Data/TypedEncoding/Combinators/Encode/Experimental.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Experimental features, slow to compile when used.+module Data.TypedEncoding.Combinators.Encode.Experimental where++import           Data.TypedEncoding.Combinators.Encode+import           Data.TypedEncoding.Common.Types.Enc+import           Data.TypedEncoding.Common.Types.Common+import           Data.TypedEncoding.Common.Class.Util -- Append+import           Data.TypedEncoding.Common.Class.Encode    +import           Data.Functor.Identity+import           GHC.TypeLits++-- * Combinators equivalent to "Data.TypedEncoding.Common.Class.Encode" that automatically figure out algorithm name.+-- Cause slow compilation when used++_encodeF :: forall nm xs f c str alg . (Encode f nm alg c str, alg ~ AlgNm nm) => Enc xs c str -> f (Enc (nm ': xs) c str)+_encodeF = encodeF' @(AlgNm nm) @nm++_encodeFAll :: forall nms f c str algs . (Monad f,  EncodeAll f nms algs c str, algs ~ AlgNmMap nms) =>  +               Enc ('[]::[Symbol]) c str +               -> f (Enc nms c str)  +_encodeFAll = encodeFAll' @(AlgNmMap nms) @nms++_encodeAll :: forall nms c str algs . (EncodeAll Identity nms algs c str, algs ~ AlgNmMap nms) =>+               Enc ('[]::[Symbol]) c str +               -> Enc nms c str +_encodeAll = encodeAll' @(AlgNmMap nms) @nms ++_encodeFPart :: forall xs xsf f c str algs . (Monad f, EncodeAll f xs algs c str, algs ~ AlgNmMap xs) => Enc xsf c str -> f (Enc (Append xs xsf) c str)+_encodeFPart = encodeFPart' @(AlgNmMap xs) @xs++_encodePart :: forall xs xsf c str algs . (EncodeAll Identity xs algs c str, algs ~ AlgNmMap xs) => Enc xsf c str -> Enc (Append xs xsf) c str   +_encodePart = encodePart' @(AlgNmMap xs) @xs+
+ src/Data/TypedEncoding/Combinators/Promotion.hs view
@@ -0,0 +1,101 @@+++{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+-- {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Promote and demote combinators.+module Data.TypedEncoding.Combinators.Promotion where++import           Data.TypedEncoding.Common.Class+import           Data.TypedEncoding.Common.Util.TypeLits++import           Data.TypedEncoding.Common.Types (Enc(..) )+import           Data.TypedEncoding.Combinators.Unsafe (withUnsafeCoerce)+++-- $setup+-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XTypeApplications+-- >>> import           Data.TypedEncoding.Common.Class.Util (displ)+-- >>> import           Data.TypedEncoding.Combinators.Unsafe (unsafeSetPayload)+-- >>> import           Data.TypedEncoding.Instances.Restriction.UTF8 ()+-- >>> import           Data.TypedEncoding.Instances.Restriction.ASCII ()+-- >>> import           Data.Text as T++-- | Remove redundant superset right after the top (at second last encoding position)+--+-- >>> displ $ demoteFlattenTop (unsafeSetPayload () "" :: Enc '["r-ASCII", "r-UTF8", "r-boo"] () T.Text)+-- "Enc '[r-ASCII,r-boo] () (Text )"+--+-- @since 0.2.2.0 (moved)+demoteFlattenTop :: forall y x xs c str . (IsSuperset y x ~ 'True) => Enc (x ': y ': xs) c str ->  Enc (x ': xs) c str+demoteFlattenTop = withUnsafeCoerce id++-- | add redundant superset right after+--+-- >>> displ $ promoteUnFlattenTop @"r-UTF8" (unsafeSetPayload () "" :: Enc '["r-ASCII", "r-boo"] () T.Text)+-- "Enc '[r-ASCII,r-UTF8,r-boo] () (Text )"+--+-- @since 0.2.2.0 (moved)+promoteUnFlattenTop :: forall y x xs c str . (IsSuperset y x ~ 'True) => Enc (x ': xs) c str -> Enc (x ': y ': xs) c str+promoteUnFlattenTop = withUnsafeCoerce id++-- | remove redunant superset from the top (at last applied encoding position)+--+-- >>> displ $ demoteRemoveTop (unsafeSetPayload () "" :: Enc '["r-UTF8", "r-ASCII", "r-boo"] () T.Text)+-- "Enc '[r-ASCII,r-boo] () (Text )"+--+-- @since 0.2.2.0 (moved)+demoteRemoveTop :: forall y x xs c str . (IsSuperset y x ~ 'True) => Enc (y ': x ' : xs) c str ->  Enc (x ': xs) c str+demoteRemoveTop = withUnsafeCoerce id++-- | add redundant superset at the top+--+-- >>> displ $ promoteAddTop @"r-UTF8" (unsafeSetPayload () "" :: Enc '["r-ASCII", "r-boo"] () T.Text)+-- "Enc '[r-UTF8,r-ASCII,r-boo] () (Text )"+--+-- @since 0.2.2.0 (moved)+promoteAddTop :: forall y x xs c str . (IsSuperset y x ~ 'True) => Enc (x ': xs) c str -> Enc (y ': x ' : xs) c str +promoteAddTop = withUnsafeCoerce id++-- | remove redundant superset at bottom (first encoding) position+--+-- >>> displ $ demoteRemoveBot (unsafeSetPayload () "" :: Enc '["r-boo", "r-ASCII", "r-UTF8"] () T.Text)+-- "Enc '[r-boo,r-ASCII] () (Text )"+--+-- @since 0.2.2.0 (moved)+demoteRemoveBot :: (UnSnoc xs ~ '(,) ys y, UnSnoc ys ~ '(,) zs x, IsSuperset y x ~ 'True) => Enc xs c str -> Enc ys c str+demoteRemoveBot = withUnsafeCoerce id++-- | add redundant superset at bottom (first encoding) position+--+-- >>> displ $ promoteAddBot @"r-UTF8" (unsafeSetPayload () "" :: Enc '["r-boo", "r-ASCII"] () T.Text)+-- "Enc '[r-boo,r-ASCII,r-UTF8] () (Text )"+promoteAddBot :: forall y x xs c str ys . (UnSnoc xs ~ '(,) ys x,  IsSuperset y x ~ 'True) => Enc xs c str -> Enc (Snoc xs y) c str+promoteAddBot = withUnsafeCoerce id++-- | remove redundant superset at second bottom (second encoding) position+--+-- >>> displ $ demoteFlattenBot (unsafeSetPayload () "" :: Enc '["r-boo", "r-UTF8", "r-ASCII"] () T.Text)+-- "Enc '[r-boo,r-ASCII] () (Text )"+--+-- @since 0.2.2.0 (moved)+demoteFlattenBot :: (UnSnoc xs ~ '(,) ys x, UnSnoc ys ~ '(,) zs y, IsSuperset y x ~ 'True) => Enc xs c str -> Enc (Snoc zs x) c str+demoteFlattenBot = withUnsafeCoerce id++-- | add redundant superset at second bottom (second encoding) position+--+-- >>> displ $ promoteUnFlattenBot @"r-UTF8" (unsafeSetPayload () "" :: Enc '["r-boo", "r-ASCII"] () T.Text)+-- "Enc '[r-boo,r-UTF8,r-ASCII] () (Text )"+--+-- @since 0.2.2.0 (moved)+promoteUnFlattenBot :: forall y x xs c str ys . (UnSnoc xs ~ '(,) ys x,  IsSuperset y x ~ 'True) => Enc xs c str -> Enc (Snoc (Snoc ys y) x) c str+promoteUnFlattenBot = withUnsafeCoerce id
− src/Data/TypedEncoding/Combinators/Restriction/Bool.hs 
@@ -1,395 +0,0 @@--{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE UndecidableInstances #-}---- |--- Boolean algebra on encodings------ @since 0.2.1.0--- --- == Grammar--- --- Simple grammar requires boolean terms to be included in parentheses------ @--- bool[BinaryOp]:(leftTerm)(rightTerm)--- bool[UnaryOp]:(term)--- @------ Expected behavior is described next to corresponding combinator.------ Typeclass encoding is not used to avoid instance overlapping.--- --- Use 'Data.TypedEncoding.Combinators.Restriction.Common.recWithEncR' --- to create manual recovery step that can be combined with 'recreateFPart'.---- This is very much in beta state.----module Data.TypedEncoding.Combinators.Restriction.Bool where ---import           GHC.TypeLits-import           Data.Proxy-import           Data.Symbol.Ascii--import           Data.TypedEncoding-import           Data.TypedEncoding.Instances.Support--- import           Data.TypedEncoding.Internal.Util.TypeLits-import           Data.TypedEncoding.Combinators.Restriction.Common---- import qualified Data.Text as T--- import           Data.TypedEncoding.Instances.Restriction.Common()----- $setup--- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XTypeApplications--- >>> import qualified Data.Text as T--- >>> import           Data.TypedEncoding.Instances.Restriction.Common()----- |--- See examples in 'encBoolOrRight''-encBoolOrLeft :: forall f s t xs c str . (-    BoolOpIs s "or" ~ 'True-    -- IsBoolOr s ~ 'True-    , Functor f-    , LeftTerm s ~ t-    ) => (Enc xs c str -> f (Enc (t ': xs) c str)) -> Enc xs c str -> f (Enc (s ': xs) c str)  -encBoolOrLeft = implChangeAnn ---- |--- See examples in 'encBoolOrRight''-encBoolOrLeft' :: forall f s t xs c str . (-    BoolOpIs s "or" ~ 'True-    -- IsBoolOr s ~ 'True-    , Functor f-    , LeftTerm s ~ t-    , EncodeF f (Enc xs c str) (Enc (t ': xs) c str) -    ) => Enc xs c str -> f (Enc (s ': xs) c str)  -encBoolOrLeft' = encBoolOrLeft (encodeF @f @(Enc xs c str) @(Enc (t ': xs) c str)) ---- |--- -encBoolOrRight :: forall f s t xs c str . (-    BoolOpIs s "or" ~ 'True-    -- IsBoolOr s ~ 'True-    , Functor f-    , RightTerm s ~ t-    ) => (Enc xs c str -> f (Enc (t ': xs) c str)) -> Enc xs c str -> f (Enc (s ': xs) c str)  -encBoolOrRight = implChangeAnn ---- |--- >>> :{ --- let tst1, tst2, tst3 :: Either EncodeEx (Enc '["boolOr:(r-Word8-decimal)(r-Int-decimal)"] () T.Text)---     tst1 = encBoolOrLeft' . toEncoding () $ "212" ---     tst2 = encBoolOrRight' . toEncoding () $ "1000000" ---     tst3 = encBoolOrLeft' . toEncoding () $ "1000000"--- :}--- --- >>> tst1 --- Right (MkEnc Proxy () "212")------ >>> tst2--- Right (MkEnc Proxy () "1000000")------ >>> tst3--- Left (EncodeEx "r-Word8-decimal" ("Payload does not satisfy format Word8-decimal: 1000000"))-encBoolOrRight' :: forall f s t xs c str . (-    BoolOpIs s "or" ~ 'True-    -- IsBoolOr s ~ 'True-    , Functor f-    , RightTerm s ~ t-    , EncodeF f (Enc xs c str) (Enc (t ': xs) c str) -    ) => Enc xs c str -> f (Enc (s ': xs) c str)  -encBoolOrRight' = encBoolOrRight (encodeF @f @(Enc xs c str) @(Enc (t ': xs) c str)) --encBoolAnd :: forall f s t1 t2 xs c str . (-    BoolOpIs s "and" ~ 'True -    , KnownSymbol s-    -- IsBoolAnd s ~ 'True-    , f ~ Either EncodeEx-    , Eq str-    , LeftTerm s ~ t1-    , RightTerm s ~ t2-    ) => -    (Enc xs c str -> f (Enc (t1 ': xs) c str)) -    -> (Enc xs c str -> f (Enc (t2 : xs) c str)) -    -> Enc xs c str -> f (Enc (s ': xs) c str)  -encBoolAnd fnl fnr en0 =  -       let -           eent1 = fnl en0-           eent2 = fnr en0-           p = (Proxy :: Proxy s)-       in -           case (eent1, eent2) of-               (Right ent1, Right ent2) -> -                   if getPayload ent1 == getPayload ent2-                   then Right . withUnsafeCoerce id $ ent1 -                   else Left $ EncodeEx p "Left - right encoding do not match"                   -               (_, _) -> mergeErrs (emptyEncErr p) (mergeEncodeEx p) eent1 eent2---- |--- @"boolOr:(enc1)(enc2)"@ contains strings that encode the same way under both encodings.--- for example  @"boolOr:(r-UPPER)(r-lower)"@ valid elements would include @"123-34"@ but not @"abc"@------ >>> :{--- let tst1, tst2 :: Either EncodeEx (Enc '["boolAnd:(r-Word8-decimal)(r-Int-decimal)"] () T.Text)---     tst1 = encBoolAnd' . toEncoding () $ "234"---     tst2 = encBoolAnd' . toEncoding () $ "100000"--- :}--- --- >>> tst1--- Right (MkEnc Proxy () "234")--- >>> tst2--- Left (EncodeEx "r-Word8-decimal" ("Payload does not satisfy format Word8-decimal: 100000"))-encBoolAnd' :: forall f s t1 t2 xs c str . (-    BoolOpIs s "and" ~ 'True -    , KnownSymbol s-    -- IsBoolAnd s ~ 'True-    , f ~ Either EncodeEx-    , Eq str-    , LeftTerm s ~ t1-    , RightTerm s ~ t2-    , EncodeF f (Enc xs c str) (Enc (t1 ': xs) c str) -    , EncodeF f (Enc xs c str) (Enc (t2 ': xs) c str) -    ) => Enc xs c str -> f (Enc (s ': xs) c str)  -encBoolAnd'  = encBoolAnd (encodeF @f @(Enc xs c str) @(Enc (t1 ': xs) c str)) (encodeF @f @(Enc xs c str) @(Enc (t2 ': xs) c str)) ----- tst1, tst2 :: Either EncodeEx (Enc '["boolNot:(r-Word8-decimal)"] () T.Text)--- tst1 = encBoolNot' . toEncoding () $ "334"--- tst2 = encBoolNot' . toEncoding () $ "127"--encBoolNot :: forall f s t xs c str . (-    BoolOpIs s "not" ~ 'True-    , KnownSymbol s-    , f ~ Either EncodeEx-    , FirstTerm s ~ t-    , KnownSymbol t-    , IsR t ~ 'True-    ) => (Enc xs c str -> f (Enc (t ': xs) c str)) -> Enc xs c str -> f (Enc (s ': xs) c str)  -encBoolNot fn en0 = -        let -           een = fn en0-           p = (Proxy :: Proxy s)-           pt = (Proxy :: Proxy t)-        in -           case een of-               Left _ -> Right . withUnsafeCoerce id $ en0-               Right _ -> Left $ EncodeEx p $ "Encoding " ++ symbolVal pt ++ " succeeded"  - ---- |--- >>> :{--- let tst1, tst2 :: Either EncodeEx (Enc '["boolNot:(r-Word8-decimal)"] () T.Text)---     tst1 = encBoolNot' . toEncoding () $ "334"---     tst2 = encBoolNot' . toEncoding () $ "127"--- :}------ >>> tst1--- Right (MkEnc Proxy () "334")--- >>> tst2--- Left (EncodeEx "boolNot:(r-Word8-decimal)" ("Encoding r-Word8-decimal succeeded"))-encBoolNot' :: forall f s t xs c str . (-    BoolOpIs s "not" ~ 'True-    , KnownSymbol s-    , f ~ Either EncodeEx-    , FirstTerm s ~ t-    , KnownSymbol t-    , IsR t ~ 'True-    , EncodeF f (Enc xs c str) (Enc (t ': xs) c str) -    ) => Enc xs c str -> f (Enc (s ': xs) c str)  -encBoolNot' = encBoolNot (encodeF :: Enc xs c str -> f (Enc (t ': xs) c str))---- | --- Decodes boolean expression if all leaves are @"r-"@-decBoolR :: forall f xs t s c str . (-    NestedR s  ~ 'True-    , Applicative f-    ) => Enc (s ': xs) c str -> f (Enc xs c str)  --decBoolR = implTranP id --recWithEncBoolR :: forall (s :: Symbol) xs c str . (NestedR s ~ 'True) -                       => (Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str)) -                       -> Enc xs c str -> Either RecreateEx (Enc (s ': xs) c str)-recWithEncBoolR = unsafeRecWithEncR---- * Type family based parser ---- |--- >>> :kind! BoolOpIs "boolAnd:(someenc)(otherenc)" "and"--- ...--- = 'True-type family BoolOpIs (s :: Symbol) (op :: Symbol) :: Bool where-    BoolOpIs s op = AcceptEq ('Text "Invalid bool encoding " ':<>: ShowType s ) (CmpSymbol (BoolOp s) op)---- | --- This works fast with @!kind@ but is much slower in declaration --- :kind! BoolOp "boolOr:()()"-type family BoolOp (s :: Symbol) :: Symbol where-    BoolOp s = Fst (BoolOpHelper (Dupl s))-        -- ToLower (TakeUntil (Drop 4 s) ":")--type family BoolOpHelper (x :: (Symbol, Symbol)) :: (Symbol, Bool) where-    BoolOpHelper ('(,) s1 s2) = '(,) (ToLower (TakeUntil (Drop 4 s1) ":")) ( AcceptEq ('Text "Invalid bool encoding " ':<>: ShowType s2 ) (CmpSymbol "bool" (Take 4 s2)))---type family IsBool (s :: Symbol) :: Bool where-    IsBool s = AcceptEq ('Text "Not boolean encoding " ':<>: ShowType s ) (CmpSymbol "bool" (Take 4 s))---- |--- --- >>> :kind! NestedR "boolOr:(r-abc)(r-cd)"--- ...--- = 'True------ >>> :kind! NestedR "boolOr:(boolAnd:(r-ab)(r-ac))(boolNot:(r-cd))"--- ...--- = 'True------ >>> :kind! NestedR "boolOr:(boolAnd:(r-ab)(ac))(boolNot:(r-cd))"--- ...--- ... (TypeError ...)--- ...-type family NestedR (s :: Symbol) :: Bool where-    NestedR "" = 'True -- RightTerm, LeftTerm return "" on "r-"-    NestedR s = Or (IsROrEmpty s) -                   (And (IsBool s) (And (NestedR (LeftTerm s)) (NestedR (RightTerm s)))) ---- Value level check------ nestedR :: String -> Bool--- nestedR s = isROrEmpty s || isBool s && (nestedR (leftTerm s) && nestedR (rightTerm s))---- isBool ('b' :'o' : 'o' : _) = True--- isBool _ = False---- isROrEmpty "" = True--- isROrEmpty ('r' : '-' : _) = True--- isROrEmpty _ = False---type family FirstTerm (s :: Symbol) :: Symbol where-    FirstTerm s = LeftTerm s---- | --- returns "" for unary operator-type family SecondTerm (s :: Symbol) :: Symbol where-    SecondTerm s = RightTerm s----- |--- >>> :kind! LeftTerm "boolSomeOp:(agag)(222)"--- ...--- = "agag"------ >>> :kind! LeftTerm "r-Int-decimal"--- ...--- = ""-type family LeftTerm (s :: Symbol) :: Symbol where-    LeftTerm s = Concat (LDropLast( LTakeFstParen (LParenCnt (ToList s))))---- |--- >>> :kind! RightTerm "boolSomeOp:(agag)(222)"--- ...--- = "222"------ >>> :kind! RightTerm "r-Int-decimal"--- ...--- = ""-type family RightTerm (s :: Symbol) :: Symbol where-    RightTerm s = Concat (LDropLast (LTakeSndParen 0 (LParenCnt (ToList s))))---type family LDropLast (s :: [Symbol]) :: [Symbol] where-    LDropLast '[] = '[]-    LDropLast '[x] = '[]-    LDropLast (x ': xs) = x ': LDropLast xs---type family LParenCnt (s :: [Symbol]) :: [(Symbol, Nat)] where-    LParenCnt '[] = '[]-    LParenCnt ("(" ': xs) = LParenCntHelper ('(,) "(" 'Decr) (LParenCnt xs) -- '(,) "(" (LParenCntFstCnt (LParenCnt xs) - 1) ': LParenCnt xs-    LParenCnt (")" ': xs) = LParenCntHelper ('(,) ")" 'Incr) (LParenCnt xs)-    LParenCnt (x ': xs) = LParenCntHelper ('(,) x 'NoChng) (LParenCnt xs)--data Adjust = Incr | Decr | NoChng--type family AdjHelper (a :: Adjust) (n :: Nat) :: Nat where-   AdjHelper 'Incr n = n + 1-   AdjHelper 'Decr 0 = 0-   AdjHelper 'Decr n = n - 1-   AdjHelper 'NoChng n = n--type family LParenCntHelper (s :: (Symbol, Adjust)) (sx :: [(Symbol, Nat)]) :: [(Symbol, Nat)] where-    LParenCntHelper ('(,) x k) '[] = '(,) x (AdjHelper k 0) ': '[]-    LParenCntHelper ('(,) x k) ('(,) c i : xs) = '(,) x (AdjHelper k i) ': '(,) c i ': xs---type family LTakeFstParen (si :: [(Symbol, Nat)]) :: [Symbol] where -    LTakeFstParen '[] = '[]-    LTakeFstParen ('(,) _ 0 ': xs) = LTakeFstParen xs-    LTakeFstParen ('(,) ")" 1 ': _) = '[")"]-    LTakeFstParen ('(,) a p ': xs) = a ': LTakeFstParen xs---type family LTakeSndParen (n :: Nat)  (si :: [(Symbol, Nat)]) :: [Symbol] where-    LTakeSndParen _ '[] = '[]-    LTakeSndParen 0 ('(,) ")" 1 ': xs) = LTakeSndParen 1 xs-    LTakeSndParen 1 ('(,) _ 0 : xs) = LTakeSndParen 1 xs-    LTakeSndParen 0 ('(,) _ _ ': xs) = LTakeSndParen 0 xs-    LTakeSndParen 1 ('(,) a _ ': xs) = a : LTakeSndParen 1 xs-    LTakeSndParen n _ = '[]---- -- * (Example) Value level equivalend of type family parsers----- -- map snd . parenCnt $ "((AGA)(bcd))(123) "--- -- dropLast . takeFstParen . parenCnt $ "((AGA)(bcd))(123)" --- -- dropLast . takeSndParen 0 . parenCnt $ "((AGA)(bcd))(123)" ---- leftTerm :: String -> String--- leftTerm = dropLast . takeFstParen . parenCnt---- rightTerm :: String -> String--- rightTerm = dropLast . takeSndParen 0 . parenCnt---- parenCnt :: String -> [(Char, Int)]--- parenCnt [] = []--- parenCnt ('(' : xs) = parenCntHelper ('(', -1) (parenCnt xs) --('(', parenCntFstCnt (parenCnt xs) - 1) : parenCnt xs--- parenCnt (')' : xs) = parenCntHelper (')', 1) (parenCnt xs)  -- (')', parenCntFstCnt (parenCnt xs) + 1) : parenCnt xs--- parenCnt (x : xs) = parenCntHelper (x, 0) (parenCnt xs) -- (x, parenCntFstCnt (parenCnt xs) ) : parenCnt xs----- parenCntHelper :: (Char, Int) -> [(Char, Int)]  -> [(Char, Int)]--- parenCntHelper (x, k) [] = [(x,k)]--- parenCntHelper (x, k) ((c,i) : xs) = (x, i + k): (c,i) : xs----- takeFstParen :: [(Char, Int)] -> [Char]--- takeFstParen [] = []--- takeFstParen ((_, 0) : xs) = takeFstParen xs--- takeFstParen ((')', 1) : _) = [')']--- takeFstParen ((a, p) : xs) = a : takeFstParen xs---- takeSndParen :: Int -> [(Char, Int)] -> [Char]--- takeSndParen _ [] = []--- takeSndParen 0 ((')', 1) : xs) = takeSndParen 1 xs--- takeSndParen 1 ((_, 0) : xs) = takeSndParen 1 xs--- takeSndParen 0 ((_, _) : xs) = takeSndParen 0 xs--- takeSndParen 1 ((a, _) : xs) = a : takeSndParen 1 xs--- takeSndParen _ _ = []---- dropLast :: [Char] -> [Char]--- dropLast [] = []--- dropLast [x] = []--- dropLast (x:xs) = x : dropLast xs-
− src/Data/TypedEncoding/Combinators/Restriction/BoundedAlphaNums.hs 
@@ -1,112 +0,0 @@--{-# LANGUAGE MultiParamTypeClasses #-}--- {-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}--- {-# LANGUAGE KindSignatures  #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE UndecidableInstances #-}---- | --- Restrictions @"r-ban:"@ cover commonly used fixed (short) size strings with restricted--- characters such as GUID, credit card numbers, etc.  --- --- Alphanumeric chars are ordered: @0-9@ followed by @A-Z@,--- followed by @a-z@. Annotation specifies upper character bound. --- Any non alpha numeric characters are considered fixed delimiters--- and need to be present exactly as specified.--- For example @"r-ban:999-99-9999"@ could be used to describe SSN numbers,--- @"r-ban:FFFF" would describe strings consisting of 4 hex digits.------ This is a simple implementation that converts to @String@, should be used--- only with short length data.------ This module does not create instances of @EncodeF@ typeclass to avoid duplicate instance issues.------ Decoding function @decFR@ is located in--- "Data.TypedEncoding.Combinators.Restriction.Common"------ Use 'Data.TypedEncoding.Combinators.Restriction.Common.recWithEncR' --- to create manual recovery step that can be combined with 'recreateFPart'.------ @since 0.2.1.0-module Data.TypedEncoding.Combinators.Restriction.BoundedAlphaNums where ---import           GHC.TypeLits-import qualified Data.List as L-import           Data.Char-import           Data.Proxy-import           Data.Either--import           Data.TypedEncoding.Internal.Util.TypeLits-import           Data.TypedEncoding.Internal.Class.IsStringR-import           Data.TypedEncoding.Instances.Support---- $setup--- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XTypeApplications--- >>> import qualified Data.Text as T--- >>> import           Data.TypedEncoding.Combinators.Restriction.Common---- better compilation errors?-type family IsBan (s :: Symbol) :: Bool where-    IsBan s = AcceptEq ('Text "Not ban restriction encoding " ':<>: ShowType s ) (CmpSymbol (TakeUntil s ":") "r-ban")--type instance IsSupersetOpen "r-ASCII" "r-ban" xs = 'True--instance  (KnownSymbol s, "r-ban" ~ TakeUntil s ":" , IsStringR str, Encodings (Either EncodeEx) xs grps c str) => Encodings (Either EncodeEx) (s ': xs) ("r-ban" ': grps) c str where-    encodings = AppendEnc encFBan encodings---- |--- >>> encFBan . toEncoding () $ "C59F9FB7-4621-44D9-9020-CE37BF6E2BD1" :: Either EncodeEx (Enc '["r-ban:FFFFFFFF-FFFF-FFFF-FFFF-FFFFFFFFFFFF"] () T.Text)--- Right (MkEnc Proxy () "C59F9FB7-4621-44D9-9020-CE37BF6E2BD1")--- --- >>> recWithEncR encFBan . toEncoding () $ "211-22-9934" :: Either RecreateEx (Enc '["r-ban:999-99-9999"] () T.Text)--- Right (MkEnc Proxy () "211-22-9934")-encFBan :: forall f s t xs c str .-              (-                IsStringR str-              , KnownSymbol s-              , IsBan s ~ 'True-              , f ~ Either EncodeEx-              ) => -              Enc xs c str -> f (Enc (s ': xs) c str)  -encFBan = implEncodeF @s (verifyBoundedAlphaNum (Proxy :: Proxy s))              ---- TODO v0.3 remove f from forall in encFBan (slightly breaking chanage)----- |--- >>> verifyBoundedAlphaNum (Proxy :: Proxy "r-ban:FF-FF") (T.pack "12-3E")--- Right "12-3E"--- >>> verifyBoundedAlphaNum (Proxy :: Proxy "r-ban:FF-FF") (T.pack "1G-3E")--- Left "'G' not boulded by 'F'"--- >>> verifyBoundedAlphaNum (Proxy :: Proxy "r-ban:FF-FF") (T.pack "13G3E")--- Left "'G' not matching '-'"--- >>> verifyBoundedAlphaNum (Proxy :: Proxy "r-ban:FF-FF") (T.pack "13-234")--- Left "Input list has wrong size expecting 5 but length \"13-234\" == 6"-verifyBoundedAlphaNum :: forall s a str . (KnownSymbol s, IsStringR str) => Proxy s -> str -> Either String str-verifyBoundedAlphaNum p str = -    if pattl == inpl -    then case lefts match of-        (e: _) -> Left e-        _ -> Right str-    else Left $ "Input list has wrong size expecting " ++ show pattl ++ " but length " ++ show input ++ " == " ++ show inpl   -    where -        patt = L.drop (L.length ("r-ban:" :: String)) . symbolVal $ p-        input = toString str-        pattl = L.length patt-        inpl = L.length input -        -        match = L.zipWith fn input patt---        fn ci cp = case (isAlphaNum ci, isAlphaNum cp, ci <= cp, ci == cp) of-            (True, True, True, _) -> Right ()-            (_, _, _, True) -> Right ()-            (_, True, _, False) -> Left $ show ci ++ " not boulded by " ++ show cp-            (_, False, _, False) -> Left $ show ci ++ " not matching " ++ show cp
− src/Data/TypedEncoding/Combinators/Restriction/Common.hs 
@@ -1,64 +0,0 @@---- {-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}--- {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}--- {-# LANGUAGE KindSignatures  #-}s-{-# LANGUAGE UndecidableInstances #-}---- |--- Common combinators used across encodings.------ @since 0.2.1.0-module Data.TypedEncoding.Combinators.Restriction.Common where --import           GHC.TypeLits-import           Data.TypedEncoding.Internal.Util.TypeLits-import           Data.TypedEncoding.Instances.Support---- $setup--- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XTypeApplications----- | Universal decode for all "r-" types-decFR :: (IsR s ~ 'True, Applicative f) => -            Enc (s ': xs) c str -> f (Enc xs c str) -decFR = implTranP id ----- | --- Manual recreate step combinator converting @"r-"@ encode function to a recreate step.------ For "r-" encoding recreate and encode are the same other than the exception type used. ------ The convention in @typed-encoding@ is to implement encode and convert it to recreate.-recWithEncR :: forall (s :: Symbol) xs c str . (IsR s ~ 'True) -                       => (Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str)) -                       -> Enc xs c str -> Either RecreateEx (Enc (s ': xs) c str)-recWithEncR = unsafeRecWithEncR---unsafeRecWithEncR :: forall (s :: Symbol) xs c str .-                       (Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str)) -                       -> Enc xs c str -> Either RecreateEx (Enc (s ': xs) c str)-unsafeRecWithEncR fn = either (Left . encToRecrEx) Right . fn---- |--- >>> :kind! IsR "r-UPPER"--- ...--- ... 'True------ >>> :kind! IsR "do-UPPER"--- ...--- = (TypeError ... -type family IsR (s :: Symbol) :: Bool where-    IsR s = AcceptEq ('Text "Not restriction encoding " ':<>: ShowType s ) (CmpSymbol "r-" (Take 2 s))---type family IsROrEmpty (s :: Symbol) :: Bool where-    IsROrEmpty "" = True-    IsROrEmpty x  = IsR x
+ src/Data/TypedEncoding/Combinators/ToEncStr.hs view
@@ -0,0 +1,50 @@++{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | v0.2 like (backward compatible) combinators for covering to and from encoded string.+--+-- @since 0.3.0.0++module Data.TypedEncoding.Combinators.ToEncStr where++import           Data.TypedEncoding.Common.Class+import           Data.TypedEncoding.Common.Types (Enc(..) )++import           Data.Functor.Identity++toEncStringF :: forall nm f a str  . (ToEncString f nm nm a str) => a -> f (Enc '[nm] () str)+toEncStringF = toEncStringF' @nm @nm++toEncStringF' :: forall alg nm f a str  . (ToEncString f nm alg a str) => a -> f (Enc '[nm] () str)+toEncStringF' = toEncF @f @nm @alg++toEncString :: forall nm a str  . (ToEncString Identity nm nm a str) => a -> Enc '[nm] () str+toEncString = toEncString' @nm @nm++toEncString' :: forall alg nm a str  . (ToEncString Identity nm alg a str) => a -> Enc '[nm] () str+toEncString' = runIdentity . toEncF @Identity @nm @alg++++-- backward compatible v0.2 like combinators+fromEncStringF :: forall nm f a str  . (FromEncString f nm nm a str) => Enc '[nm] () str -> f a+fromEncStringF = fromEncStringF' @nm @nm++fromEncStringF' :: forall alg nm f a str  . (FromEncString f nm alg a str) => Enc '[nm] () str -> f a+fromEncStringF' = fromEncF @f @nm @alg++fromEncString :: forall nm a str  . (FromEncString Identity nm nm a str) => Enc '[nm] () str -> a+fromEncString = fromEncString' @nm @nm++fromEncString' :: forall alg nm a str  . (FromEncString Identity nm alg a str) => Enc '[nm] () str -> a+fromEncString' = runIdentity . fromEncF @Identity @nm @alg
+ src/Data/TypedEncoding/Combinators/Unsafe.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Basic unsafe operations on 'Enc'+module Data.TypedEncoding.Combinators.Unsafe where++import           Data.TypedEncoding.Common.Types.Enc+import           Data.Proxy+++-- |+-- Currently recommended way of recreating encoding from trusted input,+-- if avoiding cost of "Data.TypedEncoding.Common.Types.Validation" is important+--    +-- @since 0.1.0.0 (moved)+unsafeSetPayload :: conf -> str -> Enc enc conf str +unsafeSetPayload  = UnsafeMkEnc Proxy ++-- |+-- @since 0.1.0.0 (moved)+withUnsafeCoerce ::  (s1 -> s2) -> Enc e1 c s1 -> Enc e2 c s2+withUnsafeCoerce f (UnsafeMkEnc _ conf str)  = UnsafeMkEnc Proxy conf (f str)++-- |+-- @since 0.3.0.0+withUnsafeCoerceF :: forall e1 e2 f c s1 s2 . Functor f => (s1 -> f s2) -> Enc e1 c s1 -> f (Enc e2 c s2)+withUnsafeCoerceF f (UnsafeMkEnc _ conf str)  = UnsafeMkEnc Proxy conf <$> f str++-- |+-- @since 0.1.0.0 (moved)+unsafeChangePayload ::  (s1 -> s2) -> Enc e c s1 -> Enc e c s2+unsafeChangePayload f (UnsafeMkEnc p conf str)  = UnsafeMkEnc p conf (f str)
+ src/Data/TypedEncoding/Combinators/Validate.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}++-- | Combinators reexported in Data.TypedEncoding+module Data.TypedEncoding.Combinators.Validate where++import           Data.TypedEncoding.Combinators.Common+import           Data.TypedEncoding.Combinators.Unsafe+import           Data.TypedEncoding.Common.Types+import           Data.TypedEncoding.Common.Class.Validate+import           Data.TypedEncoding.Common.Class.Util (SymbolList, Append)+import           GHC.TypeLits+import           Data.Functor.Identity+++-- * Validation++-- | Maybe signals annotation mismatch, effect @f@ is not evaluated unless there is match+checkWithValidations :: forall algs (nms :: [Symbol]) f c str . (+                    Monad f+                    , SymbolList nms+                    ) => Validations f nms algs c str -> UncheckedEnc c str -> Maybe (f (Enc nms c str))+checkWithValidations vers x = +      case verifyAnn @nms x of+            Left err -> Nothing -- asRecreateErr_ perr $ Left err+            Right (MkUncheckedEnc _ c str) -> Just $ recreateWithValidations vers . toEncoding c $ str++check :: forall (nms :: [Symbol]) f c str . (+            Monad f+            ,  ValidateAll f nms nms c str+            , SymbolList nms+           ) => UncheckedEnc c str -> Maybe (f (Enc nms c str)) +check = checkWithValidations @nms @nms @f validations ++check' :: forall algs (nms :: [Symbol]) f c str . (+            Monad f+            ,  ValidateAll f nms algs c str+            , SymbolList nms+           ) => UncheckedEnc c str -> Maybe (f (Enc nms c str)) +check' = checkWithValidations @algs @nms @f validations +++recreateWithValidations :: forall algs nms f c str . (Monad f) => Validations f nms algs c str -> Enc ('[]::[Symbol]) c str -> f (Enc nms c str)+recreateWithValidations vers str@(UnsafeMkEnc _ _ pay) = +        let str0 :: Enc nms c str = withUnsafeCoerce id str+        in withUnsafeCoerce (const pay) <$> runValidationChecks vers str0    ++-- * v0.2 style recreate functions++recreateFAll :: forall nms f c str . (Monad f,  ValidateAll f nms nms c str) =>  +               Enc ('[]::[Symbol]) c str +               -> f (Enc nms c str)  +recreateFAll = recreateFAll' @nms @nms ++recreateAll :: forall nms c str . (ValidateAll Identity nms nms c str) =>+               Enc ('[]::[Symbol]) c str +               -> Enc nms c str +recreateAll = recreateAll' @nms @nms  ++recreateFPart :: forall xs xsf f c str . (Monad f, ValidateAll f xs xs c str) => Enc xsf c str -> f (Enc (Append xs xsf) c str)+recreateFPart = recreateFPart' @xs @xs ++-- * Convenience combinators which mimic pre-v0.3 type signatures. These do not try to figure out @algs@ or assume much about them++recreateFAll' :: forall algs nms f c str . (Monad f,  ValidateAll f nms algs c str) =>  +               Enc ('[]::[Symbol]) c str +               -> f (Enc nms c str)  +recreateFAll' = recreateWithValidations @algs @nms @f validations ++recreateAll' :: forall algs nms c str . (ValidateAll Identity nms algs c str) =>+               Enc ('[]::[Symbol]) c str +               -> Enc nms c str +recreateAll' = runIdentity . recreateFAll' @algs ++recreateFPart' :: forall algs xs xsf f c str . (Monad f, ValidateAll f xs algs c str) => Enc xsf c str -> f (Enc (Append xs xsf) c str)+recreateFPart' = aboveF @xsf @'[] @xs (recreateFAll' @algs) ++recreatePart' :: forall algs xs xsf c str . (ValidateAll Identity xs algs c str) => Enc xsf c str -> Enc (Append xs xsf) c str   +recreatePart' = runIdentity . recreateFPart' @algs @xs+++--------------------------------------------
+ src/Data/TypedEncoding/Common/Class.hs view
@@ -0,0 +1,63 @@++{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++module Data.TypedEncoding.Common.Class (+    module Data.TypedEncoding.Common.Class+    , module Data.TypedEncoding.Common.Class.Util+    , module Data.TypedEncoding.Common.Class.Encode+    , module Data.TypedEncoding.Common.Class.Decode+    , module Data.TypedEncoding.Common.Class.Validate +    , module Data.TypedEncoding.Common.Class.Superset +  ) where++import           Data.TypedEncoding.Common.Class.Util+import           Data.TypedEncoding.Common.Class.Encode+import           Data.TypedEncoding.Common.Class.Decode+import           Data.TypedEncoding.Common.Class.Validate+import           Data.TypedEncoding.Common.Class.Superset++import           Data.TypedEncoding.Common.Types (Enc(..) )+import           Data.TypedEncoding.Combinators.Unsafe (withUnsafeCoerce)++import           GHC.TypeLits++++-- | +-- Generalized Java @toString@ or a type safe version of Haskell's 'Show'.+--+-- Encodes @a@ as @Enc '[xs]@ specifying algorithm @alg@ and using effect @f@ +--+class (KnownSymbol nm, KnownSymbol ann) => ToEncString f nm ann a str where+    toEncF :: a -> f (Enc '[nm] () str)++-- | +-- Reverse of 'ToEncString' decodes encoded string back to @a@+class (KnownSymbol nm, KnownSymbol ann) => FromEncString f nm ann a str where+    fromEncF :: Enc '[nm] () str -> f a++++-- Other classes --++-- | Flatten is more permissive 'IsSuperset'+-- @+-- instance FlattenAs "r-ASCII" "enc-B64" where -- OK+-- @+-- +-- Now encoded data has form @Enc '["r-ASCII"] c str@ +-- and there is no danger of it begin incorrectly decoded.++class FlattenAs (y :: Symbol) (x :: Symbol) where+    flattenAs ::  Enc (x ': xs) c str ->  Enc '[y] c str+    flattenAs = withUnsafeCoerce id
+ src/Data/TypedEncoding/Common/Class/Decode.hs view
@@ -0,0 +1,58 @@+{-# 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++-- |+-- @since 0.3.0.0+class Decode f nm alg conf str where+    decoding :: Decoding f nm alg conf str++-- |+-- @since 0.3.0.0+class DecodeAll f nms algs conf str where+    decodings :: Decodings f nms algs conf str++instance DecodeAll f '[] '[] conf str where  +    decodings = ZeroD ++instance (DecodeAll f nms algs conf str, Decode f nm alg conf str) => DecodeAll f (nm ': nms) (alg ': algs) conf str where  +    decodings = ConsD decoding decodings      +++-- | With type safety in place decoding errors should be unexpected.+-- This class can be used to provide extra info if decoding could fail+--+-- @since 0.1.0.0+class UnexpectedDecodeErr f where +    unexpectedDecodeErr :: UnexpectedDecodeEx -> f a++instance UnexpectedDecodeErr Identity where+    unexpectedDecodeErr x = fail $ show x++instance UnexpectedDecodeErr (Either UnexpectedDecodeEx) where+    unexpectedDecodeErr = Left ++-- |+-- @since 0.1.0.0+asUnexpected_ :: (KnownSymbol x, UnexpectedDecodeErr f, Applicative f, Show err) => Proxy x -> Either err a -> f a+asUnexpected_ p (Left err) = unexpectedDecodeErr $ UnexpectedDecodeEx p err+asUnexpected_ _ (Right r) = pure r++-- |+-- @since 0.1.0.0+asUnexpected :: forall x f err a . (KnownSymbol x, UnexpectedDecodeErr f, Applicative f, Show err) => Either err a -> f a+asUnexpected = asUnexpected_ (Proxy :: Proxy x)
+ src/Data/TypedEncoding/Common/Class/Encode.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}++module Data.TypedEncoding.Common.Class.Encode where++import           Data.TypedEncoding.Common.Types.Enc+++-- | +-- Using 2 Symbol type variables (@nm@ and @alg@) creates what seems like redundant typing+-- in statically defined instances such as @"r-ASCII"@, however it +-- provides future flexibility to +-- constrain @nm@ in some interesting way, different than @AlgNm nm ~ alg@. +--+-- It also seems to be easier to understand as type variables used in the definition of 'Encoding'+-- match with what is on the typeclass.+--+-- @alg@ is expected to be very statically defined and is needed to support more open instances such as @"r-ban"@.+--+-- @since 0.3.0.0+class Encode f nm alg conf str where+    encoding :: Encoding f nm alg conf str++-- |+-- @since 0.3.0.0+class EncodeAll f nms algs conf str where+    encodings :: Encodings f nms algs conf str++instance EncodeAll f '[] '[] conf str where  +    encodings = ZeroE  ++instance (EncodeAll f nms algs conf str, Encode f nm alg conf str) => EncodeAll f (nm ': nms) (alg ': algs) conf str where  +    encodings = ConsE encoding encodings      ++++
+ src/Data/TypedEncoding/Common/Class/IsStringR.hs view
@@ -0,0 +1,72 @@+++{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleInstances #-}++-- | This Module will be removed in the future in favor of classes defined in+-- "Data.TypedEncoding.Common.Class.Util.StringConstraints"+module Data.TypedEncoding.Common.Class.IsStringR where++import           Data.Proxy++import           Data.String+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL++++-- $setup+-- >>> :set -XScopedTypeVariables -XTypeApplications -XAllowAmbiguousTypes+-- >>> import Test.QuickCheck+-- >>> import Test.QuickCheck.Instances.Text()+-- >>> import Test.QuickCheck.Instances.ByteString()++-- | This class will be removed in 0.3.x.x in favor of classes definined in +-- "Data.TypedEncoding.Common.Class.Util.StringConstraints"+--+-- Reverses 'Data.String.IsString'+--+-- laws:+--+-- @+--  toString . fromString == id+--  fromString . toString == id+-- @+--+-- Note: ByteString is not a valid instance, ByteString "r-ASCII", or "r-UTF8" would+-- be needed.+-- @B.unpack $ B.pack "\160688" == "\176"@+class IsStringR a where+    toString :: a -> String++prop_fromStringToString :: forall s . (IsString s, IsStringR s, Eq s) => s -> Bool+prop_fromStringToString x = x == (fromString @s . toString $ x)++prop_toStringFromString :: forall s . (IsString s, IsStringR s) => Proxy s -> String -> Bool+prop_toStringFromString _ x = x == (toString @s . fromString $ x)++-- This would not work+-- @B.unpack $ B.pack "\160688" == "\176"@+--+-- prop> prop_toStringFromString (Proxy :: Proxy B.ByteString) +-- prop> prop_fromStringToString @B.ByteString+-- instance IsStringR B.ByteString where+--     toString = B.unpack+ ++-- |+-- prop> prop_toStringFromString (Proxy :: Proxy T.Text) +-- prop> prop_fromStringToString @T.Text+instance IsStringR T.Text where+    toString = T.unpack    ++-- |+-- prop> prop_toStringFromString (Proxy :: Proxy TL.Text) +-- prop> prop_fromStringToString @TL.Text+instance IsStringR TL.Text where+    toString = TL.unpack  ++instance IsStringR [Char] where+    toString = id
+ src/Data/TypedEncoding/Common/Class/Superset.hs view
@@ -0,0 +1,89 @@++{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+-- {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++module Data.TypedEncoding.Common.Class.Superset where++import           Data.TypedEncoding.Common.Util.TypeLits++import           Data.TypedEncoding.Common.Types (Enc(..) )+import           Data.TypedEncoding.Combinators.Unsafe (withUnsafeCoerce)+import           GHC.TypeLits+import           Data.Symbol.Ascii+++-- $setup+-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XTypeApplications+-- >>> import           Data.TypedEncoding+-- >>> import           Data.TypedEncoding.Instances.Restriction.UTF8 ()+-- >>> import           Data.TypedEncoding.Instances.Restriction.ASCII ()+-- >>> import           Data.Text as T+++-- |+-- Replaces previous @Superset@ typeclass.+--+-- Subsets are useful for restriction encodings+-- like r-UFT8 but should not be used for other encodings as+-- this would be dangerous. For example, considering "enc-" encoding as a superset of "r-" encoding would+-- permit converting encoded binary +-- @"Enc '["enc-"] c ByteString@ to @"Enc '["r-ASCII"] c ByteString@ and then to @"Enc '["r-ASCII"] c Text@, +-- which could result in runtime errors.+--+-- The requirement is that that the decoding in the superset+-- can replace the decoding from injected subset.+--+-- @IsSuperset bigger smaller@ reads as @bigger@ is a superset of @smaller@+--+-- @since 0.2.2.0+type family IsSuperset (y :: Symbol) (x :: Symbol) :: Bool where+    IsSuperset "r-ASCII" "r-ASCII" = 'True+    IsSuperset "r-UTF8"  "r-ASCII" = 'True+    IsSuperset "r-UTF8"  "r-UTF8" = 'True+    IsSuperset y x = IsSupersetOpen y (TakeUntil x ":") (ToList x)++type family IsSupersetOpen (y :: Symbol) (x :: Symbol) (xs :: [Symbol]) :: Bool++-- |+-- >>> let Right tstAscii = encodeFAll . toEncoding () $ "Hello World" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text)+-- >>> displ (injectInto @ "r-UTF8" tstAscii)+-- "Enc '[r-UTF8] () (Text Hello World)"+--+-- @since 0.2.2.0+injectInto :: forall y x xs c str . (IsSuperset y x ~ 'True) => Enc (x ': xs) c str ->  Enc (y ': xs) c str+injectInto = withUnsafeCoerce id++-- TODO consider expanding to +-- _injectInto ::forall y x xs c str . (IsSuperset y x ~ 'True) =>  Enc (x ': xs) c str ->  Enc (Replace x y xs) c str++-- |+-- IsSuperset is not intended for @"enc-"@ encodings. This class is.+-- +-- It allows to specify constraints that say, for example, that /Base 64/ encodes into +-- a subset of /ASCII/.+--+-- @since 0.3.0.0+class EncodingSuperset (enc :: Symbol) where+    type EncSuperset enc :: Symbol++    implEncInto :: forall xs c str . Enc (enc ': xs) c str -> Enc (EncSuperset enc ': enc ': xs) c str+    implEncInto = withUnsafeCoerce id+    +{-# WARNING implEncInto "Using this method at the call site may not be backward compatible between minor version upgrades, use _encodesInto instead." #-}++_encodesInto :: forall y enc xs c str r . (IsSuperset y r ~ 'True, EncodingSuperset enc, r ~ EncSuperset enc) => Enc (enc ': xs) c str -> Enc (y ': enc ': xs) c str+_encodesInto = injectInto . implEncInto++-- prop_Superset :: forall y x xs c str . (Superset y x, Eq str) => Enc (x ': xs) c str -> Bool+-- prop_Superset x = getPayload x == (getPayload . inject @y @x $ x)+
+ src/Data/TypedEncoding/Common/Class/Util.hs view
@@ -0,0 +1,89 @@++{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++module Data.TypedEncoding.Common.Class.Util where++import           Data.TypedEncoding.Common.Types.Common++import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as BL+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL++import           Data.Proxy+import qualified Data.List as L+import           GHC.TypeLits++-- $setup+-- >>> :set -XScopedTypeVariables -XTypeApplications -XAllowAmbiguousTypes -XDataKinds++-- * Symbol List++class SymbolList (xs::[Symbol]) where +    symbolVals :: [String]++instance SymbolList '[] where+    symbolVals = []++-- |+-- >>> symbolVals @ '["FIRST", "SECOND"]+-- ["FIRST","SECOND"]+instance (SymbolList xs, KnownSymbol x) => SymbolList (x ': xs) where+    symbolVals =  symbolVal (Proxy :: Proxy x) : symbolVals @xs+ +symbolVals_ :: forall xs . SymbolList xs => Proxy xs -> [String]+symbolVals_ _ = symbolVals @xs++-- * Display ++-- | Human friendly version of Show+class Displ x where +    displ :: x -> String+++instance Displ [EncAnn] where +    displ x = "[" ++ L.intercalate "," x ++ "]"+instance Displ T.Text where+    displ x = "(Text " ++ T.unpack x ++ ")"+instance Displ TL.Text where+    displ x = "(TL.Text " ++ TL.unpack x ++ ")"+instance Displ B.ByteString where+    displ x = "(ByteString " ++ B.unpack x ++ ")" +instance Displ BL.ByteString where+    displ x = "(ByteString " ++ BL.unpack x ++ ")"   +instance Displ String where+    displ x = "(String " ++ x ++ ")" ++++-- |+-- >>> displ (Proxy :: Proxy ["FIRST", "SECOND"])+-- "[FIRST,SECOND]"+instance (SymbolList xs) => Displ (Proxy xs) where+    displ _ = displ $  symbolVals @ xs+        -- "[" ++ (L.intercalate "," $ map displ $ symbolVals @ xs) ++ "]"+++-- * Other++-- | TODO should this be imported from somewhere?+type family Append (xs :: [k]) (ys :: [k]) :: [k] where+    Append '[] xs = xs+    Append (y ': ys) xs = y ': Append ys xs++-- | Polymorphic data payloads used to encode/decode+class HasA a c where+    has :: c -> a++instance HasA () c where+    has = const ()
+ src/Data/TypedEncoding/Common/Class/Util/StringConstraints.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Future replacement for "Data.TypedEncoding.Common.Class.IsStringR"+module Data.TypedEncoding.Common.Class.Util.StringConstraints where++import qualified Data.List as L+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import           Data.String+import           Data.Proxy+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy.Char8 as BL8++-- $setup+-- >>> :set -XScopedTypeVariables -XTypeApplications -XAllowAmbiguousTypes+-- >>> import Test.QuickCheck+-- >>> import Test.QuickCheck.Instances.Text()+-- >>> import Test.QuickCheck.Instances.ByteString()+++-- * IsString reversal++-- | Reverses 'Data.String.IsString'+--+-- law for types that are also @IsString@:+-- +-- @+--  toString . fromString == id+-- @+--+-- Note: ByteString is not a valid instance, ByteString "r-ASCII", or "r-UTF8" would+-- be needed.+-- @B8.unpack $ B8.pack "\160688" == "\176"@+--+-- This class is separated from @ToStrIso@ to allow instances from /smaller/ types+-- the can inject into the 'String' type.+class ToStrInj str from where+    toString :: from -> str++prop_toStringFromString :: forall s . (IsString s, ToStrInj String s) => Proxy s -> String -> Bool+prop_toStringFromString _ x = x == (toString @String @s . fromString $ x)+++-- |+-- prop> prop_toStringFromString (Proxy :: Proxy T.Text) +instance ToStrInj String T.Text where+    toString = T.unpack    ++-- |+-- prop> prop_toStringFromString (Proxy :: Proxy TL.Text) +instance ToStrInj String TL.Text where+    toString = TL.unpack  +++instance ToStrInj String String where+    toString = id++-- will not work!+-- prop> prop_toStringFromString (Proxy :: Proxy B.ByteString) +-- instance ToStrInj String B.ByteString where+--     toString = B8.unpack++-- will not work!+-- prop> prop_toStringFromString (Proxy :: Proxy BL.ByteString) +-- instance ToStrInj String BL.ByteString where+--     toString = BL8.unpack+++-- | Same as @ToStrInj@ but with additional+--+-- law for types that are also @IsString@:+-- @+--  fromString . toString == id+-- @+class ToStrInj str from => ToStrIso str from where++prop_fromStringToString :: forall s . (IsString s, ToStrIso String s, Eq s) => s -> Bool+prop_fromStringToString x = x == (fromString @s . toString $ x)++-- |+-- prop> prop_fromStringToString @T.Text+instance ToStrIso String T.Text where++-- |+-- prop> prop_fromStringToString @TL.Text+instance ToStrIso String TL.Text where    ++instance ToStrIso String String where++-- |+-- Used to find exceptions that violated "r-" encoding+-- Expected to be used to check encoding of ASCII-7 so Text and ByteString are compatible.+class Char8Find str where+    find :: (Char -> Bool) -> str -> Maybe Char++instance Char8Find String where+    find = L.find++instance Char8Find T.Text where+    find = T.find++instance Char8Find TL.Text where+    find = TL.find    ++-- |+-- B8.pack is basically a convenient way to get Word8 elements into ByteString.+--+-- During B8.pack conversion charters are downsized to the 0-255 range (become a Word8).+-- The length is preserved. +-- +-- >>> B8.pack "\160582"+-- "F"+--+-- >>> B.length $ B8.pack "\160582"+-- 1+--+-- This instance allows to check elements of ByteString interpreting them as Char.+-- +-- Safe if restricting to 7bit code points.+instance Char8Find B.ByteString where+    find = B8.find   ++instance Char8Find BL.ByteString where+    find = BL8.find
+ src/Data/TypedEncoding/Common/Class/Validate.hs view
@@ -0,0 +1,50 @@++{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+-- {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++module Data.TypedEncoding.Common.Class.Validate where++import           Data.TypedEncoding.Common.Types (RecreateEx(..))+import           Data.TypedEncoding.Common.Types.Validation++import           Data.Proxy+import           GHC.TypeLits+++class Validate f nm alg conf str where+    validation :: Validation f nm alg conf str++class ValidateAll f nms algs conf str where+    validations :: Validations f nms algs conf str++instance ValidateAll f '[] '[] conf str where  +    validations = ZeroV++instance (ValidateAll f nms algs conf str, Validate f nm alg conf str) => ValidateAll f (nm ': nms) (alg ': algs) conf str where  +    validations = ConsV validation validations      ++++-- | Recovery errors are expected unless Recovery allows Identity instance+class RecreateErr f where +    recoveryErr :: RecreateEx -> f a++instance RecreateErr (Either RecreateEx) where+    recoveryErr = Left  ++asRecreateErr_ :: (RecreateErr f, Applicative f, Show err, KnownSymbol x) => Proxy x -> Either err a -> f a+asRecreateErr_ p (Left err) = recoveryErr $ RecreateEx p err+asRecreateErr_ _ (Right r) = pure r+++asRecreateErr :: forall x f err a . (RecreateErr f, Applicative f, Show err, KnownSymbol x) => Either err a -> f a+asRecreateErr = asRecreateErr_ (Proxy :: Proxy x)
+ src/Data/TypedEncoding/Common/Types.hs view
@@ -0,0 +1,23 @@++-- |+-- Internal definition of types++module Data.TypedEncoding.Common.Types (+        module Data.TypedEncoding.Common.Types+        , module Data.TypedEncoding.Common.Types.Enc+        , module Data.TypedEncoding.Common.Types.Decoding+        , module Data.TypedEncoding.Common.Types.Validation+        , module Data.TypedEncoding.Common.Types.CheckedEnc+        , module Data.TypedEncoding.Common.Types.UncheckedEnc+        , module Data.TypedEncoding.Common.Types.Common+        , module Data.TypedEncoding.Common.Types.Exceptions+    ) where++import           Data.TypedEncoding.Common.Types.Enc+import           Data.TypedEncoding.Common.Types.Decoding+import           Data.TypedEncoding.Common.Types.Validation+import           Data.TypedEncoding.Common.Types.CheckedEnc+import           Data.TypedEncoding.Common.Types.UncheckedEnc+import           Data.TypedEncoding.Common.Types.Common+import           Data.TypedEncoding.Common.Types.Exceptions+
+ src/Data/TypedEncoding/Common/Types/CheckedEnc.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- {-# LANGUAGE PolyKinds #-}+-- {-# LANGUAGE DataKinds #-}+-- {-# LANGUAGE TypeOperators #-}+-- {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE RankNTypes #-}++-- |+-- Module defines 'CheckedEnc' - untyped ADT version of 'Enc' ++module Data.TypedEncoding.Common.Types.CheckedEnc where++import           Data.TypedEncoding.Common.Types.Enc+import           Data.TypedEncoding.Common.Types.Common+import           Data.TypedEncoding.Common.Class.Util+import           Data.Proxy++-- $setup+-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XAllowAmbiguousTypes+-- >>> import qualified Data.Text as T+-- >>> import  Data.TypedEncoding.Combinators.Unsafe (unsafeSetPayload)+++-- * Untyped Enc++-- constructor is to be treated as Unsafe to Encode and Decode instance implementations+-- particular encoding instances may expose smart constructors for limited data types++-- | Represents some validated encoded string. +--+-- @CheckedEnc@ is untyped version of 'Data.TypedEncoding.Common.Types.Enc.Enc'. +-- @CheckedEnc@ contains verified encoded data, encoding is visible+-- at the value level only.+data CheckedEnc conf str = UnsafeMkCheckedEnc [EncAnn] conf str+     deriving (Show, Eq) ++unsafeCheckedEnc:: [EncAnn] -> c -> s -> CheckedEnc c s+unsafeCheckedEnc = UnsafeMkCheckedEnc++getCheckedPayload :: CheckedEnc conf str -> str+getCheckedPayload = snd . getCheckedEncPayload++getCheckedEncPayload :: CheckedEnc conf str -> ([EncAnn], str) +getCheckedEncPayload (UnsafeMkCheckedEnc t _ s) = (t,s)++toCheckedEnc :: forall xs c str . (SymbolList xs) => Enc xs c str -> CheckedEnc c str +toCheckedEnc (UnsafeMkEnc p c s) = +        UnsafeMkCheckedEnc (symbolVals @ xs) c s   +++fromCheckedEnc :: forall xs c str . SymbolList xs => CheckedEnc c str -> Maybe (Enc xs c str)+fromCheckedEnc (UnsafeMkCheckedEnc xs c s) = +    let p = Proxy :: Proxy xs+    in if symbolVals @ xs == xs+       then Just $ UnsafeMkEnc p c s+       else Nothing++------------------------++-- |+-- >>> let encsometest = UnsafeMkCheckedEnc ["TEST"] () $ T.pack "hello"+-- >>> proc_toCheckedEncFromCheckedEnc @'["TEST"] encsometest+-- True+-- >>> proc_toCheckedEncFromCheckedEnc @'["TEST1"] encsometest+-- False+proc_toCheckedEncFromCheckedEnc :: forall xs c str . (SymbolList xs, Eq c, Eq str) => CheckedEnc c str -> Bool+proc_toCheckedEncFromCheckedEnc x = (== Just x) . fmap (toCheckedEnc @ xs) . fromCheckedEnc $ x++-- |+-- >>> let enctest = unsafeSetPayload () "hello" :: Enc '["TEST"] () T.Text+-- >>> proc_fromCheckedEncToCheckedEnc enctest+-- True+proc_fromCheckedEncToCheckedEnc :: forall xs c str . (SymbolList xs, Eq c, Eq str) => Enc xs c str -> Bool+proc_fromCheckedEncToCheckedEnc x = (== Just x) . fromCheckedEnc . toCheckedEnc $ x++-- |+-- >>> displ $ unsafeCheckedEnc ["TEST"] () ("hello" :: T.Text)+-- "UnsafeMkCheckedEnc [TEST] () (Text hello)"+instance (Show c, Displ str) => Displ (CheckedEnc c str) where+    displ (UnsafeMkCheckedEnc xs c s) = +        "UnsafeMkCheckedEnc " ++ displ xs  ++ " " ++ show c ++ " " ++ displ s+
+ src/Data/TypedEncoding/Common/Types/Common.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+-- {-# LANGUAGE FlexibleInstances #-}+-- {-# LANGUAGE FlexibleContexts #-}+-- {-# LANGUAGE UndecidableInstances #-}+-- {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE KindSignatures  #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ConstraintKinds #-}++module Data.TypedEncoding.Common.Types.Common where++import           Data.TypedEncoding.Common.Util.TypeLits+import           GHC.TypeLits+++-- $setup+-- >>> :set -XScopedTypeVariables -XTypeFamilies -XKindSignatures -XDataKinds+++-- | Represents value level (single) annotation.+type EncAnn = String    ++type Restriction s = (KnownSymbol s, IsR s ~ 'True)++type Algorithm nm alg = AlgNm nm ~ alg+++-- |+-- Converts encoding name to algorithm name, this assumes the ":" delimiter expected by this library. +--+-- This allows working with open encoding definitions such as "r-ban" or "r-bool"+-- +-- >>> :kind! AlgNm "enc-B64"+-- ...+-- = "enc-B64"+--+-- >>> :kind! AlgNm "r-ban:999-99-9999"+-- ...+-- = "r-ban"+--+type family AlgNm (encnm :: Symbol) :: Symbol where+    AlgNm encnm = TakeUntil encnm ":"+++type family AlgNmMap (nms :: [Symbol]) :: [Symbol] where+    AlgNmMap '[] = '[]+    AlgNmMap (x ': xs) = AlgNm x ': AlgNmMap xs++-- |+-- >>> :kind! IsR "r-UPPER"+-- ...+-- ... 'True+--+-- >>> :kind! IsR "do-UPPER"+-- ...+-- = (TypeError ... +type family IsR (s :: Symbol) :: Bool where+    IsR s = AcceptEq ('Text "Not restriction encoding " ':<>: ShowType s ) (CmpSymbol "r-" (Take 2 s))+++type family IsROrEmpty (s :: Symbol) :: Bool where+    IsROrEmpty "" = True+    IsROrEmpty x  = IsR x+
+ src/Data/TypedEncoding/Common/Types/Decoding.hs view
@@ -0,0 +1,76 @@+{-# 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 #-}++-- |+-- Internal definition of types+--+-- Decoding types for @Enc@+module Data.TypedEncoding.Common.Types.Decoding where++import           Data.Proxy+import           GHC.TypeLits++import           Data.TypedEncoding.Common.Types.Enc+import           Data.TypedEncoding.Common.Types.Common++-- |+-- Similar to 'Data.TypedEncoding.Common.Types.Enc.Encoding'+--+-- Used to create instances of decoding.++data Decoding f (nm :: Symbol) (alg :: Symbol) conf str where+    -- | Consider this constructor as private or use it with care+    --+    -- Using this constructor:+    -- @+    -- MkDecoding :: Proxy nm -> (forall (xs :: [Symbol]) . Enc (nm ': xs) conf str -> f (Enc xs conf str)) -> Decoding f nm (AlgNm nm) conf str+    -- @+    -- +    -- would make compilation much slower+    UnsafeMkDecoding :: Proxy nm -> (forall (xs :: [Symbol]) . Enc (nm ': xs) conf str -> f (Enc xs conf str)) -> Decoding f nm alg conf str++-- | Type safe smart constructor+-- (See also 'Data.TypedEncoding.Common.Types.Enc._mkEncoding')      +mkDecoding :: forall f (nm :: Symbol) conf str . (forall (xs :: [Symbol]) . Enc (nm ': xs) conf str -> f (Enc xs conf str)) -> Decoding f nm (AlgNm nm) conf str+mkDecoding = UnsafeMkDecoding Proxy++runDecoding :: forall alg nm f xs conf str . Decoding f nm alg conf str -> Enc (nm ': xs) conf str -> f (Enc xs conf str)+runDecoding (UnsafeMkDecoding _ fn) = fn++-- | Same as 'runDecoding" but compiler figures out algorithm name+--+-- Using it can slowdown compilation+_runDecoding :: forall nm f xs conf str alg . (AlgNm nm ~ alg) => Decoding f nm alg conf str -> Enc (nm ': xs) conf str -> f (Enc xs conf str)+_runDecoding = runDecoding @(AlgNm nm)++-- |+-- Wraps a list of @Decoding@ elements.+--+-- Similarly to 'Data.TypedEncoding.Common.Types.Enc.Encodings' can be used with a typeclass+-- 'Data.TypedDecoding.Internal.Class.Decode.DecodeAll'+data Decodings f (nms :: [Symbol]) (algs :: [Symbol]) conf str where+    -- | constructor is to be treated as Unsafe to Encode and Decode instance implementations+    -- particular encoding instances may expose smart constructors for limited data types+    ZeroD :: Decodings f '[] '[] conf str+    ConsD ::  Decoding f nm alg conf str -> Decodings f nms algs conf str -> Decodings f (nm ': nms) (alg ': algs) conf str++runDecodings :: forall algs nms f c str . (Monad f) => Decodings f nms algs c str -> Enc nms c str -> f (Enc ('[]::[Symbol]) c str)+runDecodings ZeroD enc0 = pure enc0+runDecodings (ConsD fn xs) enc = +        let re :: f (Enc _ c str) = runDecoding fn enc+        in re >>= runDecodings xs+++-- | At possibly big compilation cost, have compiler figure out algorithm names.+_runDecodings :: forall nms f c str algs . (Monad f, algs ~ AlgNmMap nms) => Decodings f nms algs c str -> Enc nms c str -> f (Enc ('[]::[Symbol]) c str)+_runDecodings = runDecodings @(AlgNmMap nms)
+ src/Data/TypedEncoding/Common/Types/Enc.hs view
@@ -0,0 +1,225 @@+{-# 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 #-}+-- |+-- Internal definition of types++module Data.TypedEncoding.Common.Types.Enc where++import           Data.Proxy+import           GHC.TypeLits++import           Data.TypedEncoding.Common.Class.Util+import           Data.TypedEncoding.Common.Types.Common++-- $setup+-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XAllowAmbiguousTypes+-- >>> import qualified Data.ByteString as B+-- >>> import qualified Data.Text as T+-- >>> import Data.Functor.Identity+-- >>> import Data.TypedEncoding+-- >>> import Data.TypedEncoding.Instances.Enc.Base64 ()+-- >>> import Data.TypedEncoding.Instances.Restriction.BoundedAlphaNums ()++-- |+-- Contains encoded data annotated by +--+-- * @nms@ list of @Symbol@s with encoding names (encoding stack)+-- * @conf@ that can contain configuration / encoding information such as digest.+-- * @str@ the encoded data+--+--  Example: +--+-- @+-- Enc '["r-ASCII"] () ByteString+-- @+--+-- @since 0.1.0.0+data Enc nms conf str where+    -- | +    -- @since 0.3.0.0 renamed from MkEnc +    --+    -- Use of this constructor should be kept to a minimum. +    --+    -- Use of 'Data.TypedEncoding.Combinators.Unsafe.unsafeSetPayload' currently recommended+    -- for recovering 'Enc' from trusted input sources (if avoiding cost of "Data.TypedEncoding.Common.Types.Validation" is important).+    UnsafeMkEnc :: Proxy nms -> conf -> str -> Enc nms conf str+    deriving (Show, Eq) ++-- |+-- >>> let disptest = UnsafeMkEnc Proxy () "hello" :: Enc '["TEST"] () T.Text+-- >>> displ disptest+-- "Enc '[TEST] () (Text hello)"+instance (SymbolList xs, Show c, Displ str) => Displ ( Enc xs c str) where+    displ (UnsafeMkEnc p c s) = +        "Enc '" ++ displ (Proxy :: Proxy xs) ++ " " ++ show c ++ " " ++ displ s++-- |+-- @since 0.1.0.0+toEncoding :: conf -> str -> Enc ('[] :: [Symbol]) conf str+toEncoding = UnsafeMkEnc Proxy ++-- |+-- @since 0.1.0.0+fromEncoding :: Enc '[] conf str -> str+fromEncoding = getPayload++-- |+-- @since 0.1.0.0+getPayload :: Enc enc conf str -> str  +getPayload (UnsafeMkEnc _ _ str) = str++ ++-- |+-- Wraps the encoding function.+-- Contains type level information about the encoding name and the algorithm used. +--+-- This type is used by programs implementing encoding instance.+-- Such program needs to define a value of this type. +-- It also implements 'Data.TypedEncoding.Common.Class.Encode.Encode' instance that simply returns that value.+--+-- Programs using encoding can access this type using 'Data.TypedEncoding.Common.Class.Encode.Encode.encoding'+-- (from the @Encode@ typeclass) but a better (and recommended) approach is to use its plural sibling 'Encodings' +-- defined below.+--+-- This type has 2 symbol type variables:+--+-- * @nm@  defines the encoding+-- * @alg@  defines algorithm +--+-- These two are related, currently this library only supports +--+-- * Names @nm@ containing ":" using format "alg:...", for example name "r-ban:999" has "r-ban" algorithm +-- * Names without ":" require that @nm ~ alg@+--+-- Future version are likely to relax this, possibly introducing ability do define more than one algorithm+-- for given encoding. +--+-- Using 2 variables allows us to define typeclass constraints that work+-- with definitions like @"r-ban"@ where @"r-ban:@" can be followed by arbitrary+-- string literal.+--+-- Examples: +--+-- @+-- Encoding (Either EncodeEx) "r-ban:9" "r-ban" () String+-- @+--+-- encodes a single character @ <= 9'@+--+-- @+-- Encoding Identity "enc-B64" "enc-B64" () ByteString+-- @+--+-- Represents a /Byte 64/ encoder that can operate on any stack of previous encodings.+-- (encoding name and algorithm name are "enc-B64", there is no  +-- additional configuration @()@ needed and it runs in the @Identity@ Functor.+--+-- Similar boilerplate for /Decoding/ and /Validation/ is specified in separate modules.+--+-- @since 0.3.0.0+data Encoding f (nm :: Symbol) (alg :: Symbol) conf str where+    -- | Consider this constructor as private or use it with care+    --+    -- Defining constructor like this:+    -- @+    -- MkEncoding :: Proxy nm -> (forall (xs :: [Symbol]) . Enc xs conf str -> f (Enc (nm ': xs) conf str)) -> Encoding f nm (AlgNm nm) conf str+    -- @+    -- +    -- would make compilation much slower+    UnsafeMkEncoding :: Proxy nm -> (forall (xs :: [Symbol]) . Enc xs conf str -> f (Enc (nm ': xs) conf str)) -> Encoding f nm alg conf str++-- | Type safe smart constructor+--+-- Adding the type family @(AlgNm nm)@ mapping to @Encoding@ constructor slows down the compilation.  +-- Using smart constructor does not have that issue.+--+-- This approach also provides more future flexibility with possibility of future overloads relaxing current +-- limitations on @alg@ names. +-- +-- /Notice underscore @_@ convention, it indicates a use of @Algorithm@ @AlgNm@: compiler figures out @alg@ value. These can be slower to compile when used. /+--+-- Here are other conventions that relate to the existence of @alg@+--+-- * functions ending with: @'@, for example 'Data.TypedEncoding.Combinators.Encode.encodeF'' have @alg@+--   as first type variable in the @forall@ list.+--+-- * functions without tick tend to assume @nm ~ alg@+-- +-- This particular function appears to not increase compilation time. +--+-- @since 0.3.0.0+_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 = UnsafeMkEncoding Proxy++-- |+-- @since 0.3.0.0+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' (UnsafeMkEncoding _ fn) = fn++-- | Same as 'runEncoding'' but compiler figures out algorithm name+--+-- Using it can slowdown compilation+--+-- This combinator has @Algorithm nm alg@ constraint (which stands for @TakeUntil ":" nm ~ alg@.+-- If rules on @alg@ are relaxed this will just return the /default/ algorithm.+--+-- If that happens @-XTypeApplications@ annotations will be needed and @_@ methods will simply +-- use default algorithm name.+--+-- @since 0.3.0.0+_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 = runEncoding' @(AlgNm nm)++-- |+-- HList like construction that defines a list of @Encoding@ elements.+--+-- This type is used by programs using / manipulating encodings.+--+-- Can be easily accessed with 'Data.TypedEncoding.Common.Class.Encode.EncodeAll' constraint using+-- 'Data.TypedEncoding.Common.Class.Encode.EncodeAll.encodings'.  But could also be used by creating+-- @Encodings@ list by hand.+--+-- @since 0.3.0.0+data Encodings f (nms :: [Symbol]) (algs :: [Symbol]) conf str where+    -- | constructor is to be treated as Unsafe to Encode and Decode instance implementations+    -- particular encoding instances may expose smart constructors for limited data types+    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++-- |+-- Runs encodings, requires -XTypeApplication annotation specifying the algorithm(s)+--+-- >>> runEncodings' @'["r-ban"] encodings . toEncoding () $ ("22") :: Either EncodeEx (Enc '["r-ban:111"] () T.Text)+-- Left (EncodeEx "r-ban:111" ("Input list has wrong size expecting 3 but length \"22\" == 2"))+--+-- @since 0.3.0.0+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' ZeroE enc0 = pure enc0+runEncodings' (ConsE fn enc) enc0 = +        let re :: f (Enc _ c str) = runEncodings' enc enc0+        in re >>= runEncoding' fn+++-- | At a possibly some compilation cost, have compiler figure out algorithm names.+--+-- >>> _runEncodings encodings . toEncoding () $ ("Hello World") :: Identity (Enc '["enc-B64","enc-B64"] () B.ByteString)+-- Identity (UnsafeMkEnc Proxy () "U0dWc2JHOGdWMjl5YkdRPQ==")+-- +-- >>> _runEncodings encodings . toEncoding () $ ("22") :: Either EncodeEx (Enc '["r-ban:111"] () T.Text)+-- Left (EncodeEx "r-ban:111" ("Input list has wrong size expecting 3 but length \"22\" == 2"))+--+-- (see also '_runEncoding')+-- @since 0.3.0.0+_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 = runEncodings' @(AlgNmMap nms)
+ src/Data/TypedEncoding/Common/Types/Exceptions.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+-- {-# LANGUAGE RankNTypes #-}++-- |+-- Internal definition of types++module Data.TypedEncoding.Common.Types.Exceptions where+++import           Data.Proxy+import           GHC.TypeLits+++-- $setup+-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XAllowAmbiguousTypes+-- >>> import qualified Data.Text as T+++-- | Represents errors in recovery (recreation of encoded types).+data RecreateEx where+    RecreateEx:: (Show e, KnownSymbol x) => Proxy x -> e -> RecreateEx+    RecreateExUnkStep::   (Show e) => e -> RecreateEx++instance Show RecreateEx where+    show (RecreateEx prxy a) = "(RecreateEx \"" ++ symbolVal prxy ++ "\" (" ++ show a ++ "))"+    show (RecreateExUnkStep  a) = "(UnknownDecodeStep (" ++ show a ++ "))"+++recreateErrUnknown :: (Show e) => e -> RecreateEx+recreateErrUnknown  = RecreateExUnkStep++-- instance Eq RecreateEx where+--     (RecreateEx prxy1 a1) == RecreateEx prxy2 a2 = (symbolVal prxy1) == (symbolVal prxy2)+++-- | Represents errors in encoding+data EncodeEx where+    EncodeEx:: (Show a, KnownSymbol x) => Proxy x -> a -> EncodeEx ++instance Show EncodeEx where+    show (EncodeEx prxy a) = "(EncodeEx \"" ++ symbolVal prxy ++ "\" (" ++ show a ++ "))"++asEncodeEx :: (Show a, KnownSymbol x) => Proxy x -> Either a b -> Either EncodeEx b+asEncodeEx p = either (Left . EncodeEx p) Right +++-- | Useful when manually recreating using recovery+encToRecrEx :: EncodeEx ->  RecreateEx+encToRecrEx (EncodeEx p a) = RecreateEx p a++mergeEncodeEx ::  KnownSymbol x => Proxy x -> EncodeEx -> Maybe EncodeEx -> EncodeEx+mergeEncodeEx _ ex Nothing = ex+mergeEncodeEx p (EncodeEx _ a) (Just (EncodeEx _ b)) = EncodeEx p $ "Errors: " ++ show (a,b)++emptyEncErr ::  KnownSymbol x =>  Proxy x -> EncodeEx +emptyEncErr p = EncodeEx p ("unexpected" :: String)++-- | Type safety over encodings makes decoding process safe.+-- However failures are still possible due to bugs or unsafe payload modifications.+-- UnexpectedDecodeEx represents such errors.+data UnexpectedDecodeEx where+    UnexpectedDecodeEx :: (Show a, KnownSymbol x) => Proxy x -> a -> UnexpectedDecodeEx++instance Show UnexpectedDecodeEx where+    show (UnexpectedDecodeEx prxy a) = "(UnexpectedDecodeEx \"" ++ symbolVal prxy ++ "\" (" ++ show a ++ "))"+++-- * Base combinators that rely on types defined here++mergeErrs :: err -> (err -> Maybe err -> err) -> Either err a -> Either err b -> Either err c+mergeErrs _ fn (Left er1) (Left er2) = Left (fn er1 $ Just er2)+mergeErrs _ fn (Left er1) _ = Left (fn er1 Nothing)+mergeErrs _ fn _  (Left er2) = Left (fn er2 Nothing) +mergeErrs de fn (Right r) (Right y) = Left de
+ src/Data/TypedEncoding/Common/Types/SomeAnnotation.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE RankNTypes #-}++-- | internally used existential type for taking track of annotations+module Data.TypedEncoding.Common.Types.SomeAnnotation where++import           Data.TypedEncoding.Common.Types.Common+import           Data.TypedEncoding.Common.Class.Util+import           Data.TypedEncoding.Internal.Util+import           Data.Proxy+import           GHC.TypeLits+++data SomeAnnotation where+    MkSomeAnnotation :: SymbolList xs => Proxy xs -> SomeAnnotation++withSomeAnnotation :: SomeAnnotation -> (forall xs . SymbolList xs => Proxy xs -> r) -> r+withSomeAnnotation (MkSomeAnnotation p) fn = fn p++-- folds over SomeSymbol list using withSomeSymbol and proxyCons+someAnnValue :: [EncAnn] -> SomeAnnotation+someAnnValue xs = +     foldr (fn . someSymbolVal) (MkSomeAnnotation (Proxy :: Proxy '[])) xs+     where +         somesymbs = map someSymbolVal xs+         fn ss (MkSomeAnnotation pxs) = withSomeSymbol ss (\px -> MkSomeAnnotation  (px `proxyCons` pxs)) ++proxyCons :: forall (x :: Symbol) (xs :: [Symbol]) . Proxy x -> Proxy xs -> Proxy (x ': xs)+proxyCons _ _ = Proxy
+ src/Data/TypedEncoding/Common/Types/SomeEnc.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- {-# LANGUAGE PolyKinds #-}+-- {-# LANGUAGE DataKinds #-}+-- {-# LANGUAGE TypeOperators #-}+-- {-# LANGUAGE FlexibleInstances #-}+-- {-# LANGUAGE StandaloneDeriving #-}+-- {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE RankNTypes #-}++-- |+-- Module defines 'SomeEnc' - existentially quantified version of @Enc@+-- and basic combinators++module Data.TypedEncoding.Common.Types.SomeEnc where++import           Data.TypedEncoding.Common.Types.Enc+import           Data.TypedEncoding.Common.Class.Util+import           Data.TypedEncoding.Common.Types.SomeAnnotation+import           Data.TypedEncoding.Common.Types.CheckedEnc++-- $setup+-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XAllowAmbiguousTypes+-- >>> import qualified Data.Text as T+-- >>> import Data.TypedEncoding.Combinators.Unsafe++++-- | Existentially quantified quantified @Enc@+-- effectively isomorphic to 'CheckedEnc'+data SomeEnc conf str where+    MkSomeEnc :: SymbolList xs => Enc xs conf str -> SomeEnc conf str+    +withSomeEnc :: SomeEnc conf str -> (forall xs . SymbolList xs => Enc xs conf str -> r) -> r+withSomeEnc (MkSomeEnc enc) f = f enc++toSome :: SymbolList xs => Enc xs conf str -> SomeEnc conf str+toSome = MkSomeEnc++-- | +-- >>> let enctest = unsafeSetPayload () "hello" :: Enc '["TEST"] () T.Text+-- >>> someToChecked . MkSomeEnc $ enctest+-- UnsafeMkCheckedEnc ["TEST"] () "hello"+someToChecked :: SomeEnc conf str -> CheckedEnc conf str+someToChecked se = withSomeEnc se toCheckedEnc++-- | +-- >>> let tst = unsafeCheckedEnc ["TEST"] () "test"+-- >>> displ $ checkedToSome tst+-- "Some (Enc '[TEST] () (String test))"+checkedToSome :: CheckedEnc conf str -> SomeEnc conf str+checkedToSome (UnsafeMkCheckedEnc xs c s) = withSomeAnnotation (someAnnValue xs) (\p -> MkSomeEnc (UnsafeMkEnc p c s))+++-- |+-- >>> let enctest = unsafeSetPayload () "hello" :: Enc '["TEST"] () T.Text+-- >>> displ $ MkSomeEnc enctest+-- "Some (Enc '[TEST] () (Text hello))"+instance (Show c, Displ str) => Displ (SomeEnc c str) where+    displ (MkSomeEnc en) = +       "Some (" ++ displ en ++ ")"
+ src/Data/TypedEncoding/Common/Types/UncheckedEnc.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- |+-- Internal definition of types++module Data.TypedEncoding.Common.Types.UncheckedEnc where++import           Data.Proxy+import           Data.TypedEncoding.Common.Class.Util+import           Data.TypedEncoding.Common.Types.Common++-- $setup+-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XAllowAmbiguousTypes+-- >>> import qualified Data.Text as T+++-- * UncheckedEnc for validation, similar to CheckedEnc but not verified++-- | Represents some encoded string where encoding was not validated.+--+-- Similar to 'Data.TypedEncoding.Common.Types.CheckedEnc' but unlike+-- @CheckedEnc@ it can contain payloads that have invalid encoding.+-- +-- See 'Data.TypedEncoding.Combinators.Validate.check'+data UncheckedEnc c str = MkUncheckedEnc [EncAnn] c str deriving (Show, Eq)++toUncheckedEnc :: [EncAnn] -> c -> str -> UncheckedEnc c str+toUncheckedEnc = MkUncheckedEnc++getUncheckedEncAnn :: UncheckedEnc c str -> [EncAnn]+getUncheckedEncAnn (MkUncheckedEnc ann _ _) = ann++verifyAnn :: forall xs c str . SymbolList xs => UncheckedEnc c str -> Either String (UncheckedEnc c str)+verifyAnn x@(MkUncheckedEnc xs _ _) = +    let p = Proxy :: Proxy xs+    in if symbolVals @ xs == xs+       then Right x+       else Left $ "UncheckedEnc has not matching annotation " ++ displ xs++-- |+-- >>> displ $ MkUncheckedEnc ["TEST"] () ("hello" :: T.Text)+-- "MkUncheckedEnc [TEST] () (Text hello)"+instance (Show c, Displ str) => Displ (UncheckedEnc c str) where+    displ (MkUncheckedEnc xs c s) = +        "MkUncheckedEnc " ++ displ xs ++ " " ++ show c ++ " " ++ displ s
+ src/Data/TypedEncoding/Common/Types/Unsafe.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}++module Data.TypedEncoding.Common.Types.Unsafe where++import           Data.Proxy+import           Data.TypedEncoding.Common.Types++ +-- | Allows to operate within Enc. These are considered unsafe.+-- keeping the same list of encodings +newtype Unsafe enc conf str = Unsafe {runUnsafe :: Enc enc conf str} deriving (Show)++withUnsafe :: (Unsafe e c s1 -> Unsafe e c s2) -> Enc e c s1 -> Enc e c s2+withUnsafe f enc = runUnsafe . f $ Unsafe enc++instance Functor (Unsafe enc conf) where+    fmap f (Unsafe (UnsafeMkEnc p c x)) = Unsafe (UnsafeMkEnc p c (f x))+  +instance Applicative (Unsafe enc ()) where+    pure = Unsafe . UnsafeMkEnc Proxy ()  +    Unsafe (UnsafeMkEnc p c1 f) <*> Unsafe (UnsafeMkEnc _ c2 x) = Unsafe (UnsafeMkEnc p () (f x))  ++instance Monad (Unsafe enc ()) where +    Unsafe (UnsafeMkEnc _ _ x) >>= f = f x     +
+ src/Data/TypedEncoding/Common/Types/Validation.hs view
@@ -0,0 +1,81 @@+{-# 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 #-}+-- |+-- Internal definition of types+--+-- Validation types for @Enc@+--+-- See also+--+-- * "Data.TypedEncoding.Combinators.Validate"+-- * "Data.TypedEncoding.Common.Class.Validate"+--+-- Use of 'Data.TypedEncoding.Combinators.Unsafe.unsafeSetPayload' currently recommended+-- for recovering 'Enc' from trusted input sources (if avoiding cost of Validation is important).++module Data.TypedEncoding.Common.Types.Validation where++import           Data.Proxy+import           GHC.TypeLits++import           Data.TypedEncoding.Common.Types.Enc+import           Data.TypedEncoding.Common.Types.Common+++-- |+-- Validation unwraps a layer of encoding and offers payload data down the encoding stack+-- for further verification. +--+-- For "enc-" encodings this will typically be decoding step.+-- +-- For "r-" encodings this will typically be encoding step.+data Validation f (nm :: Symbol) (alg :: Symbol) conf str where+    UnsafeMkValidation :: Proxy nm -> (forall (xs :: [Symbol]) . Enc (nm ': xs) conf str -> f (Enc xs conf str)) -> Validation f nm alg conf str++-- | Type safe smart constructor+-- adding the type family @(AlgNm nm)@ restriction to UnsafeMkValidation slows down compilation, especially in tests.      +mkValidation :: forall f (nm :: Symbol) conf str . (forall (xs :: [Symbol]) . Enc (nm ': xs) conf str -> f (Enc xs conf str)) -> Validation f nm (AlgNm nm) conf str+mkValidation = UnsafeMkValidation Proxy++runValidation :: forall alg nm f xs conf str . Validation f nm alg conf str -> Enc (nm ': xs) conf str -> f (Enc xs conf str)+runValidation (UnsafeMkValidation _ fn) = fn++-- | Same as 'runValidation" but compiler figures out algorithm name+--+-- Using it can slowdown compilation+_runValidation :: forall nm f xs conf str alg . (AlgNm nm ~ alg) => Validation f nm alg conf str -> Enc (nm ': xs) conf str -> f (Enc xs conf str)+_runValidation = runValidation @(AlgNm nm)++-- |+-- Wraps a list of @Validation@ elements.+--+-- Similarly to 'Validation' it can be used with a typeclass+-- 'Data.TypedValidation.Internal.Class.Encode.EncodeAll'+data Validations f (nms :: [Symbol]) (algs :: [Symbol]) conf str where+    -- | constructor is to be treated as Unsafe to Encode and Decode instance implementations+    -- particular encoding instances may expose smart constructors for limited data types+    ZeroV :: Validations f '[] '[] conf str+    ConsV ::  Validation f nm alg conf str -> Validations f nms algs conf str -> Validations f (nm ': nms) (alg ': algs) conf str++-- | This basically puts payload in decoded state.+-- More useful combinators are in "Data.TypedEncoding.Combinators.Validate"+runValidationChecks :: forall algs nms f c str . (Monad f) => Validations f nms algs c str -> Enc nms c str -> f (Enc ('[]::[Symbol]) c str)+runValidationChecks ZeroV enc0 = pure enc0+runValidationChecks (ConsV fn xs) enc = +        let re :: f (Enc _ c str) = runValidation fn enc+        in re >>= runValidationChecks xs+++-- -- | At possibly big compilation cost, have compiler figure out algorithm names.+-- _runValidations :: forall nms f c str algs . (Monad f, algs ~ AlgNmMap nms) => Validations f nms algs c str -> Enc nms c str -> f (Enc ('[]::[Symbol]) c str)+-- _runValidations = runValidations @(AlgNmMap nms)
+ src/Data/TypedEncoding/Common/Util/TypeLits.hs view
@@ -0,0 +1,145 @@+++{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE KindSignatures  #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+++-- | TypeLits related utilities.+--+-- Lots of this could be avoided by adding @singletons@ as dependency.+--+-- Uses @symbols@ library for its ToList type family.+--+-- Currently this is spread out in different modules+--+-- * "Data.TypedEncoding.Common.Class.Util"+-- * "Data.TypedEncoding.Common.Types.SomeAnnotation"+--+-- (TODO) these will need to get consolidated.+module  Data.TypedEncoding.Common.Util.TypeLits where++import           GHC.TypeLits+import           Data.Symbol.Ascii+++-- $setup+-- >>> :set -XScopedTypeVariables -XTypeFamilies -XKindSignatures -XDataKinds++type family AcceptEq (msg :: ErrorMessage) (c :: Ordering) :: Bool where+    AcceptEq _  EQ = True+    AcceptEq msg _ =  TypeError msg++type family And (b1 :: Bool) (b2 :: Bool) :: Bool where+    And 'True 'True = 'True+    And _ _ = 'False++type family Or (b1 :: Bool) (b2 :: Bool) :: Bool where+    Or 'False 'False = 'False+    Or _ _ = 'True++type family Repeat (n :: Nat) (s :: Symbol) :: Symbol where+    Repeat 0 s = ""+    Repeat n s = AppendSymbol s (Repeat (n - 1) s)++type family Fst (s :: (k,h)) :: k where+   Fst ('(,) a _) = a++type family Dupl (s :: k) :: (k,k) where+   Dupl a = '(,) a a++-- | :kind! Concat (LDrop 6 (ToList "bool: \"r-ban:ff-ff\" | \"r-ban:ffff\""))+type family Concat (s :: [Symbol]) :: Symbol where+    Concat '[] = ""+    Concat (x ': xs) = AppendSymbol x (Concat xs)+++type family Drop (n :: Nat) (s :: Symbol) :: Symbol where+    Drop n s = Concat (LDrop n (ToList s))++-- TODO create TypeList.List module ?++-- | :kind! LDrop 6 (ToList "bool: \"r-ban:ff-ff\" | \"r-ban:ffff\"")+type family LDrop (n :: Nat) (s :: [k]) :: [k] where+    LDrop 0 s = s+    LDrop n '[] = '[]+    LDrop n (x ': xs) = LDrop (n - 1) xs +++-- type family DropVerify (n :: Nat) (s :: Symbol) (v :: Symbol) :: Symbol where+--     Drop n s v = Concat (LDrop n (ToList s))++-- type family DropVerify (n :: Nat) (s :: Symbol) (v :: Symbol) :: Symbol where+--     Drop n s v = Concat (LDrop n (ToList s))++-- | +-- :kind! Take 3 "123456"+type family Take (n :: Nat) (s :: Symbol) :: Symbol where+    Take n s = Concat (LTake n (ToList s))++-- | :kind! LTake 3 (ToList "123456")+type family LTake (n :: Nat) (s :: [k]) :: [k] where+    LTake 0 s = '[]+    LTake n '[] = '[]+    LTake n (x ': xs) = x ': LTake (n - 1) xs ++-- +-- :kind! TakeUntil "findme:blah" ":"+type family TakeUntil (s :: Symbol) (stop :: Symbol) :: Symbol where+    TakeUntil s stop = Concat (LTakeUntil (ToList s) stop)++type family LTakeUntil (s :: [Symbol]) (stop :: Symbol) :: [Symbol] where+    LTakeUntil '[] _ = '[]+    LTakeUntil (x ': xs) stop = LTakeUntilHelper (x ': LTakeUntil xs stop) (CmpSymbol x stop)++type family LTakeUntilHelper (s :: [Symbol]) (o :: Ordering) :: [Symbol] where+    LTakeUntilHelper '[] _ = '[]+    LTakeUntilHelper (x ': xs) 'EQ = '[]+    LTakeUntilHelper (x ': xs) _ = (x ': xs)+++type family Length (s :: Symbol) :: Nat where  +    Length x = LLengh (ToList x)++type family LLengh (s :: [k]) :: Nat where+    LLengh '[] = 0+    LLengh (x ': xs) = 1 + LLengh xs+++-- |+-- >>> :kind! LLast '["1","2","3"]+-- ...+-- = "3"+type family LLast (s :: [Symbol]) :: Symbol where+    LLast '[] = TypeError ('Text "Empty Symbol list not allowed")+    LLast '[x] = x+    LLast (_ ': xs) = LLast xs+++-- |+-- Concat (Snoc '["1","2","3"] "4") +-- ...+-- = "1234"+type family Snoc (s :: [k]) (t :: k) :: [k] where+    Snoc '[] x = '[x]+    Snoc (x ': xs) y = x ': Snoc xs y+++-- |+-- :kind! UnSnoc '["1","2","3"]    +type family UnSnoc (s :: [k]) :: ([k], k) where+    UnSnoc '[] = TypeError ('Text "Empty list, no last element")     +    UnSnoc '[x] = '(,) '[] x+    UnSnoc (x ': xs) = UnSnocHelper x (UnSnoc xs)+++type family UnSnocHelper (s :: k) (t :: ([k], k)) :: ([k], k) where +   UnSnocHelper y ('(,) xs x) = '(,) (y ': xs) x
src/Data/TypedEncoding/Conv/ByteString/Char8.hs view
@@ -9,9 +9,8 @@ module Data.TypedEncoding.Conv.ByteString.Char8 where  import qualified Data.ByteString.Char8 as B8-import           Data.TypedEncoding.Internal.Types.Enc (Enc, unsafeChangePayload)-import qualified Data.TypedEncoding.Internal.Util.TypeLits as Knds-import           Data.TypedEncoding+import qualified Data.TypedEncoding.Common.Util.TypeLits as Knds+import           Data.TypedEncoding.Instances.Support  -- $setup -- >>> :set -XDataKinds -XTypeApplications -XOverloadedStrings@@ -31,7 +30,7 @@ -- ... -- -- >>> displ $ pack (unsafeSetPayload () "Hello" :: Enc '["r-bar", "r-ASCII"] () String)--- "MkEnc '[r-bar,r-ASCII] () (ByteString Hello)"+-- "Enc '[r-bar,r-ASCII] () (ByteString Hello)" pack :: (Knds.LLast xs ~ t, IsSuperset "r-ASCII" t ~ 'True) => Enc xs c String -> Enc xs c B8.ByteString pack = unsafeChangePayload B8.pack
src/Data/TypedEncoding/Conv/ByteString/Lazy/Char8.hs view
@@ -9,9 +9,8 @@ module Data.TypedEncoding.Conv.ByteString.Lazy.Char8 where  import qualified Data.ByteString.Lazy.Char8 as BL8-import           Data.TypedEncoding.Internal.Types.Enc (Enc, unsafeChangePayload)-import qualified Data.TypedEncoding.Internal.Util.TypeLits as Knds-import           Data.TypedEncoding+import qualified Data.TypedEncoding.Common.Util.TypeLits as Knds+import           Data.TypedEncoding.Instances.Support  -- $setup -- >>> :set -XDataKinds -XTypeApplications -XOverloadedStrings
src/Data/TypedEncoding/Conv/Text.hs view
@@ -22,16 +22,23 @@ unpack :: Enc xs c T.Text -> Enc xs c String unpack = unsafeChangePayload T.unpack  --- | Text is automatically @"r-UTF8"@ encoded+-- | +-- Text is automatically @"r-UTF8"@ encoded -- +-- Adding @"r-UTF8"@ annotation simply adds type level interpretion requirement that 'T.Text' is treated+-- as /UTF8/. The internals of 'T.Text' (currently /UTF-16/) are not relevant and @utf8Promote@ is implemented+-- as 'id'.  This is not the same as encoding @Word8@ layouts into 'Char'-s.+-- This, in /typed-encoding/ terminology, would be @"enc-UTF8"@, not @"r-UTF8".+-- -- >>> displ $ utf8Promote $ toEncoding () ("text" :: T.Text)--- "MkEnc '[r-UTF8] () (Text text)"+-- "Enc '[r-UTF8] () (Text text)" utf8Promote :: Enc xs c T.Text -> Enc (Snoc xs "r-UTF8") c T.Text utf8Promote = withUnsafeCoerce id --- | For 'T.Text' @"r-UTF8"@ is redundant+-- | +-- For 'T.Text' @"r-UTF8"@ is redundant -- -- >>> displ . utf8Demote $ (unsafeSetPayload () "Hello" :: Enc '["r-UTF8"] () T.Text)--- "MkEnc '[] () (Text Hello)"+-- "Enc '[] () (Text Hello)" utf8Demote :: (UnSnoc xs ~ '(,) ys "r-UTF8") => Enc xs c T.Text -> Enc ys c T.Text utf8Demote = withUnsafeCoerce id
src/Data/TypedEncoding/Conv/Text/Encoding.hs view
@@ -27,13 +27,14 @@ -- >>> import qualified Data.ByteString.Char8 as B8 -- >>> import Data.Char -- >>> import Data.Either+-- >>> import Data.TypedEncoding -- >>> import Data.TypedEncoding.Conv.Text -- >>> let emptyUTF8B = unsafeSetPayload () "" :: Enc '["r-UTF8"] () B.ByteString   -- >>> :{ -- instance Arbitrary (Enc '["r-UTF8"] () B.ByteString) where  --      arbitrary =  fmap (fromRight emptyUTF8B)  --                   . flip suchThat isRight ---                   . fmap (encodeFAll @(Either EncodeEx) @'["r-UTF8"] @(). toEncoding ()) $ arbitrary +--                   . fmap (encodeFAll @'["r-UTF8"] @(Either EncodeEx) @(). toEncoding ()) $ arbitrary  -- instance Arbitrary (Enc '["r-UTF8"] () T.Text) where  --      arbitrary =  fmap (unsafeSetPayload ())  --                         arbitrary @@ -52,12 +53,12 @@ -- With given constraints 'decodeUtf8' and 'encodeUtf8' can be used on subsets of @"r-UTF8"@ -- -- >>> displ . decodeUtf8 $ (unsafeSetPayload () "Hello" :: Enc '["r-ASCII"] () B.ByteString)--- "MkEnc '[r-ASCII] () (Text Hello)"+-- "Enc '[r-ASCII] () (Text Hello)" -- -- "r-UTF8" is redundant: -- -- >>> displ . utf8Demote . decodeUtf8 $ (unsafeSetPayload () "Hello" :: Enc '["r-UTF8"] () B.ByteString)--- "MkEnc '[] () (Text Hello)"+-- "Enc '[] () (Text Hello)" -- -- @decodeUtf8@ and  @encodeUtf8@ form isomorphism -- @@ -74,6 +75,6 @@  -- | -- >>> displ $ encodeUtf8 $ utf8Promote $ toEncoding () ("text" :: T.Text)--- "MkEnc '[r-UTF8] () (ByteString text)"+-- "Enc '[r-UTF8] () (ByteString text)" encodeUtf8 :: forall xs c t.  (LLast xs ~ t, IsSuperset "r-UTF8" t ~ 'True) => Enc xs c T.Text -> Enc xs c B.ByteString  encodeUtf8 = withUnsafe (fmap TE.encodeUtf8)
src/Data/TypedEncoding/Instances/Do/Sample.hs view
@@ -16,43 +16,51 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.ByteString as B--- import qualified Data.ByteString.Lazy as BL+ import           Data.Char  import           Data.TypedEncoding.Instances.Support+import           Data.TypedEncoding.Instances.Support.Unsafe  +instance Applicative f => Encode f "do-UPPER" "do-UPPER" c T.Text where+    encoding = _implEncodingP T.toUpper -instance Applicative f => EncodeF f (Enc xs c T.Text) (Enc ("do-UPPER" ': xs) c T.Text) where-    encodeF = implEncodeP T.toUpper-instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c T.Text) (Enc ("do-UPPER" ': xs) c T.Text) where-    checkPrevF = implCheckPrevF (asRecreateErr @"do-UPPER" . (\t -> +instance (RecreateErr f, Applicative f) => Validate f "do-UPPER" "do-UPPER" c T.Text where+    validation = mkValidation $+                          implTranF (asRecreateErr @"do-UPPER" . (\t ->                                   let (g,b) = T.partition isUpper t                                  in if T.null b                                     then Right t                                     else Left $ "Found not upper case chars " ++ T.unpack b)                            )-instance Applicative f => EncodeF f (Enc xs c TL.Text) (Enc ("do-UPPER" ': xs) c TL.Text) where-    encodeF = implEncodeP TL.toUpper  -instance Applicative f => EncodeF f (Enc xs c T.Text) (Enc ("do-lower" ': xs) c T.Text) where-    encodeF = implEncodeP T.toLower    -instance Applicative f => EncodeF f (Enc xs c TL.Text) (Enc ("do-lower" ': xs) c TL.Text) where-    encodeF = implEncodeP TL.toLower  -instance Applicative f => EncodeF f (Enc xs c T.Text) (Enc ("do-Title" ': xs) c T.Text) where-    encodeF = implEncodeP T.toTitle   -instance Applicative f => EncodeF f (Enc xs c TL.Text) (Enc ("do-Title" ': xs) c TL.Text) where-    encodeF = implEncodeP TL.toTitle   +instance Applicative f => Encode f "do-UPPER" "do-UPPER" c TL.Text where+    encoding = _implEncodingP TL.toUpper -instance Applicative f => EncodeF f (Enc xs c T.Text) (Enc ("do-reverse" ': xs) c T.Text) where-    encodeF = implEncodeP T.reverse -instance Applicative f => EncodeF f (Enc xs c TL.Text) (Enc ("do-reverse" ': xs) c TL.Text) where-    encodeF = implEncodeP TL.reverse     ++instance Applicative f => Encode f "do-lower" "do-lower" c T.Text where+    encoding = _implEncodingP T.toLower   ++instance Applicative f => Encode f "do-lower" "do-lower" c TL.Text where+    encoding = _implEncodingP TL.toLower ++instance Applicative f => Encode f "do-Title" "do-Title" c T.Text where+    encoding = _implEncodingP T.toTitle   ++instance Applicative f => Encode f "do-Title" "do-Title" c TL.Text where+    encoding = _implEncodingP TL.toTitle   ++instance Applicative f => Encode f "do-reverse" "do-reverse" c T.Text where+    encoding = _implEncodingP T.reverse +instance Applicative f => Encode f "do-reverse" "do-reverse" c TL.Text where+    encoding = _implEncodingP TL.reverse    + newtype SizeLimit = SizeLimit {unSizeLimit :: Int} deriving (Eq, Show)-instance (HasA SizeLimit c, Applicative f) => EncodeF f (Enc xs c T.Text) (Enc ("do-size-limit" ': xs) c T.Text) where-    encodeF =  implEncodeP' (T.take . unSizeLimit . has @ SizeLimit) -instance (HasA SizeLimit c, Applicative f) => EncodeF f (Enc xs c B.ByteString) (Enc ("do-size-limit" ': xs) c B.ByteString) where-    encodeF =  implEncodeP' (B.take . unSizeLimit .  has @ SizeLimit) +instance (HasA SizeLimit c, Applicative f) => Encode f "do-size-limit" "do-size-limit" c T.Text where+    encoding = _implEncodingConfP (T.take . unSizeLimit . has @ SizeLimit) +instance (HasA SizeLimit c, Applicative f) => Encode f "do-size-limit" "do-size-limit" c B.ByteString where+    encoding = _implEncodingConfP (B.take . unSizeLimit .  has @ SizeLimit)
src/Data/TypedEncoding/Instances/Enc/Base64.hs view
@@ -4,12 +4,14 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}  -- | Defines /Base64/ encoding module Data.TypedEncoding.Instances.Enc.Base64 where  import           Data.TypedEncoding import           Data.TypedEncoding.Instances.Support+import           Data.TypedEncoding.Instances.Support.Unsafe  import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL@@ -21,73 +23,18 @@ import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Base64.Lazy as BL64 --- import qualified Data.ByteString.Base64.URL as B64URL--- import qualified Data.ByteString.Base64.URL.Lazy as BL64URL + -- $setup--- >>> :set -XScopedTypeVariables -XKindSignatures -XMultiParamTypeClasses -XDataKinds -XPolyKinds -XPartialTypeSignatures -XFlexibleInstances+-- >>> :set -XOverloadedStrings -XScopedTypeVariables -XKindSignatures -XMultiParamTypeClasses -XDataKinds -XPolyKinds -XPartialTypeSignatures -XFlexibleInstances -XTypeApplications -- >>> import Test.QuickCheck -- >>> import Test.QuickCheck.Instances.Text() -- >>> import Test.QuickCheck.Instances.ByteString()  -------------------- Conversions --+-- * Conversions ----------------- --- | --- DEPRECATED use 'Data.TypedEncoding.Conv.Text.Encoding.decodeUtf8'--- and 'Data.TypedEncoding.Conv.Text.utf8Demote'--- --- Will be removed in 0.3.x.x------ See warning in 'Data.TypedEncoding.Instances.Restriction.ASCII.byteString2TextS'-byteString2TextS :: Enc ("enc-B64" ': "r-UTF8" ': ys) c B.ByteString -> Enc ("enc-B64" ': ys) c T.Text -byteString2TextS = withUnsafeCoerce TE.decodeUtf8---- | --- DEPRECATED use 'Data.TypedEncoding.Conv.Text.Lazy.Encoding.decodeUtf8'--- and 'Data.TypedEncoding.Conv.Text.utf8Demote'------ Will be removed in 0.3.x.x------ See warning in 'Data.TypedEncoding.Instances.Restriction.ASCII.byteString2TextS'-byteString2TextL :: Enc ("enc-B64" ': "r-UTF8" ': ys) c BL.ByteString -> Enc ("enc-B64" ': ys) c TL.Text -byteString2TextL = withUnsafeCoerce TEL.decodeUtf8---- DEPRECATED use 'Data.TypedEncoding.Conv.Text.Encoding.encodeUtf8'--- and 'Data.TypedEncoding.Conv.Text.utf8Promote'--- --- Will be removed in 0.3.x.x-text2ByteStringS :: Enc ("enc-B64" ': ys) c T.Text -> Enc ("enc-B64" ': "r-UTF8" ': ys) c B.ByteString -text2ByteStringS = withUnsafeCoerce TE.encodeUtf8---- DEPRECATED use 'Data.TypedEncoding.Conv.Text.Lazy.Encoding.encodeUtf8'--- and 'Data.TypedEncoding.Conv.Text.utf8Promote'--- --- Will be removed in 0.3.x.x-text2ByteStringL  :: Enc ("enc-B64" ': ys) c TL.Text -> Enc ("enc-B64" ': "r-UTF8" ': ys) c BL.ByteString -text2ByteStringL  = withUnsafeCoerce TEL.encodeUtf8----- | B64 encoded bytestring can be converted to Text as "enc-B64-nontext" preventing it from --- being B64-decoded directly to Text-byteString2TextS' :: Enc ("enc-B64" ': ys) c B.ByteString -> Enc ("enc-B64-nontext" ': ys) c T.Text -byteString2TextS' = withUnsafeCoerce TE.decodeUtf8---- DEPRECATED -byteString2TextL' :: Enc ("enc-B64" ': ys) c BL.ByteString -> Enc ("enc-B64-nontext" ': ys) c TL.Text -byteString2TextL' = withUnsafeCoerce TEL.decodeUtf8---- DEPRECATED -text2ByteStringS' :: Enc ("enc-B64-nontext" ': ys) c T.Text -> Enc ("enc-B64" ': ys) c B.ByteString -text2ByteStringS' = withUnsafeCoerce TE.encodeUtf8---- DEPRECATED -text2ByteStringL'  :: Enc ("enc-B64-nontext" ': ys) c TL.Text -> Enc ("enc-B64" ': ys) c BL.ByteString -text2ByteStringL'  = withUnsafeCoerce TEL.encodeUtf8--- acceptLenientS :: Enc ("enc-B64-len" ': ys) c B.ByteString -> Enc ("enc-B64" ': ys) c B.ByteString  acceptLenientS = withUnsafeCoerce (B64.encode . B64.decodeLenient) @@ -99,82 +46,110 @@ -- -- >>> let tstB64 = encodeAll . toEncoding () $ "Hello World" :: Enc '["enc-B64"] () B.ByteString -- >>> displ (flattenAs tstB64 :: Enc '["r-ASCII"] () B.ByteString)--- "MkEnc '[r-ASCII] () (ByteString SGVsbG8gV29ybGQ=)"+-- "Enc '[r-ASCII] () (ByteString SGVsbG8gV29ybGQ=)" instance FlattenAs "r-ASCII" "enc-B64-nontext" where instance FlattenAs "r-ASCII" "enc-B64" where --- DEPRECATED will be removed+-- |+-- This is not precise, actually /Base 64/ uses a subset of ASCII+-- and that would require a new definition @"r-B64"@. ----- dangerous, with new approach.--- Supersets are for "r-" types only-instance Superset "r-ASCII" "enc-B64-nontext" where-instance Superset "r-ASCII" "enc-B64" where+-- This instance likely to be changed / corrected in the future if @"r-B64"@ is defined.+--+-- >>> let tstB64 = encodeAll . toEncoding () $ "Hello World" :: Enc '["enc-B64"] () B.ByteString+-- >>> displ (_encodesInto @"r-ASCII" $ tstB64)+-- "Enc '[r-ASCII,enc-B64] () (ByteString SGVsbG8gV29ybGQ=)"+--+-- >>> displ (_encodesInto @"r-UTF8" $ tstB64)+-- "Enc '[r-UTF8,enc-B64] () (ByteString SGVsbG8gV29ybGQ=)"+--+-- @since 0.3.0.0+instance EncodingSuperset "enc-B64" where+    type EncSuperset "enc-B64" = "r-ASCII" --------------------- Encodings   --------------------+-- * Encoders -instance Encodings (Either EncodeEx) xs grps c B.ByteString => Encodings (Either EncodeEx) ("enc-B64" ': xs) ("enc-B64" ': grps) c B.ByteString where-    encodings = encodeFEncoder @(Either EncodeEx) @"enc-B64" @"enc-B64"+instance Applicative f => Encode f "enc-B64" "enc-B64" c B.ByteString where+    encoding = encB64B -instance Applicative f => EncodeF f (Enc xs c B.ByteString) (Enc ("enc-B64" ': xs) c B.ByteString) where-    encodeF = implEncodeP B64.encode -        --- | Effectful instance for corruption detection.+encB64B :: Applicative f => Encoding f "enc-B64" "enc-B64" c B.ByteString+encB64B = _implEncodingP B64.encode++instance Applicative f => Encode f "enc-B64" "enc-B64" c BL.ByteString where+    encoding = encB64BL++encB64BL :: Applicative f => Encoding f "enc-B64" "enc-B64" c BL.ByteString+encB64BL = _implEncodingP BL64.encode+++-- | This instance will likely be removed in future versions (performance concerns)+instance Applicative f => Encode f "enc-B64" "enc-B64" c T.Text where+    encoding = endB64T++-- | This function will likely be removed in future versions (performance concerns)+endB64T :: Applicative f => Encoding f "enc-B64" "enc-B64" c T.Text+endB64T = _implEncodingP (TE.decodeUtf8 . B64.encode . TE.encodeUtf8)  ++-- * Decoders++instance (UnexpectedDecodeErr f, Applicative f) => Decode f "enc-B64" "enc-B64" c B.ByteString where+    decoding = decB64B++-- | Effectful decoding for corruption detection. -- This protocol is used, for example, in emails.  -- It is a well known encoding and hackers will have no problem  -- making undetectable changes, but error handling at this stage -- could verify that email was corrupted.-instance (UnexpectedDecodeErr f, Applicative f) => DecodeF f (Enc ("enc-B64" ': xs) c B.ByteString) (Enc xs c B.ByteString) where-    decodeF = implDecodeF (asUnexpected @"enc-B64" . B64.decode) +decB64B :: (UnexpectedDecodeErr f, Applicative f) => Decoding f "enc-B64" "enc-B64" c B.ByteString+decB64B = _implDecodingF (asUnexpected @"enc-B64" . B64.decode) -instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c B.ByteString) (Enc ("enc-B64" ': xs) c B.ByteString) where-    checkPrevF = implCheckPrevF (asRecreateErr @"enc-B64" .  B64.decode) +instance (UnexpectedDecodeErr f, Applicative f) => Decode f "enc-B64" "enc-B64" c BL.ByteString where+    decoding = decB64BL -instance Applicative f => RecreateF f (Enc xs c B.ByteString) (Enc ("enc-B64-len" ': xs) c B.ByteString) where-    checkPrevF = implTranP id+decB64BL :: (UnexpectedDecodeErr f, Applicative f) => Decoding f "enc-B64" "enc-B64" c BL.ByteString+decB64BL = _implDecodingF (asUnexpected @"enc-B64" . BL64.decode) -instance Applicative f => EncodeF f  (Enc xs c BL.ByteString) (Enc ("enc-B64" ': xs) c BL.ByteString) where-    encodeF = implEncodeP BL64.encode  -instance (UnexpectedDecodeErr f, Applicative f) => DecodeF f  (Enc ("enc-B64" ': xs) c BL.ByteString) (Enc xs c BL.ByteString) where-    decodeF = implDecodeF (asUnexpected @"enc-B64"  . BL64.decode)+-- Kept for now but performance issues -instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c BL.ByteString) (Enc ("enc-B64" ': xs) c BL.ByteString) where-    checkPrevF = implCheckPrevF (asRecreateErr @"enc-B64" .  BL64.decode) +-- | WARNING (performance)+instance (UnexpectedDecodeErr f, Applicative f) => Decode f "enc-B64" "enc-B64" c T.Text where+    decoding = decB64T -instance Applicative f => RecreateF f (Enc xs c BL.ByteString) (Enc ("enc-B64-len" ': xs) c BL.ByteString) where-    checkPrevF = implTranP id+decB64T :: (UnexpectedDecodeErr f, Applicative f) => Decoding f "enc-B64" "enc-B64" c T.Text+decB64T = _implDecodingF (asUnexpected @"enc-B64"  . fmap TE.decodeUtf8 . B64.decode . TE.encodeUtf8) +{-# WARNING decB64T "This method was not optimized for performance." #-} --- B64URL currently not supported--- instance Applicative f => EncodeF f (Enc xs c B.ByteString) (Enc ("enc-B64URL" ': xs) c B.ByteString) where---     encodeF = implEncodeP B64URL.encode --- instance DecodeF (Either String) (Enc ("enc-B64URL" ': xs) c B.ByteString) (Enc xs c B.ByteString) where---     decodeF = implDecodeF B64URL.decode --- instance DecodeF Identity (Enc ("enc-B64URL" ': xs) c B.ByteString) (Enc xs c B.ByteString) where---     decodeF = implTranP B64URL.decodeLenient +-- | WARNING (performance)+instance (UnexpectedDecodeErr f, Applicative f) => Decode f "enc-B64" "enc-B64" c TL.Text where+    decoding = decB64TL --- instance Applicative f => EncodeF f (Enc xs c BL.ByteString) (Enc ("enc-B64URL" ': xs) c BL.ByteString) where---     encodeF = implEncodeP BL64URL.encode --- instance DecodeF (Either String) (Enc ("enc-B64URL" ': xs) c BL.ByteString) (Enc xs c BL.ByteString) where---     decodeF = implDecodeF BL64URL.decode --- instance DecodeF Identity (Enc ("enc-B64URL" ': xs) c BL.ByteString) (Enc xs c BL.ByteString) where---     decodeF = implTranP BL64URL.decodeLenient +decB64TL :: (UnexpectedDecodeErr f, Applicative f) => Decoding f "enc-B64" "enc-B64" c TL.Text+decB64TL = _implDecodingF (asUnexpected @"enc-B64"  . fmap TEL.decodeUtf8 . BL64.decode . TEL.encodeUtf8) +{-# WARNING decB64TL "This method was not optimized for performance." #-} -instance Applicative f => EncodeF f (Enc xs c T.Text) (Enc ("enc-B64" ': xs) c T.Text) where-    encodeF = implEncodeP (TE.decodeUtf8 . B64.encode . TE.encodeUtf8)    -instance (UnexpectedDecodeErr f, Applicative f) => DecodeF f (Enc ("enc-B64" ': xs) c T.Text) (Enc xs c T.Text) where-    decodeF = implDecodeF (asUnexpected @"enc-B64"  . fmap TE.decodeUtf8 . B64.decode . TE.encodeUtf8) +-- * Validation -instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c T.Text) (Enc ("enc-B64" ': xs) c T.Text) where-    checkPrevF = implCheckPrevF (asRecreateErr @"enc-B64" . fmap TE.decodeUtf8 .  B64.decode . TE.encodeUtf8) +instance (RecreateErr f, Applicative f) => Validate f "enc-B64" "enc-B64" c B.ByteString where+    validation = validFromDec decB64B -instance Applicative f => EncodeF f (Enc xs c TL.Text) (Enc ("enc-B64" ': xs) c TL.Text) where-    encodeF = implEncodeP (TEL.decodeUtf8 . BL64.encode . TEL.encodeUtf8)   +instance (RecreateErr f, Applicative f) => Validate f "enc-B64" "enc-B64" c BL.ByteString where+    validation = validFromDec decB64BL -instance (UnexpectedDecodeErr f, Applicative f) => DecodeF f (Enc ("enc-B64" ': xs) c TL.Text) (Enc xs c TL.Text) where-    decodeF = implDecodeF (asUnexpected @"enc-B64"  . fmap TEL.decodeUtf8 . BL64.decode . TEL.encodeUtf8) +instance (RecreateErr f, Applicative f) => Validate f "enc-B64" "enc-B64" c T.Text where+    validation = validFromDec decB64T -instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c TL.Text) (Enc ("enc-B64" ': xs) c TL.Text) where-    checkPrevF = implCheckPrevF (asRecreateErr @"enc-B64" . fmap TEL.decodeUtf8 .  BL64.decode . TEL.encodeUtf8) +instance (RecreateErr f, Applicative f) => Validate f "enc-B64" "enc-B64" c TL.Text where+    validation = validFromDec decB64TL++-- | Lenient decoding does not fail+instance Applicative f => Validate f "enc-B64-len" "enc-B64-len" c B.ByteString where+    validation = mkValidation $ implTranP id++-- | Lenient decoding does not fail+instance Applicative f => Validate f "enc-B64-len" "enc-B64-len" c BL.ByteString where+    validation = mkValidation $ implTranP id+++
src/Data/TypedEncoding/Instances/Restriction/ASCII.hs view
@@ -15,36 +15,27 @@ --  -- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -- >>> encodeFAll . toEncoding () $ "Hello World" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text)--- Right (MkEnc Proxy () "Hello World")+-- Right (UnsafeMkEnc Proxy () "Hello World") -- -- >>> encodeFAll . toEncoding () $ "\194\160" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text) -- Left (EncodeEx "r-ASCII" (NonAsciiChar '\194')) module Data.TypedEncoding.Instances.Restriction.ASCII where  import           Data.TypedEncoding.Instances.Support--import           Data.Proxy--import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Encoding as TE -import qualified Data.Text.Lazy.Encoding as TEL -import qualified Data.List as L--import qualified Data.ByteString.Char8 as B8-import qualified Data.ByteString.Lazy.Char8 as BL8+import           Data.TypedEncoding.Common.Class.Util.StringConstraints -import           Data.Char import           Data.TypedEncoding.Internal.Util (explainBool)-import           Data.TypedEncoding.Unsafe (withUnsafe)-import           Control.Arrow+import           Data.Char + -- $setup -- >>> :set -XDataKinds -XTypeApplications+-- >>> import qualified Data.Text as T+-- >>> import qualified Data.ByteString as B+-- >>> import qualified Data.ByteString.Char8 as B8 -- >>> import Test.QuickCheck -- >>> import Test.QuickCheck.Instances.ByteString()+-- >>> import Data.TypedEncoding -- >>> :{ -- instance Arbitrary (Enc '["r-ASCII"] () B.ByteString) where  --      arbitrary =  fmap (unsafeSetPayload ()) @@ -55,138 +46,38 @@   -------------------- Conversions ------------------------ |--- DEPRECATED use 'Data.TypedEncoding.Conv.Text.Encoding.decodeUtf8'--- --- Will be removed in 0.3.x.x------ This is not type safe, for example, would allow converting------ @Enc `["r-ASCII", "enc-B64"] c B.ByteString@ containing B64 encoded binary --- to @Enc `["r-ASCII", "enc-B64"] c T.Text@ and which then could be decoded causing --- unexpected error.  --byteString2TextS :: Enc ("r-ASCII" ': ys) c B.ByteString -> Enc ("r-ASCII" ': ys) c T.Text -byteString2TextS = withUnsafe (fmap TE.decodeUtf8)---- | --- DEPRECATED use 'Data.TypedEncoding.Conv.Text.Lazy.Encoding.decodeUtf8'--- --- Will be removed in 0.3.x.x------ see 'byteString2TextS'-byteString2TextL :: Enc ("r-ASCII" ': ys) c BL.ByteString -> Enc ("r-ASCII" ': ys) c TL.Text -byteString2TextL = withUnsafe (fmap TEL.decodeUtf8)---- | --- DEPRECATED use 'Data.TypedEncoding.Conv.Text.Encoding.encodeUtf8'--- --- Will be removed in 0.3.x.x----text2ByteStringS :: Enc ("r-ASCII" ': ys) c T.Text -> Enc ("r-ASCII" ': ys) c B.ByteString -text2ByteStringS = withUnsafe (fmap TE.encodeUtf8)---- | --- DEPRECATED use 'Data.TypedEncoding.Conv.Text.Lazy.Encoding.encodeUtf8'--- --- Will be removed in 0.3.x.x----text2ByteStringL  :: Enc ("r-ASCII" ': ys) c TL.Text -> Enc ("r-ASCII" ': ys) c BL.ByteString -text2ByteStringL  = withUnsafe (fmap TEL.encodeUtf8)----- | allow to treat ASCII encodings as UTF8 forgetting about B64 encoding--- --- UTF-8 is backward compatible on first 128 characters using just one byte to store it.--- --- Payload does not change when @ASCII@ only strings are encoded to @UTF8@ in types like @ByteString@.------ >>> let Right tstAscii = encodeFAll . toEncoding () $ "Hello World" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text)--- >>> displ (inject @ "r-UTF8" tstAscii)--- "MkEnc '[r-UTF8] () (Text Hello World)"-instance Superset "r-UTF8" "r-ASCII" where---- type instance IsSuperset "r-UTF8" "r-ASCII" = True  --- type instance IsSuperset "r-ASCII" "r-ASCII" = True  ------------------- -- Encodings  -- -----------------  newtype NonAsciiChar = NonAsciiChar Char deriving (Eq, Show) -prxyAscii = Proxy :: Proxy "r-ASCII"--instance EncodeF (Either EncodeEx) (Enc xs c Char) (Enc ("r-ASCII" ': xs) c Char) where-    encodeF = implEncodeF_ prxyAscii (\c -> explainBool NonAsciiChar (c, isAscii c))    -instance Applicative f => DecodeF f (Enc ("r-ASCII" ': xs) c Char) (Enc xs c Char) where-    decodeF = implTranP id --instance Encodings (Either EncodeEx) xs grps c String => Encodings (Either EncodeEx) ("r-ASCII" ': xs) ("r-ASCII" ': grps) c String where-    encodings = encodeFEncoder @(Either EncodeEx) @"r-ASCII" @"r-ASCII"--instance EncodeF (Either EncodeEx) (Enc xs c String) (Enc ("r-ASCII" ': xs) c String) where-    encodeF = implEncodeF_ prxyAscii (encodeImpl L.partition L.head L.null)-instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c String) (Enc ("r-ASCII" ': xs) c String) where-    checkPrevF = implCheckPrevF (asRecreateErr @"r-ASCII" . encodeImpl L.partition L.head L.null)-instance Applicative f => DecodeF f (Enc ("r-ASCII" ': xs) c String) (Enc xs c String) where-    decodeF = implTranP id --instance Encodings (Either EncodeEx) xs grps c T.Text => Encodings (Either EncodeEx) ("r-ASCII" ': xs) ("r-ASCII" ': grps) c T.Text where-    encodings = encodeFEncoder @(Either EncodeEx) @"r-ASCII" @"r-ASCII"--instance EncodeF (Either EncodeEx) (Enc xs c T.Text) (Enc ("r-ASCII" ': xs) c T.Text) where-    encodeF = implEncodeF_ prxyAscii (encodeImpl T.partition T.head T.null)-instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c T.Text) (Enc ("r-ASCII" ': xs) c T.Text) where-    checkPrevF = implCheckPrevF (asRecreateErr @"r-ASCII" . encodeImpl T.partition T.head T.null)-instance Applicative f => DecodeF f (Enc ("r-ASCII" ': xs) c T.Text) (Enc xs c T.Text) where-    decodeF = implTranP id +-- * Encoding  -instance Encodings (Either EncodeEx) xs grps c TL.Text => Encodings (Either EncodeEx) ("r-ASCII" ': xs) ("r-ASCII" ': grps) c TL.Text where-    encodings = encodeFEncoder @(Either EncodeEx) @"r-ASCII" @"r-ASCII"+instance Encode (Either EncodeEx) "r-ASCII" "r-ASCII" c Char where+    encoding = encASCIIChar     -instance EncodeF (Either EncodeEx) (Enc xs c TL.Text) (Enc ("r-ASCII" ': xs) c TL.Text) where-    encodeF = implEncodeF_ prxyAscii (encodeImpl TL.partition TL.head TL.null)-instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c TL.Text) (Enc ("r-ASCII" ': xs) c TL.Text) where -    checkPrevF = implCheckPrevF (asRecreateErr @"r-ASCII" . encodeImpl TL.partition TL.head TL.null)-instance Applicative f => DecodeF f (Enc ("r-ASCII" ': xs) c TL.Text) (Enc xs c TL.Text) where-    decodeF = implTranP id +instance Char8Find str => Encode (Either EncodeEx) "r-ASCII" "r-ASCII" c str where+    encoding = encASCII -instance Encodings (Either EncodeEx) xs grps c B.ByteString => Encodings (Either EncodeEx) ("r-ASCII" ': xs) ("r-ASCII" ': grps) c B.ByteString where-    encodings = encodeFEncoder @(Either EncodeEx) @"r-ASCII" @"r-ASCII"+encASCIIChar :: Encoding (Either EncodeEx) "r-ASCII" "r-ASCII" c Char +encASCIIChar = _implEncodingEx (\c -> explainBool NonAsciiChar (c, isAscii c))     -instance EncodeF (Either EncodeEx) (Enc xs c B.ByteString) (Enc ("r-ASCII" ': xs) c B.ByteString) where-    encodeF = implEncodeF_ prxyAscii (encodeImpl (\p -> B8.filter p &&& B8.filter (not . p)) B8.head B8.null)-instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c B.ByteString) (Enc ("r-ASCII" ': xs) c B.ByteString) where-    checkPrevF = implCheckPrevF (asRecreateErr @"r-ASCII" . encodeImpl (\p -> B8.filter p &&& B8.filter (not . p)) B8.head B8.null)-instance Applicative f => DecodeF f (Enc ("r-ASCII" ': xs) c B.ByteString) (Enc xs c B.ByteString) where-    decodeF = implTranP id +encASCII :: Char8Find str =>  Encoding (Either EncodeEx) "r-ASCII" "r-ASCII" c str+encASCII = _implEncodingEx @"r-ASCII" encImpl -instance Encodings (Either EncodeEx) xs grps c BL.ByteString => Encodings (Either EncodeEx) ("r-ASCII" ': xs) ("r-ASCII" ': grps) c BL.ByteString where-    encodings = encodeFEncoder @(Either EncodeEx) @"r-ASCII" @"r-ASCII"+encImpl :: Char8Find str => str -> Either NonAsciiChar str+encImpl str = case find (not . isAscii) str of +    Nothing -> Right str+    Just ch -> Left $ NonAsciiChar ch -instance EncodeF (Either EncodeEx) (Enc xs c BL.ByteString) (Enc ("r-ASCII" ': xs) c BL.ByteString) where-    encodeF = implEncodeF_ prxyAscii (encodeImpl (\p -> BL8.filter p &&& BL8.filter (not . p)) BL8.head BL8.null)-instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c BL.ByteString) (Enc ("r-ASCII" ': xs) c BL.ByteString) where-    checkPrevF = implCheckPrevF (asRecreateErr @"r-ASCII" . encodeImpl (\p -> BL8.filter p &&& BL8.filter (not . p)) BL8.head BL8.null)-instance Applicative f => DecodeF f (Enc ("r-ASCII" ': xs) c BL.ByteString) (Enc xs c BL.ByteString) where-    decodeF = implTranP id +-- * Decoding +instance (Applicative f) => Decode f "r-ASCII" "r-ASCII" c str where+    decoding = decAnyR+    +instance (Char8Find str, RecreateErr f, Applicative f) => Validate f "r-ASCII" "r-ASCII" () str where+    validation = validR encASCII -encodeImpl :: -   ((Char -> Bool) -> a -> (a, a))-   -> (a -> Char)-   -> (a -> Bool)-   -> a-   -> Either NonAsciiChar a-encodeImpl partitionf headf nullf t = -                 let (tascii, nonascii) = partitionf isAscii t -                 in if nullf nonascii -                    then Right tascii-                    else Left . NonAsciiChar $ headf nonascii   -- tst = encodeFAll . toEncoding () $ "Hello World" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text) -- tst2 = encodeFAll . toEncoding () $ "\194\160" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text)
+ src/Data/TypedEncoding/Instances/Restriction/Bool.hs view
@@ -0,0 +1,429 @@++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- |+-- Boolean algebra on encodings+--+-- @since 0.2.1.0+-- +-- /(Experimental, early alpha development stage)/ This module was not converted to v0.3 style yet.+--+-- == Grammar+-- +-- Simple grammar requires boolean terms to be included in parentheses+--+-- @+-- bool[BinaryOp]:(leftTerm)(rightTerm)+-- bool[UnaryOp]:(term)+-- @+--+-- Expected behavior is described next to the corresponding combinator.++module Data.TypedEncoding.Instances.Restriction.Bool where +++import           GHC.TypeLits+import           Data.Proxy+import           Data.Symbol.Ascii++import           Data.TypedEncoding+import           Data.TypedEncoding.Instances.Support+import           Data.TypedEncoding.Instances.Support.Unsafe++++-- $setup+-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XTypeApplications+-- >>> import qualified Data.Text as T+-- >>> import           Data.TypedEncoding.Instances.Restriction.Misc()+++-- |+-- See examples in 'encBoolOrRight''+encBoolOrLeft :: forall f s t xs c str . (+    BoolOpIs s "or" ~ 'True+    -- IsBoolOr s ~ 'True+    , Functor f+    , LeftTerm s ~ t+    ) => (Enc xs c str -> f (Enc (t ': xs) c str)) -> Enc xs c str -> f (Enc (s ': xs) c str)  +encBoolOrLeft = implChangeAnn ++-- |+-- See examples in 'encBoolOrRight''+encBoolOrLeft' :: forall f s t xs c str . (+    BoolOpIs s "or" ~ 'True+    -- IsBoolOr s ~ 'True+    , Functor f+    , LeftTerm s ~ t+    , Encode f t t c str+    ) => Enc xs c str -> f (Enc (s ': xs) c str)  +encBoolOrLeft' = encBoolOrLeft'' @t++encBoolOrLeft'' :: forall alg f s t xs c str . (+    BoolOpIs s "or" ~ 'True+    -- IsBoolOr s ~ 'True+    , Functor f+    , LeftTerm s ~ t+    , Encode f t alg c str+    ) => Enc xs c str -> f (Enc (s ': xs) c str)  +encBoolOrLeft'' = encBoolOrLeft (encodeF' @alg @t @xs @f)++-- |+-- +encBoolOrRight :: forall f s t xs c str . (+    BoolOpIs s "or" ~ 'True+    -- IsBoolOr s ~ 'True+    , Functor f+    , RightTerm s ~ t+    ) => (Enc xs c str -> f (Enc (t ': xs) c str)) -> Enc xs c str -> f (Enc (s ': xs) c str)  +encBoolOrRight = implChangeAnn ++-- |+-- >>> :{ +-- let tst1, tst2, tst3 :: Either EncodeEx (Enc '["boolOr:(r-Word8-decimal)(r-Int-decimal)"] () T.Text)+--     tst1 = encBoolOrLeft' . toEncoding () $ "212" +--     tst2 = encBoolOrRight' . toEncoding () $ "1000000" +--     tst3 = encBoolOrLeft' . toEncoding () $ "1000000"+-- :}+-- +-- >>> tst1 +-- Right (UnsafeMkEnc Proxy () "212")+--+-- >>> tst2+-- Right (UnsafeMkEnc Proxy () "1000000")+--+-- >>> tst3+-- Left (EncodeEx "r-Word8-decimal" ("Payload does not satisfy format Word8-decimal: 1000000"))+encBoolOrRight' :: forall f s t xs c str . (+    BoolOpIs s "or" ~ 'True+    -- IsBoolOr s ~ 'True+    , Functor f+    , RightTerm s ~ t+    , Encode f t t c str+    ) => Enc xs c str -> f (Enc (s ': xs) c str)  +encBoolOrRight' = encBoolOrRight'' @t++encBoolOrRight'' :: forall alg f s t xs c str . (+    BoolOpIs s "or" ~ 'True+    -- IsBoolOr s ~ 'True+    , Functor f+    , RightTerm s ~ t+    , Encode f t alg c str+    ) => Enc xs c str -> f (Enc (s ': xs) c str)  +encBoolOrRight'' = encBoolOrRight (encodeF' @alg @t @xs @f) ++encBoolAnd :: forall f s t1 t2 xs c str . (+    BoolOpIs s "and" ~ 'True +    , KnownSymbol s+    -- IsBoolAnd s ~ 'True+    , f ~ Either EncodeEx+    , Eq str+    , LeftTerm s ~ t1+    , RightTerm s ~ t2+    ) => +    (Enc xs c str -> f (Enc (t1 ': xs) c str)) +    -> (Enc xs c str -> f (Enc (t2 : xs) c str)) +    -> Enc xs c str -> f (Enc (s ': xs) c str)  +encBoolAnd fnl fnr en0 =  +       let +           eent1 = fnl en0+           eent2 = fnr en0+           p = (Proxy :: Proxy s)+       in +           case (eent1, eent2) of+               (Right ent1, Right ent2) -> +                   if getPayload ent1 == getPayload ent2+                   then Right . withUnsafeCoerce id $ ent1 +                   else Left $ EncodeEx p "Left - right encoding do not match"                   +               (_, _) -> mergeErrs (emptyEncErr p) (mergeEncodeEx p) eent1 eent2++-- |+-- @"boolOr:(enc1)(enc2)"@ contains strings that encode the same way under both encodings.+-- for example  @"boolOr:(r-UPPER)(r-lower)"@ valid elements would include @"123-34"@ but not @"abc"@+--+-- >>> :{+-- let tst1, tst2 :: Either EncodeEx (Enc '["boolAnd:(r-Word8-decimal)(r-Int-decimal)"] () T.Text)+--     tst1 = encBoolAnd' . toEncoding () $ "234"+--     tst2 = encBoolAnd' . toEncoding () $ "100000"+-- :}+-- +-- >>> tst1+-- Right (UnsafeMkEnc Proxy () "234")+-- >>> tst2+-- Left (EncodeEx "r-Word8-decimal" ("Payload does not satisfy format Word8-decimal: 100000"))+encBoolAnd' :: forall s t1 t2 xs c str . (+    BoolOpIs s "and" ~ 'True +    , KnownSymbol s+    -- IsBoolAnd s ~ 'True+    , Eq str+    , LeftTerm s ~ t1+    , RightTerm s ~ t2+    , Encode (Either EncodeEx) t1 t1 c str+    , Encode (Either EncodeEx) t2 t2 c str+    ) => Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str)  +encBoolAnd'  = encBoolAnd'' @t1 @t2++encBoolAnd'' :: forall al1 al2 s t1 t2 xs c str . (+    BoolOpIs s "and" ~ 'True +    , KnownSymbol s+    -- IsBoolAnd s ~ 'True+    , Eq str+    , LeftTerm s ~ t1+    , RightTerm s ~ t2+    , Encode (Either EncodeEx) t1 al1 c str+    , Encode (Either EncodeEx) t2 al2 c str+    ) => Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str)  +encBoolAnd''  = encBoolAnd (encodeF' @al1 @t1 @xs) (encodeF' @al2 @t2 @xs) +++-- tst1, tst2 :: Either EncodeEx (Enc '["boolNot:(r-Word8-decimal)"] () T.Text)+-- tst1 = encBoolNot' . toEncoding () $ "334"+-- tst2 = encBoolNot' . toEncoding () $ "127"++encBoolNot :: forall s t xs c str . (+    BoolOpIs s "not" ~ 'True+    , KnownSymbol s+    , FirstTerm s ~ t+    , Restriction t +    ) => (Enc xs c str -> Either EncodeEx (Enc (t ': xs) c str)) -> Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str)  +encBoolNot fn en0 = +        let +           een = fn en0+           p = (Proxy :: Proxy s)+           pt = (Proxy :: Proxy t)+        in +           case een of+               Left _ -> Right . withUnsafeCoerce id $ en0+               Right _ -> Left $ EncodeEx p $ "Encoding " ++ symbolVal pt ++ " succeeded"  + ++-- |+-- >>> :{+-- let tst1, tst2 :: Either EncodeEx (Enc '["boolNot:(r-Word8-decimal)"] () T.Text)+--     tst1 = encBoolNot' . toEncoding () $ "334"+--     tst2 = encBoolNot' . toEncoding () $ "127"+-- :}+--+-- >>> tst1+-- Right (UnsafeMkEnc Proxy () "334")+-- >>> tst2+-- Left (EncodeEx "boolNot:(r-Word8-decimal)" ("Encoding r-Word8-decimal succeeded"))+encBoolNot' :: forall s t xs c str . (+    BoolOpIs s "not" ~ 'True+    , KnownSymbol s+    , FirstTerm s ~ t+    , KnownSymbol t+    , Restriction t +    , Encode (Either EncodeEx) t t c str+    ) => Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str)  +encBoolNot' = encBoolNot'' @t++encBoolNot'' :: forall alg s t xs c str . (+    BoolOpIs s "not" ~ 'True+    , KnownSymbol s+    , FirstTerm s ~ t+    , Restriction t  +    , Encode (Either EncodeEx) t alg c str+    ) => Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str)  +encBoolNot'' = encBoolNot (encodeF' @alg @t @xs)++-- | +-- Decodes boolean expression if all leaves are @"r-"@+decBoolR :: forall f xs t s c str . (+    NestedR s  ~ 'True+    , Applicative f+    ) => Enc (s ': xs) c str -> f (Enc xs c str)  ++decBoolR = implTranP id +++recWithEncBoolR :: forall (s :: Symbol) xs c str . (NestedR s ~ 'True) +                       => (Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str)) +                       -> Enc xs c str -> Either RecreateEx (Enc (s ': xs) c str)+recWithEncBoolR = unsafeRecWithEncR++unsafeRecWithEncR :: forall (s :: Symbol) xs c str .+                       (Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str)) +                       -> Enc xs c str -> Either RecreateEx (Enc (s ': xs) c str)+unsafeRecWithEncR fn = either (Left . encToRecrEx) Right . fn++-- * Type family based parser ++-- |+-- >>> :kind! BoolOpIs "boolAnd:(someenc)(otherenc)" "and"+-- ...+-- = 'True+type family BoolOpIs (s :: Symbol) (op :: Symbol) :: Bool where+    BoolOpIs s op = AcceptEq ('Text "Invalid bool encoding " ':<>: ShowType s ) (CmpSymbol (BoolOp s) op)++-- | +-- This works fast with @!kind@ but is much slower in declaration +-- :kind! BoolOp "boolOr:()()"+type family BoolOp (s :: Symbol) :: Symbol where+    BoolOp s = Fst (BoolOpHelper (Dupl s))+        -- ToLower (TakeUntil (Drop 4 s) ":")++type family BoolOpHelper (x :: (Symbol, Symbol)) :: (Symbol, Bool) where+    BoolOpHelper ('(,) s1 s2) = '(,) (ToLower (TakeUntil (Drop 4 s1) ":")) ( AcceptEq ('Text "Invalid bool encoding " ':<>: ShowType s2 ) (CmpSymbol "bool" (Take 4 s2)))+++type family IsBool (s :: Symbol) :: Bool where+    IsBool s = AcceptEq ('Text "Not boolean encoding " ':<>: ShowType s ) (CmpSymbol "bool" (Take 4 s))++-- |+-- +-- >>> :kind! NestedR "boolOr:(r-abc)(r-cd)"+-- ...+-- = 'True+--+-- >>> :kind! NestedR "boolOr:(boolAnd:(r-ab)(r-ac))(boolNot:(r-cd))"+-- ...+-- = 'True+--+-- >>> :kind! NestedR "boolOr:(boolAnd:(r-ab)(ac))(boolNot:(r-cd))"+-- ...+-- ... (TypeError ...)+-- ...+type family NestedR (s :: Symbol) :: Bool where+    NestedR "" = 'True -- RightTerm, LeftTerm return "" on "r-"+    NestedR s = Or (IsROrEmpty s) +                   (And (IsBool s) (And (NestedR (LeftTerm s)) (NestedR (RightTerm s)))) ++-- Value level check+--+-- nestedR :: String -> Bool+-- nestedR s = isROrEmpty s || isBool s && (nestedR (leftTerm s) && nestedR (rightTerm s))++-- isBool ('b' :'o' : 'o' : _) = True+-- isBool _ = False++-- isROrEmpty "" = True+-- isROrEmpty ('r' : '-' : _) = True+-- isROrEmpty _ = False+++type family FirstTerm (s :: Symbol) :: Symbol where+    FirstTerm s = LeftTerm s++-- | +-- returns "" for unary operator+type family SecondTerm (s :: Symbol) :: Symbol where+    SecondTerm s = RightTerm s+++-- |+-- >>> :kind! LeftTerm "boolSomeOp:(agag)(222)"+-- ...+-- = "agag"+--+-- >>> :kind! LeftTerm "r-Int-decimal"+-- ...+-- = ""+type family LeftTerm (s :: Symbol) :: Symbol where+    LeftTerm s = Concat (LDropLast( LTakeFstParen (LParenCnt (ToList s))))++-- |+-- >>> :kind! RightTerm "boolSomeOp:(agag)(222)"+-- ...+-- = "222"+--+-- >>> :kind! RightTerm "r-Int-decimal"+-- ...+-- = ""+type family RightTerm (s :: Symbol) :: Symbol where+    RightTerm s = Concat (LDropLast (LTakeSndParen 0 (LParenCnt (ToList s))))+++type family LDropLast (s :: [Symbol]) :: [Symbol] where+    LDropLast '[] = '[]+    LDropLast '[x] = '[]+    LDropLast (x ': xs) = x ': LDropLast xs+++type family LParenCnt (s :: [Symbol]) :: [(Symbol, Nat)] where+    LParenCnt '[] = '[]+    LParenCnt ("(" ': xs) = LParenCntHelper ('(,) "(" 'Decr) (LParenCnt xs) -- '(,) "(" (LParenCntFstCnt (LParenCnt xs) - 1) ': LParenCnt xs+    LParenCnt (")" ': xs) = LParenCntHelper ('(,) ")" 'Incr) (LParenCnt xs)+    LParenCnt (x ': xs) = LParenCntHelper ('(,) x 'NoChng) (LParenCnt xs)++data Adjust = Incr | Decr | NoChng++type family AdjHelper (a :: Adjust) (n :: Nat) :: Nat where+   AdjHelper 'Incr n = n + 1+   AdjHelper 'Decr 0 = 0+   AdjHelper 'Decr n = n - 1+   AdjHelper 'NoChng n = n++type family LParenCntHelper (s :: (Symbol, Adjust)) (sx :: [(Symbol, Nat)]) :: [(Symbol, Nat)] where+    LParenCntHelper ('(,) x k) '[] = '(,) x (AdjHelper k 0) ': '[]+    LParenCntHelper ('(,) x k) ('(,) c i : xs) = '(,) x (AdjHelper k i) ': '(,) c i ': xs+++type family LTakeFstParen (si :: [(Symbol, Nat)]) :: [Symbol] where +    LTakeFstParen '[] = '[]+    LTakeFstParen ('(,) _ 0 ': xs) = LTakeFstParen xs+    LTakeFstParen ('(,) ")" 1 ': _) = '[")"]+    LTakeFstParen ('(,) a p ': xs) = a ': LTakeFstParen xs+++type family LTakeSndParen (n :: Nat)  (si :: [(Symbol, Nat)]) :: [Symbol] where+    LTakeSndParen _ '[] = '[]+    LTakeSndParen 0 ('(,) ")" 1 ': xs) = LTakeSndParen 1 xs+    LTakeSndParen 1 ('(,) _ 0 : xs) = LTakeSndParen 1 xs+    LTakeSndParen 0 ('(,) _ _ ': xs) = LTakeSndParen 0 xs+    LTakeSndParen 1 ('(,) a _ ': xs) = a : LTakeSndParen 1 xs+    LTakeSndParen n _ = '[]++-- -- * (Example) Value level equivalend of type family parsers+++-- -- map snd . parenCnt $ "((AGA)(bcd))(123) "+-- -- dropLast . takeFstParen . parenCnt $ "((AGA)(bcd))(123)" +-- -- dropLast . takeSndParen 0 . parenCnt $ "((AGA)(bcd))(123)" ++-- leftTerm :: String -> String+-- leftTerm = dropLast . takeFstParen . parenCnt++-- rightTerm :: String -> String+-- rightTerm = dropLast . takeSndParen 0 . parenCnt++-- parenCnt :: String -> [(Char, Int)]+-- parenCnt [] = []+-- parenCnt ('(' : xs) = parenCntHelper ('(', -1) (parenCnt xs) --('(', parenCntFstCnt (parenCnt xs) - 1) : parenCnt xs+-- parenCnt (')' : xs) = parenCntHelper (')', 1) (parenCnt xs)  -- (')', parenCntFstCnt (parenCnt xs) + 1) : parenCnt xs+-- parenCnt (x : xs) = parenCntHelper (x, 0) (parenCnt xs) -- (x, parenCntFstCnt (parenCnt xs) ) : parenCnt xs+++-- parenCntHelper :: (Char, Int) -> [(Char, Int)]  -> [(Char, Int)]+-- parenCntHelper (x, k) [] = [(x,k)]+-- parenCntHelper (x, k) ((c,i) : xs) = (x, i + k): (c,i) : xs+++-- takeFstParen :: [(Char, Int)] -> [Char]+-- takeFstParen [] = []+-- takeFstParen ((_, 0) : xs) = takeFstParen xs+-- takeFstParen ((')', 1) : _) = [')']+-- takeFstParen ((a, p) : xs) = a : takeFstParen xs++-- takeSndParen :: Int -> [(Char, Int)] -> [Char]+-- takeSndParen _ [] = []+-- takeSndParen 0 ((')', 1) : xs) = takeSndParen 1 xs+-- takeSndParen 1 ((_, 0) : xs) = takeSndParen 1 xs+-- takeSndParen 0 ((_, _) : xs) = takeSndParen 0 xs+-- takeSndParen 1 ((a, _) : xs) = a : takeSndParen 1 xs+-- takeSndParen _ _ = []++-- dropLast :: [Char] -> [Char]+-- dropLast [] = []+-- dropLast [x] = []+-- dropLast (x:xs) = x : dropLast xs+
+ src/Data/TypedEncoding/Instances/Restriction/BoundedAlphaNums.hs view
@@ -0,0 +1,122 @@++{-# LANGUAGE MultiParamTypeClasses #-}+-- {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+-- {-# LANGUAGE KindSignatures  #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ConstraintKinds #-}++-- | +-- Restrictions @"r-ban:"@ cover commonly used fixed (short) size strings with restricted+-- characters such as GUID, credit card numbers, etc.  +-- +-- Alphanumeric chars are ordered: @0-9@ followed by @A-Z@,+-- followed by @a-z@. Annotation specifies upper character bound. +-- Any non alpha numeric characters are considered fixed delimiters+-- and need to be present exactly as specified.+-- For example @"r-ban:999-99-9999"@ could be used to describe SSN numbers,+-- @"r-ban:FFFF" would describe strings consisting of 4 hex digits.+--+-- This is a simple implementation that converts to @String@, should be used+-- only with short length data.+--+--+-- @since 0.2.1.0+module Data.TypedEncoding.Instances.Restriction.BoundedAlphaNums where +++import           GHC.TypeLits+import qualified Data.List as L+import           Data.Char+import           Data.Proxy+import           Data.Either++import           Data.TypedEncoding.Common.Util.TypeLits+import           Data.TypedEncoding.Common.Class.IsStringR+import           Data.TypedEncoding.Instances.Support++-- $setup+-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XTypeApplications+-- >>> import qualified Data.Text as T+-- >>> import           Data.TypedEncoding++-- better compilation errors?+type family IsBan (s :: Symbol) :: Bool where+    IsBan s = AcceptEq ('Text "Not ban restriction encoding " ':<>: ShowType s ) (CmpSymbol (TakeUntil s ":") "r-ban")++type Ban s = (KnownSymbol s, IsBan s ~ 'True)++type instance IsSupersetOpen "r-ASCII" "r-ban" xs = 'True+++instance (Ban s, Algorithm s "r-ban", IsStringR str) => Encode (Either EncodeEx) s "r-ban" c str where+    encoding = encFBan+++-- |+-- >>> runEncoding' encFBan . toEncoding () $ "C59F9FB7-4621-44D9-9020-CE37BF6E2BD1" :: Either EncodeEx (Enc '["r-ban:FFFFFFFF-FFFF-FFFF-FFFF-FFFFFFFFFFFF"] () T.Text)+-- Right (UnsafeMkEnc Proxy () "C59F9FB7-4621-44D9-9020-CE37BF6E2BD1")+-- +-- >>> recreateFAll' @'["r-ban"] . toEncoding () $ "211-22-9934" :: Either RecreateEx (Enc '["r-ban:999-99-9999"] () T.Text)+-- Right (UnsafeMkEnc Proxy () "211-22-9934")+encFBan :: forall s c str .+              (+                IsStringR str+              , Ban s+              , Algorithm s "r-ban"+              ) => +              Encoding (Either EncodeEx) s "r-ban" c str+encFBan = _implEncodingEx @s (verifyBoundedAlphaNum (Proxy :: Proxy s))              ++++-- * Decoding++instance (KnownSymbol s, Restriction s, Algorithm s "r-ban", Applicative f) => Decode f s "r-ban" c str where+    decoding = decAnyR_+++-- * Validation++instance (KnownSymbol s , Ban s, Algorithm s "r-ban", IsStringR str, RecreateErr f, Applicative f) => Validate f s "r-ban" c str where+    validation = validFromEnc' @"r-ban" encFBan+++-- * Implementation++-- |+-- >>> verifyBoundedAlphaNum (Proxy :: Proxy "r-ban:FF-FF") (T.pack "12-3E")+-- Right "12-3E"+-- >>> verifyBoundedAlphaNum (Proxy :: Proxy "r-ban:FF-FF") (T.pack "1G-3E")+-- Left "'G' not boulded by 'F'"+-- >>> verifyBoundedAlphaNum (Proxy :: Proxy "r-ban:FF-FF") (T.pack "13G3E")+-- Left "'G' not matching '-'"+-- >>> verifyBoundedAlphaNum (Proxy :: Proxy "r-ban:FF-FF") (T.pack "13-234")+-- Left "Input list has wrong size expecting 5 but length \"13-234\" == 6"+verifyBoundedAlphaNum :: forall s str . (KnownSymbol s, IsStringR str) => Proxy s -> str -> Either String str+verifyBoundedAlphaNum p str = +    if pattl == inpl +    then case lefts match of+        (e: _) -> Left e+        _ -> Right str+    else Left $ "Input list has wrong size expecting " ++ show pattl ++ " but length " ++ show input ++ " == " ++ show inpl   +    where +        patt = L.drop (L.length ("r-ban:" :: String)) . symbolVal $ p+        input = toString str+        pattl = L.length patt+        inpl = L.length input +        +        match = L.zipWith fn input patt+++        fn ci cp = case (isAlphaNum ci, isAlphaNum cp, ci <= cp, ci == cp) of+            (True, True, True, _) -> Right ()+            (_, _, _, True) -> Right ()+            (_, True, _, False) -> Left $ show ci ++ " not boulded by " ++ show cp+            (_, False, _, False) -> Left $ show ci ++ " not matching " ++ show cp
− src/Data/TypedEncoding/Instances/Restriction/Common.hs 
@@ -1,45 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}---- | Common /restriction/ "r-" instances-module Data.TypedEncoding.Instances.Restriction.Common where--import           Data.Word---- import qualified Data.ByteString as B--- import qualified Data.ByteString.Lazy as BL--- import qualified Data.Text as T--- import qualified Data.Text.Lazy as TL--import           Data.TypedEncoding.Internal.Class.IsStringR-import           Data.TypedEncoding.Internal.Instances.Combinators-import           Data.TypedEncoding.Instances.Support---- $setup--- >>> import qualified Data.Text as T---instance (IsStringR str) =>  EncodeF (Either EncodeEx) (Enc xs c str) (Enc ("r-Word8-decimal" ': xs) c str) where-    encodeF = implEncodeF @"r-Word8-decimal" (verifyWithRead @Word8 "Word8-decimal")-instance (IsStringR str, RecreateErr f, Applicative f) => RecreateF f (Enc xs c str) (Enc ("r-Word8-decimal" ': xs) c str) where-    checkPrevF = implCheckPrevF (asRecreateErr @"r-Word8-decimal" . verifyWithRead @Word8 "Word8-decimal")-instance (IsStringR str, Applicative f) => DecodeF f (Enc ("r-Word8-decimal" ': xs) c str) (Enc xs c str) where-    decodeF = implTranP id --instance (IsStringR str) =>  EncodeF (Either EncodeEx) (Enc xs c str) (Enc ("r-Int-decimal" ': xs) c str) where-    encodeF = implEncodeF @"r-Int-decimal" (verifyWithRead @Int "Int-decimal")-instance (IsStringR str, RecreateErr f, Applicative f) => RecreateF f (Enc xs c str) (Enc ("r-Int-decimal" ': xs) c str) where-    checkPrevF = implCheckPrevF (asRecreateErr @"r-Int-decimal" . verifyWithRead @Int "Int-decimal")-instance (IsStringR str, Applicative f) => DecodeF f (Enc ("r-Int-decimal" ': xs) c str) (Enc xs c str) where-    decodeF = implTranP id ----- tst :: T.Text--- tst = fromString $ show $ (fromString $ "123" :: T.Text)
+ src/Data/TypedEncoding/Instances/Restriction/Misc.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Common /restriction/ "r-" instances+module Data.TypedEncoding.Instances.Restriction.Misc where++import           Data.Word+import           Data.Functor.Identity+import           Data.String+import           Data.Proxy+import           Text.Read++import           Data.TypedEncoding.Common.Class.IsStringR+import           Data.TypedEncoding.Instances.Support++-- $setup+-- >>> import qualified Data.Text as T++instance IsString str => ToEncString Identity "r-()" "r-()" () str where+    toEncF _ = Identity $ UnsafeMkEnc Proxy () (fromString "()")+++instance (IsStringR str) =>  Encode (Either EncodeEx) "r-Word8-decimal" "r-Word8-decimal" c str where+    encoding = encWord8Dec+instance (Applicative f) => Decode f "r-Word8-decimal" "r-Word8-decimal" c str where+    decoding = decAnyR+instance (IsStringR str) =>  Validate (Either RecreateEx) "r-Word8-decimal" "r-Word8-decimal" c str where+    validation = validR encWord8Dec+instance IsString str => ToEncString Identity "r-Word8-decimal" "r-Word8-decimal" Word8 str where+    toEncF  i = Identity $ UnsafeMkEnc Proxy () (fromString . show $ i)+instance (IsStringR str, UnexpectedDecodeErr f, Applicative f) => FromEncString f "r-Word8-decimal" "r-Word8-decimal" Word8 str where+    fromEncF  = asUnexpected @ "r-Word8-decimal" . readEither . toString . getPayload++encWord8Dec :: (IsStringR str) => Encoding (Either EncodeEx) "r-Word8-decimal" "r-Word8-decimal" c str+encWord8Dec = _implEncodingEx (verifyWithRead @Word8 "Word8-decimal")+++instance (IsStringR str) =>  Encode (Either EncodeEx) "r-Int-decimal" "r-Int-decimal" c str where+    encoding = encIntDec+instance (Applicative f) => Decode f "r-Int-decimal" "r-Int-decimal" c str where+    decoding = decAnyR+instance (IsStringR str) =>  Validate (Either RecreateEx) "r-Int-decimal" "r-Int-decimal" c str where+    validation = validR encIntDec+instance IsString str => ToEncString Identity "r-Int-decimal" "r-Int-decimal" Int str where+    toEncF  i = Identity $ UnsafeMkEnc Proxy () (fromString . show $ i)++encIntDec :: (IsStringR str) => Encoding (Either EncodeEx) "r-Int-decimal" "r-Int-decimal" c str+encIntDec =  _implEncodingEx (verifyWithRead @Int "Int-decimal")++++++-- All instances of "r-Word8-decimal" are  @Show@ / @Read@ based
src/Data/TypedEncoding/Instances/Restriction/UTF8.hs view
@@ -16,95 +16,43 @@ import           Data.TypedEncoding.Instances.Support  import           Data.Proxy-import           GHC.TypeLits  import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL import qualified Data.Text.Encoding as TE  import qualified Data.Text.Lazy.Encoding as TEL ---- import qualified Data.ByteString.Char8 as B8--- import qualified Data.ByteString.Lazy.Char8 as BL8- import           Data.Either + -- $setup -- >>> :set -XScopedTypeVariables -XKindSignatures -XMultiParamTypeClasses -XDataKinds -XPolyKinds -XPartialTypeSignatures -XFlexibleInstances -XTypeApplications -- >>> import Test.QuickCheck -- >>> import Test.QuickCheck.Instances.Text() -- >>> import Test.QuickCheck.Instances.ByteString()+-- >>> import Data.TypedEncoding -- >>> import Data.TypedEncoding.Internal.Util (proxiedId)--- >>> :{--- >>> instance Arbitrary (Enc '["r-UTF8"] () B.ByteString) where ---      arbitrary =  fmap (fromRight (emptyUTF8B ())) +-- >>> let emptyUTF8B = unsafeSetPayload () "" ::  Enc '["r-UTF8"] () B.ByteString +-- >>> :{  +-- instance Arbitrary (Enc '["r-UTF8"] () B.ByteString) where +--      arbitrary =  fmap (fromRight emptyUTF8B)  --                   . flip suchThat isRight ---                   . fmap (encodeFAll @(Either EncodeEx) @'["r-UTF8"] @(). toEncoding ()) $ arbitrary +--                   . fmap (encodeFAll @'["r-UTF8"] @(Either EncodeEx) @(). toEncoding ()) $ arbitrary  -- :} --- | DEPRECATED will be removed in 0.3 --- empty string is valid utf8-emptyUTF8B :: c -> Enc '["r-UTF8"] c B.ByteString-emptyUTF8B c = unsafeSetPayload c ""    --------------------- Conversions -------------------- --- |--- | DEPRECATED will be removed in 0.3 --- --- use 'Data.TypedEncoding.Conv.Text.Lazy.Encoding.encodeUtf8'--- and 'Data.TypedEncoding.Conv.Text.utf8Promote'-text2ByteStringS :: Enc ys c T.Text -> Enc ("r-UTF8" ': ys) c B.ByteString-text2ByteStringS = withUnsafeCoerce TE.encodeUtf8---- | --- DEPRECATED------ | DEPRECATED will be removed in 0.3 --- --- use 'Data.TypedEncoding.Conv.Text.Lazy.Encoding.decodeUtf8'--- and 'Data.TypedEncoding.Conv.Text.utf8Demote'------ See warning in 'Data.TypedEncoding.Instances.Restriction.ASCII.byteString2TextS'------ Type-safer version of Data.Text.Encoding.decodeUtf8----byteString2TextS :: Enc ("r-UTF8" ': ys) c B.ByteString -> Enc ys c T.Text -byteString2TextS = withUnsafeCoerce TE.decodeUtf8---- | To be removed-txtBsSIdProp :: Proxy (ys :: [Symbol]) -> Enc ys c T.Text -> Enc ys c T.Text-txtBsSIdProp _ = byteString2TextS . text2ByteStringS ---- To be removed-bsTxtIdProp :: Proxy (ys :: [Symbol]) -> Enc ("r-UTF8" ': ys) c B.ByteString -> Enc ("r-UTF8" ': ys) c B.ByteString-bsTxtIdProp _ = text2ByteStringS . byteString2TextS---- DEPRECATED see above-text2ByteStringL :: Enc ys c TL.Text -> Enc ("r-UTF8" ': ys) c BL.ByteString-text2ByteStringL = withUnsafeCoerce TEL.encodeUtf8---- DEPRECATED------ See warning in 'Data.TypedEncoding.Instances.Restriction.ASCII.byteString2TextS'-byteString2TextL :: Enc ("r-UTF8" ': ys) c BL.ByteString -> Enc ys c TL.Text -byteString2TextL = withUnsafeCoerce TEL.decodeUtf8- ----------------- -- Encodings  -- -----------------  prxyUtf8 = Proxy :: Proxy "r-UTF8" --- TODO these are quick and dirty+-- TODO these may need rethinking (performance)  -- | UTF8 encodings are defined for ByteString only as that would not make much sense for Text -- -- >>> encodeFAll . toEncoding () $ "\xc3\xb1" :: Either EncodeEx (Enc '["r-UTF8"] () B.ByteString)--- Right (MkEnc Proxy () "\195\177")+-- Right (UnsafeMkEnc Proxy () "\195\177") -- -- >>> encodeFAll . toEncoding () $ "\xc3\x28" :: Either EncodeEx (Enc '["r-UTF8"] () B.ByteString) -- Left (EncodeEx "r-UTF8" (Cannot decode byte '\xc3': Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream))@@ -112,28 +60,32 @@ -- Following test uses 'verEncoding' helper that checks that bytes are encoded as Right iff they are valid UTF8 bytes -- -- prop> \(b :: B.ByteString) -> verEncoding b (fmap (fromEncoding . decodeAll . proxiedId (Proxy :: Proxy (Enc '["r-UTF8"] _ _))) . (encodeFAll :: _ -> Either EncodeEx _). toEncoding () $ b)+instance Encode (Either EncodeEx) "r-UTF8" "r-UTF8" c B.ByteString where+    encoding = encUTF8B -instance Encodings (Either EncodeEx) xs grps c B.ByteString => Encodings (Either EncodeEx) ("r-UTF8" ': xs) ("r-UTF8" ': grps) c B.ByteString where-    encodings = encodeFEncoder @(Either EncodeEx) @"r-UTF8" @"r-UTF8"+instance Encode (Either EncodeEx) "r-UTF8" "r-UTF8" c BL.ByteString where+    encoding = encUTF8BL :: Encoding (Either EncodeEx) "r-UTF8" "r-UTF8" c BL.ByteString +encUTF8B :: Encoding (Either EncodeEx) "r-UTF8" "r-UTF8" c B.ByteString+encUTF8B = _implEncodingEx (fmap TE.encodeUtf8 . TE.decodeUtf8')+{-# WARNING encUTF8B "This method was not optimized for performance." #-} -instance EncodeF (Either EncodeEx) (Enc xs c B.ByteString) (Enc ("r-UTF8" ': xs) c B.ByteString) where-    encodeF = implEncodeF_ prxyUtf8 (fmap TE.encodeUtf8 . TE.decodeUtf8')-instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c B.ByteString) (Enc ("r-UTF8" ': xs) c B.ByteString) where-    checkPrevF = implCheckPrevF (asRecreateErr @"r-UTF8" . fmap TE.encodeUtf8 . TE.decodeUtf8')-instance Applicative f => DecodeF f (Enc ("r-UTF8" ': xs) c B.ByteString) (Enc xs c B.ByteString) where-    decodeF = implTranP id  +encUTF8BL :: Encoding (Either EncodeEx) "r-UTF8" "r-UTF8" c BL.ByteString+encUTF8BL = _implEncodingEx (fmap TEL.encodeUtf8 . TEL.decodeUtf8')+{-# WARNING encUTF8BL "This method was not optimized for performance." #-} -instance Encodings (Either EncodeEx) xs grps c BL.ByteString => Encodings (Either EncodeEx) ("r-UTF8" ': xs) ("r-UTF8" ': grps) c BL.ByteString where-    encodings = encodeFEncoder @(Either EncodeEx) @"r-UTF8" @"r-UTF8"+-- * Decoding -instance EncodeF (Either EncodeEx) (Enc xs c BL.ByteString) (Enc ("r-UTF8" ': xs) c BL.ByteString) where-    encodeF = implEncodeF_ prxyUtf8 (fmap TEL.encodeUtf8 . TEL.decodeUtf8')-instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c BL.ByteString) (Enc ("r-UTF8" ': xs) c BL.ByteString) where-    checkPrevF = implCheckPrevF (asRecreateErr @"r-UTF8" . fmap TEL.encodeUtf8 . TEL.decodeUtf8')-instance Applicative f => DecodeF f (Enc ("r-UTF8" ': xs) c BL.ByteString) (Enc xs c BL.ByteString) where-    decodeF = implTranP id +instance (Applicative f) => Decode f "r-UTF8" "r-UTF8" c str where+    decoding = decAnyR++instance (RecreateErr f, Applicative f) =>  Validate f "r-UTF8" "r-UTF8" c B.ByteString  where+    validation = validR encUTF8B++instance (RecreateErr f, Applicative f) =>  Validate f "r-UTF8" "r-UTF8" c BL.ByteString  where+    validation = validR encUTF8BL+  --- Utilities ---
src/Data/TypedEncoding/Instances/Support.hs view
@@ -4,16 +4,29 @@ -- Contains typical things needed when implementing -- encoding, decoding, recreate, or type to string conversions. module Data.TypedEncoding.Instances.Support (+    module Data.TypedEncoding.Instances.Support     -- * Types-    module Data.TypedEncoding.Internal.Types+    , module Data.TypedEncoding.Common.Types     -- * Classes-    , module Data.TypedEncoding.Internal.Class+    , module Data.TypedEncoding.Common.Class     -- * Combinators-    , module Data.TypedEncoding.Internal.Instances.Combinators+    , module Data.TypedEncoding.Instances.Support.Common+    , module Data.TypedEncoding.Instances.Support.Helpers+    , module Data.TypedEncoding.Instances.Support.Encode+    , module Data.TypedEncoding.Instances.Support.Decode+    , module Data.TypedEncoding.Instances.Support.Validate+    , module Data.TypedEncoding.Combinators.Unsafe     -- * Type level conveniences-    , module Data.TypedEncoding.Internal.Util.TypeLits+    , module Data.TypedEncoding.Common.Util.TypeLits    ) where-import           Data.TypedEncoding.Internal.Types-import           Data.TypedEncoding.Internal.Class -import           Data.TypedEncoding.Internal.Instances.Combinators -import           Data.TypedEncoding.Internal.Util.TypeLits ++import           Data.TypedEncoding.Instances.Support.Common +import           Data.TypedEncoding.Instances.Support.Helpers +import           Data.TypedEncoding.Instances.Support.Encode +import           Data.TypedEncoding.Instances.Support.Decode +import           Data.TypedEncoding.Instances.Support.Validate +import           Data.TypedEncoding.Common.Types+import           Data.TypedEncoding.Common.Class +import           Data.TypedEncoding.Common.Util.TypeLits+import           Data.TypedEncoding.Combinators.Unsafe +
+ src/Data/TypedEncoding/Instances/Support/Common.hs view
@@ -0,0 +1,36 @@++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeApplications #-}++-- | Exports for instance creation.+-- +-- Contains typical things needed when implementing+-- encoding, decoding, recreate, or type to string conversions.+module Data.TypedEncoding.Instances.Support.Common where++import           Data.TypedEncoding.Instances.Support.Unsafe+import           Data.TypedEncoding.Common.Types+import           Data.Proxy++-- $setup+-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XTypeApplications+++-- * Decoding ++-- | Universal decoding for all "r-" types+decAnyR :: forall r f c str . (Restriction r, Applicative f) => Decoding f r r c str+decAnyR = decAnyR' @r @r++decAnyR' :: forall alg r f c str . (Restriction r, Applicative f) => Decoding f r alg c str+decAnyR' = UnsafeMkDecoding Proxy (implTranP id) ++decAnyR_ :: forall r f c str alg . (Restriction r, Algorithm r alg, Applicative f) => Decoding f r alg c str+decAnyR_ = mkDecoding $ implTranP id+
+ src/Data/TypedEncoding/Instances/Support/Decode.hs view
@@ -0,0 +1,39 @@++{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}++-- | v0.2 style decoding combinators+module Data.TypedEncoding.Instances.Support.Decode where++import           Data.TypedEncoding.Instances.Support.Unsafe+import           Data.TypedEncoding.Common.Types.Decoding+import           Data.Proxy+import           Data.TypedEncoding.Common.Types++++-- * Compiler figure out algorithm, these appear fast enough ++_implDecodingF :: forall nm f c str . Functor f => (str -> f str) -> Decoding f nm (AlgNm nm) c str+_implDecodingF f = mkDecoding $ implTranF f++_implDecodingConfF :: forall nm f c str . Functor f => (c -> str -> f str) -> Decoding f nm (AlgNm nm) c str+_implDecodingConfF f = mkDecoding $ implTranF' f+++-- * Assume @alg ~ nm@ or explicit @alg@ ++implDecodingF :: forall nm f c str . Functor f => (str -> f str) -> Decoding f nm nm c str+implDecodingF = implDecodingF' @nm @nm++implDecodingF' :: forall alg nm f c str . Functor f => (str -> f str) -> Decoding f nm alg c str+implDecodingF' f = UnsafeMkDecoding Proxy $ implTranF f+++
+ src/Data/TypedEncoding/Instances/Support/Encode.hs view
@@ -0,0 +1,63 @@++{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+++module Data.TypedEncoding.Instances.Support.Encode where++import           Data.TypedEncoding.Instances.Support.Unsafe+import           Data.TypedEncoding.Common.Types.Enc+import           Data.Proxy+import           Data.TypedEncoding.Common.Types+import           GHC.TypeLits+++-- * Compiler figure out algorithm, these appear fast enough ++_implEncodingP :: forall nm f c str . Applicative f => (str -> str) -> Encoding f nm (AlgNm nm)  c str+_implEncodingP f = _mkEncoding $ implTranF (pure . f)++_implEncodingConfP :: forall nm f c str . Applicative f => (c -> str -> str) -> Encoding f nm (AlgNm nm) c str+_implEncodingConfP f = _mkEncoding $ implTranF' (\c -> pure . f c)++_implEncodingEx :: forall nm err c str . (KnownSymbol nm, Show err) => (str -> Either err str) -> Encoding (Either EncodeEx) nm (AlgNm nm) c str+_implEncodingEx f = _mkEncoding $ implTranF (either (Left . EncodeEx p) Right . f) +   where+        p = Proxy :: Proxy nm++_implEncodingEncodeEx :: forall nm c str . (KnownSymbol nm) => (str -> Either EncodeEx str) -> Encoding (Either EncodeEx) nm (AlgNm nm) c str+_implEncodingEncodeEx f = _mkEncoding $ implTranF f +++_implEncodingConfEx :: forall nm err c str . (KnownSymbol nm, Show err) => (c -> str -> Either err str) -> Encoding (Either EncodeEx) nm (AlgNm nm) c str+_implEncodingConfEx f = _mkEncoding $ implTranF' (\c -> either (Left . EncodeEx p) Right . f c) +    where+        p = Proxy :: Proxy nm++++-- * Assume @alg ~ nm@ or explicit @alg@ ++implEncodingP :: forall nm f c str . Applicative f => (str -> str) -> Encoding f nm nm c str+implEncodingP f = UnsafeMkEncoding Proxy $ implTranF (pure . f)++implEncodingEx :: forall nm err c str . (KnownSymbol nm, Show err) =>  (str -> Either err str) -> Encoding (Either EncodeEx) nm nm c str+implEncodingEx = implEncodingEx' @nm @nm++implEncodingEx' :: forall alg nm err c str . (KnownSymbol nm, Show err) =>  (str -> Either err str) -> Encoding (Either EncodeEx) nm alg c str+implEncodingEx' f = UnsafeMkEncoding Proxy $ implTranF (either (Left . EncodeEx p) Right . f) +   where+        p = Proxy :: Proxy nm++implEncodingEncodeEx' :: forall alg nm c str . (KnownSymbol nm) =>  (str -> Either EncodeEx str) -> Encoding (Either EncodeEx) nm alg c str+implEncodingEncodeEx' f = UnsafeMkEncoding Proxy $ implTranF f +   where+        p = Proxy :: Proxy nm++
+ src/Data/TypedEncoding/Instances/Support/Helpers.hs view
@@ -0,0 +1,112 @@++{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- {-# LANGUAGE AllowAmbiguousTypes #-}+-- {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}++-- | Support for mostly creating instances ToEncString and FromEncString conversions++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.+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 f sinit = unsafeSetPayload c . foldr f sinit . fmap getPayload ++-- | Similar to 'foldEnc', assumes that destination payload has @IsString@ instance and uses @""@ as base case. +foldEncStr :: forall (xs2 :: [Symbol]) (xs1 :: [Symbol]) f c s1 s2 +             . (Foldable f, Functor f, IsString s2) +             => c -> (s1 -> s2 -> s2) -> f (Enc xs1 c s1) -> Enc xs2 c s2+foldEncStr c f = foldEnc c f ""++-- | Similar to 'foldEnc', works with untyped 'CheckedEnc'+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 f sinit = unsafeSetPayload c . foldr (uncurry f) sinit . fmap getCheckedEncPayload++-- | Similar to 'foldEncStr', works with untyped 'CheckedEnc'+foldCheckedEncStr :: forall (xs2 :: [Symbol]) f c s1 s2 . (Foldable f, Functor f, IsString s2) => c -> ([EncAnn] -> s1 -> s2 -> s2) -> f (CheckedEnc c s1) -> Enc xs2 c s2+foldCheckedEncStr c f  = foldCheckedEnc c f ""+++-- * Composite encoding: Recreate and Encode helpers++-- | Splits composite payload into homogenious chunks+splitPayload :: forall (xs2 :: [Symbol]) (xs1 :: [Symbol]) c s1 s2 . +             (s1 -> [s2]) +             -> Enc xs1 c s1 +             -> [Enc xs2 c s2]+splitPayload f (UnsafeMkEnc _ c s1) = map (UnsafeMkEnc Proxy c) (f s1)+   +-- | Untyped version of 'splitPayload'+splitSomePayload :: forall c s1 s2 . +             ([EncAnn] -> s1 -> [([EncAnn], s2)]) +             -> CheckedEnc c s1 +             -> [CheckedEnc c s2]+splitSomePayload f (UnsafeMkCheckedEnc ann1 c s1) = map (\(ann2, s2) -> UnsafeMkCheckedEnc ann2 c s2) (f ann1 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"+verifyWithRead :: forall a str . (IsStringR str, Read a, Show a) => String -> str -> Either String str+verifyWithRead msg x = +    let s = toString x+        a :: Maybe a = readMaybe s+        check = (show <$> a) == Just s +    in if check+       then Right x+       else Left $ "Payload does not satisfy format " ++ msg ++ ": " ++ s    +++-- | Convenience function for checking if @str@ decodes without error+-- using @enc@ encoding markers and decoders that can pick decoder based+-- on that marker+verifyDynEnc :: forall s str err1 err2 enc a. (KnownSymbol s, Show err1, Show err2) => +                  Proxy s   -- ^ proxy defining encoding annotation+                  -> (Proxy s -> Either err1 enc)  -- ^ finds encoding marker @enc@ for given annotation or fails+                  -> (enc -> str -> Either err2 a)  -- ^ decoder based on @enc@ marker+                  -> str                            -- ^ input+                  -> Either EncodeEx str+verifyDynEnc p findenc decoder str = +  do+    enc <- asEncodeEx p . findenc $ p+    case decoder enc str of+      Left err -> Left $ EncodeEx p err+      Right r -> Right str++
+ src/Data/TypedEncoding/Instances/Support/Unsafe.hs view
@@ -0,0 +1,35 @@++{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- {-# LANGUAGE AllowAmbiguousTypes #-}+-- {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}++-- | Direct use of these methods is discouraged.+-- Use "Data.TypedEncoding.Instances.Support.Encode" or "Data.TypedEncoding.Instances.Support.Decode" +module Data.TypedEncoding.Instances.Support.Unsafe where++import           Data.Proxy+import           Data.TypedEncoding.Common.Types+import           Data.TypedEncoding.Combinators.Unsafe++++implTranF :: Functor f => (str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str)+implTranF f  = implTranF' (const f)++implTranF' :: Functor f =>  (conf -> str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str)+implTranF' f (UnsafeMkEnc _ conf str) = UnsafeMkEnc Proxy conf <$> f conf str++implTranP :: Applicative f => (str -> str) -> Enc enc1 conf str -> f (Enc enc2 conf str)+implTranP f  = implTranF' (\c -> pure . f)++implTranP' :: Applicative f => (conf -> str -> str) -> Enc enc1 conf str -> f (Enc enc2 conf str)+implTranP' f  = implTranF' (\c -> pure . f c)++implChangeAnn :: Functor f => (Enc enc1 conf str -> f (Enc enc2a conf str)) -> Enc enc1 conf str -> f (Enc enc2b conf str)+implChangeAnn fn = fmap (withUnsafeCoerce id) . fn+
+ src/Data/TypedEncoding/Instances/Support/Validate.hs view
@@ -0,0 +1,60 @@++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeApplications #-}++-- | Exports for instance creation.+-- +-- Contains typical things needed when implementing+-- encoding, decoding, recreate, or type to string conversions.+module Data.TypedEncoding.Instances.Support.Validate where+import           Data.TypedEncoding.Common.Types+import           Data.TypedEncoding.Common.Class ++import           GHC.TypeLits+import           Data.Proxy++-- $setup+-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XTypeApplications+++-- * Validation++validFromDec :: forall nm f c str . (KnownSymbol nm, RecreateErr f, Applicative f) => Decoding (Either UnexpectedDecodeEx) nm nm c str -> Validation f nm nm c str  +validFromDec = validFromDec' @nm @nm ++validFromDec' :: forall alg nm f c str . (KnownSymbol nm, RecreateErr f, Applicative f) => Decoding (Either UnexpectedDecodeEx) nm alg c str -> Validation f nm alg c str  +validFromDec' (UnsafeMkDecoding p fn) = UnsafeMkValidation p (decAsRecreateErr . fn)+   where +        decAsRecreateErr :: Either UnexpectedDecodeEx a -> f a+        decAsRecreateErr (Left (UnexpectedDecodeEx p err)) = recoveryErr $ RecreateEx p err+        decAsRecreateErr (Right r) = pure r+++validR :: forall nm f c str . (Restriction nm, KnownSymbol nm, RecreateErr f, Applicative f) => Encoding (Either EncodeEx) nm nm c str -> Validation f nm nm c str  +validR = validFromEnc' @nm @nm ++-- | Can cause slow compilation if used+validR' :: forall nm f c str alg . (Restriction nm, Algorithm nm alg, KnownSymbol nm, RecreateErr f, Applicative f) =>  Encoding (Either EncodeEx) nm alg c str -> Validation f nm alg c str  +validR' = validFromEnc' @alg @nm +++validFromEnc' :: forall alg nm f c str . (KnownSymbol nm, RecreateErr f, Applicative f) => Encoding (Either EncodeEx) nm alg c str -> Validation f nm alg c str  +validFromEnc' (UnsafeMkEncoding p fn) = UnsafeMkValidation p (encAsRecreateErr . rfn) +   where+        encAsRecreateErr :: Either EncodeEx a -> f a+        encAsRecreateErr (Left (EncodeEx p err)) = recoveryErr $ RecreateEx p err+        encAsRecreateErr (Right r) = pure r +        rfn :: forall (xs :: [Symbol]) . Enc (nm ': xs) c str -> Either EncodeEx (Enc xs c str)+        rfn (UnsafeMkEnc _ conf str)  =    +            let re = fn $ UnsafeMkEnc Proxy conf str+            in  UnsafeMkEnc Proxy conf . getPayload <$> re ++++
− src/Data/TypedEncoding/Instances/ToEncString/Common.hs 
@@ -1,44 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE OverloadedStrings #-}---- | Common 'ToEncString' and 'FromEncString' instances.-module Data.TypedEncoding.Instances.ToEncString.Common where----- import qualified Data.Text as T--- import qualified Data.Text.Lazy as TL--- import qualified Data.ByteString as B--- -- import qualified Data.ByteString.Lazy as BL--import           Data.TypedEncoding.Instances.Support-import           Data.TypedEncoding.Internal.Class.IsStringR--import           Data.String-import           Data.Proxy-import           Data.Word-import           Text.Read-import           Data.Functor.Identity---instance IsString str => ToEncString "r-()" str Identity () where-    toEncStringF _ = Identity $ MkEnc Proxy () (fromString "()")--instance IsString str => ToEncString "r-Int-decimal" str Identity Int where-    toEncStringF i = Identity $ MkEnc Proxy () (fromString . show $ i)--instance IsString str => ToEncString "r-Word8-decimal" str Identity Word8 where-    toEncStringF i = Identity $ MkEnc Proxy () (fromString . show $ i)---- All instances of "r-Word8-decimal" are  @Show@ / @Read@ based-instance (IsStringR str, UnexpectedDecodeErr f, Applicative f) => FromEncString Word8 f str "r-Word8-decimal" where-    fromEncStringF  = asUnexpected @ "r-Word8-decimal" . readEither . toString . getPayload
− src/Data/TypedEncoding/Internal/Class.hs 
@@ -1,72 +0,0 @@--{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}--module Data.TypedEncoding.Internal.Class (-    module Data.TypedEncoding.Internal.Class-    , module Data.TypedEncoding.Internal.Class.Util-    , module Data.TypedEncoding.Internal.Class.Encode-    , module Data.TypedEncoding.Internal.Class.Decode-    , module Data.TypedEncoding.Internal.Class.Recreate -    , module Data.TypedEncoding.Internal.Class.Superset -    -- * Encoder and Encoding replace EncodeFAll-    , module Data.TypedEncoding.Internal.Class.Encoder -  ) where--import           Data.TypedEncoding.Internal.Class.Util-import           Data.TypedEncoding.Internal.Class.Encode-import           Data.TypedEncoding.Internal.Class.Decode-import           Data.TypedEncoding.Internal.Class.Recreate-import           Data.TypedEncoding.Internal.Class.Superset-import           Data.TypedEncoding.Internal.Class.Encoder --import           Data.TypedEncoding.Internal.Types (Enc(..) -                                                   , withUnsafeCoerce-                                                   -- , getPayload-                                                   )-import           Data.Functor.Identity-import           GHC.TypeLits----- | --- Generalized Java @toString@ or a type safe version of Haskell's 'Show'.------ Encodes @a@ as @Enc '[xs]@.----class KnownSymbol x => ToEncString x str f a where-    toEncStringF :: a -> f (Enc '[x] () str)--toEncString :: forall x str f a  . (ToEncString x str Identity a) => a -> Enc '[x] () str-toEncString = runIdentity . toEncStringF----- | --- Reverse of 'ToEncString' decodes encoded string back to @a@-class (KnownSymbol x) => FromEncString a f str x where-    fromEncStringF :: Enc '[x] () str -> f a--fromEncString :: forall a str x . (FromEncString a Identity str x) => Enc '[x] () str -> a-fromEncString = runIdentity . fromEncStringF---- Other classes ------ | Flatten is more permissive than 'Superset'--- @--- instance FlattenAs "r-ASCII" "enc-B64" where -- OK--- @--- --- Now encoded data has form @Enc '["r-ASCII"] c str@ --- and there is no danger of it begin incorrectly decoded.--class FlattenAs (y :: Symbol) (x :: Symbol) where-    flattenAs ::  Enc (x ': xs) c str ->  Enc '[y] c str-    flattenAs = withUnsafeCoerce id
− src/Data/TypedEncoding/Internal/Class/Decode.hs 
@@ -1,81 +0,0 @@--{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE AllowAmbiguousTypes #-}--module Data.TypedEncoding.Internal.Class.Decode where--import           Data.TypedEncoding.Internal.Class.Util--import           Data.TypedEncoding.Internal.Types (Enc(..) -                                              , toEncoding-                                              , getPayload-                                              , UnexpectedDecodeEx(..))-import           Data.Proxy-import           Data.Functor.Identity-import           GHC.TypeLits---class DecodeF f instr outstr where    -    decodeF :: instr -> f outstr--class DecodeFAll f (xs :: [Symbol]) c str where-    decodeFAll :: Enc xs c str ->  f (Enc '[] c str)--instance Applicative f => DecodeFAll f '[] c str where-    decodeFAll (MkEnc _ c str) = pure $ toEncoding c str --instance (Monad f, DecodeFAll f xs c str, DecodeF f (Enc (x ': xs) c str) (Enc xs c str)) => DecodeFAll f (x ': xs) c str where-    decodeFAll str = -        let re :: f (Enc xs c str) = decodeF str-        in re >>= decodeFAll--decodeAll :: forall xs c str . DecodeFAll Identity (xs :: [Symbol]) c str => -              Enc xs c str-              -> Enc '[] c str-decodeAll = runIdentity . decodeFAll ---decodeFPart_ :: forall f xs xsf c str . (Functor f, DecodeFAll f xs c str) => Proxy xs -> Enc (Append xs xsf) c str -> f (Enc xsf c str)-decodeFPart_ p (MkEnc _ conf str) = -    let re :: f (Enc '[] c str) = decodeFAll $ MkEnc (Proxy :: Proxy xs) conf str-    in  MkEnc Proxy conf . getPayload <$> re --decodeFPart :: forall (xs :: [Symbol]) xsf f c str . (Functor f, DecodeFAll f xs c str) =>  Enc (Append xs xsf) c str -> f (Enc xsf c str)-decodeFPart = decodeFPart_ (Proxy :: Proxy xs) --decodePart_ :: DecodeFAll Identity (xs :: [Symbol]) c str => -              Proxy xs -              -> Enc (Append xs xsf) c str -              -> Enc xsf c str -decodePart_ p = runIdentity . decodeFPart_ p--decodePart :: forall (xs :: [Symbol]) xsf c str .  DecodeFAll Identity xs c str => -              Enc (Append xs xsf) c str -              -> Enc xsf c str-decodePart = decodePart_ (Proxy :: Proxy xs)              ---- | With type safety in place decoding errors should be unexpected.--- This class can be used to provide extra info if decoding could fail-class UnexpectedDecodeErr f where -    unexpectedDecodeErr :: UnexpectedDecodeEx -> f a--instance UnexpectedDecodeErr Identity where-    unexpectedDecodeErr x = fail $ show x--instance UnexpectedDecodeErr (Either UnexpectedDecodeEx) where-    unexpectedDecodeErr = Left --asUnexpected_ :: (KnownSymbol x, UnexpectedDecodeErr f, Applicative f, Show err) => Proxy x -> Either err a -> f a-asUnexpected_ p (Left err) = unexpectedDecodeErr $ UnexpectedDecodeEx p err-asUnexpected_ _ (Right r) = pure r--asUnexpected :: forall x f err a . (KnownSymbol x, UnexpectedDecodeErr f, Applicative f, Show err) => Either err a -> f a-asUnexpected = asUnexpected_ (Proxy :: Proxy x)
− src/Data/TypedEncoding/Internal/Class/Encode.hs 
@@ -1,71 +0,0 @@--{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}--- {-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}--module Data.TypedEncoding.Internal.Class.Encode where--import           Data.TypedEncoding.Internal.Class.Util--import           Data.TypedEncoding.Internal.Types (Enc(..) -                                              , toEncoding-                                              , getPayload-                                             )-import           Data.Proxy-import           Data.Functor.Identity-import           GHC.TypeLits---class EncodeF f instr outstr where    -    encodeF :: instr -> f outstr--class EncodeFAll f (xs :: [Symbol]) c str where-    encodeFAll :: Enc '[] c str -> f (Enc xs c str)--instance Applicative f => EncodeFAll f '[] c str where-    encodeFAll (MkEnc _ c str) = pure $ toEncoding c str --instance (Monad f, EncodeFAll f xs c str, EncodeF f (Enc xs c str) (Enc (x ': xs) c str)) => EncodeFAll f (x ': xs) c str where-    encodeFAll str = -        let re :: f (Enc xs c str) = encodeFAll str-        in re >>= encodeF---encodeAll :: forall xs c str . EncodeFAll Identity (xs :: [Symbol]) c str => -              Enc '[] c str -              -> Enc xs c str-encodeAll = runIdentity . encodeFAll             ----encodeFPart_ :: forall f xs xsf c str . (Functor f, EncodeFAll f xs c str) => Proxy xs -> Enc xsf c str -> f (Enc (Append xs xsf) c str)-encodeFPart_ p (MkEnc _ conf str) = -    let re :: f (Enc xs c str) = encodeFAll $ MkEnc Proxy conf str-    in  MkEnc Proxy conf . getPayload <$> re ---encodeFPart :: forall (xs :: [Symbol]) xsf f c str . (Functor f, EncodeFAll f xs c str) => Enc xsf c str -> f (Enc (Append xs xsf) c str)-encodeFPart = encodeFPart_ (Proxy :: Proxy xs) ---encodePart_ :: EncodeFAll Identity (xs :: [Symbol]) c str => -              Proxy xs -              -> Enc xsf c str-              -> Enc (Append xs xsf) c str -encodePart_ p = runIdentity . encodeFPart_ p---- | for some reason ApplyTypes syntax does not want to work if xs is specified with --- polymorphic [Symbol]-encodePart :: forall (xs :: [Symbol]) xsf c str . EncodeFAll Identity xs c str => -               Enc xsf c str-              -> Enc (Append xs xsf) c str -encodePart = encodePart_ (Proxy :: Proxy xs)              -
− src/Data/TypedEncoding/Internal/Class/Encoder.hs 
@@ -1,49 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE PartialTypeSignatures #-}--- {-# LANGUAGE RankNTypes #-}-{-# OPTIONS_GHC -Wno-partial-type-signatures #-}---- |--- Internal definition of types------ Possible replacement for EncodeFAll class that works with open definitions such as "r-ban"--module Data.TypedEncoding.Internal.Class.Encoder where--import           Data.TypedEncoding.Internal.Types.Enc--- import           Data.TypedEncoding.Internal.Class.Util-import           Data.TypedEncoding.Internal.Class.Encode-import           Data.TypedEncoding.Internal.Util.TypeLits-import           GHC.TypeLits--- import           Data.Symbol.Ascii---data Encoder f (enc :: [Symbol]) (grps :: [Symbol]) conf str where-    -- | constructor is to be treated as Unsafe to Encode and Decode instance implementations-    -- particular encoding instances may expose smart constructors for limited data types-    ZeroEnc :: Encoder f '[] '[] conf str-    AppendEnc ::  (Enc xs conf str -> f (Enc (x ': xs) conf str)) -> Encoder f xs grps conf str -> Encoder f (x ': xs) ((TakeUntil x ":") ': grps) conf str--runEncoder :: forall grps enc f c str . (Monad f) => Encoder f enc grps c str -> Enc ('[]::[Symbol]) c str -> f (Enc enc c str)-runEncoder ZeroEnc enc0 = pure enc0-runEncoder (AppendEnc fn enc) enc0 = -        let re :: f (Enc _ c str) = runEncoder enc enc0-        in re >>= fn--encodeFEncoder :: forall f t tg xs gxs c str . (tg ~ TakeUntil t ":", Encodings f xs gxs c str, EncodeF f (Enc xs c str) (Enc (t ': xs) c str)) => Encoder f (t ': xs) (tg ': gxs) c str-encodeFEncoder = AppendEnc (encodeF @f @(Enc xs c str) @(Enc (t ': xs) c str)) encodings--class Encodings f (enc :: [Symbol]) (grps :: [Symbol]) c str where-    encodings :: Encoder f enc grps c str--instance Encodings f '[] '[] c str where-    encodings = ZeroEnc
− src/Data/TypedEncoding/Internal/Class/IsStringR.hs 
@@ -1,73 +0,0 @@---{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE FlexibleInstances #-}---- | This Module will be removed in 0.3.x.x in favor of --- "Data.TypedEncoding.Internal.Class.Util.StringConstraints"-module Data.TypedEncoding.Internal.Class.IsStringR where--import           Data.Proxy--import           Data.String--- import qualified Data.ByteString.Char8 as B-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL------ $setup--- >>> :set -XScopedTypeVariables -XTypeApplications -XAllowAmbiguousTypes--- >>> import Test.QuickCheck--- >>> import Test.QuickCheck.Instances.Text()--- >>> import Test.QuickCheck.Instances.ByteString()---- | This class will be removed in 0.3.x.x in favor of classes definined in --- "Data.TypedEncoding.Internal.Class.Util.StringConstraints"------ Reverses 'Data.String.IsString'------ laws:------ @---  toString . fromString == id---  fromString . toString == id--- @------ Note: ByteString is not a valid instance, ByteString "r-ASCII", or "r-UTF8" would--- be needed.--- @B.unpack $ B.pack "\160688" == "\176"@-class IsStringR a where-    toString :: a -> String--prop_fromStringToString :: forall s . (IsString s, IsStringR s, Eq s) => s -> Bool-prop_fromStringToString x = x == (fromString @s . toString $ x)--prop_toStringFromString :: forall s . (IsString s, IsStringR s) => Proxy s -> String -> Bool-prop_toStringFromString _ x = x == (toString @s . fromString $ x)---- This would not work--- @B.unpack $ B.pack "\160688" == "\176"@------ prop> prop_toStringFromString (Proxy :: Proxy B.ByteString) --- prop> prop_fromStringToString @B.ByteString--- instance IsStringR B.ByteString where---     toString = B.unpack- ---- |--- prop> prop_toStringFromString (Proxy :: Proxy T.Text) --- prop> prop_fromStringToString @T.Text-instance IsStringR T.Text where-    toString = T.unpack    ---- |--- prop> prop_toStringFromString (Proxy :: Proxy TL.Text) --- prop> prop_fromStringToString @TL.Text-instance IsStringR TL.Text where-    toString = TL.unpack  --instance IsStringR [Char] where-    toString = id
− src/Data/TypedEncoding/Internal/Class/Recreate.hs 
@@ -1,90 +0,0 @@--{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}--- {-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}--module Data.TypedEncoding.Internal.Class.Recreate where--import           Data.TypedEncoding.Internal.Types (Enc(..) -                                              , toEncoding-                                              , withUnsafeCoerce-                                              , RecreateEx(..)-                                              , getPayload-                                             )-import           Data.TypedEncoding.Internal.Class.Util                                             -import           Data.Proxy-import           Data.Functor.Identity-import           GHC.TypeLits----- | Used to safely recover encoded data validating all encodingss-class RecreateF f instr outstr where    -    checkPrevF :: outstr -> f instr--class (Functor f) => RecreateFAll f (xs :: [Symbol]) c str where-    checkFAll :: Enc xs c str -> f (Enc '[] c str)-    recreateFAll :: Enc '[] c str -> f (Enc xs c str)-    recreateFAll str@(MkEnc _ _ pay) = -        let str0 :: Enc xs c str = withUnsafeCoerce id str-        in withUnsafeCoerce (const pay) <$> checkFAll str0    --instance Applicative f => RecreateFAll f '[] c str where-    checkFAll (MkEnc _ c str) = pure $ toEncoding c str ---instance (Monad f, RecreateFAll f xs c str, RecreateF f (Enc xs c str) (Enc (x ': xs) c str)) => RecreateFAll f (x ': xs) c str where-    checkFAll str = -        let re :: f (Enc xs c str) = checkPrevF str-        in re >>= checkFAll---recreateAll :: forall xs c str . RecreateFAll Identity xs c str => -              Enc '[] c str -              -> Enc xs c str-recreateAll = runIdentity . recreateFAll ----- | Useful for partially manual recreation-recreateFPart_ :: forall f xs xsf c str . (Functor f, RecreateFAll f xs c str) => Proxy xs -> Enc xsf c str -> f (Enc (Append xs xsf) c str)-recreateFPart_ p (MkEnc _ conf str) = -    let re :: f (Enc xs c str) = recreateFAll $ MkEnc Proxy conf str-    in  MkEnc Proxy conf . getPayload <$> re ---recreateFPart :: forall (xs :: [Symbol]) xsf f c str . (Functor f, RecreateFAll f xs c str) => Enc xsf c str -> f (Enc (Append xs xsf) c str)-recreateFPart = recreateFPart_ (Proxy :: Proxy xs) ---recreatePart_ :: RecreateFAll Identity (xs :: [Symbol]) c str => -              Proxy xs -              -> Enc xsf c str-              -> Enc (Append xs xsf) c str -recreatePart_ p = runIdentity . recreateFPart_ p--recreatePart :: forall (xs :: [Symbol]) xsf c str . RecreateFAll Identity xs c str => -               Enc xsf c str-              -> Enc (Append xs xsf) c str -recreatePart = recreatePart_ (Proxy :: Proxy xs)   ---- | Recovery errors are expected unless Recovery allows Identity instance-class RecreateErr f where -    recoveryErr :: RecreateEx -> f a--instance RecreateErr (Either RecreateEx) where-    recoveryErr = Left  --asRecreateErr_ :: (RecreateErr f, Applicative f, Show err, KnownSymbol x) => Proxy x -> Either err a -> f a-asRecreateErr_ p (Left err) = recoveryErr $ RecreateEx p err-asRecreateErr_ _ (Right r) = pure r---asRecreateErr :: forall x f err a . (RecreateErr f, Applicative f, Show err, KnownSymbol x) => Either err a -> f a-asRecreateErr = asRecreateErr_ (Proxy :: Proxy x)
− src/Data/TypedEncoding/Internal/Class/Superset.hs 
@@ -1,131 +0,0 @@--{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}--- {-# LANGUAGE TypeApplications #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE AllowAmbiguousTypes #-}--module Data.TypedEncoding.Internal.Class.Superset where--import           Data.TypedEncoding.Internal.Util.TypeLits---import           Data.TypedEncoding.Internal.Class.Util (displ)--import           Data.TypedEncoding.Internal.Types (Enc(..) -                                                   , withUnsafeCoerce-                                                   --, unsafeSetPayload-                                                   )-import           GHC.TypeLits-import           Data.Symbol.Ascii--- import           Data.Proxy---- $setup--- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XTypeApplications--- >>> import           Data.TypedEncoding.Internal.Class.Util (displ)--- >>> import           Data.TypedEncoding.Internal.Types (unsafeSetPayload)--- >>> import           Data.Text as T----- |--- DEPRECATED see 'IsSuperset'--- --- Subsets are useful for restriction encodings--- like r-UFT8 but should not be used for other encodings.------ This would be dangerous, it would, for example, permit converting encoded binary --- @"Enc '["enc-"] c ByteString@ to @"Enc '["enc-"] c Text@, decoding which--- could result in runtime errors.------ The requirement is that that the decoding in the superset--- can replace the decoding from injected subset.------ @--- instance Superset "r-ASCII" "enc-B64" where -- DANGEROUS--- @------ 'inject' is identity on payloads------ @Superset bigger smaller@ reads as @bigger@ is a superset of @smaller@-class Superset (y :: Symbol) (x :: Symbol) where-    inject :: Enc (x ': xs) c str ->  Enc (y ': xs) c str-    inject = withUnsafeCoerce id--instance Superset x x where---- | more permissive than class-type family IsSuperset (y :: Symbol) (x :: Symbol) :: Bool where-    IsSuperset "r-ASCII" "r-ASCII" = 'True-    IsSuperset "r-UTF8"  "r-ASCII" = 'True-    IsSuperset "r-UTF8"  "r-UTF8" = 'True-    IsSuperset y x = IsSupersetOpen y (TakeUntil x ":") (ToList x)--type family IsSupersetOpen (y :: Symbol) (x :: Symbol) (xs :: [Symbol]) :: Bool--injectInto :: forall y x xs c str . (IsSuperset y x ~ 'True) => Enc (x ': xs) c str ->  Enc (y ': xs) c str-injectInto = withUnsafeCoerce id---- | remove redundant superset right after the top (at second last encoding position)------ >>> displ $ demoteFlattenTop (unsafeSetPayload () "" :: Enc '["r-ASCII", "r-UTF8", "r-boo"] () T.Text)--- "MkEnc '[r-ASCII,r-boo] () (Text )"-demoteFlattenTop :: forall y x xs c str . (IsSuperset y x ~ 'True) => Enc (x ': y ': xs) c str ->  Enc (x ': xs) c str-demoteFlattenTop = withUnsafeCoerce id---- | add redundant superset right after------ >>> displ $ promoteUnFlattenTop @"r-UTF8" (unsafeSetPayload () "" :: Enc '["r-ASCII", "r-boo"] () T.Text)--- "MkEnc '[r-ASCII,r-UTF8,r-boo] () (Text )"-promoteUnFlattenTop :: forall y x xs c str . (IsSuperset y x ~ 'True) => Enc (x ': xs) c str -> Enc (x ': y ': xs) c str-promoteUnFlattenTop = withUnsafeCoerce id---- | remove redunant superset from the top (at last applied encoding position)------ >>> displ $ demoteRemoveTop (unsafeSetPayload () "" :: Enc '["r-UTF8", "r-ASCII", "r-boo"] () T.Text)--- "MkEnc '[r-ASCII,r-boo] () (Text )"-demoteRemoveTop :: forall y x xs c str . (IsSuperset y x ~ 'True) => Enc (y ': x ' : xs) c str ->  Enc (x ': xs) c str-demoteRemoveTop = withUnsafeCoerce id---- | add redundant superset at the top------ >>> displ $ promoteAddTop @"r-UTF8" (unsafeSetPayload () "" :: Enc '["r-ASCII", "r-boo"] () T.Text)--- "MkEnc '[r-UTF8,r-ASCII,r-boo] () (Text )"-promoteAddTop :: forall y x xs c str . (IsSuperset y x ~ 'True) => Enc (x ': xs) c str -> Enc (y ': x ' : xs) c str -promoteAddTop = withUnsafeCoerce id---- | remove redundant superset at bottom (first encoding) position------ >>> displ $ demoteRemoveBot (unsafeSetPayload () "" :: Enc '["r-boo", "r-ASCII", "r-UTF8"] () T.Text)--- "MkEnc '[r-boo,r-ASCII] () (Text )"-demoteRemoveBot :: (UnSnoc xs ~ '(,) ys y, UnSnoc ys ~ '(,) zs x, IsSuperset y x ~ 'True) => Enc xs c str -> Enc ys c str-demoteRemoveBot = withUnsafeCoerce id---- | add redundant superset at bottom (first encoding) position------ >>> displ $ promoteAddBot @"r-UTF8" (unsafeSetPayload () "" :: Enc '["r-boo", "r-ASCII"] () T.Text)--- "MkEnc '[r-boo,r-ASCII,r-UTF8] () (Text )"-promoteAddBot :: forall y x xs c str ys . (UnSnoc xs ~ '(,) ys x,  IsSuperset y x ~ 'True) => Enc xs c str -> Enc (Snoc xs y) c str-promoteAddBot = withUnsafeCoerce id---- | remove redundant superset at second bottom (second encoding) position------ >>> displ $ demoteFlattenBot (unsafeSetPayload () "" :: Enc '["r-boo", "r-UTF8", "r-ASCII"] () T.Text)--- "MkEnc '[r-boo,r-ASCII] () (Text )"-demoteFlattenBot :: (UnSnoc xs ~ '(,) ys x, UnSnoc ys ~ '(,) zs y, IsSuperset y x ~ 'True) => Enc xs c str -> Enc (Snoc zs x) c str-demoteFlattenBot = withUnsafeCoerce id---- | add redundant superset at second bottom (second encoding) position------ >>> displ $ promoteUnFlattenBot @"r-UTF8" (unsafeSetPayload () "" :: Enc '["r-boo", "r-ASCII"] () T.Text)--- "MkEnc '[r-boo,r-UTF8,r-ASCII] () (Text )"-promoteUnFlattenBot :: forall y x xs c str ys . (UnSnoc xs ~ '(,) ys x,  IsSuperset y x ~ 'True) => Enc xs c str -> Enc (Snoc (Snoc ys y) x) c str-promoteUnFlattenBot = withUnsafeCoerce id---- prop_Superset :: forall y x xs c str . (Superset y x, Eq str) => Enc (x ': xs) c str -> Bool--- prop_Superset x = getPayload x == (getPayload . inject @y @x $ x)-
− src/Data/TypedEncoding/Internal/Class/Util.hs 
@@ -1,94 +0,0 @@--{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}--module Data.TypedEncoding.Internal.Class.Util where--import           Data.TypedEncoding.Internal.Types.Common--import qualified Data.ByteString.Char8 as B-import qualified Data.ByteString.Lazy.Char8 as BL-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL--import           Data.Proxy-import qualified Data.List as L-import           GHC.TypeLits---- $setup--- >>> :set -XScopedTypeVariables -XTypeApplications -XAllowAmbiguousTypes -XDataKinds---- * Symbol List--class SymbolList (xs::[Symbol]) where -    symbolVals :: [String]--instance SymbolList '[] where-    symbolVals = []---- |--- >>> symbolVals @ '["FIRST", "SECOND"]--- ["FIRST","SECOND"]-instance (SymbolList xs, KnownSymbol x) => SymbolList (x ': xs) where-    symbolVals =  symbolVal (Proxy :: Proxy x) : symbolVals @xs- -symbolVals_ :: forall xs . SymbolList xs => Proxy xs -> [String]-symbolVals_ _ = symbolVals @xs---- * Display ---- | Human friendly version of Show-class Displ x where -    displ :: x -> String---- | TODO 0.3 TO BE REMOVED-instance Displ EncAnn where-    displ = id --instance Displ [EncAnn] where -    displ x = "[" ++ L.intercalate "," x ++ "]"-instance Displ T.Text where-    displ x = "(Text " ++ T.unpack x ++ ")"-instance Displ TL.Text where-    displ x = "(TL.Text " ++ TL.unpack x ++ ")"-instance Displ B.ByteString where-    displ x = "(ByteString " ++ B.unpack x ++ ")" -instance Displ BL.ByteString where-    displ x = "(ByteString " ++ BL.unpack x ++ ")" ---- TODO 0.3 replaces:  instance Displ EncAnn   --- instance Displ String where---     displ x = "(String " ++ x ++ ")" ------ |--- >>> displ (Proxy :: Proxy ["FIRST", "SECOND"])--- "[FIRST,SECOND]"-instance (SymbolList xs) => Displ (Proxy xs) where-    displ _ = displ $  symbolVals @ xs-        -- "[" ++ (L.intercalate "," $ map displ $ symbolVals @ xs) ++ "]"----- * Other---- | TODO should this be imported from somewhere?-type family Append (xs :: [k]) (ys :: [k]) :: [k] where-    Append '[] xs = xs-    Append (y ': ys) xs = y ': Append ys xs---- | Polymorphic data payloads used to encode/decode-class HasA a c where-    has :: c -> a--instance HasA () c where-    has = const ()
− src/Data/TypedEncoding/Internal/Class/Util/StringConstraints.hs 
@@ -1,134 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}---- | Future replacement for "Data.TypedEncoding.Internal.Class.IsStringR"-module Data.TypedEncoding.Internal.Class.Util.StringConstraints () where--import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import           Data.String-import           Data.Proxy-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Char8 as B8-import qualified Data.ByteString.Lazy.Char8 as BL8---- $setup--- >>> :set -XScopedTypeVariables -XTypeApplications -XAllowAmbiguousTypes--- >>> import Test.QuickCheck--- >>> import Test.QuickCheck.Instances.Text()--- >>> import Test.QuickCheck.Instances.ByteString()----- * IsString reversal---- | Reverses 'Data.String.IsString'------ law for types that are also @IsString@:--- --- @---  toString . fromString == id--- @------ Note: ByteString is not a valid instance, ByteString "r-ASCII", or "r-UTF8" would--- be needed.--- @B8.unpack $ B8.pack "\160688" == "\176"@------ This class is separated from @ToStrIso@ to allow instances from /smaller/ types--- the can inject into the 'String' type.-class ToStrInj str from where-    toString :: from -> str--prop_toStringFromString :: forall s . (IsString s, ToStrInj String s) => Proxy s -> String -> Bool-prop_toStringFromString _ x = x == (toString @String @s . fromString $ x)----- |--- prop> prop_toStringFromString (Proxy :: Proxy T.Text) -instance ToStrInj String T.Text where-    toString = T.unpack    ---- |--- prop> prop_toStringFromString (Proxy :: Proxy TL.Text) -instance ToStrInj String TL.Text where-    toString = TL.unpack  ---instance ToStrInj String String where-    toString = id---- will not work!--- prop> prop_toStringFromString (Proxy :: Proxy B.ByteString) --- instance ToStrInj String B.ByteString where---     toString = B8.unpack---- will not work!--- prop> prop_toStringFromString (Proxy :: Proxy BL.ByteString) --- instance ToStrInj String BL.ByteString where---     toString = BL8.unpack----- | Same as @ToStrInj@ but with additional------ law for types that are also @IsString@:--- @---  fromString . toString == id--- @-class ToStrInj str from => ToStrIso str from where--prop_fromStringToString :: forall s . (IsString s, ToStrIso String s, Eq s) => s -> Bool-prop_fromStringToString x = x == (fromString @s . toString $ x)---- |--- prop> prop_fromStringToString @T.Text-instance ToStrIso String T.Text where---- |--- prop> prop_fromStringToString @TL.Text-instance ToStrIso String TL.Text where    --instance ToStrIso String String where---- |--- Used to find exceptions that violated "r-" encoding--- Expected to be used to check encoding of ASCII-7 so Text and ByteString are compatible.-class Char7Find str where-    find :: (Char -> Bool) -> str -> Maybe Char---instance Char7Find T.Text where-    find = T.find--instance Char7Find TL.Text where-    find = TL.find    ---- |--- B8.pack is basically a convenient way to get Word8 elements into ByteString.------ During B8.pack conversion charters are downsized to the 0-255 range (become a Word8).--- The length is preserved. --- --- >>> B8.pack "\160582"--- "F"------ >>> B.length $ B8.pack "\160582"--- 1------ This instance allows to check elements of ByteString interpreting them as Char.--- --- This may or may not work with UTF8 conversions.--- Safe if restricting to 7bit code points.s-instance Char7Find B.ByteString where-    find = B8.find   --instance Char7Find BL.ByteString where-    find = BL8.find
− src/Data/TypedEncoding/Internal/Combinators.hs 
@@ -1,54 +0,0 @@--{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}--- {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE FlexibleContexts #-}---- | Combinators reexported in Data.TypedEncoding-module Data.TypedEncoding.Internal.Combinators where--import           Data.TypedEncoding.Internal.Types-import           Data.TypedEncoding.Internal.Class.Recreate-import           Data.TypedEncoding.Internal.Class.Util (SymbolList)-import           GHC.TypeLits--- import           Data.Proxy---- $setup--- >>> :set -XTypeApplications--- >>> import qualified Data.Text as T--- >>> import           Data.Word---- * Converting 'UncheckedEnc' to 'Enc'---- | Maybe signals annotation mismatch, effect @f@ is not evaluated unless there is match-verifyUncheckedEnc :: forall (xs :: [Symbol]) f c str . (-                     RecreateFAll f xs c str-                     , RecreateErr f-                     , Applicative f-                     , SymbolList xs-                   ) -                   =>-                   UncheckedEnc c str-                   ->  Maybe (f (Enc xs c str))--verifyUncheckedEnc x = -    -- let perr = Proxy :: Proxy "e-mismatch"-    --in  -      case verifyAnn @xs x of-            Left err -> Nothing -- asRecreateErr_ perr $ Left err-            Right (MkUncheckedEnc _ c str) -> Just $ recreateFAll . toEncoding c $ str---verifyUncheckedEnc' :: forall (xs :: [Symbol]) c str . (-                     RecreateFAll (Either RecreateEx) xs c str-                     , SymbolList xs-                   ) -                   =>-                   UncheckedEnc c str-                   ->  Maybe (Either RecreateEx (Enc xs c str))-verifyUncheckedEnc' = verifyUncheckedEnc--
− src/Data/TypedEncoding/Internal/Instances/Combinators.hs 
@@ -1,107 +0,0 @@--{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--- {-# LANGUAGE AllowAmbiguousTypes #-}--- {-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE FlexibleContexts #-}---- | Combinators that can be helpful in instance creation.-module Data.TypedEncoding.Internal.Instances.Combinators where--import           Data.String-import           Data.Proxy-import           Text.Read-import           Data.TypedEncoding.Internal.Types-import           Data.TypedEncoding.Internal.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.-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 f sinit = unsafeSetPayload c . foldr f sinit . fmap getPayload ---- | Similar to 'foldEnc', assumes that destination payload has @IsString@ instance and uses @""@ as base case. -foldEncStr :: forall (xs2 :: [Symbol]) (xs1 :: [Symbol]) f c s1 s2 -             . (Foldable f, Functor f, IsString s2) -             => c -> (s1 -> s2 -> s2) -> f (Enc xs1 c s1) -> Enc xs2 c s2-foldEncStr c f = foldEnc c f ""---- | Similar to 'foldEnc', works with untyped 'CheckedEnc'-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 f sinit = unsafeSetPayload c . foldr (uncurry f) sinit . fmap getCheckedEncPayload---- | Similar to 'foldEncStr', works with untyped 'CheckedEnc'-foldCheckedEncStr :: forall (xs2 :: [Symbol]) f c s1 s2 . (Foldable f, Functor f, IsString s2) => c -> ([EncAnn] -> s1 -> s2 -> s2) -> f (CheckedEnc c s1) -> Enc xs2 c s2-foldCheckedEncStr c f  = foldCheckedEnc c f ""----- * Composite encoding: Recreate and Encode helpers---- | Splits composite payload into homogenious chunks-splitPayload :: forall (xs2 :: [Symbol]) (xs1 :: [Symbol]) c s1 s2 . -             (s1 -> [s2]) -             -> Enc xs1 c s1 -             -> [Enc xs2 c s2]-splitPayload f (MkEnc _ c s1) = map (MkEnc Proxy c) (f s1)-   --- | Untyped version of 'splitPayload'-splitSomePayload :: forall c s1 s2 . -             ([EncAnn] -> s1 -> [([EncAnn], s2)]) -             -> CheckedEnc c s1 -             -> [CheckedEnc c s2]-splitSomePayload f (MkCheckedEnc ann1 c s1) = map (\(ann2, s2) -> MkCheckedEnc ann2 c s2) (f ann1 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"-verifyWithRead :: forall a str . (IsStringR str, Read a, Show a) => String -> str -> Either String str-verifyWithRead msg x = -    let s = toString x-        a :: Maybe a = readMaybe s-        check = (show <$> a) == Just s -    in if check-       then Right x-       else Left $ "Payload does not satisfy format " ++ msg ++ ": " ++ s    ----- | Convenience function for checking if @str@ decodes properly--- using @enc@ encoding markers and decoders that can pick decoder based--- on that marker-verifyDynEnc :: forall s str err1 err2 enc a. (KnownSymbol s, Show err1, Show err2) => -                  Proxy s   -- ^ proxy defining encoding annotation-                  -> (Proxy s -> Either err1 enc)  -- ^ finds encoding marker @enc@ for given annotation or fails-                  -> (enc -> str -> Either err2 a)  -- ^ decoder based on @enc@ marker-                  -> str                            -- ^ input-                  -> Either EncodeEx str-verifyDynEnc p findenc decoder str = -  do-    enc <- asEncodeEx p . findenc $ p-    case decoder enc str of-      Left err -> Left $ EncodeEx p err-      Right r -> Right str
− src/Data/TypedEncoding/Internal/Types.hs 
@@ -1,109 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE AllowAmbiguousTypes #-}--- {-# LANGUAGE RankNTypes #-}---- |--- Internal definition of types--module Data.TypedEncoding.Internal.Types (-        module Data.TypedEncoding.Internal.Types-        -- * Main encoding type and basic combinators.-        , module Data.TypedEncoding.Internal.Types.Enc-        -- * Untyped version and existentially quantified versions of Enc-        , module Data.TypedEncoding.Internal.Types.CheckedEnc-        -- * Not verified encoded data-        , module Data.TypedEncoding.Internal.Types.UncheckedEnc-        -- * Commmon types-        , module Data.TypedEncoding.Internal.Types.Common-    ) where--import           Data.TypedEncoding.Internal.Types.Enc-import           Data.TypedEncoding.Internal.Types.CheckedEnc-import           Data.TypedEncoding.Internal.Types.UncheckedEnc-import           Data.TypedEncoding.Internal.Types.Common--import           Data.Proxy--- import           Data.Functor.Identity-import           GHC.TypeLits--- import           Data.TypedEncoding.Internal.Class.Util---- $setup--- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XAllowAmbiguousTypes--- >>> import qualified Data.Text as T----- | Represents errors in recovery (recreation of encoded types).-data RecreateEx where-    RecreateEx:: (Show e, KnownSymbol x) => Proxy x -> e -> RecreateEx-    RecreateExUnkStep::   (Show e) => e -> RecreateEx--instance Show RecreateEx where-    show (RecreateEx prxy a) = "(RecreateEx \"" ++ symbolVal prxy ++ "\" (" ++ show a ++ "))"-    show (RecreateExUnkStep  a) = "(UnknownDecodeStep (" ++ show a ++ "))"---recreateErrUnknown :: (Show e) => e -> RecreateEx-recreateErrUnknown  = RecreateExUnkStep---- instance Eq RecreateEx where---     (RecreateEx prxy1 a1) == RecreateEx prxy2 a2 = (symbolVal prxy1) == (symbolVal prxy2)----- | Represents errors in encoding-data EncodeEx where-    EncodeEx:: (Show a, KnownSymbol x) => Proxy x -> a -> EncodeEx --instance Show EncodeEx where-    show (EncodeEx prxy a) = "(EncodeEx \"" ++ symbolVal prxy ++ "\" (" ++ show a ++ "))"--asEncodeEx :: (Show a, KnownSymbol x) => Proxy x -> Either a b -> Either EncodeEx b-asEncodeEx p = either (Left . EncodeEx p) Right ----- | Useful when manually recreating using recovery-encToRecrEx :: EncodeEx ->  RecreateEx-encToRecrEx (EncodeEx p a) = RecreateEx p a--mergeEncodeEx ::  KnownSymbol x => Proxy x -> EncodeEx -> Maybe EncodeEx -> EncodeEx-mergeEncodeEx _ ex Nothing = ex-mergeEncodeEx p (EncodeEx _ a) (Just (EncodeEx _ b)) = EncodeEx p $ "Errors: " ++ show (a,b)--emptyEncErr ::  KnownSymbol x =>  Proxy x -> EncodeEx -emptyEncErr p = EncodeEx p ("unexpected" :: String)---- | Type safety over encodings makes decoding process safe.--- However failures are still possible due to bugs or unsafe payload modifications.--- UnexpectedDecodeEx represents such errors.-data UnexpectedDecodeEx where-    UnexpectedDecodeEx :: (Show a, KnownSymbol x) => Proxy x -> a -> UnexpectedDecodeEx--instance Show UnexpectedDecodeEx where-    show (UnexpectedDecodeEx prxy a) = "(UnexpectedDecodeEx \"" ++ symbolVal prxy ++ "\" (" ++ show a ++ "))"----- * Base combinators that rely on types defined here---- TODO could this type be more precise?-implEncodeF_ :: (Show err, KnownSymbol x) => Proxy x -> (str -> Either err str) ->  Enc enc1 conf str -> Either EncodeEx (Enc enc2 conf str) -implEncodeF_ p f = implTranF (either (Left . EncodeEx p) Right . f) --implEncodeF :: forall x enc1 enc2 err conf str . -              (Show err, KnownSymbol x) -              => (str -> Either err str) ->  Enc enc1 conf str -> Either EncodeEx (Enc enc2 conf str) -implEncodeF = implEncodeF_ (Proxy :: Proxy x)--implEncodeF_' :: (Show err, KnownSymbol x) => Proxy x -> (conf -> str -> Either err str) ->  Enc enc1 conf str -> Either EncodeEx (Enc enc2 conf str) -implEncodeF_' p f = implTranF' (\c -> either (Left . EncodeEx p) Right . f c) ---mergeErrs :: err -> (err -> Maybe err -> err) -> Either err a -> Either err b -> Either err c-mergeErrs _ fn (Left er1) (Left er2) = Left (fn er1 $ Just er2)-mergeErrs _ fn (Left er1) _ = Left (fn er1 Nothing)-mergeErrs _ fn _  (Left er2) = Left (fn er2 Nothing) -mergeErrs de fn (Right r) (Right y) = Left de
− src/Data/TypedEncoding/Internal/Types/CheckedEnc.hs 
@@ -1,85 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE ScopedTypeVariables #-}--- {-# LANGUAGE PolyKinds #-}--- {-# LANGUAGE DataKinds #-}--- {-# LANGUAGE TypeOperators #-}--- {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE RankNTypes #-}---- |--- Module defines 'CheckedEnc' - untyped ADT version of 'Enc' --module Data.TypedEncoding.Internal.Types.CheckedEnc where--import           Data.TypedEncoding.Internal.Types.Enc-import           Data.TypedEncoding.Internal.Types.Common-import           Data.TypedEncoding.Internal.Class.Util-import           Data.Proxy---- $setup--- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XAllowAmbiguousTypes--- >>> import qualified Data.Text as T----- * Untyped Enc---- constructor is to be treated as Unsafe to Encode and Decode instance implementations--- particular encoding instances may expose smart constructors for limited data types---- | Represents some validated encoded string. ------ @CheckedEnc@ is untyped version of 'Data.TypedEncoding.Internal.Types.Enc.Enc'. --- @CheckedEnc@ contains verified encoded data, encoding is visible--- at the value level only.-data CheckedEnc conf str = MkCheckedEnc [EncAnn] conf str-     deriving (Show, Eq) --unsafeCheckedEnc:: [EncAnn] -> c -> s -> CheckedEnc c s-unsafeCheckedEnc = MkCheckedEnc--getCheckedPayload :: CheckedEnc conf str -> str-getCheckedPayload = snd . getCheckedEncPayload--getCheckedEncPayload :: CheckedEnc conf str -> ([EncAnn], str) -getCheckedEncPayload (MkCheckedEnc t _ s) = (t,s)--toCheckedEnc :: forall xs c str . (SymbolList xs) => Enc xs c str -> CheckedEnc c str -toCheckedEnc (MkEnc p c s) = -        MkCheckedEnc (symbolVals @ xs) c s   ---fromCheckedEnc :: forall xs c str . SymbolList xs => CheckedEnc c str -> Maybe (Enc xs c str)-fromCheckedEnc (MkCheckedEnc xs c s) = -    let p = Proxy :: Proxy xs-    in if symbolVals @ xs == xs-       then Just $ MkEnc p c s-       else Nothing------------------------------ |--- >>> let encsometest = MkCheckedEnc ["TEST"] () $ T.pack "hello"--- >>> proc_toCheckedEncFromCheckedEnc @'["TEST"] encsometest--- True--- >>> proc_toCheckedEncFromCheckedEnc @'["TEST1"] encsometest--- False-proc_toCheckedEncFromCheckedEnc :: forall xs c str . (SymbolList xs, Eq c, Eq str) => CheckedEnc c str -> Bool-proc_toCheckedEncFromCheckedEnc x = (== Just x) . fmap (toCheckedEnc @ xs) . fromCheckedEnc $ x---- |--- >>> let enctest = unsafeSetPayload () "hello" :: Enc '["TEST"] () T.Text--- >>> proc_fromCheckedEncToCheckedEnc enctest--- True-proc_fromCheckedEncToCheckedEnc :: forall xs c str . (SymbolList xs, Eq c, Eq str) => Enc xs c str -> Bool-proc_fromCheckedEncToCheckedEnc x = (== Just x) . fromCheckedEnc . toCheckedEnc $ x---- |--- >>> displ $ unsafeCheckedEnc ["TEST"] () ("hello" :: T.Text)--- "MkCheckedEnc [TEST] () (Text hello)"-instance (Show c, Displ str) => Displ (CheckedEnc c str) where-    displ (MkCheckedEnc xs c s) = -        "MkCheckedEnc " ++ displ xs  ++ " " ++ show c ++ " " ++ displ s-
− src/Data/TypedEncoding/Internal/Types/Common.hs 
@@ -1,4 +0,0 @@-module Data.TypedEncoding.Internal.Types.Common where---- | Represents value level (single) annotation.-type EncAnn = String
− src/Data/TypedEncoding/Internal/Types/Enc.hs 
@@ -1,97 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}--- {-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}--- {-# LANGUAGE RankNTypes #-}---- |--- Internal definition of types--module Data.TypedEncoding.Internal.Types.Enc where--import           Data.Proxy--import           Data.TypedEncoding.Internal.Class.Util---- $setup--- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XAllowAmbiguousTypes--- >>> import qualified Data.Text as T---- This type contains type level encoding information as well as--- configuration and payload.-data Enc enc conf str where-    -- | constructor is to be treated as Unsafe to Encode and Decode instance implementations-    -- particular encoding instances may expose smart constructors for limited data types-    MkEnc :: Proxy enc -> conf -> str -> Enc enc conf str-    deriving (Show, Eq) ---- |--- >>> let disptest = unsafeSetPayload () "hello" :: Enc '["TEST"] () T.Text--- >>> displ disptest--- "MkEnc '[TEST] () (Text hello)"-instance (SymbolList xs, Show c, Displ str) => Displ ( Enc xs c str) where-    displ (MkEnc p c s) = -        "MkEnc '" ++ displ (Proxy :: Proxy xs) ++ " " ++ show c ++ " " ++ displ s---toEncoding :: conf -> str -> Enc '[] conf str-toEncoding = MkEnc Proxy --fromEncoding :: Enc '[] conf str -> str-fromEncoding = getPayload---- TODO make all implTran functions module-private--- TODO disambiguate implEncode from implDecode, from implCheckPrevF for type safety--- especially since these are always used in combo with asRecreateErr_ or asUnexpected --implTranF :: Functor f => (str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str)-implTranF f  = implTranF' (const f)---implDecodeF :: Functor f => (str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str)-implDecodeF = implTranF--implCheckPrevF :: Functor f => (str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str)-implCheckPrevF = implTranF---implTranF' :: Functor f =>  (conf -> str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str)-implTranF' f (MkEnc _ conf str) = MkEnc Proxy conf <$> f conf str---implDecodeF' :: Functor f =>  (conf -> str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str)-implDecodeF' = implTranF'--implTranP :: Applicative f => (str -> str) -> Enc enc1 conf str -> f (Enc enc2 conf str)-implTranP f  = implTranF' (\c -> pure . f)--implEncodeP :: Applicative f => (str -> str) -> Enc enc1 conf str -> f (Enc enc2 conf str)-implEncodeP = implTranP--implTranP' :: Applicative f => (conf -> str -> str) -> Enc enc1 conf str -> f (Enc enc2 conf str)-implTranP' f  = implTranF' (\c -> pure . f c)--implEncodeP' :: Applicative f => (conf -> str -> str) -> Enc enc1 conf str -> f (Enc enc2 conf str)-implEncodeP' = implTranP'--implChangeAnn :: Functor f => (Enc enc1 conf str -> f (Enc enc2a conf str)) -> Enc enc1 conf str -> f (Enc enc2b conf str)-implChangeAnn fn = fmap (withUnsafeCoerce id) . fn----getPayload :: Enc enc conf str -> str  -getPayload (MkEnc _ _ str) = str--unsafeSetPayload :: conf -> str -> Enc enc conf str -unsafeSetPayload  = MkEnc Proxy --withUnsafeCoerce ::  (s1 -> s2) -> Enc e1 c s1 -> Enc e2 c s2-withUnsafeCoerce f (MkEnc _ conf str)  = MkEnc Proxy conf (f str)--unsafeChangePayload ::  (s1 -> s2) -> Enc e c s1 -> Enc e c s2-unsafeChangePayload f (MkEnc p conf str)  = MkEnc p conf (f str)
− src/Data/TypedEncoding/Internal/Types/SomeAnnotation.hs 
@@ -1,34 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE RankNTypes #-}---- | internally used existential type for taking track of annotations-module Data.TypedEncoding.Internal.Types.SomeAnnotation where--import           Data.TypedEncoding.Internal.Types.Common-import           Data.TypedEncoding.Internal.Class.Util-import           Data.TypedEncoding.Internal.Util-import           Data.Proxy-import           GHC.TypeLits---data SomeAnnotation where-    MkSomeAnnotation :: SymbolList xs => Proxy xs -> SomeAnnotation--withSomeAnnotation :: SomeAnnotation -> (forall xs . SymbolList xs => Proxy xs -> r) -> r-withSomeAnnotation (MkSomeAnnotation p) fn = fn p---- folds over SomeSymbol list using withSomeSymbol and proxyCons-someAnnValue :: [EncAnn] -> SomeAnnotation-someAnnValue xs = -     foldr (fn . someSymbolVal) (MkSomeAnnotation (Proxy :: Proxy '[])) xs-     where -         somesymbs = map someSymbolVal xs-         fn ss (MkSomeAnnotation pxs) = withSomeSymbol ss (\px -> MkSomeAnnotation  (px `proxyCons` pxs)) --proxyCons :: forall (x :: Symbol) (xs :: [Symbol]) . Proxy x -> Proxy xs -> Proxy (x ': xs)-proxyCons _ _ = Proxy
− src/Data/TypedEncoding/Internal/Types/SomeEnc.hs 
@@ -1,61 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE ScopedTypeVariables #-}--- {-# LANGUAGE PolyKinds #-}--- {-# LANGUAGE DataKinds #-}--- {-# LANGUAGE TypeOperators #-}--- {-# LANGUAGE FlexibleInstances #-}--- {-# LANGUAGE StandaloneDeriving #-}--- {-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE RankNTypes #-}---- |--- Module defines 'SomeEnc' - existentially quantified version of @Enc@--- and basic combinators--module Data.TypedEncoding.Internal.Types.SomeEnc where--import           Data.TypedEncoding.Internal.Types.Enc-import           Data.TypedEncoding.Internal.Class.Util-import           Data.TypedEncoding.Internal.Types.SomeAnnotation-import           Data.TypedEncoding.Internal.Types.CheckedEnc---- $setup--- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XAllowAmbiguousTypes--- >>> import qualified Data.Text as T------ | Existentially quantified quanitified @Enc@--- effectively isomorphic to 'CheckedEnc'-data SomeEnc conf str where-    MkSomeEnc :: SymbolList xs => Enc xs conf str -> SomeEnc conf str-    -withSomeEnc :: SomeEnc conf str -> (forall xs . SymbolList xs => Enc xs conf str -> r) -> r-withSomeEnc (MkSomeEnc enc) f = f enc--toSome :: SymbolList xs => Enc xs conf str -> SomeEnc conf str-toSome = MkSomeEnc---- | --- >>> let enctest = unsafeSetPayload () "hello" :: Enc '["TEST"] () T.Text--- >>> someToChecked . MkSomeEnc $ enctest--- MkCheckedEnc ["TEST"] () "hello"-someToChecked :: SomeEnc conf str -> CheckedEnc conf str-someToChecked se = withSomeEnc se toCheckedEnc---- | --- >>> let tst = unsafeCheckedEnc ["TEST"] () "test"--- >>> displ $ checkedToSome tst--- "Some (MkEnc '[TEST] () test)"-checkedToSome :: CheckedEnc conf str -> SomeEnc conf str-checkedToSome (MkCheckedEnc xs c s) = withSomeAnnotation (someAnnValue xs) (\p -> MkSomeEnc (MkEnc p c s))----- |--- >>> let enctest = unsafeSetPayload () "hello" :: Enc '["TEST"] () T.Text--- >>> displ $ MkSomeEnc enctest--- "Some (MkEnc '[TEST] () (Text hello))"-instance (Show c, Displ str) => Displ (SomeEnc c str) where-    displ (MkSomeEnc en) = -       "Some (" ++ displ en ++ ")"
− src/Data/TypedEncoding/Internal/Types/UncheckedEnc.hs 
@@ -1,52 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}---- |--- Internal definition of types--module Data.TypedEncoding.Internal.Types.UncheckedEnc where--import           Data.Proxy-import           Data.TypedEncoding.Internal.Class.Util-import           Data.TypedEncoding.Internal.Types.Common---- $setup--- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XAllowAmbiguousTypes--- >>> import qualified Data.Text as T----- * UncheckedEnc for recreate, similar to CheckedEnc only not verified---- | Represents some encoded string where encoding was not validated.------ Similar to 'Data.TypedEncoding.Internal.Types.CheckedEnc' but unlike--- @CheckedEnc@ it can contain payloads that have invalid encoding.--- -data UncheckedEnc c str = MkUncheckedEnc [EncAnn] c str deriving (Show, Eq)--toUncheckedEnc :: [EncAnn] -> c -> str -> UncheckedEnc c str-toUncheckedEnc = MkUncheckedEnc--getUncheckedEncAnn :: UncheckedEnc c str -> [EncAnn]-getUncheckedEncAnn (MkUncheckedEnc ann _ _) = ann--verifyAnn :: forall xs c str . SymbolList xs => UncheckedEnc c str -> Either String (UncheckedEnc c str)-verifyAnn x@(MkUncheckedEnc xs _ _) = -    let p = Proxy :: Proxy xs-    in if symbolVals @ xs == xs-       then Right x-       else Left $ "UncheckedEnc has not matching annotation " ++ displ xs---- |--- >>> displ $ MkUncheckedEnc ["TEST"] () ("hello" :: T.Text)--- "MkUncheckedEnc [TEST] () (Text hello)"-instance (Show c, Displ str) => Displ (UncheckedEnc c str) where-    displ (MkUncheckedEnc xs c s) = -        "MkUncheckedEnc " ++ displ xs ++ " " ++ show c ++ " " ++ displ s
− src/Data/TypedEncoding/Internal/Types/Unsafe.hs 
@@ -1,29 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}--module Data.TypedEncoding.Internal.Types.Unsafe where--import           Data.Proxy-import           Data.TypedEncoding.Internal.Types-- --- | Allows to operate within Enc. These are considered unsafe.--- keeping the same list of encodings -newtype Unsafe enc conf str = Unsafe {runUnsafe :: Enc enc conf str} deriving (Show)--withUnsafe :: (Unsafe e c s1 -> Unsafe e c s2) -> Enc e c s1 -> Enc e c s2-withUnsafe f enc = runUnsafe . f $ Unsafe enc--instance Functor (Unsafe enc conf) where-    fmap f (Unsafe (MkEnc p c x)) = Unsafe (MkEnc p c (f x))-  -instance Applicative (Unsafe enc ()) where-    pure = Unsafe . MkEnc Proxy ()  -    Unsafe (MkEnc p c1 f) <*> Unsafe (MkEnc _ c2 x) = Unsafe (MkEnc p () (f x))  --instance Monad (Unsafe enc ()) where -    Unsafe (MkEnc _ _ x) >>= f = f x     -
− src/Data/TypedEncoding/Internal/Util/TypeLits.hs 
@@ -1,146 +0,0 @@---{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE KindSignatures  #-}-{-# LANGUAGE AllowAmbiguousTypes #-}----- | TypeLits related utilities.------ Lots of this could be avoided by adding @singletons@ as dependency.------ Uses @symbols@ library for its ToList type family.------ Currently this is spread out in different modules------ * "Data.TypedEncoding.Internal.Class.Util"--- * "Data.TypedEncoding.Internal.Types.SomeAnnotation"------ (TODO) these will need to get consolidated.-module  Data.TypedEncoding.Internal.Util.TypeLits where--import           GHC.TypeLits--- import           Data.Symbol.Utils-import           Data.Symbol.Ascii--- import           Data.Proxy---- $setup--- >>> :set -XScopedTypeVariables -XTypeFamilies -XKindSignatures -XDataKinds--type family AcceptEq (msg :: ErrorMessage) (c :: Ordering) :: Bool where-    AcceptEq _  EQ = True-    AcceptEq msg _ =  TypeError msg--type family And (b1 :: Bool) (b2 :: Bool) :: Bool where-    And 'True 'True = 'True-    And _ _ = 'False--type family Or (b1 :: Bool) (b2 :: Bool) :: Bool where-    Or 'False 'False = 'False-    Or _ _ = 'True--type family Repeat (n :: Nat) (s :: Symbol) :: Symbol where-    Repeat 0 s = ""-    Repeat n s = AppendSymbol s (Repeat (n - 1) s)--type family Fst (s :: (k,h)) :: k where-   Fst ('(,) a _) = a--type family Dupl (s :: k) :: (k,k) where-   Dupl a = '(,) a a---- | :kind! Concat (LDrop 6 (ToList "bool: \"r-ban:ff-ff\" | \"r-ban:ffff\""))-type family Concat (s :: [Symbol]) :: Symbol where-    Concat '[] = ""-    Concat (x ': xs) = AppendSymbol x (Concat xs)---type family Drop (n :: Nat) (s :: Symbol) :: Symbol where-    Drop n s = Concat (LDrop n (ToList s))---- TODO create TypeList.List module ?---- | :kind! LDrop 6 (ToList "bool: \"r-ban:ff-ff\" | \"r-ban:ffff\"")-type family LDrop (n :: Nat) (s :: [k]) :: [k] where-    LDrop 0 s = s-    LDrop n '[] = '[]-    LDrop n (x ': xs) = LDrop (n - 1) xs ----- type family DropVerify (n :: Nat) (s :: Symbol) (v :: Symbol) :: Symbol where---     Drop n s v = Concat (LDrop n (ToList s))---- type family DropVerify (n :: Nat) (s :: Symbol) (v :: Symbol) :: Symbol where---     Drop n s v = Concat (LDrop n (ToList s))---- | --- :kind! Take 3 "123456"-type family Take (n :: Nat) (s :: Symbol) :: Symbol where-    Take n s = Concat (LTake n (ToList s))---- | :kind! LTake 3 (ToList "123456")-type family LTake (n :: Nat) (s :: [k]) :: [k] where-    LTake 0 s = '[]-    LTake n '[] = '[]-    LTake n (x ': xs) = x ': LTake (n - 1) xs ---- --- :kind! TakeUntil "findme:blah" ":"-type family TakeUntil (s :: Symbol) (stop :: Symbol) :: Symbol where-    TakeUntil s stop = Concat (LTakeUntil (ToList s) stop)--type family LTakeUntil (s :: [Symbol]) (stop :: Symbol) :: [Symbol] where-    LTakeUntil '[] _ = '[]-    LTakeUntil (x ': xs) stop = LTakeUntilHelper (x ': LTakeUntil xs stop) (CmpSymbol x stop)--type family LTakeUntilHelper (s :: [Symbol]) (o :: Ordering) :: [Symbol] where-    LTakeUntilHelper '[] _ = '[]-    LTakeUntilHelper (x ': xs) 'EQ = '[]-    LTakeUntilHelper (x ': xs) _ = (x ': xs)---type family Length (s :: Symbol) :: Nat where  -    Length x = LLengh (ToList x)--type family LLengh (s :: [k]) :: Nat where-    LLengh '[] = 0-    LLengh (x ': xs) = 1 + LLengh xs----- |--- >>> :kind! LLast '["1","2","3"]--- ...--- = "3"-type family LLast (s :: [Symbol]) :: Symbol where-    LLast '[] = TypeError ('Text "Empty Symbol list not allowed")-    LLast '[x] = x-    LLast (_ ': xs) = LLast xs----- |--- Concat (Snoc '["1","2","3"] "4") --- ...--- = "1234"-type family Snoc (s :: [k]) (t :: k) :: [k] where-    Snoc '[] x = '[x]-    Snoc (x ': xs) y = x ': Snoc xs y----- |--- :kind! UnSnoc '["1","2","3"]    -type family UnSnoc (s :: [k]) :: ([k], k) where-    UnSnoc '[] = TypeError ('Text "Empty list, no last element")     -    UnSnoc '[x] = '(,) '[] x-    UnSnoc (x ': xs) = UnSnocHelper x (UnSnoc xs)---type family UnSnocHelper (s :: k) (t :: ([k], k)) :: ([k], k) where -   UnSnocHelper y ('(,) xs x) = '(,) (y ': xs) x
src/Data/TypedEncoding/Unsafe.hs view
@@ -5,8 +5,8 @@ {-# LANGUAGE FlexibleInstances #-}  module Data.TypedEncoding.Unsafe (-     module Data.TypedEncoding.Internal.Types.Unsafe+     module Data.TypedEncoding.Common.Types.Unsafe   ) where -import           Data.TypedEncoding.Internal.Types.Unsafe+import           Data.TypedEncoding.Common.Types.Unsafe
src/Examples/TypedEncoding/Conversions.hs view
@@ -38,7 +38,7 @@ -- EncodeF SomeErr (Enc xs () Text) (Enc ("enc-B64" ': xs) () Text)     -- @ -- --- Then @typed-encoding@ expects @pack@ @encodeF@ to commute:+-- Then @typed-encoding@ expects @pack@ @encodeF@ to commute (if encoding instances exist): --  -- @ --  str     -- EncT.pack -->   txt@@ -70,7 +70,7 @@ import           GHC.TypeLits  import qualified Data.TypedEncoding.Conv.ByteString.Char8 as EncB8-import           Data.TypedEncoding.Combinators.Restriction.BoundedAlphaNums ()+import           Data.TypedEncoding.Instances.Restriction.BoundedAlphaNums ()  -- $setup -- >>> :set -XDataKinds -XMultiParamTypeClasses -XKindSignatures -XFlexibleInstances -XFlexibleContexts -XOverloadedStrings -XTypeApplications -XScopedTypeVariables@@ -93,7 +93,7 @@ -- ^ Example value to play with -- -- >>>  encodeFAll . toEncoding () $ "HeLlo world" :: Either EncodeEx (Enc '["r-ASCII"] () B.ByteString) --- Right (MkEnc Proxy () "HeLlo world")+-- Right (UnsafeMkEnc Proxy () "HeLlo world")  Right helloAsciiB = eHelloAsciiB -- ^ above with either removed@@ -101,13 +101,13 @@ helloAsciiT :: Enc '["r-ASCII"] () T.Text helloAsciiT = EncTe.decodeUtf8 helloAsciiB -- ^ --- We use a tween function to the popular 'Data.Text.Encoding.decodeUtf8' +-- We use a tween function of the popular 'Data.Text.Encoding.decodeUtf8'  -- from the @test@ package. -- -- Notice the encoding annotation is preserved. -- -- >>> displ $ EncTe.decodeUtf8 helloAsciiB--- "MkEnc '[r-ASCII] () (Text HeLlo world)"+-- "Enc '[r-ASCII] () (Text HeLlo world)"   -- * pack and unpack@@ -117,7 +117,7 @@ -- ^ Consider 0-encoding of a 'String',  to move it to @Enc '[] () String@ one could try: -- -- >>> displ . EncT.pack $ helloZero--- "MkEnc '[] () (Text Hello)"+-- "Enc '[] () (Text Hello)" -- -- this works, but: -- @@ -133,19 +133,19 @@ --  -- @EncB8.pack@ will not compile unless the encoding is ASCII restricted, this works: -- --- >>> fmap (displ . EncB8.pack) . encodeFAll @(Either EncodeEx) @'["r-ASCII"] $ helloZero--- Right "MkEnc '[r-ASCII] () (ByteString Hello)"+-- >>> fmap (displ . EncB8.pack) . encodeFAll @'["r-ASCII"] @(Either EncodeEx) $ helloZero+-- Right "Enc '[r-ASCII] () (ByteString Hello)" -- -- And the result is a @ByteString@ with bonus annotation describing its content.   helloRestricted :: Either EncodeEx (Enc '["r-ban:zzzzz"] () B.ByteString)-helloRestricted = fmap EncB8.pack . runEncoder @'["r-ban"] encodings $ toEncoding () "Hello"--- ^ more interstingly @EncB8.pack@ works fine on "r-" encodings that are subsets of "r-ASCII"--- this example @"r-ban:zzzzz"@ restricts to 5 alapha-numeric charters all < @'z'@+helloRestricted = fmap EncB8.pack . _runEncodings encodings $ toEncoding () "Hello"+-- ^ more interestingly @EncB8.pack@ works fine on "r-" encodings that are subsets of "r-ASCII"+-- this example @"r-ban:zzzzz"@ restricts to 5 alpha-numeric charters all < @\'z\'@ --  -- >>> displ <$> helloRestricted--- Right "MkEnc '[r-ban:zzzzz] () (ByteString Hello)"+-- Right "Enc '[r-ban:zzzzz] () (ByteString Hello)" -- -- Adding @"r-ASCII"@ annotation on this ByteString would have been redundant since @"r-ban:zzzzz"@ is more -- restrictive (see Supersets below).@@ -153,54 +153,30 @@ -- @unpack@, as expected will put us back in a String keeping the annotation -- -- >>> fmap (displ . EncB8.unpack) helloRestricted--- Right "MkEnc '[r-ban:zzzzz] () Hello"+-- Right "Enc '[r-ban:zzzzz] () (String Hello)" --   --- * Supersets--helloUtf8B :: Enc '["r-UTF8"] () B.ByteString-helloUtf8B = injectInto helloAsciiB--- ^ To get UTF8 annotation, instead of doing this: ------ >>> encodeFAll . toEncoding () $ "HeLlo world" :: Either EncodeEx (Enc '["r-UTF8"] () B.ByteString)--- Right (MkEnc Proxy () "HeLlo world")--- --- We should be able to convert the ASCII version we already have.------ This is done using 'Superset' typeclass.------ @injectInto@ method accepts proxy to specify superset to use.------ >>> displ $ injectInto @ "r-UTF8" helloAsciiB--- "MkEnc '[r-UTF8] () (ByteString HeLlo world)"------ Superset is intended for @"r-"@ annotations only, should not be used--- with general encodings like @"enc-B64"@, it assumes that decoding in the superset--- can replace the decoding from injected subset.--- -- * More complex rules  helloUtf8B64B :: Enc '["enc-B64", "r-UTF8"] () B.ByteString helloUtf8B64B = encodePart @'["enc-B64"] helloUtf8B --- ^ We put Base64 on a ByteString which adheres to UTF8 layout+-- ^ We Base64 encode a ByteString which adheres to UTF8 layout ----- >>> displ $ encodePart_ (Proxy :: Proxy '["enc-B64"]) helloUtf8B--- "MkEnc '[enc-B64,r-UTF8] () (ByteString SGVMbG8gd29ybGQ=)"+-- >>> displ $ encodePart @'["enc-B64"] helloUtf8B+-- "Enc '[enc-B64,r-UTF8] () (ByteString SGVMbG8gd29ybGQ=)"  helloUtf8B64T :: Enc '["enc-B64"] () T.Text helloUtf8B64T = EncT.utf8Demote . EncTe.decodeUtf8 $ helloUtf8B64B   -- ^ .. and copy it over to Text. -- -- >>> displ $ EncTe.decodeUtf8 helloUtf8B64B--- "MkEnc '[enc-B64,r-UTF8] () (Text SGVMbG8gd29ybGQ=)"+-- "Enc '[enc-B64,r-UTF8] () (Text SGVMbG8gd29ybGQ=)" -- -- but UTF8 would be redundant in Text so the "r-UTF8" can be dropped: -- -- >>> displ . EncT.utf8Demote . EncTe.decodeUtf8 $ helloUtf8B64B--- "MkEnc '[enc-B64] () (Text SGVMbG8gd29ybGQ=)"+-- "Enc '[enc-B64] () (Text SGVMbG8gd29ybGQ=)" -- -- Conversely moving back to ByteString we need to recover the annotation -- @@ -213,7 +189,7 @@ -- This is not allowed! We need to add the redundant "r-UTF8" back: -- -- >>> displ .  EncTe.encodeUtf8 . EncT.utf8Promote $ helloUtf8B64T--- "MkEnc '[enc-B64,r-UTF8] () (ByteString SGVMbG8gd29ybGQ=)"+-- "Enc '[enc-B64,r-UTF8] () (ByteString SGVMbG8gd29ybGQ=)" -- -- To achieve type safety, our @encodeUtf8@ and @decodeUtf8@ require "r-UTF8" annotation.  -- But since @Text@ values can always emit @UTF8@ layout, we can simply add and remove@@ -224,7 +200,7 @@ -- ^ 'notTextB' a binary, one that does not even represent a valid UTF8. --  -- >>> encodeAll . toEncoding () $ "\195\177" :: Enc '["enc-B64"] () B.ByteString--- MkEnc Proxy () "w7E="+-- UnsafeMkEnc Proxy () "w7E=" -- -- Decoding it to Text is prevented by the compiler --@@ -242,13 +218,60 @@ -- This can be done, for example, using flattening (see below).  +-- * Supersets++helloUtf8B :: Enc '["r-UTF8"] () B.ByteString+helloUtf8B = injectInto helloAsciiB+-- ^ To claim UTF8 on @helloAsciiB@, instead encoding again: +--+-- >>> encodeFAll . toEncoding () $ "HeLlo world" :: Either EncodeEx (Enc '["r-UTF8"] () B.ByteString)+-- Right (UnsafeMkEnc Proxy () "HeLlo world")+-- +-- We should be able to convert the ASCII annotation directly.+--+-- This is done using 'IsSuperset' type family.+--+-- @injectInto@ method accepts proxy to specify superset to use.+--+-- >>> displ $ injectInto @ "r-UTF8" helloAsciiB+-- "Enc '[r-UTF8] () (ByteString HeLlo world)"+--+-- Superset is intended for @"r-"@ annotations only, should not be used+-- with general encodings like @"enc-B64"@, it assumes that decoding in the superset+-- can replace the decoding from injected subset.+++notTextBB64Ascii :: Enc '["r-ASCII", "enc-B64"] () B.ByteString+notTextBB64Ascii =  _encodesInto notTextB+-- ^ /Base64/ encoding represents binary data in an ASCII string format.+-- +-- In Haskell, we should be able to express this in types.+--+-- 'EncodingSuperset' class is what specifies this.+--+-- We can use it with '_encodesInto' combinator. +-- 'EncodingSuperset' should not be used directly at the calling site. +--+-- >>>  displ (_encodesInto @"r-ASCII" $ notTextB)+-- "Enc '[r-ASCII,enc-B64] () (ByteString w7E=)"+--+-- '_encodesInto' can be used with a superset of the encoding +-- character set as well making it more backward compatible +-- (the definition of @EncodingSuperset "enc-B64" could be made more precise without breaking the code).+--+-- >>>  displ (_encodesInto @"r-UTF8" $ notTextB)+-- "Enc '[r-UTF8,enc-B64] () (ByteString w7E=)"+--+++ -- * Lenient recovery  lenientSomething :: Enc '["enc-B64-len"] () B.ByteString lenientSomething = recreateAll . toEncoding () $ "abc==CB" -- ^  -- >>> recreateAll . toEncoding () $ "abc==CB" :: Enc '["enc-B64-len"] () B.ByteString--- MkEnc Proxy () "abc==CB"+-- UnsafeMkEnc Proxy () "abc==CB" -- -- The rest of Haskell does lenient decoding, type safety allows this library to use it for recovery. -- lenient algorithms are not partial and automatically fix invalid input:@@ -261,17 +284,17 @@ -- 'EnB64.acceptLenientS' allows to convert "enc-B64-len" to "enc-B64" -- -- >>> displ $ EnB64.acceptLenientS lenientSomething--- "MkEnc '[enc-B64] () (ByteString abc=)"+-- "Enc '[enc-B64] () (ByteString abc=)" -- -- This is now properly encoded data -- -- >>> recreateFAll . toEncoding () $ "abc=" :: Either RecreateEx (Enc '["enc-B64"] () B.ByteString)--- Right (MkEnc Proxy () "abc=")+-- Right (UnsafeMkEnc Proxy () "abc=") -- -- Except the content could be surprising -- -- >>> decodeAll $ EnB64.acceptLenientS lenientSomething--- MkEnc Proxy () "i\183"+-- UnsafeMkEnc Proxy () "i\183"   -- * Flattening
src/Examples/TypedEncoding/DiySignEncoding.hs view
@@ -19,7 +19,7 @@ -- Decoding cannot fail unless somehow underlying data has been corrupted. -- -- Such integrity of data should be enforced at boundaries--- (JSON instances, DB retrievals, etc).  This can be accomplished using provided 'RecreateF' typeclass.+-- (JSON instances, DB retrievals, etc).  This can be accomplished using provided support for /Validation/ or using 'Data.TypedEncoding.Common.Types.UncheckedEnc.UncheckedEnc'. --  -- This still is user decision, the errors during decoding process are considered unexpected 'UnexpectedDecodeErr'. -- In particular user can decide to use unsafe operations with the encoded type. See 'Examples.TypedEncoding.Unsafe'.@@ -66,7 +66,7 @@ -- | Encoded hello world example. -- -- >>> helloSigned--- MkEnc Proxy () "11:Hello World"+-- UnsafeMkEnc Proxy () "11:Hello World" -- -- >>> fromEncoding . decodeAll $ helloSigned  -- "Hello World"@@ -99,23 +99,27 @@ -- Left (RecreateEx "my-sign" ("Corrupted Signature")) -- -- >>> recreateFAll . toEncoding () $ payload :: Either RecreateEx (Enc '["my-sign"] () T.Text)--- Right (MkEnc Proxy () "11:Hello World")+-- Right (UnsafeMkEnc Proxy () "11:Hello World")   -- | Because encoding function is pure we can create instance of EncodeF  -- that is polymorphic in effect @f@. This is done using 'EnT.implTranP' combinator.-instance Applicative f => EncodeF f (Enc xs c T.Text) (Enc ("my-sign" ': xs) c T.Text) where-    encodeF = EnT.implEncodeP encodeSign    +instance Applicative f => Encode f "my-sign" "my-sign" c T.Text where+   encoding = EnT._implEncodingP encodeSign      -- | Decoding allows effectful @f@ to allow for troubleshooting and unsafe payload changes. ----- Implementation simply uses 'EnT.implDecodeF' combinator on the 'asUnexpected' composed with decoding function.+-- Implementation simply uses 'EnT.implDecodingF' combinator on the 'asUnexpected' composed with decoding function. -- 'UnexpectedDecodeErr' has Identity instance allowing for decoding that assumes errors are not possible. -- For debugging purposes or when unsafe changes to "my-sign" @Error UnexpectedDecodeEx@ instance can be used.-instance (UnexpectedDecodeErr f, Applicative f) => DecodeF f (Enc ("my-sign" ': xs) c T.Text) (Enc xs c T.Text) where-    decodeF = EnT.implDecodeF (asUnexpected @"my-sign" . decodeSign) +instance (UnexpectedDecodeErr f, Applicative f) => Decode f "my-sign" "my-sign" c T.Text where+    decoding = decMySign  +decMySign :: (UnexpectedDecodeErr f, Applicative f) => Decoding f "my-sign" "my-sign" c T.Text+decMySign = EnT.implDecodingF (asUnexpected @"my-sign" . decodeSign) + -- | Recreation allows effectful @f@ to check for tampering with data.--- Implementation simply uses 'EnT.implCheckPrevF' combinator on the recovery function.-instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c T.Text) (Enc ("my-sign" ': xs) c T.Text) where   -    checkPrevF = EnT.implCheckPrevF (asRecreateErr @"my-sign" . decodeSign) +-- Implementation simply uses 'EnT.validFromDec' combinator on the recovery function.+instance (RecreateErr f, Applicative f) => Validate f "my-sign" "my-sign" c T.Text where+    validation = EnT.validFromDec decMySign+
src/Examples/TypedEncoding/Overview.hs view
@@ -32,6 +32,7 @@  -- $setup -- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XTypeApplications+-- >>> import Data.Functor.Identity -- -- This module contains some ghci friendly values to play with. --@@ -43,23 +44,38 @@ -- | "Hello World" encoded as Base64 -- -- >>> helloB64 --- MkEnc Proxy () "SGVsbG8gV29ybGQ="+-- UnsafeMkEnc Proxy () "SGVsbG8gV29ybGQ=" -- -- >>> displ helloB64--- "MkEnc '[enc-B64] () (ByteString SGVsbG8gV29ybGQ=)"+-- "Enc '[enc-B64] () (ByteString SGVsbG8gV29ybGQ=)" --  -- >>> encodeAll . toEncoding () $ "Hello World" :: Enc '["enc-B64"] () B.ByteString--- MkEnc Proxy () "SGVsbG8gV29ybGQ="------ There is currently an alternative polymorphic way (prototype) to create encodings by /running/ 'Encoder' on 'encodings'.--- This approach works better with more open / dynamic encoding setup it also provides first class @Encoder@. --- In future versions encodeAll will either be improved to provide similar flexibility or will be deprecated and removed.--- --- >>> displ <$> (runEncoder @'["enc-B64"] encodings $ toEncoding () "Hello" :: Either EncodeEx (Enc '["enc-B64"] () B.ByteString))--- Right "MkEnc '[enc-B64] () (ByteString SGVsbG8=)"+-- UnsafeMkEnc Proxy () "SGVsbG8gV29ybGQ=" helloB64 :: Enc '["enc-B64"] () B.ByteString helloB64 = encodeAll . toEncoding () $ "Hello World" +-- | "Hello World" double-Base64 encoded.+-- Notice the same code used as in single encoding, the game is played at type level.+--+-- >>> encodeAll . toEncoding () $ "Hello World" :: Enc '["enc-B64","enc-B64"] () B.ByteString  +-- UnsafeMkEnc Proxy () "U0dWc2JHOGdWMjl5YkdRPQ=="+--+-- >>> displ helloB64B64+-- "Enc '[enc-B64,enc-B64] () (ByteString U0dWc2JHOGdWMjl5YkdRPQ==)"+--+-- An alternative version of the above code is this:+--+-- >>> fmap displ . runEncodings' @'["enc-B64","enc-B64"] @'["enc-B64","enc-B64"] @Identity encodings . toEncoding () $ ("Hello World" :: B.ByteString)+-- Identity "Enc '[enc-B64,enc-B64] () (ByteString U0dWc2JHOGdWMjl5YkdRPQ==)"+--+-- This is how @typed-encoding@ works, the "Data.TypedEncoding.Common.Class.Encode.EncodeAll"+-- constraint can be used to get access to list to encodings required by the symbol annotation. +-- 'runEncodings'' executes all the necessary transformations.+--+-- Similar story is true for /decoding/ and /validation/. In these examples we will use shortcut combinators.+helloB64B64 :: Enc '["enc-B64","enc-B64"] () B.ByteString+helloB64B64 = encodeAll . toEncoding () $ "Hello World"+ -- | Previous text decoded from Base64 -- -- >>> fromEncoding . decodeAll $ helloB64 @@ -71,7 +87,7 @@ -- It makes sure that the content satisfies specified encodings. --  -- >>> recreateFAll . toEncoding () $ "SGVsbG8gV29ybGQ=" :: Either RecreateEx (Enc '["enc-B64"] () B.ByteString)--- Right (MkEnc Proxy () "SGVsbG8gV29ybGQ=")+-- Right (UnsafeMkEnc Proxy () "SGVsbG8gV29ybGQ=") -- -- >>> recreateFAll . toEncoding () $ "SGVsbG8gV29ybGQ" :: Either RecreateEx (Enc '["enc-B64"] () B.ByteString) -- Left (RecreateEx "enc-B64" ("invalid padding"))@@ -86,29 +102,24 @@ -- This module is concerned only with the first approach.  -- -- >>> let unchecked = toUncheckedEnc ["enc-B64"] () ("SGVsbG8gV29ybGQ=" :: T.Text)--- >>> verifyUncheckedEnc' @'["enc-B64"] unchecked--- Just (Right (MkEnc Proxy () "SGVsbG8gV29ybGQ="))+-- >>> check @'["enc-B64"] @(Either RecreateEx) unchecked+-- Just (Right (UnsafeMkEnc Proxy () "SGVsbG8gV29ybGQ=")) helloB64Recovered :: Either RecreateEx (Enc '["enc-B64"] () B.ByteString) helloB64Recovered = recreateFAll . toEncoding () $ "SGVsbG8gV29ybGQ=" --- | "Hello World" double-Base64 encoded.--- Notice the same code used as in single encoding, the game is played at type level.------ >>> encodeAll . toEncoding () $ "Hello World" :: Enc '["enc-B64","enc-B64"] () B.ByteString  --- MkEnc Proxy () "U0dWc2JHOGdWMjl5YkdRPQ=="------ >>> displ helloB64B64--- "MkEnc '[enc-B64,enc-B64] () (ByteString U0dWc2JHOGdWMjl5YkdRPQ==)"-helloB64B64 :: Enc '["enc-B64","enc-B64"] () B.ByteString-helloB64B64 = encodeAll . toEncoding () $ "Hello World"  -- | Double Base64 encoded "Hello World" with one layer of encoding removed -- -- >>> decodePart @'["enc-B64"] $ helloB64B64 :: Enc '["enc-B64"] () B.ByteString--- MkEnc Proxy () "SGVsbG8gV29ybGQ="+-- UnsafeMkEnc Proxy () "SGVsbG8gV29ybGQ=" -- -- >>> helloB64B64PartDecode == helloB64 -- True+--+-- @decodePart@ is a convenience function that simply replies decoding 'above' first "enc-B64"+--+-- >>> above @'["enc-B64"] @'["enc-B64"] @'[] decodeAll $ helloB64B64 +-- UnsafeMkEnc Proxy () "SGVsbG8gV29ybGQ=" helloB64B64PartDecode :: Enc '["enc-B64"] () B.ByteString helloB64B64PartDecode = decodePart @'["enc-B64"] helloB64B64 @@ -148,14 +159,14 @@ -- The same code is used as in "enc-" examples to encode (now transform). -- -- >>> encodeAll . toEncoding () $ "Hello World" :: Enc '["do-UPPER"] () T.Text--- MkEnc Proxy () "HELLO WORLD"+-- UnsafeMkEnc Proxy () "HELLO WORLD" helloUPP :: Enc '["do-UPPER"] () T.Text helloUPP = encodeAll . toEncoding () $ "Hello World"  -- | Sample compound transformation  --  -- >>> encodeAll . toEncoding () $ "HeLLo world" :: Enc '["do-reverse", "do-Title"] () T.Text--- MkEnc Proxy () "dlroW olleH" +-- UnsafeMkEnc Proxy () "dlroW olleH"  helloTitleRev :: Enc '["do-reverse", "do-Title"] () T.Text helloTitleRev = encodeAll . toEncoding () $ "HeLLo world" @@ -184,27 +195,32 @@ -- configuration we can also do this: -- -- >>> encodeAll . toEncoding exampleConf $ "HeLLo world" :: Enc '["do-reverse", "do-Title"] Config T.Text--- MkEnc Proxy (Config {sizeLimit = SizeLimit {unSizeLimit = 8}}) "dlroW olleH"+-- UnsafeMkEnc Proxy (Config {sizeLimit = SizeLimit {unSizeLimit = 8}}) "dlroW olleH" -- -- >>> encodeAll . toEncoding exampleConf $ "HeLlo world" :: Enc '["do-size-limit", "do-reverse", "do-Title"] Config T.Text--- MkEnc Proxy (Config {sizeLimit = SizeLimit {unSizeLimit = 8}}) "dlroW ol"+-- UnsafeMkEnc Proxy (Config {sizeLimit = SizeLimit {unSizeLimit = 8}}) "dlroW ol" -- -- Instead, encode previously defined 'helloTitle' by reversing it and adding size limit -- -- >>> encodePart @'["do-size-limit", "do-reverse"] helloTitle :: Enc '["do-size-limit", "do-reverse", "do-Title"] Config T.Text--- MkEnc Proxy (Config {sizeLimit = SizeLimit {unSizeLimit = 8}}) "dlroW ol"+-- UnsafeMkEnc Proxy (Config {sizeLimit = SizeLimit {unSizeLimit = 8}}) "dlroW ol"+--+-- @encodePart@ is simply encodeAll played above "do-Title" encoding:+--+-- >>> above @'["do-Title"] @'[] @'["do-size-limit", "do-reverse"] encodeAll helloTitle+-- UnsafeMkEnc Proxy (Config {sizeLimit = SizeLimit {unSizeLimit = 8}}) "dlroW ol" helloRevLimit :: Enc '["do-size-limit", "do-reverse", "do-Title"] Config T.Text helloRevLimit = encodePart @'["do-size-limit", "do-reverse"] helloTitle  -- >>> encodeAll . toEncoding exampleConf $ "HeLlo world" :: Enc '["enc-B64", "do-size-limit"] Config B.ByteString--- MkEnc Proxy (Config {sizeLimit = SizeLimit {unSizeLimit = 8}}) "SGVMbG8gd28="+-- UnsafeMkEnc Proxy (Config {sizeLimit = SizeLimit {unSizeLimit = 8}}) "SGVMbG8gd28=" helloLimitB64 :: Enc '["enc-B64", "do-size-limit"] Config B.ByteString helloLimitB64 = encodeAll . toEncoding exampleConf $ "HeLlo world"  -- | ... and we unwrap the B64 part only --  -- >>> decodePart @'["enc-B64"] $ helloLimitB64--- MkEnc Proxy (Config {sizeLimit = SizeLimit {unSizeLimit = 8}}) "HeLlo wo"+-- UnsafeMkEnc Proxy (Config {sizeLimit = SizeLimit {unSizeLimit = 8}}) "HeLlo wo" helloRevLimitParDec :: Enc '["do-size-limit"] Config B.ByteString helloRevLimitParDec =  decodePart @'["enc-B64"] helloLimitB64 @@ -224,7 +240,7 @@ -- Note naming thing: "r-" is partial identity ("r-" is from restriction). -- -- >>>  encodeFAll . toEncoding () $ "HeLlo world" :: Either EncodeEx (Enc '["r-ASCII"] () B.ByteString) --- Right (MkEnc Proxy () "HeLlo world")+-- Right (UnsafeMkEnc Proxy () "HeLlo world") helloAscii :: Either EncodeEx (Enc '["r-ASCII"] () B.ByteString) helloAscii = encodeFAll . toEncoding () $ "HeLlo world"  @@ -232,12 +248,12 @@ -- a better version is here: -- -- >>> encodeFAll . toEncoding () $ "Hello World" :: Either EncodeEx (Enc '["enc-B64", "r-ASCII"] () B.ByteString)--- Right (MkEnc Proxy () "SGVsbG8gV29ybGQ=") +-- Right (UnsafeMkEnc Proxy () "SGVsbG8gV29ybGQ=")  helloAsciiB64 :: Either EncodeEx (Enc '["enc-B64", "r-ASCII"] () B.ByteString) helloAsciiB64 = encodeFAll . toEncoding () $ "Hello World"  -- | -- >>> decodePart @'["enc-B64"] <$> helloAsciiB64--- Right (MkEnc Proxy () "Hello World")+-- Right (UnsafeMkEnc Proxy () "Hello World") helloAsciiB64PartDec :: Either EncodeEx (Enc '["r-ASCII"] () B.ByteString) helloAsciiB64PartDec = decodePart @'["enc-B64"] <$> helloAsciiB64
src/Examples/TypedEncoding/ToEncString.hs view
@@ -36,8 +36,7 @@  import           Data.TypedEncoding import qualified Data.TypedEncoding.Instances.Support as EnT-import           Data.TypedEncoding.Instances.Restriction.Common ()-import           Data.TypedEncoding.Instances.ToEncString.Common ()+import           Data.TypedEncoding.Instances.Restriction.Misc () import           Data.TypedEncoding.Instances.Enc.Base64 () import           Data.TypedEncoding.Instances.Restriction.ASCII () import           Data.TypedEncoding.Instances.Restriction.UTF8 ()@@ -81,10 +80,10 @@ -- In this example @toEncString@ converts 'IpV4' to @Enc '["r-IPv4"] Text@. --   -- This is done with help of existing @"r-Word8-decimal"@ annotation defined--- in "Data.TypedEncoding.Instances.Restriction.Common"+-- in "Data.TypedEncoding.Instances.Restriction.Misc" ----- >>> toEncString @"r-IPv4" @T.Text tstIp--- MkEnc Proxy () "128.1.1.10"+-- >>> toEncString @"r-IPv4" @IpV4 @T.Text tstIp+-- UnsafeMkEnc Proxy () "128.1.1.10" -- -- Implementation is a classic map reduce where reduce is done with help of -- 'EnT.foldEncStr'@@ -92,7 +91,7 @@ -- >>> let fn a b = if b == "" then a else a <> "." <> b -- >>> let reduce = EnT.foldEncStr @'["r-IPv4"] @'["r-Word8-decimal"] () fn -- >>>  displ . reduce . fmap toEncString $ tstIp--- "MkEnc '[r-IPv4] () 128.1.1.10"+-- "Enc '[r-IPv4] () (String 128.1.1.10)" -- -- Note lack of type safety here, the same code would work just fine if we added -- 5th field to 'IpV4F' constructor.  @@ -107,8 +106,8 @@ -- @HList@ could be used for record types with heterogeneous fields. -- -- Currently, 'type-encoding' library does not have these types in scope.  -instance ToEncString "r-IPv4" T.Text Identity IpV4 where-    toEncStringF = Identity . reduce . map+instance ToEncString Identity "r-IPv4" "r-IPv4" IpV4 T.Text where+    toEncF = Identity . reduce . map       where map :: IpV4F Word8 -> IpV4F (Enc '["r-Word8-decimal"] () T.Text)              map = fmap toEncString @@ -117,23 +116,23 @@  -- | ----- >>> let enc = toEncString @"r-IPv4" @T.Text tstIp--- >>> fromEncString @IpV4 enc+-- >>> let enc = toEncString @"r-IPv4" @IpV4 @T.Text tstIp+-- >>> fromEncString @"r-IPv4" @IpV4 enc -- IpV4F {oct1 = 128, oct2 = 1, oct3 = 1, oct4 = 10} -- -- To get 'IpV4' out of the string we need to reverse previous @reduce@. -- This is currently done using helper 'EnT.splitPayload' combinator.  -- -- >>> EnT.splitPayload @ '["r-Word8-decimal"] (T.splitOn $ T.pack ".") $ enc --- [MkEnc Proxy () "128",MkEnc Proxy () "1",MkEnc Proxy () "1",MkEnc Proxy () "10"]+-- [UnsafeMkEnc Proxy () "128",UnsafeMkEnc Proxy () "1",UnsafeMkEnc Proxy () "1",UnsafeMkEnc Proxy () "10"] --  -- The conversion of a list to IpV4F needs handle errors but these errors  -- are considered unexpected. -- -- Note, again, the error condition exposed by this implementation could have been avoided -- if 'EnT.splitPayload' returned fixed size @Vect 4@.-instance (UnexpectedDecodeErr f, Applicative f) => FromEncString IpV4 f T.Text "r-IPv4" where   -    fromEncStringF = fmap map . unreduce+instance (UnexpectedDecodeErr f, Applicative f) => FromEncString f "r-IPv4" "r-IPv4" IpV4 T.Text where   +    fromEncF = fmap map . unreduce       where unreduce :: Enc '["r-IPv4"] () T.Text -> f (IpV4F (Enc '["r-Word8-decimal"] () T.Text))             unreduce = asUnexpected @"r-IPv4" . recover . EnT.splitPayload @ '["r-Word8-decimal"] (T.splitOn ".")             @@ -205,10 +204,10 @@ -- -- We can play 'Alternative' ('<|>') game (we acually use @Maybe@) with final option being a 'RecreateEx' error: ----- >>> verifyUncheckedEnc' @'["enc-B64","r-ASCII"] $ unchecked+-- >>> check @'["enc-B64","r-ASCII"] @(Either RecreateEx) $ unchecked -- Nothing--- >>> verifyUncheckedEnc' @'["enc-B64","r-UTF8"] $ unchecked--- Just (Right (MkEnc Proxy () "U29tZSBVVEY4IFRleHQ="))+-- >>> check @'["enc-B64","r-UTF8"] @(Either RecreateEx) $ unchecked+-- Just (Right (UnsafeMkEnc Proxy () "U29tZSBVVEY4IFRleHQ=")) -- -- Since the data is heterogeneous (each piece has a different encoding annotation), we need wrap the result in another plain ADT: 'CheckedEnc'. -- @@ -236,11 +235,11 @@           runAlternatives' (fromMaybe def) [try1, try2, try3, try4, try5] body           where               unchecked = toUncheckedEnc (parseHeader parth) () -              try1 = fmap (fmap toCheckedEnc) . verifyUncheckedEnc' @'["enc-B64","r-UTF8"] . unchecked-              try2 = fmap (fmap toCheckedEnc) . verifyUncheckedEnc' @'["enc-B64","r-ASCII"] . unchecked-              try3 = fmap (fmap toCheckedEnc) . verifyUncheckedEnc' @'["r-ASCII"] . unchecked-              try4 = fmap (fmap toCheckedEnc) . verifyUncheckedEnc' @'["r-UTF8"] . unchecked-              try5 = fmap (fmap toCheckedEnc) . verifyUncheckedEnc' @'["enc-B64"] . unchecked+              try1 = fmap (fmap toCheckedEnc) . check @'["enc-B64","r-UTF8"] . unchecked+              try2 = fmap (fmap toCheckedEnc) . check @'["enc-B64","r-ASCII"] . unchecked+              try3 = fmap (fmap toCheckedEnc) . check @'["r-ASCII"] . unchecked+              try4 = fmap (fmap toCheckedEnc) . check @'["r-UTF8"] . unchecked+              try5 = fmap (fmap toCheckedEnc) . check @'["enc-B64"] . unchecked               def =  Left $ recreateErrUnknown ("Invalid Header " ++ show parth)   @@ -251,7 +250,7 @@ -- (like trying to decode base 64 on a plain text part). -- -- >>> decodeB64ForTextOnly <$> recreateEncoding tstEmail--- Right (SimplifiedEmailF {emailHeader = "Some Header", parts = [MkCheckedEnc ["enc-B64"] () "U29tZSBBU0NJSSBUZXh0",MkCheckedEnc ["r-ASCII"] () "Some ASCII Text",MkCheckedEnc ["r-UTF8"] () "Some UTF8 Text",MkCheckedEnc ["r-ASCII"] () "Some ASCII plain text"]})+-- Right (SimplifiedEmailF {emailHeader = "Some Header", parts = [UnsafeMkCheckedEnc ["enc-B64"] () "U29tZSBBU0NJSSBUZXh0",UnsafeMkCheckedEnc ["r-ASCII"] () "Some ASCII Text",UnsafeMkCheckedEnc ["r-UTF8"] () "Some UTF8 Text",UnsafeMkCheckedEnc ["r-ASCII"] () "Some ASCII plain text"]}) -- -- Combinator @fromCheckedEnc \@'["enc-B64", "r-UTF8"]@ acts as a selector and picks only the -- @["enc-B64", "r-UTF8"]@ values from our 'Traversable' type. @@ -262,7 +261,7 @@ -- -- >>> let piece = unsafeCheckedEnc ["enc-B64","r-ASCII"] () ("U29tZSBBU0NJSSBUZXh0" :: B.ByteString) -- >>> displ piece--- "MkCheckedEnc [enc-B64,r-ASCII] () (ByteString U29tZSBBU0NJSSBUZXh0)"+-- "UnsafeMkCheckedEnc [enc-B64,r-ASCII] () (ByteString U29tZSBBU0NJSSBUZXh0)" -- -- This code will not pick it up: --@@ -272,12 +271,12 @@ -- But this one will: -- -- >>> fromCheckedEnc @ '["enc-B64", "r-ASCII"]  $ piece--- Just (MkEnc Proxy () "U29tZSBBU0NJSSBUZXh0")+-- Just (UnsafeMkEnc Proxy () "U29tZSBBU0NJSSBUZXh0") -- -- so we can apply the decoding on the selected piece  -- -- >>> fmap (toCheckedEnc . decodePart @'["enc-B64"]) . fromCheckedEnc @ '["enc-B64", "r-ASCII"] $ piece--- Just (MkCheckedEnc ["r-ASCII"] () "Some ASCII Text")+-- Just (UnsafeMkCheckedEnc ["r-ASCII"] () "Some ASCII Text")  decodeB64ForTextOnly :: SimplifiedEmailEncB -> SimplifiedEmailEncB decodeB64ForTextOnly = fmap (runAlternatives fromMaybe [tryUtf8, tryAscii])
src/Examples/TypedEncoding/Unsafe.hs view
@@ -41,7 +41,7 @@ -- >>> let payload = getPayload exAsciiT -- >>> let newPayload = payload <> " some extra stuff" -- >>> recreateFAll . toEncoding () $ newPayload :: Either RecreateEx (Enc '["r-ASCII"] () T.Text)--- Right (MkEnc Proxy () "HELLO some extra stuff")+-- Right (UnsafeMkEnc Proxy () "HELLO some extra stuff") -- -- Alternatively, 'UncheckedEnc' type can be used in recreation, see 'Examples.TypedEncoding.Overview' -- @@ -58,9 +58,9 @@ -- the internal payload. --   -- >>> exAsciiTE--- Right (MkEnc Proxy () "HELLO")+-- Right (UnsafeMkEnc Proxy () "HELLO") -- >>> exAsciiTE >>= pure . Unsafe.withUnsafe (fmap T.toLower)--- Right (MkEnc Proxy () "hello")+-- Right (UnsafeMkEnc Proxy () "hello") -- -- Example uses of 'T.toLower' within encoded data -- this operation is safe for ASCII restriction@@ -75,7 +75,7 @@ -- >>> let Right hELLO = exAsciiTE -- >>> let Right hello = toLowerAscii -- >>> displ $ Unsafe.runUnsafe ((<>) <$> Unsafe.Unsafe hELLO <*> Unsafe.Unsafe hello)--- "MkEnc '[r-ASCII] () (Text HELLOhello)"+-- "Enc '[r-ASCII] () (Text HELLOhello)" appendAscii :: Either EncodeEx (Enc '["r-ASCII"] () T.Text) appendAscii = do      hELLO <- exAsciiTE
+ test/Test/Bc/ASCIISpec.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fwarn-unused-imports #-}++-- | Verified backward compatibility of ASCII encoder changes in v0.3+module Test.Bc.ASCIISpec where++import qualified Data.TypedEncoding.Instances.Restriction.ASCII as ASCII+import           Data.TypedEncoding.Common.Class.Util.StringConstraints++import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.List as L++import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy.Char8 as BL8++import           Data.Char+import           Control.Arrow++import           Test.QuickCheck.Instances.ByteString ()+import           Test.QuickCheck.Instances.Text ()+import           Test.QuickCheck+import           Test.QuickCheck.Property+import           Test.Hspec+++equivalProperty :: Eq str => (str -> Either NonAsciiChar str) -> (str -> Either NonAsciiChar str) -> str -> Property+equivalProperty alg1 alg2 str = property $ liftBool (alg1 str == alg2 str)++forwardCompatible :: (Char8Find str, Eq str) => (str -> Either NonAsciiChar str) -> str -> Property+forwardCompatible = equivalProperty newImpl+++type NonAsciiChar = ASCII.NonAsciiChar+++oldImplS = oldEncodeImpl L.partition L.head L.null+oldImplT = oldEncodeImpl T.partition T.head T.null+oldImplTL = oldEncodeImpl TL.partition TL.head TL.null+oldImplB = oldEncodeImpl (\p -> B8.filter p &&& B8.filter (not . p)) B8.head B8.null+oldImplBL = oldEncodeImpl (\p -> BL8.filter p &&& BL8.filter (not . p)) BL8.head BL8.null+++newImpl :: Char8Find str => str -> Either NonAsciiChar str+newImpl = ASCII.encImpl++oldEncodeImpl :: +   ((Char -> Bool) -> a -> (a, a))+   -> (a -> Char)+   -> (a -> Bool)+   -> a+   -> Either NonAsciiChar a+oldEncodeImpl partitionf headf nullf t = +                 let (tascii, nonascii) = partitionf isAscii t +                 in if nullf nonascii +                    then Right tascii+                    else Left . ASCII.NonAsciiChar $ headf nonascii ++spec :: Spec +spec = +    describe "ASCII backward compapatibilty check" $ do+       it "String" $ property $ forwardCompatible oldImplS +       it "Text" $ property $ forwardCompatible oldImplT+       it "Lazy.Text" $ property $ forwardCompatible oldImplTL+       it "ByteString" $ property $ forwardCompatible oldImplB+       it "Lazy.ByteString" $ property $ forwardCompatible oldImplBL++runSpec :: IO ()+runSpec = hspec spec
test/Test/Bc/IsStringRSpec.hs view
@@ -29,9 +29,8 @@ import           Data.Word import           Data.Either import           Data.TypedEncoding-import           Data.TypedEncoding.Internal.Class.IsStringR -import           Data.TypedEncoding.Instances.Restriction.Common ()-import           Data.TypedEncoding.Instances.ToEncString.Common ()+import           Data.TypedEncoding.Common.Class.IsStringR +import           Data.TypedEncoding.Instances.Restriction.Misc ()  newtype MyStr = MyStr String deriving (Eq, Show) @@ -63,13 +62,13 @@         it "Word8 fromEncString err works" $               fromEncStringTestErr `shouldSatisfy` isLeft         it "EncodeF works" $-          (encodeFAll @(Either EncodeEx) @'["r-Word8-decimal"] . toEncoding () $ tstWord8) `shouldSatisfy` isRight   +          (encodeFAll @'["r-Word8-decimal"] @(Either EncodeEx) . toEncoding () $ tstWord8) `shouldSatisfy` isRight            it "EncodeF err works" $-          (encodeFAll @(Either EncodeEx) @'["r-Word8-decimal"] . toEncoding () $ tstNotWord8') `shouldSatisfy` isLeft+          (encodeFAll @'["r-Word8-decimal"] @(Either EncodeEx). toEncoding () $ tstNotWord8') `shouldSatisfy` isLeft         it "RecreateF works" $-          (recreateFAll @(Either RecreateEx) @'["r-Word8-decimal"] . toEncoding () $ tstWord8) `shouldSatisfy` isRight   +          (recreateFAll @'["r-Word8-decimal"] @(Either RecreateEx) . toEncoding () $ tstWord8) `shouldSatisfy` isRight            it "RecreateF err works" $-          (recreateFAll @(Either RecreateEx) @'["r-Word8-decimal"] . toEncoding () $ tstNotWord8) `shouldSatisfy` isLeft+          (recreateFAll @'["r-Word8-decimal"] @(Either RecreateEx) . toEncoding () $ tstNotWord8) `shouldSatisfy` isLeft         it "DecodeF works" $           (fromEncoding . decodeAll $ tstWord8Enc) `shouldBe` tstWord8
typed-encoding.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 2bc32a22f6f7e7c49333ee187e608cb1c101c6711ae2fa7e0ee92c5d524e97ed+-- hash: f053eb403362652b43e8d0680f5e3a36c5eff26bb2f32fe383f0ab4612ba3c0f  name:           typed-encoding-version:        0.2.2.0+version:        0.3.0.0 synopsis:       Type safe string transformations description:    See README.md in the project github repository. category:       Data, Text@@ -30,9 +30,34 @@ library   exposed-modules:       Data.TypedEncoding-      Data.TypedEncoding.Combinators.Restriction.Bool-      Data.TypedEncoding.Combinators.Restriction.BoundedAlphaNums-      Data.TypedEncoding.Combinators.Restriction.Common+      Data.TypedEncoding.Combinators.Common+      Data.TypedEncoding.Combinators.Decode+      Data.TypedEncoding.Combinators.Encode+      Data.TypedEncoding.Combinators.Encode.Experimental+      Data.TypedEncoding.Combinators.Promotion+      Data.TypedEncoding.Combinators.ToEncStr+      Data.TypedEncoding.Combinators.Unsafe+      Data.TypedEncoding.Combinators.Validate+      Data.TypedEncoding.Common.Class+      Data.TypedEncoding.Common.Class.Decode+      Data.TypedEncoding.Common.Class.Encode+      Data.TypedEncoding.Common.Class.IsStringR+      Data.TypedEncoding.Common.Class.Superset+      Data.TypedEncoding.Common.Class.Util+      Data.TypedEncoding.Common.Class.Util.StringConstraints+      Data.TypedEncoding.Common.Class.Validate+      Data.TypedEncoding.Common.Types+      Data.TypedEncoding.Common.Types.CheckedEnc+      Data.TypedEncoding.Common.Types.Common+      Data.TypedEncoding.Common.Types.Decoding+      Data.TypedEncoding.Common.Types.Enc+      Data.TypedEncoding.Common.Types.Exceptions+      Data.TypedEncoding.Common.Types.SomeAnnotation+      Data.TypedEncoding.Common.Types.SomeEnc+      Data.TypedEncoding.Common.Types.UncheckedEnc+      Data.TypedEncoding.Common.Types.Unsafe+      Data.TypedEncoding.Common.Types.Validation+      Data.TypedEncoding.Common.Util.TypeLits       Data.TypedEncoding.Conv.ByteString.Char8       Data.TypedEncoding.Conv.ByteString.Lazy.Char8       Data.TypedEncoding.Conv.Text@@ -42,31 +67,18 @@       Data.TypedEncoding.Instances.Do.Sample       Data.TypedEncoding.Instances.Enc.Base64       Data.TypedEncoding.Instances.Restriction.ASCII-      Data.TypedEncoding.Instances.Restriction.Common+      Data.TypedEncoding.Instances.Restriction.Bool+      Data.TypedEncoding.Instances.Restriction.BoundedAlphaNums+      Data.TypedEncoding.Instances.Restriction.Misc       Data.TypedEncoding.Instances.Restriction.UTF8       Data.TypedEncoding.Instances.Support-      Data.TypedEncoding.Instances.ToEncString.Common-      Data.TypedEncoding.Internal.Class-      Data.TypedEncoding.Internal.Class.Decode-      Data.TypedEncoding.Internal.Class.Encode-      Data.TypedEncoding.Internal.Class.Encoder-      Data.TypedEncoding.Internal.Class.IsStringR-      Data.TypedEncoding.Internal.Class.Recreate-      Data.TypedEncoding.Internal.Class.Superset-      Data.TypedEncoding.Internal.Class.Util-      Data.TypedEncoding.Internal.Class.Util.StringConstraints-      Data.TypedEncoding.Internal.Combinators-      Data.TypedEncoding.Internal.Instances.Combinators-      Data.TypedEncoding.Internal.Types-      Data.TypedEncoding.Internal.Types.CheckedEnc-      Data.TypedEncoding.Internal.Types.Common-      Data.TypedEncoding.Internal.Types.Enc-      Data.TypedEncoding.Internal.Types.SomeAnnotation-      Data.TypedEncoding.Internal.Types.SomeEnc-      Data.TypedEncoding.Internal.Types.UncheckedEnc-      Data.TypedEncoding.Internal.Types.Unsafe+      Data.TypedEncoding.Instances.Support.Common+      Data.TypedEncoding.Instances.Support.Decode+      Data.TypedEncoding.Instances.Support.Encode+      Data.TypedEncoding.Instances.Support.Helpers+      Data.TypedEncoding.Instances.Support.Unsafe+      Data.TypedEncoding.Instances.Support.Validate       Data.TypedEncoding.Internal.Util-      Data.TypedEncoding.Internal.Util.TypeLits       Data.TypedEncoding.Unsafe       Examples.TypedEncoding       Examples.TypedEncoding.Conversions@@ -113,6 +125,7 @@   main-is: Spec.hs   other-modules:       Test.Bc.IsStringRSpec+      Test.Bc.ASCIISpec   hs-source-dirs:       test   ghc-options: -threaded -rtsopts -with-rtsopts=-N