summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorrpeszek <>2020-05-23 01:29:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-05-23 01:29:00 (GMT)
commit4d9ed6c5f3301d70457f84cbfdcffffba9abfc39 (patch)
treeaca52f50a4823f002549d2331e8b1427835dad06
parent228c134905653d1212e9036a1db1733ce5906d99 (diff)
version 0.3.0.00.3.0.0
-rw-r--r--ChangeLog.md40
-rw-r--r--README.md8
-rw-r--r--src/Data/TypedEncoding.hs146
-rw-r--r--src/Data/TypedEncoding/Combinators/Common.hs52
-rw-r--r--src/Data/TypedEncoding/Combinators/Decode.hs74
-rw-r--r--src/Data/TypedEncoding/Combinators/Encode.hs68
-rw-r--r--src/Data/TypedEncoding/Combinators/Encode/Experimental.hs45
-rw-r--r--src/Data/TypedEncoding/Combinators/Promotion.hs (renamed from src/Data/TypedEncoding/Internal/Class/Superset.hs)100
-rw-r--r--src/Data/TypedEncoding/Combinators/Restriction/Common.hs64
-rw-r--r--src/Data/TypedEncoding/Combinators/ToEncStr.hs50
-rw-r--r--src/Data/TypedEncoding/Combinators/Unsafe.hs32
-rw-r--r--src/Data/TypedEncoding/Combinators/Validate.hs88
-rw-r--r--src/Data/TypedEncoding/Common/Class.hs63
-rw-r--r--src/Data/TypedEncoding/Common/Class/Decode.hs58
-rw-r--r--src/Data/TypedEncoding/Common/Class/Encode.hs44
-rw-r--r--src/Data/TypedEncoding/Common/Class/IsStringR.hs (renamed from src/Data/TypedEncoding/Internal/Class/IsStringR.hs)9
-rw-r--r--src/Data/TypedEncoding/Common/Class/Superset.hs89
-rw-r--r--src/Data/TypedEncoding/Common/Class/Util.hs (renamed from src/Data/TypedEncoding/Internal/Class/Util.hs)15
-rw-r--r--src/Data/TypedEncoding/Common/Class/Util/StringConstraints.hs (renamed from src/Data/TypedEncoding/Internal/Class/Util/StringConstraints.hs)20
-rw-r--r--src/Data/TypedEncoding/Common/Class/Validate.hs50
-rw-r--r--src/Data/TypedEncoding/Common/Types.hs23
-rw-r--r--src/Data/TypedEncoding/Common/Types/CheckedEnc.hs (renamed from src/Data/TypedEncoding/Internal/Types/CheckedEnc.hs)33
-rw-r--r--src/Data/TypedEncoding/Common/Types/Common.hs68
-rw-r--r--src/Data/TypedEncoding/Common/Types/Decoding.hs76
-rw-r--r--src/Data/TypedEncoding/Common/Types/Enc.hs225
-rw-r--r--src/Data/TypedEncoding/Common/Types/Exceptions.hs (renamed from src/Data/TypedEncoding/Internal/Types.hs)34
-rw-r--r--src/Data/TypedEncoding/Common/Types/SomeAnnotation.hs (renamed from src/Data/TypedEncoding/Internal/Types/SomeAnnotation.hs)6
-rw-r--r--src/Data/TypedEncoding/Common/Types/SomeEnc.hs (renamed from src/Data/TypedEncoding/Internal/Types/SomeEnc.hs)21
-rw-r--r--src/Data/TypedEncoding/Common/Types/UncheckedEnc.hs (renamed from src/Data/TypedEncoding/Internal/Types/UncheckedEnc.hs)11
-rw-r--r--src/Data/TypedEncoding/Common/Types/Unsafe.hs (renamed from src/Data/TypedEncoding/Internal/Types/Unsafe.hs)12
-rw-r--r--src/Data/TypedEncoding/Common/Types/Validation.hs81
-rw-r--r--src/Data/TypedEncoding/Common/Util/TypeLits.hs (renamed from src/Data/TypedEncoding/Internal/Util/TypeLits.hs)9
-rw-r--r--src/Data/TypedEncoding/Conv/ByteString/Char8.hs7
-rw-r--r--src/Data/TypedEncoding/Conv/ByteString/Lazy/Char8.hs5
-rw-r--r--src/Data/TypedEncoding/Conv/Text.hs15
-rw-r--r--src/Data/TypedEncoding/Conv/Text/Encoding.hs9
-rw-r--r--src/Data/TypedEncoding/Instances/Do/Sample.hs54
-rw-r--r--src/Data/TypedEncoding/Instances/Enc/Base64.hs199
-rw-r--r--src/Data/TypedEncoding/Instances/Restriction/ASCII.hs167
-rw-r--r--src/Data/TypedEncoding/Instances/Restriction/Bool.hs (renamed from src/Data/TypedEncoding/Combinators/Restriction/Bool.hs)112
-rw-r--r--src/Data/TypedEncoding/Instances/Restriction/BoundedAlphaNums.hs (renamed from src/Data/TypedEncoding/Combinators/Restriction/BoundedAlphaNums.hs)60
-rw-r--r--src/Data/TypedEncoding/Instances/Restriction/Common.hs45
-rw-r--r--src/Data/TypedEncoding/Instances/Restriction/Misc.hs61
-rw-r--r--src/Data/TypedEncoding/Instances/Restriction/UTF8.hs106
-rw-r--r--src/Data/TypedEncoding/Instances/Support.hs29
-rw-r--r--src/Data/TypedEncoding/Instances/Support/Common.hs36
-rw-r--r--src/Data/TypedEncoding/Instances/Support/Decode.hs39
-rw-r--r--src/Data/TypedEncoding/Instances/Support/Encode.hs63
-rw-r--r--src/Data/TypedEncoding/Instances/Support/Helpers.hs (renamed from src/Data/TypedEncoding/Internal/Instances/Combinators.hs)19
-rw-r--r--src/Data/TypedEncoding/Instances/Support/Unsafe.hs35
-rw-r--r--src/Data/TypedEncoding/Instances/Support/Validate.hs60
-rw-r--r--src/Data/TypedEncoding/Instances/ToEncString/Common.hs44
-rw-r--r--src/Data/TypedEncoding/Internal/Class.hs72
-rw-r--r--src/Data/TypedEncoding/Internal/Class/Decode.hs81
-rw-r--r--src/Data/TypedEncoding/Internal/Class/Encode.hs71
-rw-r--r--src/Data/TypedEncoding/Internal/Class/Encoder.hs49
-rw-r--r--src/Data/TypedEncoding/Internal/Class/Recreate.hs90
-rw-r--r--src/Data/TypedEncoding/Internal/Combinators.hs54
-rw-r--r--src/Data/TypedEncoding/Internal/Types/Common.hs4
-rw-r--r--src/Data/TypedEncoding/Internal/Types/Enc.hs97
-rw-r--r--src/Data/TypedEncoding/Unsafe.hs4
-rw-r--r--src/Examples/TypedEncoding/Conversions.hs119
-rw-r--r--src/Examples/TypedEncoding/DiySignEncoding.hs26
-rw-r--r--src/Examples/TypedEncoding/Overview.hs84
-rw-r--r--src/Examples/TypedEncoding/ToEncString.hs49
-rw-r--r--src/Examples/TypedEncoding/Unsafe.hs8
-rw-r--r--test/Test/Bc/ASCIISpec.hs76
-rw-r--r--test/Test/Bc/IsStringRSpec.hs13
-rw-r--r--typed-encoding.cabal67
69 files changed, 2329 insertions, 1514 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
index 43fe574..7f18cb1 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -2,18 +2,40 @@
## 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
- Next version (0.3) will have number of breaking changes, some rethinking and a lot of cleanup,
diff --git a/README.md b/README.md
index 82002a6..f12af41 100644
--- a/README.md
+++ b/README.md
@@ -63,7 +63,6 @@ phone' = ...
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 @@ Bridge work:
- [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
diff --git a/src/Data/TypedEncoding.hs b/src/Data/TypedEncoding.hs
index 12ec105..f2eb5d8 100644
--- a/src/Data/TypedEncoding.hs
+++ b/src/Data/TypedEncoding.hs
@@ -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,6 +113,14 @@
-- * "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
--
@@ -135,42 +128,69 @@
--
-- * "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 \ No newline at end of file
diff --git a/src/Data/TypedEncoding/Combinators/Common.hs b/src/Data/TypedEncoding/Combinators/Common.hs
new file mode 100644
index 0000000..6877e9a
--- /dev/null
+++ b/src/Data/TypedEncoding/Combinators/Common.hs
@@ -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)
+
+
diff --git a/src/Data/TypedEncoding/Combinators/Decode.hs b/src/Data/TypedEncoding/Combinators/Decode.hs
new file mode 100644
index 0000000..8984a2b
--- /dev/null
+++ b/src/Data/TypedEncoding/Combinators/Decode.hs
@@ -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
+
+
diff --git a/src/Data/TypedEncoding/Combinators/Encode.hs b/src/Data/TypedEncoding/Combinators/Encode.hs
new file mode 100644
index 0000000..112f1d7
--- /dev/null
+++ b/src/Data/TypedEncoding/Combinators/Encode.hs
@@ -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
diff --git a/src/Data/TypedEncoding/Combinators/Encode/Experimental.hs b/src/Data/TypedEncoding/Combinators/Encode/Experimental.hs
new file mode 100644
index 0000000..d26637e
--- /dev/null
+++ b/src/Data/TypedEncoding/Combinators/Encode/Experimental.hs
@@ -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
+
diff --git a/src/Data/TypedEncoding/Internal/Class/Superset.hs b/src/Data/TypedEncoding/Combinators/Promotion.hs
index eaa2f66..7646e92 100644
--- a/src/Data/TypedEncoding/Internal/Class/Superset.hs
+++ b/src/Data/TypedEncoding/Combinators/Promotion.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
+
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
@@ -12,120 +12,90 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
-module Data.TypedEncoding.Internal.Class.Superset where
+-- | Promote and demote combinators.
+module Data.TypedEncoding.Combinators.Promotion where
+
+import Data.TypedEncoding.Common.Class
+import Data.TypedEncoding.Common.Util.TypeLits
-import Data.TypedEncoding.Internal.Util.TypeLits
---import Data.TypedEncoding.Internal.Class.Util (displ)
+import Data.TypedEncoding.Common.Types (Enc(..) )
+import Data.TypedEncoding.Combinators.Unsafe (withUnsafeCoerce)
-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.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
-
--- |
--- 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)
+-- | 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 )"
+-- "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)
--- "MkEnc '[r-ASCII,r-UTF8,r-boo] () (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)
--- "MkEnc '[r-ASCII,r-boo] () (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)
--- "MkEnc '[r-UTF8,r-ASCII,r-boo] () (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)
--- "MkEnc '[r-boo,r-ASCII] () (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)
--- "MkEnc '[r-boo,r-ASCII,r-UTF8] () (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)
--- "MkEnc '[r-boo,r-ASCII] () (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)
--- "MkEnc '[r-boo,r-UTF8,r-ASCII] () (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
-
--- 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)
-
diff --git a/src/Data/TypedEncoding/Combinators/Restriction/Common.hs b/src/Data/TypedEncoding/Combinators/Restriction/Common.hs
deleted file mode 100644
index f163902..0000000
--- a/src/Data/TypedEncoding/Combinators/Restriction/Common.hs
+++ /dev/null
@@ -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
diff --git a/src/Data/TypedEncoding/Combinators/ToEncStr.hs b/src/Data/TypedEncoding/Combinators/ToEncStr.hs
new file mode 100644
index 0000000..9987a4f
--- /dev/null
+++ b/src/Data/TypedEncoding/Combinators/ToEncStr.hs
@@ -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
diff --git a/src/Data/TypedEncoding/Combinators/Unsafe.hs b/src/Data/TypedEncoding/Combinators/Unsafe.hs
new file mode 100644
index 0000000..33756ad
--- /dev/null
+++ b/src/Data/TypedEncoding/Combinators/Unsafe.hs
@@ -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)
diff --git a/src/Data/TypedEncoding/Combinators/Validate.hs b/src/Data/TypedEncoding/Combinators/Validate.hs
new file mode 100644
index 0000000..f599efa
--- /dev/null
+++ b/src/Data/TypedEncoding/Combinators/Validate.hs
@@ -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
+
+
+--------------------------------------------
diff --git a/src/Data/TypedEncoding/Common/Class.hs b/src/Data/TypedEncoding/Common/Class.hs
new file mode 100644
index 0000000..2fd4365
--- /dev/null
+++ b/src/Data/TypedEncoding/Common/Class.hs
@@ -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
diff --git a/src/Data/TypedEncoding/Common/Class/Decode.hs b/src/Data/TypedEncoding/Common/Class/Decode.hs
new file mode 100644
index 0000000..de2e780
--- /dev/null
+++ b/src/Data/TypedEncoding/Common/Class/Decode.hs
@@ -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)
diff --git a/src/Data/TypedEncoding/Common/Class/Encode.hs b/src/Data/TypedEncoding/Common/Class/Encode.hs
new file mode 100644
index 0000000..eb5592c
--- /dev/null
+++ b/src/Data/TypedEncoding/Common/Class/Encode.hs
@@ -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
+
+
+
+
diff --git a/src/Data/TypedEncoding/Internal/Class/IsStringR.hs b/src/Data/TypedEncoding/Common/Class/IsStringR.hs
index dfd1231..9a4992c 100644
--- a/src/Data/TypedEncoding/Internal/Class/IsStringR.hs
+++ b/src/Data/TypedEncoding/Common/Class/IsStringR.hs
@@ -5,14 +5,13 @@
{-# 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
+-- | 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.ByteString.Char8 as B
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
@@ -25,7 +24,7 @@ import qualified Data.Text.Lazy as TL
-- >>> 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"
+-- "Data.TypedEncoding.Common.Class.Util.StringConstraints"
--
-- Reverses 'Data.String.IsString'
--
diff --git a/src/Data/TypedEncoding/Common/Class/Superset.hs b/src/Data/TypedEncoding/Common/Class/Superset.hs
new file mode 100644
index 0000000..1760270
--- /dev/null
+++ b/src/Data/TypedEncoding/Common/Class/Superset.hs
@@ -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)
+
diff --git a/src/Data/TypedEncoding/Internal/Class/Util.hs b/src/Data/TypedEncoding/Common/Class/Util.hs
index a168bee..a3ec22c 100644
--- a/src/Data/TypedEncoding/Internal/Class/Util.hs
+++ b/src/Data/TypedEncoding/Common/Class/Util.hs
@@ -11,9 +11,9 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
-module Data.TypedEncoding.Internal.Class.Util where
+module Data.TypedEncoding.Common.Class.Util where
-import Data.TypedEncoding.Internal.Types.Common
+import Data.TypedEncoding.Common.Types.Common
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as BL
@@ -50,9 +50,6 @@ symbolVals_ _ = symbolVals @xs
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 ++ "]"
@@ -63,11 +60,9 @@ instance Displ TL.Text where
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 x = "(ByteString " ++ BL.unpack x ++ ")"
+instance Displ String where
+ displ x = "(String " ++ x ++ ")"
diff --git a/src/Data/TypedEncoding/Internal/Class/Util/StringConstraints.hs b/src/Data/TypedEncoding/Common/Class/Util/StringConstraints.hs
index 503c933..9a49faa 100644
--- a/src/Data/TypedEncoding/Internal/Class/Util/StringConstraints.hs
+++ b/src/Data/TypedEncoding/Common/Class/Util/StringConstraints.hs
@@ -10,9 +10,10 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
--- | Future replacement for "Data.TypedEncoding.Internal.Class.IsStringR"
-module Data.TypedEncoding.Internal.Class.Util.StringConstraints () where
+-- | 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
@@ -101,14 +102,16 @@ 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
+class Char8Find str where
find :: (Char -> Bool) -> str -> Maybe Char
+instance Char8Find String where
+ find = L.find
-instance Char7Find T.Text where
+instance Char8Find T.Text where
find = T.find
-instance Char7Find TL.Text where
+instance Char8Find TL.Text where
find = TL.find
-- |
@@ -125,10 +128,9 @@ instance Char7Find TL.Text where
--
-- 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
+-- Safe if restricting to 7bit code points.
+instance Char8Find B.ByteString where
find = B8.find
-instance Char7Find BL.ByteString where
+instance Char8Find BL.ByteString where
find = BL8.find \ No newline at end of file
diff --git a/src/Data/TypedEncoding/Common/Class/Validate.hs b/src/Data/TypedEncoding/Common/Class/Validate.hs
new file mode 100644
index 0000000..515666f
--- /dev/null
+++ b/src/Data/TypedEncoding/Common/Class/Validate.hs
@@ -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)
diff --git a/src/Data/TypedEncoding/Common/Types.hs b/src/Data/TypedEncoding/Common/Types.hs
new file mode 100644
index 0000000..e8a80c2
--- /dev/null
+++ b/src/Data/TypedEncoding/Common/Types.hs
@@ -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
+
diff --git a/src/Data/TypedEncoding/Internal/Types/CheckedEnc.hs b/src/Data/TypedEncoding/Common/Types/CheckedEnc.hs
index 68854f2..e9fc663 100644
--- a/src/Data/TypedEncoding/Internal/Types/CheckedEnc.hs
+++ b/src/Data/TypedEncoding/Common/Types/CheckedEnc.hs
@@ -12,16 +12,17 @@
-- |
-- Module defines 'CheckedEnc' - untyped ADT version of 'Enc'
-module Data.TypedEncoding.Internal.Types.CheckedEnc where
+module Data.TypedEncoding.Common.Types.CheckedEnc where
-import Data.TypedEncoding.Internal.Types.Enc
-import Data.TypedEncoding.Internal.Types.Common
-import Data.TypedEncoding.Internal.Class.Util
+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
@@ -31,37 +32,37 @@ import Data.Proxy
-- | Represents some validated encoded string.
--
--- @CheckedEnc@ is untyped version of 'Data.TypedEncoding.Internal.Types.Enc.Enc'.
+-- @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 = MkCheckedEnc [EncAnn] conf str
+data CheckedEnc conf str = UnsafeMkCheckedEnc [EncAnn] conf str
deriving (Show, Eq)
unsafeCheckedEnc:: [EncAnn] -> c -> s -> CheckedEnc c s
-unsafeCheckedEnc = MkCheckedEnc
+unsafeCheckedEnc = UnsafeMkCheckedEnc
getCheckedPayload :: CheckedEnc conf str -> str
getCheckedPayload = snd . getCheckedEncPayload
getCheckedEncPayload :: CheckedEnc conf str -> ([EncAnn], str)
-getCheckedEncPayload (MkCheckedEnc t _ s) = (t,s)
+getCheckedEncPayload (UnsafeMkCheckedEnc 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
+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 (MkCheckedEnc xs c s) =
+fromCheckedEnc (UnsafeMkCheckedEnc xs c s) =
let p = Proxy :: Proxy xs
in if symbolVals @ xs == xs
- then Just $ MkEnc p c s
+ then Just $ UnsafeMkEnc p c s
else Nothing
------------------------
-- |
--- >>> let encsometest = MkCheckedEnc ["TEST"] () $ T.pack "hello"
+-- >>> let encsometest = UnsafeMkCheckedEnc ["TEST"] () $ T.pack "hello"
-- >>> proc_toCheckedEncFromCheckedEnc @'["TEST"] encsometest
-- True
-- >>> proc_toCheckedEncFromCheckedEnc @'["TEST1"] encsometest
@@ -78,8 +79,8 @@ proc_fromCheckedEncToCheckedEnc x = (== Just x) . fromCheckedEnc . toCheckedEnc
-- |
-- >>> displ $ unsafeCheckedEnc ["TEST"] () ("hello" :: T.Text)
--- "MkCheckedEnc [TEST] () (Text hello)"
+-- "UnsafeMkCheckedEnc [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
+ displ (UnsafeMkCheckedEnc xs c s) =
+ "UnsafeMkCheckedEnc " ++ displ xs ++ " " ++ show c ++ " " ++ displ s
diff --git a/src/Data/TypedEncoding/Common/Types/Common.hs b/src/Data/TypedEncoding/Common/Types/Common.hs
new file mode 100644
index 0000000..45097f2
--- /dev/null
+++ b/src/Data/TypedEncoding/Common/Types/Common.hs
@@ -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
+
diff --git a/src/Data/TypedEncoding/Common/Types/Decoding.hs b/src/Data/TypedEncoding/Common/Types/Decoding.hs
new file mode 100644
index 0000000..f609790
--- /dev/null
+++ b/src/Data/TypedEncoding/Common/Types/Decoding.hs
@@ -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) \ No newline at end of file
diff --git a/src/Data/TypedEncoding/Common/Types/Enc.hs b/src/Data/TypedEncoding/Common/Types/Enc.hs
new file mode 100644
index 0000000..5baf8b8
--- /dev/null
+++ b/src/Data/TypedEncoding/Common/Types/Enc.hs
@@ -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) \ No newline at end of file
diff --git a/src/Data/TypedEncoding/Internal/Types.hs b/src/Data/TypedEncoding/Common/Types/Exceptions.hs
index a6e9d37..618ace0 100644
--- a/src/Data/TypedEncoding/Internal/Types.hs
+++ b/src/Data/TypedEncoding/Common/Types/Exceptions.hs
@@ -11,27 +11,12 @@
-- |
-- 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
+module Data.TypedEncoding.Common.Types.Exceptions where
+
import Data.Proxy
--- import Data.Functor.Identity
import GHC.TypeLits
--- import Data.TypedEncoding.Internal.Class.Util
+
-- $setup
-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XAllowAmbiguousTypes
@@ -89,19 +74,6 @@ instance Show UnexpectedDecodeEx where
-- * 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)
diff --git a/src/Data/TypedEncoding/Internal/Types/SomeAnnotation.hs b/src/Data/TypedEncoding/Common/Types/SomeAnnotation.hs
index 5c71578..7422142 100644
--- a/src/Data/TypedEncoding/Internal/Types/SomeAnnotation.hs
+++ b/src/Data/TypedEncoding/Common/Types/SomeAnnotation.hs
@@ -7,10 +7,10 @@
{-# LANGUAGE RankNTypes #-}
-- | internally used existential type for taking track of annotations
-module Data.TypedEncoding.Internal.Types.SomeAnnotation where
+module Data.TypedEncoding.Common.Types.SomeAnnotation where
-import Data.TypedEncoding.Internal.Types.Common
-import Data.TypedEncoding.Internal.Class.Util
+import Data.TypedEncoding.Common.Types.Common
+import Data.TypedEncoding.Common.Class.Util
import Data.TypedEncoding.Internal.Util
import Data.Proxy
import GHC.TypeLits
diff --git a/src/Data/TypedEncoding/Internal/Types/SomeEnc.hs b/src/Data/TypedEncoding/Common/Types/SomeEnc.hs
index 11e9ede..9b80c28 100644
--- a/src/Data/TypedEncoding/Internal/Types/SomeEnc.hs
+++ b/src/Data/TypedEncoding/Common/Types/SomeEnc.hs
@@ -13,20 +13,21 @@
-- Module defines 'SomeEnc' - existentially quantified version of @Enc@
-- and basic combinators
-module Data.TypedEncoding.Internal.Types.SomeEnc where
+module Data.TypedEncoding.Common.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
+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 quanitified @Enc@
+-- | Existentially quantified quantified @Enc@
-- effectively isomorphic to 'CheckedEnc'
data SomeEnc conf str where
MkSomeEnc :: SymbolList xs => Enc xs conf str -> SomeEnc conf str
@@ -40,22 +41,22 @@ toSome = MkSomeEnc
-- |
-- >>> let enctest = unsafeSetPayload () "hello" :: Enc '["TEST"] () T.Text
-- >>> someToChecked . MkSomeEnc $ enctest
--- MkCheckedEnc ["TEST"] () "hello"
+-- UnsafeMkCheckedEnc ["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)"
+-- "Some (Enc '[TEST] () (String test))"
checkedToSome :: CheckedEnc conf str -> SomeEnc conf str
-checkedToSome (MkCheckedEnc xs c s) = withSomeAnnotation (someAnnValue xs) (\p -> MkSomeEnc (MkEnc p c s))
+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 (MkEnc '[TEST] () (Text hello))"
+-- "Some (Enc '[TEST] () (Text hello))"
instance (Show c, Displ str) => Displ (SomeEnc c str) where
displ (MkSomeEnc en) =
"Some (" ++ displ en ++ ")"
diff --git a/src/Data/TypedEncoding/Internal/Types/UncheckedEnc.hs b/src/Data/TypedEncoding/Common/Types/UncheckedEnc.hs
index b5793c1..d6859e8 100644
--- a/src/Data/TypedEncoding/Internal/Types/UncheckedEnc.hs
+++ b/src/Data/TypedEncoding/Common/Types/UncheckedEnc.hs
@@ -11,24 +11,25 @@
-- |
-- Internal definition of types
-module Data.TypedEncoding.Internal.Types.UncheckedEnc where
+module Data.TypedEncoding.Common.Types.UncheckedEnc where
import Data.Proxy
-import Data.TypedEncoding.Internal.Class.Util
-import Data.TypedEncoding.Internal.Types.Common
+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 recreate, similar to CheckedEnc only not verified
+-- * UncheckedEnc for validation, similar to CheckedEnc but not verified
-- | Represents some encoded string where encoding was not validated.
--
--- Similar to 'Data.TypedEncoding.Internal.Types.CheckedEnc' but unlike
+-- 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
diff --git a/src/Data/TypedEncoding/Internal/Types/Unsafe.hs b/src/Data/TypedEncoding/Common/Types/Unsafe.hs
index 7435d34..916a021 100644
--- a/src/Data/TypedEncoding/Internal/Types/Unsafe.hs
+++ b/src/Data/TypedEncoding/Common/Types/Unsafe.hs
@@ -4,10 +4,10 @@
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
-module Data.TypedEncoding.Internal.Types.Unsafe where
+module Data.TypedEncoding.Common.Types.Unsafe where
import Data.Proxy
-import Data.TypedEncoding.Internal.Types
+import Data.TypedEncoding.Common.Types
-- | Allows to operate within Enc. These are considered unsafe.
@@ -18,12 +18,12 @@ 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))
+ fmap f (Unsafe (UnsafeMkEnc p c x)) = Unsafe (UnsafeMkEnc 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))
+ pure = Unsafe . UnsafeMkEnc Proxy ()
+ Unsafe (UnsafeMkEnc p c1 f) <*> Unsafe (UnsafeMkEnc _ c2 x) = Unsafe (UnsafeMkEnc p () (f x))
instance Monad (Unsafe enc ()) where
- Unsafe (MkEnc _ _ x) >>= f = f x
+ Unsafe (UnsafeMkEnc _ _ x) >>= f = f x
diff --git a/src/Data/TypedEncoding/Common/Types/Validation.hs b/src/Data/TypedEncoding/Common/Types/Validation.hs
new file mode 100644
index 0000000..81aa627
--- /dev/null
+++ b/src/Data/TypedEncoding/Common/Types/Validation.hs
@@ -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) \ No newline at end of file
diff --git a/src/Data/TypedEncoding/Internal/Util/TypeLits.hs b/src/Data/TypedEncoding/Common/Util/TypeLits.hs
index e4852e4..6e7f117 100644
--- a/src/Data/TypedEncoding/Internal/Util/TypeLits.hs
+++ b/src/Data/TypedEncoding/Common/Util/TypeLits.hs
@@ -21,16 +21,15 @@
--
-- Currently this is spread out in different modules
--
--- * "Data.TypedEncoding.Internal.Class.Util"
--- * "Data.TypedEncoding.Internal.Types.SomeAnnotation"
+-- * "Data.TypedEncoding.Common.Class.Util"
+-- * "Data.TypedEncoding.Common.Types.SomeAnnotation"
--
-- (TODO) these will need to get consolidated.
-module Data.TypedEncoding.Internal.Util.TypeLits where
+module Data.TypedEncoding.Common.Util.TypeLits where
import GHC.TypeLits
--- import Data.Symbol.Utils
import Data.Symbol.Ascii
--- import Data.Proxy
+
-- $setup
-- >>> :set -XScopedTypeVariables -XTypeFamilies -XKindSignatures -XDataKinds
diff --git a/src/Data/TypedEncoding/Conv/ByteString/Char8.hs b/src/Data/TypedEncoding/Conv/ByteString/Char8.hs
index 032fb17..c0caac7 100644
--- a/src/Data/TypedEncoding/Conv/ByteString/Char8.hs
+++ b/src/Data/TypedEncoding/Conv/ByteString/Char8.hs
@@ -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 @@ import Data.TypedEncoding
-- ...
--
-- >>> 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
diff --git a/src/Data/TypedEncoding/Conv/ByteString/Lazy/Char8.hs b/src/Data/TypedEncoding/Conv/ByteString/Lazy/Char8.hs
index 3b83f3e..d486e8f 100644
--- a/src/Data/TypedEncoding/Conv/ByteString/Lazy/Char8.hs
+++ b/src/Data/TypedEncoding/Conv/ByteString/Lazy/Char8.hs
@@ -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
diff --git a/src/Data/TypedEncoding/Conv/Text.hs b/src/Data/TypedEncoding/Conv/Text.hs
index 6cde824..64aea36 100644
--- a/src/Data/TypedEncoding/Conv/Text.hs
+++ b/src/Data/TypedEncoding/Conv/Text.hs
@@ -22,16 +22,23 @@ pack = unsafeChangePayload T.pack
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 \ No newline at end of file
diff --git a/src/Data/TypedEncoding/Conv/Text/Encoding.hs b/src/Data/TypedEncoding/Conv/Text/Encoding.hs
index 2b76ec3..663908d 100644
--- a/src/Data/TypedEncoding/Conv/Text/Encoding.hs
+++ b/src/Data/TypedEncoding/Conv/Text/Encoding.hs
@@ -27,13 +27,14 @@ import Data.TypedEncoding.Unsafe (withUnsafe)
-- >>> 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 @@ import Data.TypedEncoding.Unsafe (withUnsafe)
-- 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 @@ decodeUtf8 = withUnsafe (fmap TE.decodeUtf8)
-- |
-- >>> 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)
diff --git a/src/Data/TypedEncoding/Instances/Do/Sample.hs b/src/Data/TypedEncoding/Instances/Do/Sample.hs
index a683b2a..73391cd 100644
--- a/src/Data/TypedEncoding/Instances/Do/Sample.hs
+++ b/src/Data/TypedEncoding/Instances/Do/Sample.hs
@@ -16,43 +16,51 @@ module Data.TypedEncoding.Instances.Do.Sample 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.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 => 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 => 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-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)
diff --git a/src/Data/TypedEncoding/Instances/Enc/Base64.hs b/src/Data/TypedEncoding/Instances/Enc/Base64.hs
index f7562da..cd5784d 100644
--- a/src/Data/TypedEncoding/Instances/Enc/Base64.hs
+++ b/src/Data/TypedEncoding/Instances/Enc/Base64.hs
@@ -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.Text.Lazy.Encoding as TEL
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 @@ acceptLenientL = withUnsafeCoerce (BL64.encode . BL64.decodeLenient)
--
-- >>> 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"@.
+--
+-- This instance likely to be changed / corrected in the future if @"r-B64"@ is defined.
--
--- 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
+-- >>> 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 Applicative f => Encode f "enc-B64" "enc-B64" c B.ByteString where
+ encoding = encB64B
+
+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
-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 => EncodeF f (Enc xs c B.ByteString) (Enc ("enc-B64" ': xs) c B.ByteString) where
- encodeF = implEncodeP B64.encode
-
--- | Effectful instance for corruption detection.
+-- | 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 (UnexpectedDecodeErr f, Applicative f) => Decode f "enc-B64" "enc-B64" c BL.ByteString where
+ decoding = decB64BL
+
+decB64BL :: (UnexpectedDecodeErr f, Applicative f) => Decoding f "enc-B64" "enc-B64" c BL.ByteString
+decB64BL = _implDecodingF (asUnexpected @"enc-B64" . BL64.decode)
+
+
+-- Kept for now but performance issues
+
+-- | WARNING (performance)
+instance (UnexpectedDecodeErr f, Applicative f) => Decode f "enc-B64" "enc-B64" c T.Text where
+ decoding = decB64T
-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)
+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." #-}
-instance Applicative f => RecreateF f (Enc xs c B.ByteString) (Enc ("enc-B64-len" ': xs) c B.ByteString) where
- checkPrevF = implTranP id
+-- | 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-B64" ': xs) c BL.ByteString) where
- encodeF = implEncodeP BL64.encode
+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 (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)
-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)
+-- * Validation
-instance Applicative f => RecreateF f (Enc xs c BL.ByteString) (Enc ("enc-B64-len" ': xs) c BL.ByteString) where
- checkPrevF = implTranP id
+instance (RecreateErr f, Applicative f) => Validate f "enc-B64" "enc-B64" c B.ByteString where
+ validation = validFromDec decB64B
--- 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
+instance (RecreateErr f, Applicative f) => Validate f "enc-B64" "enc-B64" c BL.ByteString where
+ validation = validFromDec decB64BL
--- 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
+instance (RecreateErr f, Applicative f) => Validate f "enc-B64" "enc-B64" c T.Text where
+ validation = validFromDec decB64T
-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 (RecreateErr f, Applicative f) => Validate f "enc-B64" "enc-B64" c TL.Text where
+ validation = validFromDec decB64TL
-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)
+-- | Lenient decoding does not fail
+instance Applicative f => Validate f "enc-B64-len" "enc-B64-len" c B.ByteString where
+ validation = mkValidation $ implTranP id
-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)
+-- | Lenient decoding does not fail
+instance Applicative f => Validate f "enc-B64-len" "enc-B64-len" c BL.ByteString where
+ validation = mkValidation $ implTranP id
-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 (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) => 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)
diff --git a/src/Data/TypedEncoding/Instances/Restriction/ASCII.hs b/src/Data/TypedEncoding/Instances/Restriction/ASCII.hs
index 9f8eb1f..fcc724b 100644
--- a/src/Data/TypedEncoding/Instances/Restriction/ASCII.hs
+++ b/src/Data/TypedEncoding/Instances/Restriction/ASCII.hs
@@ -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.TypedEncoding.Common.Class.Util.StringConstraints
-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.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 @@ import Control.Arrow
-----------------
--- Conversions --
+-- Encodings --
-----------------
--- |
--- 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.
+newtype NonAsciiChar = NonAsciiChar Char deriving (Eq, Show)
-byteString2TextS :: Enc ("r-ASCII" ': ys) c B.ByteString -> Enc ("r-ASCII" ': ys) c T.Text
-byteString2TextS = withUnsafe (fmap TE.decodeUtf8)
+-- * Encoding
--- |
--- 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)
+instance Encode (Either EncodeEx) "r-ASCII" "r-ASCII" c Char where
+ encoding = encASCIIChar
--- |
--- 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)
+instance Char8Find str => Encode (Either EncodeEx) "r-ASCII" "r-ASCII" c str where
+ encoding = encASCII
+encASCIIChar :: Encoding (Either EncodeEx) "r-ASCII" "r-ASCII" c Char
+encASCIIChar = _implEncodingEx (\c -> explainBool NonAsciiChar (c, isAscii c))
--- | 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
+encASCII :: Char8Find str => Encoding (Either EncodeEx) "r-ASCII" "r-ASCII" c str
+encASCII = _implEncodingEx @"r-ASCII" encImpl
--- type instance IsSuperset "r-UTF8" "r-ASCII" = True
--- type instance IsSuperset "r-ASCII" "r-ASCII" = True
+encImpl :: Char8Find str => str -> Either NonAsciiChar str
+encImpl str = case find (not . isAscii) str of
+ Nothing -> Right str
+ Just ch -> Left $ NonAsciiChar ch
------------------
--- Encodings --
------------------
+-- * Decoding
-newtype NonAsciiChar = NonAsciiChar Char deriving (Eq, Show)
+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
-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
-
-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 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 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"
-
-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
-
-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"
-
-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
-
-
-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)
diff --git a/src/Data/TypedEncoding/Combinators/Restriction/Bool.hs b/src/Data/TypedEncoding/Instances/Restriction/Bool.hs
index e82aa38..442af0d 100644
--- a/src/Data/TypedEncoding/Combinators/Restriction/Bool.hs
+++ b/src/Data/TypedEncoding/Instances/Restriction/Bool.hs
@@ -8,12 +8,15 @@
{-# 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
@@ -23,16 +26,9 @@
-- 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'.
+-- Expected behavior is described next to the corresponding combinator.
--- This is very much in beta state.
---
-module Data.TypedEncoding.Combinators.Restriction.Bool where
+module Data.TypedEncoding.Instances.Restriction.Bool where
import GHC.TypeLits
@@ -41,17 +37,14 @@ 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 Data.TypedEncoding.Instances.Support.Unsafe
--- 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()
+-- >>> import Data.TypedEncoding.Instances.Restriction.Misc()
-- |
@@ -71,9 +64,18 @@ encBoolOrLeft' :: forall f s t xs c str . (
-- IsBoolOr s ~ 'True
, Functor f
, LeftTerm s ~ t
- , EncodeF f (Enc xs c str) (Enc (t ': xs) c str)
+ , 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 @f @(Enc xs c str) @(Enc (t ': xs) c str))
+encBoolOrLeft'' = encBoolOrLeft (encodeF' @alg @t @xs @f)
-- |
--
@@ -94,10 +96,10 @@ encBoolOrRight = implChangeAnn
-- :}
--
-- >>> tst1
--- Right (MkEnc Proxy () "212")
+-- Right (UnsafeMkEnc Proxy () "212")
--
-- >>> tst2
--- Right (MkEnc Proxy () "1000000")
+-- Right (UnsafeMkEnc Proxy () "1000000")
--
-- >>> tst3
-- Left (EncodeEx "r-Word8-decimal" ("Payload does not satisfy format Word8-decimal: 1000000"))
@@ -106,9 +108,18 @@ encBoolOrRight' :: forall f s t xs c str . (
-- IsBoolOr s ~ 'True
, Functor f
, RightTerm s ~ t
- , EncodeF f (Enc xs c str) (Enc (t ': xs) c str)
+ , Encode f t t 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))
+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
@@ -146,35 +157,44 @@ encBoolAnd fnl fnr en0 =
-- :}
--
-- >>> tst1
--- Right (MkEnc Proxy () "234")
+-- Right (UnsafeMkEnc 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 . (
+encBoolAnd' :: forall 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))
+ , 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 f s t xs c str . (
+encBoolNot :: forall 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)
+ , 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
@@ -194,19 +214,27 @@ encBoolNot fn en0 =
-- :}
--
-- >>> tst1
--- Right (MkEnc Proxy () "334")
+-- Right (UnsafeMkEnc Proxy () "334")
-- >>> tst2
-- Left (EncodeEx "boolNot:(r-Word8-decimal)" ("Encoding r-Word8-decimal succeeded"))
-encBoolNot' :: forall f s t xs c str . (
+encBoolNot' :: forall 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))
+ , 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-"@
@@ -217,11 +245,17 @@ decBoolR :: forall f xs t s 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
-- |
diff --git a/src/Data/TypedEncoding/Combinators/Restriction/BoundedAlphaNums.hs b/src/Data/TypedEncoding/Instances/Restriction/BoundedAlphaNums.hs
index 4932264..498ce91 100644
--- a/src/Data/TypedEncoding/Combinators/Restriction/BoundedAlphaNums.hs
+++ b/src/Data/TypedEncoding/Instances/Restriction/BoundedAlphaNums.hs
@@ -10,6 +10,7 @@
-- {-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ConstraintKinds #-}
-- |
-- Restrictions @"r-ban:"@ cover commonly used fixed (short) size strings with restricted
@@ -25,16 +26,9 @@
-- 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
+module Data.TypedEncoding.Instances.Restriction.BoundedAlphaNums where
import GHC.TypeLits
@@ -43,42 +37,58 @@ import Data.Char
import Data.Proxy
import Data.Either
-import Data.TypedEncoding.Internal.Util.TypeLits
-import Data.TypedEncoding.Internal.Class.IsStringR
+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.Combinators.Restriction.Common
+-- >>> 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 (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
+
+instance (Ban s, Algorithm s "r-ban", IsStringR str) => Encode (Either EncodeEx) s "r-ban" c str where
+ encoding = encFBan
+
-- |
--- >>> 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")
+-- >>> 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")
--
--- >>> 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 .
+-- >>> 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
- , KnownSymbol s
- , IsBan s ~ 'True
- , f ~ Either EncodeEx
+ , Ban s
+ , Algorithm s "r-ban"
) =>
- Enc xs c str -> f (Enc (s ': xs) c str)
-encFBan = implEncodeF @s (verifyBoundedAlphaNum (Proxy :: Proxy s))
+ 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
--- TODO v0.3 remove f from forall in encFBan (slightly breaking chanage)
+-- * Implementation
-- |
-- >>> verifyBoundedAlphaNum (Proxy :: Proxy "r-ban:FF-FF") (T.pack "12-3E")
@@ -89,7 +99,7 @@ encFBan = implEncodeF @s (verifyBoundedAlphaNum (Proxy :: Proxy s))
-- 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 :: forall s str . (KnownSymbol s, IsStringR str) => Proxy s -> str -> Either String str
verifyBoundedAlphaNum p str =
if pattl == inpl
then case lefts match of
diff --git a/src/Data/TypedEncoding/Instances/Restriction/Common.hs b/src/Data/TypedEncoding/Instances/Restriction/Common.hs
deleted file mode 100644
index dbd4723..0000000
--- a/src/Data/TypedEncoding/Instances/Restriction/Common.hs
+++ /dev/null
@@ -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)
diff --git a/src/Data/TypedEncoding/Instances/Restriction/Misc.hs b/src/Data/TypedEncoding/Instances/Restriction/Misc.hs
new file mode 100644
index 0000000..87348ec
--- /dev/null
+++ b/src/Data/TypedEncoding/Instances/Restriction/Misc.hs
@@ -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
diff --git a/src/Data/TypedEncoding/Instances/Restriction/UTF8.hs b/src/Data/TypedEncoding/Instances/Restriction/UTF8.hs
index ad840de..2d9bd03 100644
--- a/src/Data/TypedEncoding/Instances/Restriction/UTF8.hs
+++ b/src/Data/TypedEncoding/Instances/Restriction/UTF8.hs
@@ -16,82 +16,30 @@ module Data.TypedEncoding.Instances.Restriction.UTF8 where
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 --
@@ -99,12 +47,12 @@ byteString2TextL = withUnsafeCoerce TEL.decodeUtf8
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 @@ prxyUtf8 = Proxy :: Proxy "r-UTF8"
-- 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 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 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"
+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." #-}
+-- * Decoding
-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
+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 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"
+instance (RecreateErr f, Applicative f) => Validate f "r-UTF8" "r-UTF8" c BL.ByteString where
+ validation = validR encUTF8BL
-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
--- Utilities ---
diff --git a/src/Data/TypedEncoding/Instances/Support.hs b/src/Data/TypedEncoding/Instances/Support.hs
index bf233e2..a819ed4 100644
--- a/src/Data/TypedEncoding/Instances/Support.hs
+++ b/src/Data/TypedEncoding/Instances/Support.hs
@@ -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
+
diff --git a/src/Data/TypedEncoding/Instances/Support/Common.hs b/src/Data/TypedEncoding/Instances/Support/Common.hs
new file mode 100644
index 0000000..637a2b5
--- /dev/null
+++ b/src/Data/TypedEncoding/Instances/Support/Common.hs
@@ -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
+
diff --git a/src/Data/TypedEncoding/Instances/Support/Decode.hs b/src/Data/TypedEncoding/Instances/Support/Decode.hs
new file mode 100644
index 0000000..edaece9
--- /dev/null
+++ b/src/Data/TypedEncoding/Instances/Support/Decode.hs
@@ -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
+
+
+
diff --git a/src/Data/TypedEncoding/Instances/Support/Encode.hs b/src/Data/TypedEncoding/Instances/Support/Encode.hs
new file mode 100644
index 0000000..43212d6
--- /dev/null
+++ b/src/Data/TypedEncoding/Instances/Support/Encode.hs
@@ -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
+
+
diff --git a/src/Data/TypedEncoding/Internal/Instances/Combinators.hs b/src/Data/TypedEncoding/Instances/Support/Helpers.hs
index 56a633d..8997eae 100644
--- a/src/Data/TypedEncoding/Internal/Instances/Combinators.hs
+++ b/src/Data/TypedEncoding/Instances/Support/Helpers.hs
@@ -8,16 +8,19 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
--- | Combinators that can be helpful in instance creation.
-module Data.TypedEncoding.Internal.Instances.Combinators where
+-- | 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.Internal.Types
-import Data.TypedEncoding.Internal.Class.IsStringR
+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
@@ -58,14 +61,14 @@ 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)
+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 (MkCheckedEnc ann1 c s1) = map (\(ann2, s2) -> MkCheckedEnc ann2 c s2) (f ann1 s1)
+splitSomePayload f (UnsafeMkCheckedEnc ann1 c s1) = map (\(ann2, s2) -> UnsafeMkCheckedEnc ann2 c s2) (f ann1 s1)
-- * Utility combinators
@@ -90,7 +93,7 @@ verifyWithRead msg x =
else Left $ "Payload does not satisfy format " ++ msg ++ ": " ++ s
--- | Convenience function for checking if @str@ decodes properly
+-- | 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) =>
@@ -105,3 +108,5 @@ verifyDynEnc p findenc decoder str =
case decoder enc str of
Left err -> Left $ EncodeEx p err
Right r -> Right str
+
+
diff --git a/src/Data/TypedEncoding/Instances/Support/Unsafe.hs b/src/Data/TypedEncoding/Instances/Support/Unsafe.hs
new file mode 100644
index 0000000..27ea163
--- /dev/null
+++ b/src/Data/TypedEncoding/Instances/Support/Unsafe.hs
@@ -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
+
diff --git a/src/Data/TypedEncoding/Instances/Support/Validate.hs b/src/Data/TypedEncoding/Instances/Support/Validate.hs
new file mode 100644
index 0000000..0f4ab39
--- /dev/null
+++ b/src/Data/TypedEncoding/Instances/Support/Validate.hs
@@ -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
+
+
+
+
diff --git a/src/Data/TypedEncoding/Instances/ToEncString/Common.hs b/src/Data/TypedEncoding/Instances/ToEncString/Common.hs
deleted file mode 100644
index e2cde51..0000000
--- a/src/Data/TypedEncoding/Instances/ToEncString/Common.hs
+++ /dev/null
@@ -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
diff --git a/src/Data/TypedEncoding/Internal/Class.hs b/src/Data/TypedEncoding/Internal/Class.hs
deleted file mode 100644
index f3c9219..0000000
--- a/src/Data/TypedEncoding/Internal/Class.hs
+++ /dev/null
@@ -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
diff --git a/src/Data/TypedEncoding/Internal/Class/Decode.hs b/src/Data/TypedEncoding/Internal/Class/Decode.hs
deleted file mode 100644
index f9777cb..0000000
--- a/src/Data/TypedEncoding/Internal/Class/Decode.hs
+++ /dev/null
@@ -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)
diff --git a/src/Data/TypedEncoding/Internal/Class/Encode.hs b/src/Data/TypedEncoding/Internal/Class/Encode.hs
deleted file mode 100644
index 19a5480..0000000
--- a/src/Data/TypedEncoding/Internal/Class/Encode.hs
+++ /dev/null
@@ -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)
-
diff --git a/src/Data/TypedEncoding/Internal/Class/Encoder.hs b/src/Data/TypedEncoding/Internal/Class/Encoder.hs
deleted file mode 100644
index 07a5b4f..0000000
--- a/src/Data/TypedEncoding/Internal/Class/Encoder.hs
+++ /dev/null
@@ -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
diff --git a/src/Data/TypedEncoding/Internal/Class/Recreate.hs b/src/Data/TypedEncoding/Internal/Class/Recreate.hs
deleted file mode 100644
index 7a82935..0000000
--- a/src/Data/TypedEncoding/Internal/Class/Recreate.hs
+++ /dev/null
@@ -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)
diff --git a/src/Data/TypedEncoding/Internal/Combinators.hs b/src/Data/TypedEncoding/Internal/Combinators.hs
deleted file mode 100644
index 61da781..0000000
--- a/src/Data/TypedEncoding/Internal/Combinators.hs
+++ /dev/null
@@ -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
-
-
diff --git a/src/Data/TypedEncoding/Internal/Types/Common.hs b/src/Data/TypedEncoding/Internal/Types/Common.hs
deleted file mode 100644
index 091f6ae..0000000
--- a/src/Data/TypedEncoding/Internal/Types/Common.hs
+++ /dev/null
@@ -1,4 +0,0 @@
-module Data.TypedEncoding.Internal.Types.Common where
-
--- | Represents value level (single) annotation.
-type EncAnn = String
diff --git a/src/Data/TypedEncoding/Internal/Types/Enc.hs b/src/Data/TypedEncoding/Internal/Types/Enc.hs
deleted file mode 100644
index 3f6e048..0000000
--- a/src/Data/TypedEncoding/Internal/Types/Enc.hs
+++ /dev/null
@@ -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)
diff --git a/src/Data/TypedEncoding/Unsafe.hs b/src/Data/TypedEncoding/Unsafe.hs
index d237356..5a2c098 100644
--- a/src/Data/TypedEncoding/Unsafe.hs
+++ b/src/Data/TypedEncoding/Unsafe.hs
@@ -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
diff --git a/src/Examples/TypedEncoding/Conversions.hs b/src/Examples/TypedEncoding/Conversions.hs
index 2fd2d0f..41894b2 100644
--- a/src/Examples/TypedEncoding/Conversions.hs
+++ b/src/Examples/TypedEncoding/Conversions.hs
@@ -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 qualified Data.ByteString as B
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 @@ eHelloAsciiB = encodeFAll . toEncoding () $ "HeLlo world"
-- ^ 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 @@ Right helloAsciiB = eHelloAsciiB
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 @@ helloZero = toEncoding () "Hello"
-- ^ 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 @@ helloZero = toEncoding () "Hello"
--
-- @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 @@ helloRestricted = fmap EncB8.pack . runEncoder @'["r-ban"] encodings $ toEncodin
-- @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 @@ helloUtf8B64T = EncT.utf8Demote . EncTe.decodeUtf8 $ helloUtf8B64B
-- 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 = encodeAll . toEncoding () $ "\195\177"
-- ^ '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 @@ notTextB = encodeAll . toEncoding () $ "\195\177"
-- 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 @@ lenientSomething = recreateAll . toEncoding () $ "abc==CB"
-- '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
diff --git a/src/Examples/TypedEncoding/DiySignEncoding.hs b/src/Examples/TypedEncoding/DiySignEncoding.hs
index 5c2fc27..9edba0f 100644
--- a/src/Examples/TypedEncoding/DiySignEncoding.hs
+++ b/src/Examples/TypedEncoding/DiySignEncoding.hs
@@ -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 @@ decodeSign t =
-- | Encoded hello world example.
--
-- >>> helloSigned
--- MkEnc Proxy () "11:Hello World"
+-- UnsafeMkEnc Proxy () "11:Hello World"
--
-- >>> fromEncoding . decodeAll $ helloSigned
-- "Hello World"
@@ -99,23 +99,27 @@ hacker =
-- 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
+
diff --git a/src/Examples/TypedEncoding/Overview.hs b/src/Examples/TypedEncoding/Overview.hs
index 641bfe8..65135c6 100644
--- a/src/Examples/TypedEncoding/Overview.hs
+++ b/src/Examples/TypedEncoding/Overview.hs
@@ -32,6 +32,7 @@ import qualified Data.Text as T
-- $setup
-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XTypeApplications
+-- >>> import Data.Functor.Identity
--
-- This module contains some ghci friendly values to play with.
--
@@ -43,23 +44,38 @@ import qualified Data.Text as T
-- | "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 @@ helloB64Decoded = fromEncoding . decodeAll $ helloB64
-- 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 @@ helloB64Decoded = fromEncoding . decodeAll $ helloB64
-- 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 @@ helloB64B64RecoveredErr = recreateFAll . toEncoding () $ "SGVsbG8gV29ybGQ="
-- 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 @@ helloTitle = encodeAll . toEncoding exampleConf $ "hello wOrld"
-- 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 @@ helloRevLimitParDec = decodePart @'["enc-B64"] helloLimitB64
-- 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 @@ helloAscii = encodeFAll . toEncoding () $ "HeLlo world"
-- 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
diff --git a/src/Examples/TypedEncoding/ToEncString.hs b/src/Examples/TypedEncoding/ToEncString.hs
index 90c57aa..80d99da 100644
--- a/src/Examples/TypedEncoding/ToEncString.hs
+++ b/src/Examples/TypedEncoding/ToEncString.hs
@@ -36,8 +36,7 @@ module Examples.TypedEncoding.ToEncString where
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 @@ tstIp = IpV4F 128 1 1 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 @@ tstIp = IpV4F 128 1 1 10
-- >>> 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 @@ tstIp = IpV4F 128 1 1 10
-- @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 @@ instance ToEncString "r-IPv4" T.Text Identity IpV4 where
-- |
--
--- >>> 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 @@ tstEmail = SimplifiedEmailF {
--
-- 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 @@ recreateEncoding = mapM encodefn
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 @@ recreateEncoding = mapM encodefn
-- (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 @@ recreateEncoding = mapM encodefn
--
-- >>> 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 @@ recreateEncoding = mapM encodefn
-- 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])
diff --git a/src/Examples/TypedEncoding/Unsafe.hs b/src/Examples/TypedEncoding/Unsafe.hs
index 3fadb85..e77af5d 100644
--- a/src/Examples/TypedEncoding/Unsafe.hs
+++ b/src/Examples/TypedEncoding/Unsafe.hs
@@ -41,7 +41,7 @@ Right exAsciiT = exAsciiTE
-- >>> 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 @@ modifiedAsciiT = recreateFAll . toEncoding () . ( <> " some extra stuff") . get
-- 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 @@ toLowerAscii = Unsafe.withUnsafe (fmap T.toLower) <$> exAsciiTE
-- >>> 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
diff --git a/test/Test/Bc/ASCIISpec.hs b/test/Test/Bc/ASCIISpec.hs
new file mode 100644
index 0000000..0361391
--- /dev/null
+++ b/test/Test/Bc/ASCIISpec.hs
@@ -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 \ No newline at end of file
diff --git a/test/Test/Bc/IsStringRSpec.hs b/test/Test/Bc/IsStringRSpec.hs
index 61241a1..32a31da 100644
--- a/test/Test/Bc/IsStringRSpec.hs
+++ b/test/Test/Bc/IsStringRSpec.hs
@@ -29,9 +29,8 @@ import Test.Hspec
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 @@ spec =
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
diff --git a/typed-encoding.cabal b/typed-encoding.cabal
index a70b243..dddb819 100644
--- a/typed-encoding.cabal
+++ b/typed-encoding.cabal
@@ -4,10 +4,10 @@ cabal-version: 1.12
--
-- 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 @@ source-repository head
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 @@ library
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 @@ test-suite typed-encoding-test
main-is: Spec.hs
other-modules:
Test.Bc.IsStringRSpec
+ Test.Bc.ASCIISpec
hs-source-dirs:
test
ghc-options: -threaded -rtsopts -with-rtsopts=-N