diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,12 +2,73 @@ ## Anticipated future breaking changes -- `Data.TypedEncoding.Instances.Do.Sample` will be moved to `Examples` -- `HasA` Typeclass will be moved to `Examples` - `Data.TypedEncoding.Common.Class.IsStringR` expected to be be changed / replaced -- More module renaming to separate internal implementation code and code targeting examples -- (post 0.5) "enc-B64" will be moved to a different package (more distant goal) +- (post 0.5) "enc-B64" could be moved to a different package (more distant goal) + +## 0.5.2.3 +- compile with ghc 9.4.7 / lts-21.14 +## 0.5.2.2 + +- `instance UnexpectedDecodeErr Identity` does not use `fail` to allow for base >= 4.9 compilation +## 0.5.2.1 + +- documentation improvements +## 0.5.2.0 + +- Fixed up IsSuperset type family improving transitivity +- added `_mkEncoding1` `runEncoding1'` functions that show equivalence of `Encoding` to one level encoding +- added convenience one level encoding conversion functions +- base64-bytestring deps relaxed + +## 0.5.1.0 + +- "r-B64" added +- @implVerifyR@ convenience function added to 'Data.TypedEncoding.Instances.Support.Encode' + +## 0.5.0 + +### Changes on a high level + +- Most of the changes should not create a big impact on upgrading. Many definitions were moved to a different module but these modules are and had been re-exported by either `Data.TypedEncoding` or +`Data.TypedEncoding.Instances.Support` +- Some functionality has been moved to Examples or removed, notably: + - "do-" encodings + - `SomeEnc`, `SomeAnnotation` + - `HasA` typeclass +- Some functions have been renamed or type signatures adjusted to follow consistent naming conventions. In most cases the changes have been made on previously deprecated definitions. + + +### Details + +- Data.TypedEncoding.Instances.Do.Sample moved to Examples +- Examples.TypedEncoding folder re-org +- `Data.TypedEncoding.Instances.Support.Helpers` removed `foldEncStr`, `foldCheckedEncStr` + renamed `splitSomePayload` to `splitCheckedPayload` +- `HasA` typeclass moved to Examples +- removed experimental `Data.TypedEncoding.Instances.Restriction.Bool` in favor of combinator helpers + `Data.TypedEncoding.Instances.Support.Bool` +- `Data.TypedEncoding.Common.Types.SomeEnc` moved to Examples +- `Data.TypedEncoding.Common.Types.SomeAnnotation` moved to Examples +- camel-case of some property names +- Text instances for "Base64" moved to `Data.TypedEncoding.Instances.Enc.Warn.Base64` +- Removed instanced for `"r-()"` encoding +- Functions from `Data.TypedEncoding.Instances.Support.Common` moved to `Data.TypedEncoding.Instances.Support.Decode` +- Signature changed in previously deprecated function `runDecoding` to match `mn ~ alg` convention and deprecation removed +- Signature changed in previously deprecated function `runDecodings` to match `mns ~ algs` convention and deprecation removed +- Signature changed in previously deprecated function `runValidation` to match `mns ~ algs` convention and deprecation removed +- `runValidationChecks` renamed to `runValidationChecks'` to match /typed-encoding/ naming conventions. +- removed deprecated `propEncodesInto'` +- moved `Append` type family from from `Data.TypedEncoding.Common.Class.Util` to `Data.TypedEncoding.Common.Util.TypeLits` +- `Data.TypedEncoding.Common.Class.Util` renamed to `Data.TypedEncoding.Common.Class.Common` +- function `extractEither` removed from `Data.TypedEncoding.Internal.Util` +- function `withSomeSymbol` moved to `Data.TypedEncoding.Common.Util.TypeLits` +- function `proxyCons` moved to `Data.TypedEncoding.Common.Util.TypeLits` + +- More general instances for some encodings in `Data.TypedEncoding.Instances.Restriction.Misc` +- `mkDecoding` deprecated in favor of `_mkDecoding` to follow the naming convention +- `mkValidation` deprecated in favor of `_mkValidation` to follow the naming convention +- `validR'` function renamed to `_validR` ## 0.4.2 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -9,16 +9,16 @@ ```Haskell -- some data encoded in base 64 -mydata :: Enc '["enc-B64"] ByteString +mydata :: Enc '["enc-B64"] c ByteString -- some text (utf8) data encoded in base 64 -myData :: Enc '["enc-B64", "r-UTF8"] ByteString +myData :: Enc '["enc-B64", "r-UTF8"] c ByteString ``` It allows to define precise string content annotations like: ```Haskell -ipaddr :: Enc '["r-IpV4"] Text +ipaddr :: Enc '["r-IpV4"] c Text ``` and provides ways for @@ -30,6 +30,9 @@ - converting types to encoded strings - typesafe conversion of encoded strings to types +Partial and dangerous things like `decodeUtf8` are no longer dangerous, +`ByteString` `Text` conversions become fully reversible. Life is good! + ... but this approach seems to be a bit more... ```Haskell @@ -45,19 +48,30 @@ - used with parameters - applied or undone partially (if encoding is reversible) -One of more interesting uses of this library are encoding restrictions. -(Arbitrary) bounded alpha-numeric (`"r-ban"`) restrictions -and a simple annotation Boolean algebra are both provided. +One of more interesting uses of this library are encoding restrictions included in this library. +Example are (arbitrary) bounded alpha-numeric (`"r-ban"`) restrictions. ```Haskell -phone :: Enc '["r-ban:999-999-9999"] () T.Text -phone = ... +-- allow only properly formatted phone numbers --- simple boolean algebra: -phone' :: Enc '["boolOr:(r-ban:999-999-9999)(r-ban:(999) 999-9999)"] () T.Text -phone' = ... +type PhoneSymbol = "r-ban:999-999-9999" +phone :: Enc '[PhoneSymbol] () T.Text +phone = ... ``` +The author often uses _typed-encoding_ with _Servant_ (`HttpApiData` instances are not included), e.g.: + +```Haskell +type LookupByPhone = + "customer" + :> "byphone" + :> Capture "phone" (Enc '[PhoneSymbol] () T.Text) + :> Get '[JSON] ([Customer]) +``` + +or to get type safety over text document using Unix vs Windows line breaks! + + ## Goals and limitations The main goal is to provide improved type safety for programs that use string encodings and @@ -70,8 +84,19 @@ ## Examples -Please see `Examples.TypedEncoding` it the module list. +Here are some code examples: +- [Overview](src/Examples/TypedEncoding/Overview.hs) +- [Conversions between encodings](src/Examples/TypedEncoding/Conversions.hs) +- [DIY encoding, error handling](src/Examples/TypedEncoding/Instances/DiySignEncoding.hs) +- [To and from string conversions](src/Examples/TypedEncoding/ToEncString.hs) +- [Unsafe - working inside encodings](src/Examples/TypedEncoding/Unsafe.hs) + + +## Hackage + +https://hackage.haskell.org/package/typed-encoding + ## Other encoding packages My approach will be to write specific encodings (e.g. _HTTP_) or wrap encodings from other packages using separate "bridge" projects. @@ -82,15 +107,13 @@ Bridge work: -- [typed-encoding-encoding](https://github.com/rpeszek/typed-encoding-encoding) bridges [encoding](https://github.com/dmwit/encoding) package +- [typed-encoding-encoding](https://github.com/rpeszek/typed-encoding-encoding) bridges [encoding](https://github.com/dmwit/encoding) package -## News -- v0.3 has numerous changes and improvements. - ## Tested with - stack (1.9.3) lts-14.27 (ghc-8.6.5) +- stack (2.5.1) lts-16.27 (ghc-8.8.4) - needs ghc >= 8.2.2, base >=4.10 for GHC.TypeLits support ## Known issues diff --git a/src/Data/TypedEncoding.hs b/src/Data/TypedEncoding.hs --- a/src/Data/TypedEncoding.hs +++ b/src/Data/TypedEncoding.hs @@ -10,35 +10,36 @@ -- -- @ -- -- Base 64 encoded bytes (could represent binary files) --- Enc '["enc-B64"] ByteString +-- Enc '["enc-B64"] () ByteString -- -- -- Base 64 encoded UTF8 bytes --- Enc '["enc-B64", "r-UTF8"] ByteString +-- Enc '["enc-B64", "r-UTF8"] () ByteString -- -- -- Text that contains only ASCII characters --- Enc '["r-ASCII"] Text +-- Enc '["r-ASCII"] () Text -- @ -- -- or to do transformations to strings like -- -- @ --- upper :: Text -> Enc '["do-UPPER"] Text +-- upper :: Text -> Enc '["do-UPPER"] c Text -- upper = ... -- @ -- -- or to define precise types to use with 'toEncString' and 'fromEncString' -- -- @ --- date :: Enc '["r-date-%d/%b/%Y:%X %Z"] Text +-- date :: Enc '["r-date-%d/%b/%Y:%X %Z"] () Text -- date = toEncString ... -- @ -- --- Primary focus of type-encodings is to provide type safe +-- Primary focus of /type-encodings/ is to provide type safe -- -- * /encoding/ -- * /decoding/ -- * /validation (recreation)/ (verification of existing payload) --- * type conversions between encoded types +-- * safe type conversions between encoded types +-- * combinators for creating new encodings from existing encodings (e.g. by applying Boolean rules) -- -- of string-like data (@ByteString@, @Text@) that is subject of some -- encoding or formatting restrictions. @@ -62,8 +63,10 @@ -- -- Examples: @"r-UTF8"@, @"r-ASCII"@, upper alpha-numeric bound /r-ban/ restrictions like @"r-ban:999-999-9999"@ -- --- == "do-" transformations +-- == "do-" transformations -- +--(not provided in this library other than as /Examples/ "Examples.TypedEncoding.Instances.Do.Sample") +-- -- * /encoding/ applies transformation to the string (could be partial) -- * /decoding/ - typically none -- * /validation/ - typically none but, if present, verifies the payload has expected data (e.g. only uppercase chars for "do-UPPER") @@ -78,19 +81,7 @@ -- -- Examples: @"enc-B64"@ -- --- == "bool[Op]:" encodings -- --- Encodings that are defined in terms of other encodings using boolean algebra. --- --- (early, beta version) --- --- Examples: --- --- @"boolOr:(r-ban:999-999-9999)(r-ban:(999) 999-9999)"@ --- --- "@boolNot:(r-ASCII)" --- --- -- = Call Site Usage -- -- To use this library import this module and one or more /instance/ or /combinator/ module. @@ -101,15 +92,20 @@ -- * "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" - This module is intended as example code and will be moved under 'Examples.TypedEncoding' in the future -- -- ... and needed conversions. -- --- Conversion combinator module structure is similar to one found in /text/ and /bytestring/ packages --- Please see comments in "Data.TypedEncoding.Conv" for more information. +-- Conversion combinator module structure is similar to the one found in /text/ and /bytestring/ packages. -- +-- Conversion is /typed-encoding/ are safe and reversible! +-- +-- Please see comments in +-- +-- * "Data.TypedEncoding.Conv" +-- +-- for more information. +-- -- The instance list is not intended to be exhaustive, rather separate libraries -- can provide instances for other encodings and transformations. -- @@ -124,6 +120,7 @@ -- Examples of how to use this library are included in -- -- * "Examples.TypedEncoding" + module Data.TypedEncoding ( -- * @Enc@ and basic combinators @@ -131,16 +128,17 @@ , toEncoding , fromEncoding , getPayload - - -- * Existentially quantified and untyped versions of @Enc@ - , module Data.TypedEncoding.Common.Types.SomeEnc + + -- * Untyped versions of @Enc@ , module Data.TypedEncoding.Common.Types.CheckedEnc -- * @Encoding@ and basic combinators , Encoding (..) , _mkEncoding + , _mkEncoding1 , runEncoding' , _runEncoding + , runEncoding1' -- * List of encodings , Encodings (..) @@ -161,7 +159,11 @@ , propSafeValidatedDecoding' , _propSafeValidatedDecoding - -- * Classes + -- * Encoding Classes + , Encode (..) + , EncodeAll (..) + + -- * Decoding, Validation and Other Classes , module Data.TypedEncoding.Common.Class -- * Combinators @@ -187,7 +189,6 @@ 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 diff --git a/src/Data/TypedEncoding/Combinators/Common.hs b/src/Data/TypedEncoding/Combinators/Common.hs --- a/src/Data/TypedEncoding/Combinators/Common.hs +++ b/src/Data/TypedEncoding/Combinators/Common.hs @@ -7,12 +7,13 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleContexts #-} --- | Combinators reexported in Data.TypedEncoding +-- | Common encoding combinators. +-- This module is re-exported 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 Data.TypedEncoding.Common.Util.TypeLits (Append) import GHC.TypeLits import Data.Proxy diff --git a/src/Data/TypedEncoding/Combinators/Decode.hs b/src/Data/TypedEncoding/Combinators/Decode.hs --- a/src/Data/TypedEncoding/Combinators/Decode.hs +++ b/src/Data/TypedEncoding/Combinators/Decode.hs @@ -18,7 +18,7 @@ import Data.TypedEncoding.Common.Types.Decoding import Data.TypedEncoding.Combinators.Common -import Data.TypedEncoding.Common.Class.Util +import Data.TypedEncoding.Common.Util.TypeLits import Data.TypedEncoding.Common.Class.Decode import Data.Functor.Identity import GHC.TypeLits diff --git a/src/Data/TypedEncoding/Combinators/Encode.hs b/src/Data/TypedEncoding/Combinators/Encode.hs --- a/src/Data/TypedEncoding/Combinators/Encode.hs +++ b/src/Data/TypedEncoding/Combinators/Encode.hs @@ -17,7 +17,7 @@ module Data.TypedEncoding.Combinators.Encode where import Data.TypedEncoding.Common.Types.Enc -import Data.TypedEncoding.Common.Class.Util -- Append +import Data.TypedEncoding.Common.Util.TypeLits -- Append import Data.TypedEncoding.Combinators.Common import Data.TypedEncoding.Common.Class.Encode import GHC.TypeLits diff --git a/src/Data/TypedEncoding/Combinators/Encode/Experimental.hs b/src/Data/TypedEncoding/Combinators/Encode/Experimental.hs --- a/src/Data/TypedEncoding/Combinators/Encode/Experimental.hs +++ b/src/Data/TypedEncoding/Combinators/Encode/Experimental.hs @@ -16,7 +16,7 @@ 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.Util.TypeLits -- Append import Data.TypedEncoding.Common.Class.Encode import Data.Functor.Identity import GHC.TypeLits diff --git a/src/Data/TypedEncoding/Combinators/Promotion.hs b/src/Data/TypedEncoding/Combinators/Promotion.hs --- a/src/Data/TypedEncoding/Combinators/Promotion.hs +++ b/src/Data/TypedEncoding/Combinators/Promotion.hs @@ -12,7 +12,9 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE AllowAmbiguousTypes #-} --- | Promote and demote combinators. +-- | +-- Combinators allowing to add or remove redundant annotations. +-- Such operations are referred to in this package as promoting or demoting. module Data.TypedEncoding.Combinators.Promotion where import Data.TypedEncoding.Common.Class @@ -24,7 +26,7 @@ -- $setup -- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XTypeApplications --- >>> import Data.TypedEncoding.Common.Class.Util (displ) +-- >>> import Data.TypedEncoding.Common.Class.Common (displ) -- >>> import Data.TypedEncoding.Combinators.Unsafe (unsafeSetPayload) -- >>> import Data.TypedEncoding.Instances.Restriction.UTF8 () -- >>> import Data.TypedEncoding.Instances.Restriction.ASCII () diff --git a/src/Data/TypedEncoding/Combinators/Unsafe.hs b/src/Data/TypedEncoding/Combinators/Unsafe.hs --- a/src/Data/TypedEncoding/Combinators/Unsafe.hs +++ b/src/Data/TypedEncoding/Combinators/Unsafe.hs @@ -10,7 +10,7 @@ -- | -- Currently this is the recommended way of recreating encoding from trusted input, --- if avoiding cost of "Data.TypedEncoding.Common.Types.Validation" is important. +-- if avoiding cost of "Data.TypedEncoding.Common.Types.Validation" is needed. -- -- @since 0.1.0.0 unsafeSetPayload :: conf -> str -> Enc enc conf str diff --git a/src/Data/TypedEncoding/Combinators/Validate.hs b/src/Data/TypedEncoding/Combinators/Validate.hs --- a/src/Data/TypedEncoding/Combinators/Validate.hs +++ b/src/Data/TypedEncoding/Combinators/Validate.hs @@ -7,9 +7,10 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TypeApplications #-} --- | Combinators re-exported in Data.TypedEncoding. +-- | -- --- Decoding combinators that are backward compatible to v0.2 versions. +-- Validation combinators that are backward compatible to v0.2 versions. +-- This module is re-exported in Data.TypedEncoding. -- -- @since 0.3.0.0 module Data.TypedEncoding.Combinators.Validate where @@ -18,7 +19,8 @@ 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 Data.TypedEncoding.Common.Class.Common (SymbolList) +import Data.TypedEncoding.Common.Util.TypeLits (Append) import GHC.TypeLits import Data.Functor.Identity @@ -53,7 +55,7 @@ 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 + in withUnsafeCoerce (const pay) <$> runValidationChecks' vers str0 -- * v0.2 style recreate functions diff --git a/src/Data/TypedEncoding/Common/Class.hs b/src/Data/TypedEncoding/Common/Class.hs --- a/src/Data/TypedEncoding/Common/Class.hs +++ b/src/Data/TypedEncoding/Common/Class.hs @@ -13,14 +13,14 @@ module Data.TypedEncoding.Common.Class ( module Data.TypedEncoding.Common.Class - , module Data.TypedEncoding.Common.Class.Util + , module Data.TypedEncoding.Common.Class.Common , 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.Common import Data.TypedEncoding.Common.Class.Encode import Data.TypedEncoding.Common.Class.Decode import Data.TypedEncoding.Common.Class.Validate @@ -53,9 +53,9 @@ -- Other classes -- --- | Flatten is more permissive 'IsSuperset' +-- | Flatten is a more permissive 'IsSuperset' -- @ --- instance FlattenAs "r-ASCII" "enc-B64" where -- OK +-- instance FlattenAs "r-ASCII" "enc-B64" where -- @ -- -- Now encoded data has form @Enc '["r-ASCII"] c str@ diff --git a/src/Data/TypedEncoding/Common/Class/Common.hs b/src/Data/TypedEncoding/Common/Class/Common.hs new file mode 100644 --- /dev/null +++ b/src/Data/TypedEncoding/Common/Class/Common.hs @@ -0,0 +1,88 @@ + +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + +-- | +-- This module defines @SymbolList@ and @Displ@ type classes +-- using by /typed-encoding/ used for display / testing as well as +-- for construction of untyped versions of @Enc@ (@CheckedEnc@ and @UncheckedEnc@) +-- +-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly. + +module Data.TypedEncoding.Common.Class.Common where + +import Data.TypedEncoding.Common.Types.Common + +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy.Char8 as BL +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL + +import Data.Proxy +import qualified Data.List as L +import GHC.TypeLits + +-- $setup +-- >>> :set -XScopedTypeVariables -XTypeApplications -XAllowAmbiguousTypes -XDataKinds + +-- * Symbol List + +-- | +-- @since 0.2.0.0 +class SymbolList (xs::[Symbol]) where + symbolVals :: [String] + +instance SymbolList '[] where + symbolVals = [] + +-- | +-- >>> symbolVals @'["FIRST", "SECOND"] +-- ["FIRST","SECOND"] +instance (SymbolList xs, KnownSymbol x) => SymbolList (x ': xs) where + symbolVals = symbolVal (Proxy :: Proxy x) : symbolVals @xs + +symbolVals_ :: forall xs . SymbolList xs => Proxy xs -> [String] +symbolVals_ _ = symbolVals @xs + +-- * Display + +-- | Human friendly version of Show +-- +-- @since 0.2.0.0 +class Displ x where + displ :: x -> String + + +instance Displ [EncAnn] where + displ x = "[" ++ L.intercalate "," x ++ "]" +instance Displ T.Text where + displ x = "(Text " ++ T.unpack x ++ ")" +instance Displ TL.Text where + displ x = "(TL.Text " ++ TL.unpack x ++ ")" +instance Displ B.ByteString where + displ x = "(ByteString " ++ B.unpack x ++ ")" +instance Displ BL.ByteString where + displ x = "(ByteString " ++ BL.unpack x ++ ")" +instance Displ String where + displ x = "(String " ++ x ++ ")" + + + +-- | +-- >>> displ (Proxy :: Proxy ["FIRST", "SECOND"]) +-- "[FIRST,SECOND]" +instance (SymbolList xs) => Displ (Proxy xs) where + displ _ = displ $ symbolVals @xs + -- "[" ++ (L.intercalate "," $ map displ $ symbolVals @xs) ++ "]" + + + diff --git a/src/Data/TypedEncoding/Common/Class/Decode.hs b/src/Data/TypedEncoding/Common/Class/Decode.hs --- a/src/Data/TypedEncoding/Common/Class/Decode.hs +++ b/src/Data/TypedEncoding/Common/Class/Decode.hs @@ -8,6 +8,15 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TypeApplications #-} + +-- | +-- Type classes accompanying decoding types defined in "Data.TypedEncoding.Common.Types.Decoding" +-- +-- "Examples.TypedEncoding.Instances.DiySignEncoding" contains an implementation example. +-- +-- "Examples.TypedEncoding.Overview" shows decoding usage examples. +-- +-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly. module Data.TypedEncoding.Common.Class.Decode where import Data.TypedEncoding.Common.Types (UnexpectedDecodeEx(..)) @@ -41,7 +50,7 @@ unexpectedDecodeErr :: UnexpectedDecodeEx -> f a instance UnexpectedDecodeErr Identity where - unexpectedDecodeErr x = fail $ show x + unexpectedDecodeErr x = error $ show x instance UnexpectedDecodeErr (Either UnexpectedDecodeEx) where unexpectedDecodeErr = Left diff --git a/src/Data/TypedEncoding/Common/Class/Encode.hs b/src/Data/TypedEncoding/Common/Class/Encode.hs --- a/src/Data/TypedEncoding/Common/Class/Encode.hs +++ b/src/Data/TypedEncoding/Common/Class/Encode.hs @@ -8,12 +8,31 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TypeApplications #-} +-- | Type classes accompanying decoding types defined in "Data.TypedEncoding.Common.Types.Enc" +-- +-- "Examples.TypedEncoding.Instances.DiySignEncoding" contains an implementation example. +-- +-- "Examples.TypedEncoding.Overview" shows decoding usage examples. +-- +-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly. + module Data.TypedEncoding.Common.Class.Encode where import Data.TypedEncoding.Common.Types.Enc +-- $setup +-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XAllowAmbiguousTypes +-- >>> import qualified Data.ByteString as B +-- >>> import Data.Functor.Identity +-- >>> import Data.TypedEncoding +-- >>> import Data.TypedEncoding.Instances.Enc.Base64 () -- | +-- Allows for polymorphic access to encoding, for example +-- +-- >>> displ (runIdentity . _runEncoding encoding $ toEncoding () "Hello" :: Enc '["enc-B64"] () B.ByteString) +-- "Enc '[enc-B64] () (ByteString SGVsbG8=)" +-- -- 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 @@ -29,6 +48,15 @@ encoding :: Encoding f nm alg conf str -- | +-- Allows for polymorphic access to Encodings +-- +-- For example +-- +-- >>> displ (runIdentity . _runEncodings encodings $ toEncoding () "Hello" :: (Enc '["enc-B64", "enc-B64"] () B.ByteString)) +-- "Enc '[enc-B64,enc-B64] () (ByteString U0dWc2JHOD0=)" +-- +-- You can also use convenience functions like @encodeAll@ +-- -- @since 0.3.0.0 class EncodeAll f nms algs conf str where encodings :: Encodings f nms algs conf str diff --git a/src/Data/TypedEncoding/Common/Class/IsStringR.hs b/src/Data/TypedEncoding/Common/Class/IsStringR.hs --- a/src/Data/TypedEncoding/Common/Class/IsStringR.hs +++ b/src/Data/TypedEncoding/Common/Class/IsStringR.hs @@ -7,6 +7,9 @@ -- | This Module will be removed in the future in favor of classes defined in -- "Data.TypedEncoding.Common.Class.Util.StringConstraints" +-- +-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly. + module Data.TypedEncoding.Common.Class.IsStringR where import Data.Proxy diff --git a/src/Data/TypedEncoding/Common/Class/Superset.hs b/src/Data/TypedEncoding/Common/Class/Superset.hs --- a/src/Data/TypedEncoding/Common/Class/Superset.hs +++ b/src/Data/TypedEncoding/Common/Class/Superset.hs @@ -13,6 +13,12 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} +-- | +-- This module contains typeclasses and type families that are used by /typed-encoding/ to +-- define subset / superset relationships between different encodings. +-- +-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly. + module Data.TypedEncoding.Common.Class.Superset where import Data.TypedEncoding.Common.Util.TypeLits @@ -56,19 +62,27 @@ -- Note, no IsSuperset "r-UNICODE.D76" "r-CHAR8" even though the numeric range of D76 includes all CHAR8 bytes. -- This is more /nominal/ decision that prevents certain unwanted conversions from being possible. -- +-- This is not fully transitive to conserve compilation cost. -- @since 0.2.2.0 type family IsSuperset (y :: Symbol) (x :: Symbol) :: Bool where + IsSuperset "r-B64" "r-B64" = 'True -- "r-B64" is currently not expected to have any explicit superset logic IsSuperset "r-ASCII" "r-ASCII" = 'True - IsSuperset "r-UTF8" "r-ASCII" = 'True - IsSuperset "r-UTF8" "r-UTF8" = 'True - IsSuperset "r-CHAR8" "r-ASCII" = 'True -- "r-CHAR8" is phantom, no explicit instances so it does not need reflexive case - IsSuperset "r-CHAR8" "r-ByteRep" = 'True - IsSuperset "r-UNICODE.D76" "r-UNICODE.D76" = 'True - IsSuperset "r-UNICODE.D76" "r-ASCII" = 'True - IsSuperset "r-UNICODE.D76" x = Or (IsSuperset "r-CHAR8" x) (IsSupersetOpen "r-UNICODE.D76" x (TakeUntil x ":") (ToList x)) + IsSuperset "r-ASCII" "r-B64" = 'True + IsSuperset "r-UNICODE.D76" "r-UNICODE.D76" = 'True -- guards what can go to Text + -- "r-UNICODE.D76" and "r-UTF8" should be considered equivalent + -- currently there is no subset relationship between them + -- IsSuperset "r-UNICODE.D76" "r-ASCII" = 'True -- redundant + IsSuperset "r-UNICODE.D76" x = Or (IsSuperset "r-ASCII" x) (IsSupersetOpen "r-UNICODE.D76" x (TakeUntil x ":") (ToList x)) + IsSuperset "r-UTF8" "r-UTF8" = 'True + -- IsSuperset "r-UTF8" "r-ASCII" = 'True -- redundant + IsSuperset "r-UTF8" x = Or (IsSuperset "r-ASCII" x) (IsSupersetOpen "r-UTF8" x (TakeUntil x ":") (ToList x)) + -- IsSuperset "r-CHAR8" "r-ASCII" = 'True -- redundant + IsSuperset "r-CHAR8" "r-ByteRep" = 'True -- "r-CHAR8" is phantom root type defining type safe ByteString pack and unpack, it is not used directly, nor is a subset + -- "r-ByteRep" is another encoding with special handling IsSuperset "r-CHAR8" x = Or (IsSuperset "r-ASCII" x) (IsSupersetOpen "r-CHAR8" x (TakeUntil x ":") (ToList x)) IsSuperset y x = IsSupersetOpen y x (TakeUntil x ":") (ToList x) + -- TODO introduce "r-NODEC" which does not decode @@ -80,7 +94,7 @@ -- | -- >>> let Right tstAscii = encodeFAll . toEncoding () $ "Hello World" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text) --- >>> displ (injectInto @ "r-UTF8" tstAscii) +-- >>> displ (injectInto @"r-UTF8" tstAscii) -- "Enc '[r-UTF8] () (Text Hello World)" -- -- @since 0.2.2.0 @@ -143,13 +157,6 @@ _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 --- | --- validates superset restriction --- --- Actual tests in the project /test/ suite. -propEncodesInto' :: forall algb algr b r str . (EncodingSuperset b, r ~ EncSuperset b, Eq str) => Encoding (Either EncodeEx) b algb () str -> Encoding (Either EncodeEx) r algr () str -> str -> Bool -propEncodesInto' = propEncodesIntoCheck -{-# DEPRECATED propEncodesInto' "Use propEncodesIntoCheck or propEncodesInto_" #-} propEncodesInto_ :: forall b r str algb algr. ( EncodingSuperset b @@ -166,7 +173,7 @@ -- | -- validates superset restriction -- --- Actual tests in the project /test/ suite. +-- Actual tests are in the project /test/ suite. propEncodesIntoCheck :: forall algb algr b r str . (Eq str) => Encoding (Either EncodeEx) b algb () str -> Encoding (Either EncodeEx) r algr () str -> str -> Bool propEncodesIntoCheck encb encr str = case runEncoding' @algb encb . toEncoding () $ str of @@ -190,9 +197,12 @@ -- | -- Aggregate version of 'EncodingSuperset' -- --- This is not ideal but easy to implement. --- The issue is that this assumes restricted co-domain which is what often happens --- but often does not, e.g. it will not work well with id transformation. +-- It is used to assure type safety of conversion functions in "Data.TypedEncoding.Conv". +-- This approach is not ideal since +-- it produces an overly conservative restriction on encoding stack. +-- +-- The issue is that this enforces restriction on the co-domain or each encoding and it does not take +-- into account the fact that the domain is already restricted, e.g. it will prevent adding id transformation to the stack. -- -- @since 0.4.0.0 class AllEncodeInto (superset :: Symbol) (encnms :: [Symbol]) where diff --git a/src/Data/TypedEncoding/Common/Class/Util.hs b/src/Data/TypedEncoding/Common/Class/Util.hs deleted file mode 100644 --- a/src/Data/TypedEncoding/Common/Class/Util.hs +++ /dev/null @@ -1,108 +0,0 @@ - -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE AllowAmbiguousTypes #-} - --- | This module should be merged with --- "Data.TypedEncoding.Common.Util.TypeLits" --- --- Since both provide type level helpers -module Data.TypedEncoding.Common.Class.Util where - -import Data.TypedEncoding.Common.Types.Common - -import qualified Data.ByteString.Char8 as B -import qualified Data.ByteString.Lazy.Char8 as BL -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL - -import Data.Proxy -import qualified Data.List as L -import GHC.TypeLits - --- $setup --- >>> :set -XScopedTypeVariables -XTypeApplications -XAllowAmbiguousTypes -XDataKinds - --- * Symbol List - --- | --- @since 0.2.0.0 -class SymbolList (xs::[Symbol]) where - symbolVals :: [String] - -instance SymbolList '[] where - symbolVals = [] - --- | --- >>> symbolVals @ '["FIRST", "SECOND"] --- ["FIRST","SECOND"] -instance (SymbolList xs, KnownSymbol x) => SymbolList (x ': xs) where - symbolVals = symbolVal (Proxy :: Proxy x) : symbolVals @xs - -symbolVals_ :: forall xs . SymbolList xs => Proxy xs -> [String] -symbolVals_ _ = symbolVals @xs - --- * Display - --- | Human friendly version of Show --- --- @since 0.2.0.0 -class Displ x where - displ :: x -> String - - -instance Displ [EncAnn] where - displ x = "[" ++ L.intercalate "," x ++ "]" -instance Displ T.Text where - displ x = "(Text " ++ T.unpack x ++ ")" -instance Displ TL.Text where - displ x = "(TL.Text " ++ TL.unpack x ++ ")" -instance Displ B.ByteString where - displ x = "(ByteString " ++ B.unpack x ++ ")" -instance Displ BL.ByteString where - displ x = "(ByteString " ++ BL.unpack x ++ ")" -instance Displ String where - displ x = "(String " ++ x ++ ")" - - - --- | --- >>> displ (Proxy :: Proxy ["FIRST", "SECOND"]) --- "[FIRST,SECOND]" -instance (SymbolList xs) => Displ (Proxy xs) where - displ _ = displ $ symbolVals @ xs - -- "[" ++ (L.intercalate "," $ map displ $ symbolVals @ xs) ++ "]" - - --- * Other - --- TODO should this be imported from somewhere? - --- | --- Type level list append --- --- @since 0.1.0.0 -type family Append (xs :: [k]) (ys :: [k]) :: [k] where - Append '[] xs = xs - Append (y ': ys) xs = y ': Append ys xs - --- | Polymorphic data payloads used to encode/decode --- --- This class is intended for example use only and will be moved to Example modules. --- --- Use your favorite polymorphic records / ad-hock product polymorphism library. --- --- @since 0.1.0.0 -class HasA a c where - has :: c -> a - -instance HasA () c where - has = const () diff --git a/src/Data/TypedEncoding/Common/Class/Validate.hs b/src/Data/TypedEncoding/Common/Class/Validate.hs --- a/src/Data/TypedEncoding/Common/Class/Validate.hs +++ b/src/Data/TypedEncoding/Common/Class/Validate.hs @@ -11,6 +11,10 @@ -- {-# LANGUAGE TypeApplications #-} {-# LANGUAGE AllowAmbiguousTypes #-} +-- | +-- Type classes accompanying decoding types defined in "Data.TypedEncoding.Common.Types.Validation" +-- +-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly. module Data.TypedEncoding.Common.Class.Validate where import Data.TypedEncoding.Common.Types (RecreateEx(..)) diff --git a/src/Data/TypedEncoding/Common/Types/CheckedEnc.hs b/src/Data/TypedEncoding/Common/Types/CheckedEnc.hs --- a/src/Data/TypedEncoding/Common/Types/CheckedEnc.hs +++ b/src/Data/TypedEncoding/Common/Types/CheckedEnc.hs @@ -1,22 +1,30 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} --- {-# LANGUAGE PolyKinds #-} --- {-# LANGUAGE DataKinds #-} --- {-# LANGUAGE TypeOperators #-} --- {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE StandaloneDeriving #-} +-- {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE RankNTypes #-} -- | --- Module defines 'CheckedEnc' - untyped ADT version of 'Enc' +-- Module defines 'CheckedEnc' - untyped ADT version of 'Enc' +-- +-- A more dependently typed approach would be to define SomeEnc GADT +-- that accepts some @Enc '[..]@ in its constructor. The approach here +-- turns out to be isomorphic to @SomeEnc@ approach. Both, however, yield +-- somewhat different programming. +-- +-- Post v0.4 /typed-encoding/ does not support @SomeEnc@ and it remains only as an /Example/. +-- +-- See "Examples.TypedEncoding.SomeEnc". +-- +-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly. + module Data.TypedEncoding.Common.Types.CheckedEnc where import Data.TypedEncoding.Common.Types.Enc import Data.TypedEncoding.Common.Types.Common -import Data.TypedEncoding.Common.Class.Util +import Data.TypedEncoding.Common.Class.Common import Data.Proxy -- $setup @@ -27,8 +35,6 @@ -- * Untyped Enc --- constructor is to be treated as Unsafe to Encode and Decode instance implementations --- particular encoding instances may expose smart constructors for limited data types -- | Represents some validated encoded string. -- @@ -39,7 +45,8 @@ -- @since 0.2.0.0 data CheckedEnc conf str = UnsafeMkCheckedEnc [EncAnn] conf str -- ^ @since 0.3.0.0 -- Constructor renamed from previous versions - + -- This constructor is considered unsafe as pattern matching on it and + -- using it allows access to the encoded payload. deriving (Show, Eq) -- | @@ -61,14 +68,14 @@ -- @since 0.2.0.0 toCheckedEnc :: forall xs c str . (SymbolList xs) => Enc xs c str -> CheckedEnc c str toCheckedEnc (UnsafeMkEnc p c s) = - UnsafeMkCheckedEnc (symbolVals @ xs) c s + UnsafeMkCheckedEnc (symbolVals @xs) c s -- | -- @since 0.2.0.0 fromCheckedEnc :: forall xs c str . SymbolList xs => CheckedEnc c str -> Maybe (Enc xs c str) fromCheckedEnc (UnsafeMkCheckedEnc xs c s) = let p = Proxy :: Proxy xs - in if symbolVals @ xs == xs + in if symbolVals @xs == xs then Just $ UnsafeMkEnc p c s else Nothing @@ -76,19 +83,19 @@ -- | -- >>> let encsometest = UnsafeMkCheckedEnc ["TEST"] () $ T.pack "hello" --- >>> proc_toCheckedEncFromCheckedEnc @'["TEST"] encsometest +-- >>> procToCheckedEncFromCheckedEnc @'["TEST"] encsometest -- True --- >>> proc_toCheckedEncFromCheckedEnc @'["TEST1"] encsometest +-- >>> procToCheckedEncFromCheckedEnc @'["TEST1"] encsometest -- False -proc_toCheckedEncFromCheckedEnc :: forall xs c str . (SymbolList xs, Eq c, Eq str) => CheckedEnc c str -> Bool -proc_toCheckedEncFromCheckedEnc x = (== Just x) . fmap (toCheckedEnc @ xs) . fromCheckedEnc $ x +procToCheckedEncFromCheckedEnc :: forall xs c str . (SymbolList xs, Eq c, Eq str) => CheckedEnc c str -> Bool +procToCheckedEncFromCheckedEnc x = (== Just x) . fmap (toCheckedEnc @xs) . fromCheckedEnc $ x -- | -- >>> let enctest = unsafeSetPayload () "hello" :: Enc '["TEST"] () T.Text --- >>> proc_fromCheckedEncToCheckedEnc enctest +-- >>> procFromCheckedEncToCheckedEnc enctest -- True -proc_fromCheckedEncToCheckedEnc :: forall xs c str . (SymbolList xs, Eq c, Eq str) => Enc xs c str -> Bool -proc_fromCheckedEncToCheckedEnc x = (== Just x) . fromCheckedEnc . toCheckedEnc $ x +procFromCheckedEncToCheckedEnc :: forall xs c str . (SymbolList xs, Eq c, Eq str) => Enc xs c str -> Bool +procFromCheckedEncToCheckedEnc x = (== Just x) . fromCheckedEnc . toCheckedEnc $ x -- | -- >>> displ $ unsafeCheckedEnc ["TEST"] () ("hello" :: T.Text) diff --git a/src/Data/TypedEncoding/Common/Types/Common.hs b/src/Data/TypedEncoding/Common/Types/Common.hs --- a/src/Data/TypedEncoding/Common/Types/Common.hs +++ b/src/Data/TypedEncoding/Common/Types/Common.hs @@ -2,15 +2,14 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} --- {-# LANGUAGE FlexibleInstances #-} --- {-# LANGUAGE FlexibleContexts #-} --- {-# LANGUAGE UndecidableInstances #-} --- {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ConstraintKinds #-} +-- | Common types and some type families used in /typed-encoding/ definitions. +-- +-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly. module Data.TypedEncoding.Common.Types.Common where import Data.TypedEncoding.Common.Util.TypeLits @@ -49,7 +48,7 @@ -- | -- 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" +-- This allows working with open encoding definitions such as "r-ban" -- -- >>> :kind! AlgNm "enc-B64" -- ... diff --git a/src/Data/TypedEncoding/Common/Types/Decoding.hs b/src/Data/TypedEncoding/Common/Types/Decoding.hs --- a/src/Data/TypedEncoding/Common/Types/Decoding.hs +++ b/src/Data/TypedEncoding/Common/Types/Decoding.hs @@ -12,9 +12,9 @@ {-# OPTIONS_GHC -Wno-partial-type-signatures #-} -- | --- Internal definition of types --- -- Decoding types for @Enc@ +-- +-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly. module Data.TypedEncoding.Common.Types.Decoding where import Data.Proxy @@ -26,15 +26,21 @@ -- | -- Similar to 'Data.TypedEncoding.Common.Types.Enc.Encoding' -- --- Used to create instances of decoding. +-- Wraps the decoding function. -- +-- Can be used with 'Data.TypedEncoding.Common.Class.Decode.Decode' type class. +-- +-- "Examples.TypedEncoding.Instances.DiySignEncoding" contains an implementation example. +-- +-- "Examples.TypedEncoding.Overview" shows decoding usage examples. +-- -- @since 0.3.0.0 data Decoding f (nm :: Symbol) (alg :: Symbol) conf str where -- | Consider this constructor as private or use it with care -- - -- Using this constructor: + -- Using that constructor: -- @ - -- MkDecoding :: Proxy nm -> (forall (xs :: [Symbol]) . Enc (nm ': xs) conf str -> f (Enc xs conf str)) -> Decoding f nm (AlgNm nm) conf str + -- UnsafeMkDecoding :: 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 @@ -45,15 +51,27 @@ -- -- @since 0.3.0.0 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 +mkDecoding = _mkDecoding +{-# DEPRECATED mkDecoding "Use _mkDecoding" #-} + + + +-- | Type safe smart constructor +-- (See also 'Data.TypedEncoding.Common.Types.Enc._mkEncoding') +-- +-- This function follows the naming convention of using "_" when the typechecker figures out @alg@ +-- @since 0.5.0.0 +_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 + -- | --- @since 0.3.0.0 -runDecoding :: forall alg nm f xs conf str . Decoding f nm alg conf str -> Enc (nm ': xs) conf str -> f (Enc xs conf str) +-- This function assumes @mn ~ alg@, making its type different from previous (before v.0.5) versions. +-- +-- @since 0.5.0.0 +runDecoding :: forall nm f xs conf str . Decoding f nm nm conf str -> Enc (nm ': xs) conf str -> f (Enc xs conf str) runDecoding (UnsafeMkDecoding _ fn) = fn -{-# DEPRECATED runDecoding "Use runDecoding'" #-} - -- | -- @since 0.3.0.0 runDecoding' :: forall alg nm f xs conf str . Decoding f nm alg conf str -> Enc (nm ': xs) conf str -> f (Enc xs conf str) @@ -65,7 +83,7 @@ -- -- @since 0.3.0.0 _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) +_runDecoding = runDecoding' @(AlgNm nm) -- | -- Wraps a list of @Decoding@ elements. @@ -81,21 +99,21 @@ ConsD :: Decoding f nm alg conf str -> Decodings f nms algs conf str -> Decodings f (nm ': nms) (alg ': algs) conf str -- | --- @since 0.3.0.0 -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 = runDecodings' @algs @nms - -{-# DEPRECATED runDecodings "Use runDecodings'" #-} +-- This function assumes @nms ~ algs@, making its type different from previous (before v.0.5) versions. +-- +-- @since 0.5.0.0 +runDecodings :: forall nms f c str . (Monad f) => Decodings f nms nms c str -> Enc nms c str -> f (Enc ('[]::[Symbol]) c str) +runDecodings = runDecodings' @nms @nms 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 + let re :: f (Enc _ c str) = runDecoding' fn enc + in re >>= runDecodings' xs -- | At possibly big compilation cost, have compiler figure out algorithm names. -- -- @since 0.3.0.0 _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) +_runDecodings = runDecodings' @(AlgNmMap nms) diff --git a/src/Data/TypedEncoding/Common/Types/Enc.hs b/src/Data/TypedEncoding/Common/Types/Enc.hs --- a/src/Data/TypedEncoding/Common/Types/Enc.hs +++ b/src/Data/TypedEncoding/Common/Types/Enc.hs @@ -11,14 +11,18 @@ {-# LANGUAGE PartialTypeSignatures #-} {-# OPTIONS_GHC -Wno-partial-type-signatures #-} -- | --- Internal definition of types +-- Contains main @Enc@ type that carries encoded payload as well as +-- @Encoding@ and @Encodings@ types contains encoding functions. +-- This module also contains basic combinators for these types. +-- +-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly. module Data.TypedEncoding.Common.Types.Enc where import Data.Proxy import GHC.TypeLits -import Data.TypedEncoding.Common.Class.Util +import Data.TypedEncoding.Common.Class.Common import Data.TypedEncoding.Common.Types.Common -- $setup @@ -28,7 +32,7 @@ -- >>> import Data.Functor.Identity -- >>> import Data.TypedEncoding -- >>> import Data.TypedEncoding.Instances.Enc.Base64 () --- >>> import Data.TypedEncoding.Instances.Restriction.BoundedAlphaNums () +-- >>> import Data.TypedEncoding.Instances.Restriction.BoundedAlphaNums (encFBan) -- | -- Contains encoded data annotated by @@ -80,7 +84,10 @@ getPayload :: Enc enc conf str -> str getPayload (UnsafeMkEnc _ _ str) = str - +-- | +-- @since 0.5.2.0 +getContent :: Enc enc conf str -> (conf, str) +getContent (UnsafeMkEnc _ c str) = (c, str) -- | -- Wraps the encoding function. @@ -111,6 +118,13 @@ -- with definitions like @"r-ban"@ where @"r-ban:@" can be followed by arbitrary -- string literal. -- +-- This existential definition is intended for clarity. /typed-encoding/ supports type level lists of encodings +-- and each encoding should not know what encodings have already been applied. +-- +-- However, this construction is mostly equivalent to storing a simple one level encoding function +-- @Enc ('[]:: [Symbol]) conf str -> f (Enc '[nm] conf str)@ +-- (see '_mkEncoding1' and 'runEncoding1'' below). +-- -- Examples: -- -- @ @@ -123,7 +137,7 @@ -- Encoding Identity "enc-B64" "enc-B64" () ByteString -- @ -- --- Represents a /Byte 64/ encoder that can operate on any stack of previous encodings. +-- Represents a /Base 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. -- @@ -141,6 +155,8 @@ -- 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. @@ -161,28 +177,55 @@ -- 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 :: 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 -- | +-- Defines encoding by only specifying a simple one level encoding function. +-- This typically is not used in constructing encodings as there are more convenient combinators for doing this +-- (e.g. in "Data.TypedEncoding.Instances.Support"). +-- It is here for completeness to show that the @Encoding@ definition is a bit overdone. +-- +-- @since 0.5.2.0 +_mkEncoding1 :: forall f (nm :: Symbol) conf str . + Functor f => (Enc ('[]:: [Symbol]) conf str -> f (Enc '[nm] conf str)) -> Encoding f nm (AlgNm nm) conf str +_mkEncoding1 fn = UnsafeMkEncoding Proxy (fmap (mkenc Proxy . getContent) . fn . mkenc Proxy . getContent) + where + mkenc p (c,s) = UnsafeMkEnc p c s + +-- | -- @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 +-- | +-- Version of @runEncoding'@ function specialized to empty encoding +-- +-- @since 0.5.2.0 +runEncoding1' :: forall alg nm f conf str . Encoding f nm alg conf str -> Enc ('[] :: [Symbol]) conf str -> f (Enc '[nm] conf str) +runEncoding1' = runEncoding' @alg @nm @f @'[] + -- | 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. +-- This combinator has @Algorithm nm alg@ constraint (which currently stands for @TakeUntil ":" nm ~ alg@. -- --- If that happens @-XTypeApplications@ annotations will be needed and @_@ methods will simply --- use default algorithm name. +-- @runEncoding@ functions are typically not used directly, @runEncodings@ functions defined below or @encodeAll@ +-- functions are used instead. -- +-- In the following example (and other examples) we use displ convenience function that provides String display of the encoding. +-- The @"r-ban:111"@ allows only strings with 3 characters satisfying alphanumeric bound of '1' +-- +-- >>> fmap displ (_runEncoding encFBan $ toEncoding () "000" :: Either EncodeEx (Enc '["r-ban:111"] () T.Text)) +-- Right "Enc '[r-ban:111] () (Text 000)" +-- -- @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. -- @@ -194,16 +237,35 @@ -- -- @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 + ConsE :: Encoding f nm alg conf str -> Encodings f nms algs conf str -> Encodings f (nm ': nms) (alg ': algs) conf str +infixr 5 -:- +(-:-) :: Encoding f nm alg conf str -> Encodings f nms algs conf str -> Encodings f (nm ': nms) (alg ': algs) conf str +(-:-) = ConsE + -- | -- Runs encodings, requires -XTypeApplication annotation specifying the algorithm(s) -- --- >>> runEncodings' @'["r-ban"] encodings . toEncoding () $ ("22") :: Either EncodeEx (Enc '["r-ban:111"] () T.Text) +-- >>> runEncodings' @'["r-ban"] (encFBan -:- ZeroE) . toEncoding () $ "000" :: Either EncodeEx (Enc '["r-ban:111"] () T.Text) +-- Right (UnsafeMkEnc Proxy () "000") +-- +-- Polymorphic access to encodings is provided by @EncodeAll@ typeclass so we can simply write: +-- +-- >>> 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")) +-- +-- This library also offers backward compatible equivalents @encodeFAll@ to @runEncodings@ functions +-- (see "Data.TypedEncoding.Combinators.Encode") which are basically equivalent to something like +-- @ +-- runEncoding' encoding +-- @ +-- +-- >>> encodeFAll' @'["r-ban"] . toEncoding () $ "111" :: Either EncodeEx (Enc '["r-ban:111"] () T.Text) +-- Right (UnsafeMkEnc Proxy () "111") +-- +-- >>> fmap displ . encodeFAll' @'["r-ban"] @'["r-ban:111"] @(Either EncodeEx) @() @T.Text . toEncoding () $ "111" +-- Right "Enc '[r-ban:111] () (Text 111)" -- -- @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) diff --git a/src/Data/TypedEncoding/Common/Types/Exceptions.hs b/src/Data/TypedEncoding/Common/Types/Exceptions.hs --- a/src/Data/TypedEncoding/Common/Types/Exceptions.hs +++ b/src/Data/TypedEncoding/Common/Types/Exceptions.hs @@ -9,7 +9,9 @@ -- {-# LANGUAGE RankNTypes #-} -- | --- Internal definition of types +-- Exception types used in /typed-encoding/ +-- +-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly. module Data.TypedEncoding.Common.Types.Exceptions where diff --git a/src/Data/TypedEncoding/Common/Types/SomeAnnotation.hs b/src/Data/TypedEncoding/Common/Types/SomeAnnotation.hs deleted file mode 100644 --- a/src/Data/TypedEncoding/Common/Types/SomeAnnotation.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE RankNTypes #-} - --- | internally used existential type for taking track of annotations -module Data.TypedEncoding.Common.Types.SomeAnnotation where - -import Data.TypedEncoding.Common.Types.Common -import Data.TypedEncoding.Common.Class.Util -import Data.TypedEncoding.Internal.Util -import Data.Proxy -import GHC.TypeLits - --- | --- @since 0.2.0.0 -data SomeAnnotation where - MkSomeAnnotation :: SymbolList xs => Proxy xs -> SomeAnnotation - --- | --- @since 0.2.0.0 -withSomeAnnotation :: SomeAnnotation -> (forall xs . SymbolList xs => Proxy xs -> r) -> r -withSomeAnnotation (MkSomeAnnotation p) fn = fn p - - --- | folds over SomeSymbol list using withSomeSymbol and proxyCons --- @since 0.2.0.0 -someAnnValue :: [EncAnn] -> SomeAnnotation -someAnnValue xs = - foldr (fn . someSymbolVal) (MkSomeAnnotation (Proxy :: Proxy '[])) xs - where - somesymbs = map someSymbolVal xs - fn ss (MkSomeAnnotation pxs) = withSomeSymbol ss (\px -> MkSomeAnnotation (px `proxyCons` pxs)) - --- | --- @since 0.2.0.0 -proxyCons :: forall (x :: Symbol) (xs :: [Symbol]) . Proxy x -> Proxy xs -> Proxy (x ': xs) -proxyCons _ _ = Proxy diff --git a/src/Data/TypedEncoding/Common/Types/SomeEnc.hs b/src/Data/TypedEncoding/Common/Types/SomeEnc.hs deleted file mode 100644 --- a/src/Data/TypedEncoding/Common/Types/SomeEnc.hs +++ /dev/null @@ -1,66 +0,0 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE RankNTypes #-} - --- | --- Module defines 'SomeEnc' - existentially quantified version of @Enc@ --- and basic combinators - -module Data.TypedEncoding.Common.Types.SomeEnc where - -import Data.TypedEncoding.Common.Types.Enc -import Data.TypedEncoding.Common.Class.Util -import Data.TypedEncoding.Common.Types.SomeAnnotation -import Data.TypedEncoding.Common.Types.CheckedEnc - --- $setup --- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XAllowAmbiguousTypes --- >>> import qualified Data.Text as T --- >>> import Data.TypedEncoding.Combinators.Unsafe - - - --- | Existentially quantified quantified @Enc@ --- effectively isomorphic to 'CheckedEnc' --- --- @since 0.2.0.0 -data SomeEnc conf str where - MkSomeEnc :: SymbolList xs => Enc xs conf str -> SomeEnc conf str - --- | --- @since 0.2.0.0 -withSomeEnc :: SomeEnc conf str -> (forall xs . SymbolList xs => Enc xs conf str -> r) -> r -withSomeEnc (MkSomeEnc enc) f = f enc - --- | --- @since 0.2.0.0 -toSome :: SymbolList xs => Enc xs conf str -> SomeEnc conf str -toSome = MkSomeEnc - --- | --- >>> let enctest = unsafeSetPayload () "hello" :: Enc '["TEST"] () T.Text --- >>> someToChecked . MkSomeEnc $ enctest --- UnsafeMkCheckedEnc ["TEST"] () "hello" --- --- @since 0.2.0.0 -someToChecked :: SomeEnc conf str -> CheckedEnc conf str -someToChecked se = withSomeEnc se toCheckedEnc - --- | --- >>> let tst = unsafeCheckedEnc ["TEST"] () "test" --- >>> displ $ checkedToSome tst --- "Some (Enc '[TEST] () (String test))" --- --- @since 0.2.0.0 s -checkedToSome :: CheckedEnc conf str -> SomeEnc conf str -checkedToSome (UnsafeMkCheckedEnc xs c s) = withSomeAnnotation (someAnnValue xs) (\p -> MkSomeEnc (UnsafeMkEnc p c s)) - - --- | --- >>> let enctest = unsafeSetPayload () "hello" :: Enc '["TEST"] () T.Text --- >>> displ $ MkSomeEnc enctest --- "Some (Enc '[TEST] () (Text hello))" -instance (Show c, Displ str) => Displ (SomeEnc c str) where - displ (MkSomeEnc en) = - "Some (" ++ displ en ++ ")" diff --git a/src/Data/TypedEncoding/Common/Types/UncheckedEnc.hs b/src/Data/TypedEncoding/Common/Types/UncheckedEnc.hs --- a/src/Data/TypedEncoding/Common/Types/UncheckedEnc.hs +++ b/src/Data/TypedEncoding/Common/Types/UncheckedEnc.hs @@ -9,12 +9,14 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -- | --- Internal definition of types +-- Defines @UncheckedEnc@ representing not verified encoding and basic combinators for using it. +-- +-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly. module Data.TypedEncoding.Common.Types.UncheckedEnc where import Data.Proxy -import Data.TypedEncoding.Common.Class.Util +import Data.TypedEncoding.Common.Class.Common import Data.TypedEncoding.Common.Types.Common -- $setup @@ -26,6 +28,8 @@ -- | Represents some encoded string where encoding was not validated. -- +-- Encoding is not tracked at the type level. +-- -- Similar to 'Data.TypedEncoding.Common.Types.CheckedEnc' but unlike -- @CheckedEnc@ it can contain payloads that have invalid encoding. -- @@ -53,7 +57,7 @@ verifyAnn :: forall xs c str . SymbolList xs => UncheckedEnc c str -> Either String (UncheckedEnc c str) verifyAnn x@(MkUncheckedEnc xs _ _) = let p = Proxy :: Proxy xs - in if symbolVals @ xs == xs + in if symbolVals @xs == xs then Right x else Left $ "UncheckedEnc has not matching annotation " ++ displ xs diff --git a/src/Data/TypedEncoding/Common/Types/Unsafe.hs b/src/Data/TypedEncoding/Common/Types/Unsafe.hs --- a/src/Data/TypedEncoding/Common/Types/Unsafe.hs +++ b/src/Data/TypedEncoding/Common/Types/Unsafe.hs @@ -12,8 +12,10 @@ import Data.TypedEncoding.Common.Types --- | Allows to operate within Enc. These are considered unsafe. --- keeping the same list of encodings +-- | Allows to operate within @Enc@ +-- keeping the same list of encodings. +-- +-- These are considered unsafe. -- -- @since 0.1.0.0 newtype Unsafe enc conf str = Unsafe {runUnsafe :: Enc enc conf str} deriving (Show) diff --git a/src/Data/TypedEncoding/Common/Types/Validation.hs b/src/Data/TypedEncoding/Common/Types/Validation.hs --- a/src/Data/TypedEncoding/Common/Types/Validation.hs +++ b/src/Data/TypedEncoding/Common/Types/Validation.hs @@ -22,6 +22,8 @@ -- -- Use of 'Data.TypedEncoding.Combinators.Unsafe.unsafeSetPayload' currently recommended -- for recovering 'Enc' from trusted input sources (if avoiding cost of Validation is important). +-- +-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly. module Data.TypedEncoding.Common.Types.Validation where @@ -50,12 +52,21 @@ -- @since 0.3.0.0 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 +{-# DEPRECATED mkValidation "Use _mkValidation" #-} -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 +-- | Type safe smart constructor +-- adding the type family @(AlgNm nm)@ restriction to UnsafeMkValidation slows down compilation, especially in tests. +-- +-- This function follows the naming convention of using "_" when the typechecker figures out @alg@ +-- +-- @since 0.5.0.0 +_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 -{-# DEPRECATED runValidation "Use runValidation''" #-} +runValidation :: forall nm f xs conf str . Validation f nm nm conf str -> Enc (nm ': xs) conf str -> f (Enc xs conf str) +runValidation (UnsafeMkValidation _ fn) = fn + 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 @@ -80,15 +91,19 @@ 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" -- --- @since 0.3.0.0 -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 = +-- (@runValidationChecks@ before v0.5) +-- +-- @since 0.5.0.0 +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 + in re >>= runValidationChecks' xs -- -- | At possibly big compilation cost, have compiler figure out algorithm names. diff --git a/src/Data/TypedEncoding/Common/Util/TypeLits.hs b/src/Data/TypedEncoding/Common/Util/TypeLits.hs --- a/src/Data/TypedEncoding/Common/Util/TypeLits.hs +++ b/src/Data/TypedEncoding/Common/Util/TypeLits.hs @@ -11,6 +11,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE RankNTypes #-} +-- {-# LANGUAGE GADTs #-} -- | TypeLits related utilities. @@ -19,59 +21,82 @@ -- -- Uses @symbols@ library for its ToList type family. -- --- Currently this is spread out in different modules --- --- * "Data.TypedEncoding.Common.Class.Util" --- * "Data.TypedEncoding.Common.Types.SomeAnnotation" --- --- (TODO) these will need to get consolidated. module Data.TypedEncoding.Common.Util.TypeLits where import GHC.TypeLits import Data.Symbol.Ascii +import Data.Proxy -- $setup -- >>> :set -XScopedTypeVariables -XTypeFamilies -XKindSignatures -XDataKinds --- ! +-- | +-- Convenience combinator missing in TypeLits, See "Examples.TypedEncoding.SomeEnc.SomeAnnotation" +-- "Examples.TypedEncoding.SomeEnc.someAnnValue" +-- +-- @since 0.2.0.0 +withSomeSymbol :: SomeSymbol -> (forall x. KnownSymbol x => Proxy x -> r) -> r +withSomeSymbol s fn = case s of + SomeSymbol p -> fn p + + +-- | +-- (Moved from previously defined module @Data.TypedEncoding.Common.Types.SomeAnnotation@) +-- +-- @since 0.2.0.0 +proxyCons :: forall (x :: Symbol) (xs :: [Symbol]) . Proxy x -> Proxy xs -> Proxy (x ': xs) +proxyCons _ _ = Proxy + +-- | +-- Type level list append +-- +-- (moved from @Data.TypedEncoding.Common.Class.Common@) +-- +-- @since 0.1.0.0 +type family Append (xs :: [k]) (ys :: [k]) :: [k] where + Append '[] xs = xs + Append (y ': ys) xs = y ': Append ys xs + + +-- | -- @since 0.2.1.0 type family AcceptEq (msg :: ErrorMessage) (c :: Ordering) :: Bool where AcceptEq _ EQ = True AcceptEq msg _ = TypeError msg --- ! +-- | -- @since 0.4.0.0 type family OrdBool (c :: Ordering) :: Bool where OrdBool EQ = 'True OrdBool _ = 'False --- ! +-- | -- @since 0.2.1.0 type family And (b1 :: Bool) (b2 :: Bool) :: Bool where And 'True 'True = 'True And _ _ = 'False --- ! +-- | -- @since 0.2.1.0 type family Or (b1 :: Bool) (b2 :: Bool) :: Bool where Or 'False 'False = 'False Or _ _ = 'True --- ! +-- | -- @since 0.2.1.0 type family If (b1 :: Bool) (a :: k) (b :: k) :: k where If 'True a _ = a If 'False _ b = b --- ! +-- | -- @since 0.2.1.0 type family Repeat (n :: Nat) (s :: Symbol) :: Symbol where Repeat 0 s = "" Repeat n s = AppendSymbol s (Repeat (n - 1) s) --- ! +-- | -- @since 0.2.1.0 type family Fst (s :: (k,h)) :: k where Fst ('(,) a _) = a diff --git a/src/Data/TypedEncoding/Conv/Text.hs b/src/Data/TypedEncoding/Conv/Text.hs --- a/src/Data/TypedEncoding/Conv/Text.hs +++ b/src/Data/TypedEncoding/Conv/Text.hs @@ -27,6 +27,13 @@ ) => Enc xs c String -> Enc xs c T.Text pack = unsafeChangePayload T.pack +-- | simplified version of @pack@ that works on single /r-/ encodings +-- @since 0.5.2.0 +pack1 :: ( + Superset "r-UNICODE.D76" y + ) => Enc '[y] c String -> Enc '[y] c T.Text +pack1 = pack + -- | This assumes that each of the encodings in @xs@ work work equivalently in @String@ and @Text@. -- This is similar to the assumptions made in 'pack'. unpack :: ( @@ -36,6 +43,13 @@ , AllEncodeInto "r-UNICODE.D76" encs ) => Enc xs c T.Text -> Enc xs c String unpack = unsafeChangePayload T.unpack + +-- | simplified version of @unpack@ that works on single /r-/ encodings +-- @since 0.5.2.0 +unpack1 :: ( + Superset "r-UNICODE.D76" y + ) => Enc '[y] c T.Text -> Enc '[y] c String +unpack1 = unpack -- | -- Text is automatically @"r-UTF8"@ encoded diff --git a/src/Data/TypedEncoding/Conv/Text/Encoding.hs b/src/Data/TypedEncoding/Conv/Text/Encoding.hs --- a/src/Data/TypedEncoding/Conv/Text/Encoding.hs +++ b/src/Data/TypedEncoding/Conv/Text/Encoding.hs @@ -4,6 +4,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} -- | -- @since 0.2.2.0 @@ -25,6 +26,7 @@ -- >>> import Test.QuickCheck -- >>> import Test.QuickCheck.Instances.Text() -- >>> import Test.QuickCheck.Instances.ByteString() +-- >>> import Data.TypedEncoding.Instances.Restriction.BoundedAlphaNums() -- >>> import qualified Data.ByteString.Char8 as B8 -- >>> import Data.Char -- >>> import Data.Either @@ -57,11 +59,11 @@ -- To be consistent we make the same assumption of also restricting representable Unicode chars as in /Unicode.D76/. -- -- >>> TE.decodeUtf8 "\237\160\128" --- "*** Exception: Cannot decode byte '\xed': Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream +-- "*** Exception: Cannot decode byte '\xed': Data.Text.Encoding: Invalid UTF-8 stream -- -- The "\xdfff" case (@11101101 10111111 10111111@ @ed bf bf@): -- >>> TE.decodeUtf8 "\237\191\191" --- "*** Exception: Cannot decode byte '\xed': Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream +-- "*** Exception: Cannot decode byte '\xed': Data.Text.Encoding: Invalid UTF-8 stream -- -- >>> displ . decodeUtf8 $ (unsafeSetPayload () "Hello" :: Enc '["r-ASCII"] () B.ByteString) -- "Enc '[r-ASCII] () (Text Hello)" @@ -71,24 +73,34 @@ -- >>> displ . utf8Demote . decodeUtf8 $ (unsafeSetPayload () "Hello" :: Enc '["r-UTF8"] () B.ByteString) -- "Enc '[] () (Text Hello)" -- --- @decodeUtf8@ and @encodeUtf8@ form isomorphism +-- @decodeUtf8@ and @encodeUtf8@ now form isomorphism -- --- prop> \x -> getPayload x == (getPayload . encodeUtf8 . decodeUtf8 @ '["r-UTF8"] @() $ x) +-- prop> \x -> getPayload x == (getPayload . encodeUtf8 . decodeUtf8 @'["r-UTF8"] @() $ x) -- --- prop> \x -> getPayload x == (getPayload . decodeUtf8 . encodeUtf8 @ '["r-UTF8"] @() $ x) +-- prop> \x -> getPayload x == (getPayload . decodeUtf8 . encodeUtf8 @'["r-UTF8"] @() $ x) -- -- These nicely work as iso's for "r-ASCII" subset -- --- prop> \x -> getPayload x == (getPayload . encodeUtf8 . decodeUtf8 @ '["r-ASCII"] @() $ x) --- prop> \x -> getPayload x == (getPayload . decodeUtf8 . encodeUtf8 @ '["r-ASCII"] @() $ x) +-- prop> \x -> getPayload x == (getPayload . encodeUtf8 . decodeUtf8 @'["r-ASCII"] @() $ x) +-- prop> \x -> getPayload x == (getPayload . decodeUtf8 . encodeUtf8 @'["r-ASCII"] @() $ x) -- -- Similarly to 'Data.TypedEncoding.Conv.ByteString.Char8.pack' this function makes unverified assumption -- that the encoding stack @xs@ does invalidate UTF8 byte layout. This is safe for any "r-" encoding as well -- as any of the "enc-" and "do-" encodings that can be currently found in this library. -- Future versions of this method are likely to introduce constraints that guarantee better type safety. -- +-- +-- This is technically unsafe (even if we ignore the use of @unsafeSetPayload@) of decodeUtf8 +-- since currently @"r-ban:999"@ does not have @ByteString@ instances and that violates the assumption of matching encoding/decoding stacks +-- on both sides. +-- >>> displ . decodeUtf8 $ (unsafeSetPayload () "123" :: Enc '["r-ban:999"] () B.ByteString) +-- "Enc '[r-ban:999] () (Text 123)" +-- -- See "Data.TypedEncoding.Conv" for more detailed discussion. -- +-- Note: implementation uses the partial 'TE.decodeUtf8' function but provides type level guarantee that it this function +-- will not error out unless unsafe combinators were used in constructing the encoded input +-- -- @since 0.4.0.0 decodeUtf8 :: forall xs c t y ys encs. ( Knds.UnSnoc xs ~ '(,) ys y @@ -98,6 +110,13 @@ ) => Enc xs c B.ByteString -> Enc xs c T.Text decodeUtf8 = withUnsafe (fmap TE.decodeUtf8) +-- | simplified version of @decodeUtf8@ that works on single /r-/ encodings +-- @since 0.5.2.0 +decodeUtf8_1 :: ( + Superset "r-UTF8" y + ) => Enc '[y] c B.ByteString -> Enc '[y] c T.Text +decodeUtf8_1 = decodeUtf8 + -- | -- >>> displ $ encodeUtf8 $ utf8Promote $ toEncoding () ("text" :: T.Text) -- "Enc '[r-UTF8] () (ByteString text)" @@ -114,3 +133,10 @@ , AllEncodeInto "r-UTF8" encs ) => Enc xs c T.Text -> Enc xs c B.ByteString encodeUtf8 = withUnsafe (fmap TE.encodeUtf8) + +-- | simplified version of @decodeUtf8@ that works on single /r-/ encodings +-- @since 0.5.2.0 +encodeUtf8_1 :: ( + Superset "r-UTF8" y + ) => Enc '[y] c T.Text -> Enc '[y] c B.ByteString +encodeUtf8_1 = encodeUtf8 diff --git a/src/Data/TypedEncoding/Conv/Text/Lazy.hs b/src/Data/TypedEncoding/Conv/Text/Lazy.hs --- a/src/Data/TypedEncoding/Conv/Text/Lazy.hs +++ b/src/Data/TypedEncoding/Conv/Text/Lazy.hs @@ -20,8 +20,22 @@ ) => Enc xs c String -> Enc xs c TL.Text pack = unsafeChangePayload TL.pack +-- | simplified version of @pack@ that works on single /r-/ encodings +-- @since 0.5.2.0 +pack1 :: ( + Superset "r-UNICODE.D76" y + ) => Enc '[y] c String -> Enc '[y] c TL.Text +pack1 = pack + unpack :: Enc xs c TL.Text -> Enc xs c String unpack = unsafeChangePayload TL.unpack + +-- | simplified version of @unpack@ that works on single /r-/ encodings +-- @since 0.5.2.0 +unpack1 :: ( + Superset "r-UNICODE.D76" y + ) => Enc '[y] c TL.Text -> Enc '[y] c String +unpack1 = unpack -- | Text is automatically @"r-UTF8"@ encoded utf8Promote :: Enc xs c TL.Text -> Enc (Snoc xs "r-UTF8") c TL.Text diff --git a/src/Data/TypedEncoding/Conv/Text/Lazy/Encoding.hs b/src/Data/TypedEncoding/Conv/Text/Lazy/Encoding.hs --- a/src/Data/TypedEncoding/Conv/Text/Lazy/Encoding.hs +++ b/src/Data/TypedEncoding/Conv/Text/Lazy/Encoding.hs @@ -29,6 +29,13 @@ ) => Enc xs c BL.ByteString -> Enc xs c TL.Text decodeUtf8 = withUnsafe (fmap TEL.decodeUtf8) +-- | simplified version of @decodeUtf8@ that works on single /r-/ encodings +-- @since 0.5.2.0 +decodeUtf8_1 :: ( + Superset "r-UTF8" y + ) => Enc '[y] c BL.ByteString -> Enc '[y] c TL.Text +decodeUtf8_1 = decodeUtf8 + -- | Lazy version of 'Data.TypedEncoding.Conv.Text.Encoding.encodeUtf8' encodeUtf8 :: forall xs c t y ys encs. ( Knds.UnSnoc xs ~ '(,) ys y @@ -37,3 +44,10 @@ , AllEncodeInto "r-UTF8" encs ) => Enc xs c TL.Text -> Enc xs c BL.ByteString encodeUtf8 = withUnsafe (fmap TEL.encodeUtf8) + +-- | simplified version of @decodeUtf8@ that works on single /r-/ encodings +-- @since 0.5.2.0 +encodeUtf8_1 :: ( + Superset "r-UTF8" y + ) => Enc '[y] c TL.Text -> Enc '[y] c BL.ByteString +encodeUtf8_1 = encodeUtf8 diff --git a/src/Data/TypedEncoding/Instances/Do/Sample.hs b/src/Data/TypedEncoding/Instances/Do/Sample.hs deleted file mode 100644 --- a/src/Data/TypedEncoding/Instances/Do/Sample.hs +++ /dev/null @@ -1,78 +0,0 @@ - -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} - --- | This module defines some sample "do-" encodings --- currently for example use only. --- --- WARNING this Module will be moved to Examples in future versions -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 Data.Char - -import Data.TypedEncoding.Instances.Support -import Data.TypedEncoding.Instances.Support.Unsafe - --- | --- @since 0.3.0.0 -instance Applicative f => Encode f "do-UPPER" "do-UPPER" c T.Text where - encoding = _implEncodingP T.toUpper - -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 => Encode f "do-UPPER" "do-UPPER" c TL.Text where - encoding = _implEncodingP TL.toUpper - - --- | --- @since 0.3.0.0 -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 - --- | --- @since 0.3.0.0 -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 - --- | --- @since 0.3.0.0 -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 - --- | --- @since 0.1.0.0 -newtype SizeLimit = SizeLimit {unSizeLimit :: Int} deriving (Eq, Show) - --- | --- @since 0.3.0.0 -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 --- a/src/Data/TypedEncoding/Instances/Enc/Base64.hs +++ b/src/Data/TypedEncoding/Instances/Enc/Base64.hs @@ -17,20 +17,17 @@ 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.Base64 as B64 import qualified Data.ByteString.Base64.Lazy as BL64 +import Data.TypedEncoding.Instances.Restriction.Base64 () -- $setup -- >>> :set -XOverloadedStrings -XScopedTypeVariables -XKindSignatures -XMultiParamTypeClasses -XDataKinds -XPolyKinds -XPartialTypeSignatures -XFlexibleInstances -XTypeApplications -- >>> import Test.QuickCheck --- >>> import Test.QuickCheck.Instances.Text() -- >>> import Test.QuickCheck.Instances.ByteString() -- >>> :{ -- instance Arbitrary (UncheckedEnc () B.ByteString) where @@ -55,19 +52,42 @@ acceptLenientL :: Enc ("enc-B64-len" ': ys) c BL.ByteString -> Enc ("enc-B64" ': ys) c BL.ByteString acceptLenientL = withUnsafeCoerce (BL64.encode . BL64.decodeLenient) --- | allow to treat B64 encodings as ASCII forgetting about B64 encoding +-- | +-- Validated "r-B64" is guaranteed to decode. -- +-- Use flattenAs in the other direction. +-- +-- This would not be safe for Text +asEncodingB :: Enc '["r-B64"] c B.ByteString -> Enc '["enc-B64"] c B.ByteString +asEncodingB = withUnsafeCoerce id + +-- | +-- Validated "r-B64" is guaranteed to decode. +-- This would not be safe for Text +asEncodingBL :: Enc '["r-B64"] c BL.ByteString -> Enc '["enc-B64"] c BL.ByteString +asEncodingBL = withUnsafeCoerce id + + +-- @"enc-B64-nontext"@ is deprecated, use "r-B64" -- +-- @since 0.1.0.0 +instance FlattenAs "r-ASCII" "enc-B64-nontext" where + +-- | allow to treat B64 encodings as ASCII forgetting about B64 encoding. +-- +-- Converting to "r-B64" is also an option now. +-- -- >>> let tstB64 = encodeAll . toEncoding () $ "Hello World" :: Enc '["enc-B64"] () B.ByteString --- >>> displ (flattenAs tstB64 :: Enc '["r-ASCII"] () B.ByteString) +-- >>> displ (flattenAs $ tstB64 :: Enc '["r-ASCII"] () B.ByteString) -- "Enc '[r-ASCII] () (ByteString SGVsbG8gV29ybGQ=)" -- +-- -- @since 0.1.0.0 -instance FlattenAs "r-ASCII" "enc-B64-nontext" where +instance FlattenAs "r-ASCII" "enc-B64" where -- | --- @since 0.1.0.0 -instance FlattenAs "r-ASCII" "enc-B64" where +-- @since 0.5.1.0 +instance FlattenAs "r-B64" "enc-B64" where -- | -- This is not precise, actually /Base 64/ uses a subset of ASCII @@ -84,13 +104,13 @@ -- -- @since 0.3.0.0 instance EncodingSuperset "enc-B64" where - type EncSuperset "enc-B64" = "r-ASCII" + type EncSuperset "enc-B64" = "r-B64" -- | --- >>> tstChar8Encodable @ '["enc-B64-len", "enc-B64"] +-- >>> tstChar8Encodable @'["enc-B64-len", "enc-B64"] -- "I am CHAR8 encodable" instance EncodingSuperset "enc-B64-len" where - type EncSuperset "enc-B64-len" = "r-ASCII" + type EncSuperset "enc-B64-len" = "r-B64" -- * Encoders @@ -116,16 +136,7 @@ encB64BL = _implEncodingP BL64.encode --- | This instance will likely be removed in future versions (performance concerns) --- --- @since 0.3.0.0 -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 -- | @@ -160,33 +171,6 @@ decB64BL = _implDecodingF (asUnexpected @"enc-B64" . BL64.decode) --- Kept for now but performance issues - --- | WARNING (performance) --- --- @since 0.3.0.0 -instance (UnexpectedDecodeErr f, Applicative f) => Decode f "enc-B64" "enc-B64" c T.Text where - decoding = decB64T - --- | --- @since 0.3.0.0 -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." #-} - --- | WARNING (performance) --- --- @since 0.3.0.0 -instance (UnexpectedDecodeErr f, Applicative f) => Decode f "enc-B64" "enc-B64" c TL.Text where - decoding = decB64TL - --- | --- @since 0.3.0.0 -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." #-} - - -- * Validation -- | @@ -199,27 +183,18 @@ instance (RecreateErr f, Applicative f) => Validate f "enc-B64" "enc-B64" c BL.ByteString where validation = validFromDec decB64BL --- | --- @since 0.3.0.0 -instance (RecreateErr f, Applicative f) => Validate f "enc-B64" "enc-B64" c T.Text where - validation = validFromDec decB64T --- | --- @since 0.3.0.0 -instance (RecreateErr f, Applicative f) => Validate f "enc-B64" "enc-B64" c TL.Text where - validation = validFromDec decB64TL - -- | Lenient decoding does not fail -- -- @since 0.3.0.0 instance Applicative f => Validate f "enc-B64-len" "enc-B64-len" c B.ByteString where - validation = mkValidation $ implTranP id + validation = _mkValidation $ implTranP id -- | Lenient decoding does not fail -- -- @since 0.3.0.0 instance Applicative f => Validate f "enc-B64-len" "enc-B64-len" c BL.ByteString where - validation = mkValidation $ implTranP id + validation = _mkValidation $ implTranP id diff --git a/src/Data/TypedEncoding/Instances/Enc/Warn/Base64.hs b/src/Data/TypedEncoding/Instances/Enc/Warn/Base64.hs new file mode 100644 --- /dev/null +++ b/src/Data/TypedEncoding/Instances/Enc/Warn/Base64.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +-- | Defines /Base64/ encoding for Text +-- This version has poor performance. +-- +-- @since 0.5.0.0 +module Data.TypedEncoding.Instances.Enc.Warn.Base64 {-# WARNING "Not optimized for performance" #-} where + +import Data.TypedEncoding +import Data.TypedEncoding.Instances.Support + +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.Base64 as B64 +import qualified Data.ByteString.Base64.Lazy as BL64 + +-- | This instance will likely be removed in future versions (performance concerns) +-- (Moved from "Data.TypedEncoding.Instances.Enc.Base64") + +-- @since 0.3.0.0 +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) +-- (Moved from "Data.TypedEncoding.Instances.Enc.Base64") +-- +-- @since 0.3.0.0 +endB64T :: Applicative f => Encoding f "enc-B64" "enc-B64" c T.Text +endB64T = _implEncodingP (TE.decodeUtf8 . B64.encode . TE.encodeUtf8) + + +-- | +-- +-- @since 0.3.0.0 +instance (UnexpectedDecodeErr f, Applicative f) => Decode f "enc-B64" "enc-B64" c T.Text where + decoding = decB64T + +-- | +-- @since 0.3.0.0 +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) + +-- | +-- +-- @since 0.3.0.0 +instance (UnexpectedDecodeErr f, Applicative f) => Decode f "enc-B64" "enc-B64" c TL.Text where + decoding = decB64TL + +-- | +-- @since 0.3.0.0 +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) + +-- | +-- @since 0.3.0.0 +instance (RecreateErr f, Applicative f) => Validate f "enc-B64" "enc-B64" c T.Text where + validation = validFromDec decB64T + +-- | +-- @since 0.3.0.0 +instance (RecreateErr f, Applicative f) => Validate f "enc-B64" "enc-B64" c TL.Text where + validation = validFromDec decB64TL + diff --git a/src/Data/TypedEncoding/Instances/Restriction/ASCII.hs b/src/Data/TypedEncoding/Instances/Restriction/ASCII.hs --- a/src/Data/TypedEncoding/Instances/Restriction/ASCII.hs +++ b/src/Data/TypedEncoding/Instances/Restriction/ASCII.hs @@ -11,13 +11,13 @@ -- -- This is sometimes referred to as ASCII-7 and future versions of @type-encoding@ may change @"r-ASCII"@ symbol annotation to reflect this. -- --- prop> B8.all ((< 128) . ord) . getPayload @ '["r-ASCII"] @() @B.ByteString +-- prop> B8.all ((< 128) . ord) . getPayload @'["r-ASCII"] @() @B.ByteString -- -- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds --- >>> encodeFAll . toEncoding () $ "Hello World" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text) +-- >>> _runEncodings encodings . toEncoding () $ "Hello World" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text) -- Right (UnsafeMkEnc Proxy () "Hello World") -- --- >>> encodeFAll . toEncoding () $ "\194\160" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text) +-- >>> _runEncodings encodings . toEncoding () $ "\194\160" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text) -- Left (EncodeEx "r-ASCII" (NonAsciiChar '\194')) -- -- @since 0.1.0.0 diff --git a/src/Data/TypedEncoding/Instances/Restriction/Base64.hs b/src/Data/TypedEncoding/Instances/Restriction/Base64.hs new file mode 100644 --- /dev/null +++ b/src/Data/TypedEncoding/Instances/Restriction/Base64.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE DataKinds #-} +--{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +--{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PartialTypeSignatures #-} +--{-# LANGUAGE TypeApplications #-} + +-- | 'r-B64' is restricted to values that are valid Base64 encodings of some data. +-- For example, @Enc '["r-B64"] () T.Text@ can contain encoded binary image. +-- +-- "enc-B64" can be converted to "r-B64" using @flattenAs@ defined in +-- 'Data.TypedEncoding.Instances.Enc.Base64'. +-- However, there is no, and there should be no conversion general conversion from "r-B64" back to "enc-B64": +-- @Enc '["r-B64"] () T.Text@ is not B64 encoded text, it is B64 encoded something. +-- +-- @since 0.5.1.0 +module Data.TypedEncoding.Instances.Restriction.Base64 where + +import Data.TypedEncoding.Instances.Support + + +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 qualified Data.Text.Encoding as TE +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.Char8 as B8 +import qualified Data.TypedEncoding.Instances.Restriction.ASCII as RAscii + +-- $setup +-- >>> :set -XScopedTypeVariables -XKindSignatures -XMultiParamTypeClasses -XDataKinds -XPolyKinds -XPartialTypeSignatures -XFlexibleInstances -XTypeApplications + + + +instance Encode (Either EncodeEx) "r-B64" "r-B64" c B.ByteString where + encoding = encRB64B + +instance Encode (Either EncodeEx) "r-B64" "r-B64" c BL.ByteString where + encoding = encRB64BL + + +instance Encode (Either EncodeEx) "r-B64" "r-B64" c T.Text where + encoding = encRB64T + +instance Encode (Either EncodeEx) "r-B64" "r-B64" c TL.Text where + encoding = encRB64TL + +instance Encode (Either EncodeEx) "r-B64" "r-B64" c String where + encoding = encRB64S + +-- using lazy decoding to detect errors seems to be the fastest option that is not super hard to code + + +encRB64B :: Encoding (Either EncodeEx) "r-B64" "r-B64" c B.ByteString +encRB64B = _implEncodingEx (implVerifyR (B64.decode)) + +encRB64BL :: Encoding (Either EncodeEx) "r-B64" "r-B64" c BL.ByteString +encRB64BL = _implEncodingEx (implVerifyR (BL64.decode)) + +-- | Converts text to bytestring using UTF8 decoding and then verify encoding in ByteString +-- This is safe without verifying ASCII, any non-ASCII text will still convert to ByteString +-- but will fail B64.decode (TODO tests would be nice) +encRB64T :: Encoding (Either EncodeEx) "r-B64" "r-B64" c T.Text +encRB64T = _implEncodingEx (implVerifyR (B64.decode . TE.encodeUtf8)) + +encRB64TL :: Encoding (Either EncodeEx) "r-B64" "r-B64" c TL.Text +encRB64TL = _implEncodingEx (implVerifyR (BL64.decode . TEL.encodeUtf8)) + +encRB64S :: Encoding (Either EncodeEx) "r-B64" "r-B64" c String +encRB64S = _implEncodingEx (implVerifyR (fmap (B64.decode . B8.pack) . either (Left . show) Right . RAscii.encImpl)) + +-- -- * Decoding + +instance (Applicative f) => Decode f "r-B64" "r-B64" c str where + decoding = decAnyR + +instance (RecreateErr f, Applicative f) => Validate f "r-B64" "r-B64" c B.ByteString where + validation = validR encRB64B + +instance (RecreateErr f, Applicative f) => Validate f "r-B64" "r-B64" c BL.ByteString where + validation = validR encRB64BL + +instance (RecreateErr f, Applicative f) => Validate f "r-B64" "r-B64" c T.Text where + validation = validR encRB64T + +instance (RecreateErr f, Applicative f) => Validate f "r-B64" "r-B64" c TL.Text where + validation = validR encRB64TL + +instance (RecreateErr f, Applicative f) => Validate f "r-B64" "r-B64" c String where + validation = validR encRB64S + diff --git a/src/Data/TypedEncoding/Instances/Restriction/Bool.hs b/src/Data/TypedEncoding/Instances/Restriction/Bool.hs deleted file mode 100644 --- a/src/Data/TypedEncoding/Instances/Restriction/Bool.hs +++ /dev/null @@ -1,434 +0,0 @@ - -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE AllowAmbiguousTypes #-} - --- | --- Boolean algebra on encodings --- --- @since 0.2.1.0 --- --- /(Experimental, early alpha development stage)/ --- --- Use 'Data.TypedEncoding.Instances.Support.Bool' instead. --- --- This module was not converted to v0.3 style yet. --- --- == Grammar --- --- Simple grammar requires boolean terms to be included in parentheses --- --- @ --- bool[BinaryOp]:(leftTerm)(rightTerm) --- bool[UnaryOp]:(term) --- @ --- --- Expected behavior is described next to the corresponding combinator. --- --- @since 0.2.2.0 -module Data.TypedEncoding.Instances.Restriction.Bool where - - -import GHC.TypeLits -import Data.Proxy -import Data.Symbol.Ascii - -import Data.TypedEncoding -import Data.TypedEncoding.Instances.Support -import Data.TypedEncoding.Instances.Support.Unsafe - - - --- $setup --- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XTypeApplications --- >>> import qualified Data.Text as T --- >>> import Data.TypedEncoding.Instances.Restriction.Misc() - - --- | --- See examples in 'encBoolOrRight'' -encBoolOrLeft :: forall f s t xs c str . ( - BoolOpIs s "or" ~ 'True - -- IsBoolOr s ~ 'True - , Functor f - , LeftTerm s ~ t - ) => (Enc xs c str -> f (Enc (t ': xs) c str)) -> Enc xs c str -> f (Enc (s ': xs) c str) -encBoolOrLeft = implChangeAnn - --- | --- See examples in 'encBoolOrRight'' -encBoolOrLeft' :: forall f s t xs c str . ( - BoolOpIs s "or" ~ 'True - -- IsBoolOr s ~ 'True - , Functor f - , LeftTerm s ~ t - , Encode f t t c str - ) => Enc xs c str -> f (Enc (s ': xs) c str) -encBoolOrLeft' = encBoolOrLeft'' @t - -encBoolOrLeft'' :: forall alg f s t xs c str . ( - BoolOpIs s "or" ~ 'True - -- IsBoolOr s ~ 'True - , Functor f - , LeftTerm s ~ t - , Encode f t alg c str - ) => Enc xs c str -> f (Enc (s ': xs) c str) -encBoolOrLeft'' = encBoolOrLeft (encodeF' @alg @t @xs @f) - --- | --- -encBoolOrRight :: forall f s t xs c str . ( - BoolOpIs s "or" ~ 'True - -- IsBoolOr s ~ 'True - , Functor f - , RightTerm s ~ t - ) => (Enc xs c str -> f (Enc (t ': xs) c str)) -> Enc xs c str -> f (Enc (s ': xs) c str) -encBoolOrRight = implChangeAnn - --- | --- >>> :{ --- let tst1, tst2, tst3 :: Either EncodeEx (Enc '["boolOr:(r-Word8-decimal)(r-Int-decimal)"] () T.Text) --- tst1 = encBoolOrLeft' . toEncoding () $ "212" --- tst2 = encBoolOrRight' . toEncoding () $ "1000000" --- tst3 = encBoolOrLeft' . toEncoding () $ "1000000" --- :} --- --- >>> tst1 --- Right (UnsafeMkEnc Proxy () "212") --- --- >>> tst2 --- Right (UnsafeMkEnc Proxy () "1000000") --- --- >>> tst3 --- Left (EncodeEx "r-Word8-decimal" ("Payload does not satisfy format Word8-decimal: 1000000")) -encBoolOrRight' :: forall f s t xs c str . ( - BoolOpIs s "or" ~ 'True - -- IsBoolOr s ~ 'True - , Functor f - , RightTerm s ~ t - , Encode f t t c str - ) => Enc xs c str -> f (Enc (s ': xs) c str) -encBoolOrRight' = encBoolOrRight'' @t - -encBoolOrRight'' :: forall alg f s t xs c str . ( - BoolOpIs s "or" ~ 'True - -- IsBoolOr s ~ 'True - , Functor f - , RightTerm s ~ t - , Encode f t alg c str - ) => Enc xs c str -> f (Enc (s ': xs) c str) -encBoolOrRight'' = encBoolOrRight (encodeF' @alg @t @xs @f) - -encBoolAnd :: forall f s t1 t2 xs c str . ( - BoolOpIs s "and" ~ 'True - , KnownSymbol s - -- IsBoolAnd s ~ 'True - , f ~ Either EncodeEx - , Eq str - , LeftTerm s ~ t1 - , RightTerm s ~ t2 - ) => - (Enc xs c str -> f (Enc (t1 ': xs) c str)) - -> (Enc xs c str -> f (Enc (t2 : xs) c str)) - -> Enc xs c str -> f (Enc (s ': xs) c str) -encBoolAnd fnl fnr en0 = - let - eent1 = fnl en0 - eent2 = fnr en0 - p = (Proxy :: Proxy s) - in - case (eent1, eent2) of - (Right ent1, Right ent2) -> - if getPayload ent1 == getPayload ent2 - then Right . withUnsafeCoerce id $ ent1 - else Left $ EncodeEx p "Left - right encoding do not match" - (_, _) -> mergeErrs (emptyEncErr p) (mergeEncodeEx p) eent1 eent2 - --- | --- @"boolOr:(enc1)(enc2)"@ contains strings that encode the same way under both encodings. --- for example @"boolOr:(r-UPPER)(r-lower)"@ valid elements would include @"123-34"@ but not @"abc"@ --- --- >>> :{ --- let tst1, tst2 :: Either EncodeEx (Enc '["boolAnd:(r-Word8-decimal)(r-Int-decimal)"] () T.Text) --- tst1 = encBoolAnd' . toEncoding () $ "234" --- tst2 = encBoolAnd' . toEncoding () $ "100000" --- :} --- --- >>> tst1 --- Right (UnsafeMkEnc Proxy () "234") --- >>> tst2 --- Left (EncodeEx "r-Word8-decimal" ("Payload does not satisfy format Word8-decimal: 100000")) -encBoolAnd' :: forall s t1 t2 xs c str . ( - BoolOpIs s "and" ~ 'True - , KnownSymbol s - -- IsBoolAnd s ~ 'True - , Eq str - , LeftTerm s ~ t1 - , RightTerm s ~ t2 - , Encode (Either EncodeEx) t1 t1 c str - , Encode (Either EncodeEx) t2 t2 c str - ) => Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str) -encBoolAnd' = encBoolAnd'' @t1 @t2 - -encBoolAnd'' :: forall al1 al2 s t1 t2 xs c str . ( - BoolOpIs s "and" ~ 'True - , KnownSymbol s - -- IsBoolAnd s ~ 'True - , Eq str - , LeftTerm s ~ t1 - , RightTerm s ~ t2 - , Encode (Either EncodeEx) t1 al1 c str - , Encode (Either EncodeEx) t2 al2 c str - ) => Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str) -encBoolAnd'' = encBoolAnd (encodeF' @al1 @t1 @xs) (encodeF' @al2 @t2 @xs) - - --- tst1, tst2 :: Either EncodeEx (Enc '["boolNot:(r-Word8-decimal)"] () T.Text) --- tst1 = encBoolNot' . toEncoding () $ "334" --- tst2 = encBoolNot' . toEncoding () $ "127" - -encBoolNot :: forall s t xs c str . ( - BoolOpIs s "not" ~ 'True - , KnownSymbol s - , FirstTerm s ~ t - , Restriction t - ) => (Enc xs c str -> Either EncodeEx (Enc (t ': xs) c str)) -> Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str) -encBoolNot fn en0 = - let - een = fn en0 - p = (Proxy :: Proxy s) - pt = (Proxy :: Proxy t) - in - case een of - Left _ -> Right . withUnsafeCoerce id $ en0 - Right _ -> Left $ EncodeEx p $ "Encoding " ++ symbolVal pt ++ " succeeded" - - --- | --- >>> :{ --- let tst1, tst2 :: Either EncodeEx (Enc '["boolNot:(r-Word8-decimal)"] () T.Text) --- tst1 = encBoolNot' . toEncoding () $ "334" --- tst2 = encBoolNot' . toEncoding () $ "127" --- :} --- --- >>> tst1 --- Right (UnsafeMkEnc Proxy () "334") --- >>> tst2 --- Left (EncodeEx "boolNot:(r-Word8-decimal)" ("Encoding r-Word8-decimal succeeded")) -encBoolNot' :: forall s t xs c str . ( - BoolOpIs s "not" ~ 'True - , KnownSymbol s - , FirstTerm s ~ t - , KnownSymbol t - , Restriction t - , Encode (Either EncodeEx) t t c str - ) => Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str) -encBoolNot' = encBoolNot'' @t - -encBoolNot'' :: forall alg s t xs c str . ( - BoolOpIs s "not" ~ 'True - , KnownSymbol s - , FirstTerm s ~ t - , Restriction t - , Encode (Either EncodeEx) t alg c str - ) => Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str) -encBoolNot'' = encBoolNot (encodeF' @alg @t @xs) - --- | --- Decodes boolean expression if all leaves are @"r-"@ -decBoolR :: forall f xs t s c str . ( - NestedR s ~ 'True - , Applicative f - ) => Enc (s ': xs) c str -> f (Enc xs c str) - -decBoolR = implTranP id - - -recWithEncBoolR :: forall (s :: Symbol) xs c str . (NestedR s ~ 'True) - => (Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str)) - -> Enc xs c str -> Either RecreateEx (Enc (s ': xs) c str) -recWithEncBoolR = unsafeRecWithEncR - -unsafeRecWithEncR :: forall (s :: Symbol) xs c str . - (Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str)) - -> Enc xs c str -> Either RecreateEx (Enc (s ': xs) c str) -unsafeRecWithEncR fn = either (Left . encToRecrEx) Right . fn - --- * Type family based parser - --- | --- >>> :kind! BoolOpIs "boolAnd:(someenc)(otherenc)" "and" --- ... --- = 'True -type family BoolOpIs (s :: Symbol) (op :: Symbol) :: Bool where - BoolOpIs s op = AcceptEq ('Text "Invalid bool encoding " ':<>: ShowType s ) (CmpSymbol (BoolOp s) op) - --- | --- This works fast with @!kind@ but is much slower in declaration --- :kind! BoolOp "boolOr:()()" -type family BoolOp (s :: Symbol) :: Symbol where - BoolOp s = Fst (BoolOpHelper (Dupl s)) - -- ToLower (TakeUntil (Drop 4 s) ":") - -type family BoolOpHelper (x :: (Symbol, Symbol)) :: (Symbol, Bool) where - BoolOpHelper ('(,) s1 s2) = '(,) (ToLower (TakeUntil (Drop 4 s1) ":")) ( AcceptEq ('Text "Invalid bool encoding " ':<>: ShowType s2 ) (CmpSymbol "bool" (Take 4 s2))) - - -type family IsBool (s :: Symbol) :: Bool where - IsBool s = AcceptEq ('Text "Not boolean encoding " ':<>: ShowType s ) (CmpSymbol "bool" (Take 4 s)) - --- | --- --- >>> :kind! NestedR "boolOr:(r-abc)(r-cd)" --- ... --- = 'True --- --- >>> :kind! NestedR "boolOr:(boolAnd:(r-ab)(r-ac))(boolNot:(r-cd))" --- ... --- = 'True --- --- >>> :kind! NestedR "boolOr:(boolAnd:(r-ab)(ac))(boolNot:(r-cd))" --- ... --- ... (TypeError ...) --- ... -type family NestedR (s :: Symbol) :: Bool where - NestedR "" = 'True -- RightTerm, LeftTerm return "" on "r-" - NestedR s = Or (IsROrEmpty s) - (And (IsBool s) (And (NestedR (LeftTerm s)) (NestedR (RightTerm s)))) - --- Value level check --- --- nestedR :: String -> Bool --- nestedR s = isROrEmpty s || isBool s && (nestedR (leftTerm s) && nestedR (rightTerm s)) - --- isBool ('b' :'o' : 'o' : _) = True --- isBool _ = False - --- isROrEmpty "" = True --- isROrEmpty ('r' : '-' : _) = True --- isROrEmpty _ = False - - -type family FirstTerm (s :: Symbol) :: Symbol where - FirstTerm s = LeftTerm s - --- | --- returns "" for unary operator -type family SecondTerm (s :: Symbol) :: Symbol where - SecondTerm s = RightTerm s - - --- | --- >>> :kind! LeftTerm "boolSomeOp:(agag)(222)" --- ... --- = "agag" --- --- >>> :kind! LeftTerm "r-Int-decimal" --- ... --- = "" -type family LeftTerm (s :: Symbol) :: Symbol where - LeftTerm s = Concat (LDropLast( LTakeFstParen (LParenCnt (ToList s)))) - --- | --- >>> :kind! RightTerm "boolSomeOp:(agag)(222)" --- ... --- = "222" --- --- >>> :kind! RightTerm "r-Int-decimal" --- ... --- = "" -type family RightTerm (s :: Symbol) :: Symbol where - RightTerm s = Concat (LDropLast (LTakeSndParen 0 (LParenCnt (ToList s)))) - - -type family LDropLast (s :: [Symbol]) :: [Symbol] where - LDropLast '[] = '[] - LDropLast '[x] = '[] - LDropLast (x ': xs) = x ': LDropLast xs - - -type family LParenCnt (s :: [Symbol]) :: [(Symbol, Nat)] where - LParenCnt '[] = '[] - LParenCnt ("(" ': xs) = LParenCntHelper ('(,) "(" 'Decr) (LParenCnt xs) -- '(,) "(" (LParenCntFstCnt (LParenCnt xs) - 1) ': LParenCnt xs - LParenCnt (")" ': xs) = LParenCntHelper ('(,) ")" 'Incr) (LParenCnt xs) - LParenCnt (x ': xs) = LParenCntHelper ('(,) x 'NoChng) (LParenCnt xs) - -data Adjust = Incr | Decr | NoChng - -type family AdjHelper (a :: Adjust) (n :: Nat) :: Nat where - AdjHelper 'Incr n = n + 1 - AdjHelper 'Decr 0 = 0 - AdjHelper 'Decr n = n - 1 - AdjHelper 'NoChng n = n - -type family LParenCntHelper (s :: (Symbol, Adjust)) (sx :: [(Symbol, Nat)]) :: [(Symbol, Nat)] where - LParenCntHelper ('(,) x k) '[] = '(,) x (AdjHelper k 0) ': '[] - LParenCntHelper ('(,) x k) ('(,) c i : xs) = '(,) x (AdjHelper k i) ': '(,) c i ': xs - - -type family LTakeFstParen (si :: [(Symbol, Nat)]) :: [Symbol] where - LTakeFstParen '[] = '[] - LTakeFstParen ('(,) _ 0 ': xs) = LTakeFstParen xs - LTakeFstParen ('(,) ")" 1 ': _) = '[")"] - LTakeFstParen ('(,) a p ': xs) = a ': LTakeFstParen xs - - -type family LTakeSndParen (n :: Nat) (si :: [(Symbol, Nat)]) :: [Symbol] where - LTakeSndParen _ '[] = '[] - LTakeSndParen 0 ('(,) ")" 1 ': xs) = LTakeSndParen 1 xs - LTakeSndParen 1 ('(,) _ 0 : xs) = LTakeSndParen 1 xs - LTakeSndParen 0 ('(,) _ _ ': xs) = LTakeSndParen 0 xs - LTakeSndParen 1 ('(,) a _ ': xs) = a : LTakeSndParen 1 xs - LTakeSndParen n _ = '[] - --- -- * (Example) Value level equivalend of type family parsers - - --- -- map snd . parenCnt $ "((AGA)(bcd))(123) " --- -- dropLast . takeFstParen . parenCnt $ "((AGA)(bcd))(123)" --- -- dropLast . takeSndParen 0 . parenCnt $ "((AGA)(bcd))(123)" - --- leftTerm :: String -> String --- leftTerm = dropLast . takeFstParen . parenCnt - --- rightTerm :: String -> String --- rightTerm = dropLast . takeSndParen 0 . parenCnt - --- parenCnt :: String -> [(Char, Int)] --- parenCnt [] = [] --- parenCnt ('(' : xs) = parenCntHelper ('(', -1) (parenCnt xs) --('(', parenCntFstCnt (parenCnt xs) - 1) : parenCnt xs --- parenCnt (')' : xs) = parenCntHelper (')', 1) (parenCnt xs) -- (')', parenCntFstCnt (parenCnt xs) + 1) : parenCnt xs --- parenCnt (x : xs) = parenCntHelper (x, 0) (parenCnt xs) -- (x, parenCntFstCnt (parenCnt xs) ) : parenCnt xs - - --- parenCntHelper :: (Char, Int) -> [(Char, Int)] -> [(Char, Int)] --- parenCntHelper (x, k) [] = [(x,k)] --- parenCntHelper (x, k) ((c,i) : xs) = (x, i + k): (c,i) : xs - - --- takeFstParen :: [(Char, Int)] -> [Char] --- takeFstParen [] = [] --- takeFstParen ((_, 0) : xs) = takeFstParen xs --- takeFstParen ((')', 1) : _) = [')'] --- takeFstParen ((a, p) : xs) = a : takeFstParen xs - --- takeSndParen :: Int -> [(Char, Int)] -> [Char] --- takeSndParen _ [] = [] --- takeSndParen 0 ((')', 1) : xs) = takeSndParen 1 xs --- takeSndParen 1 ((_, 0) : xs) = takeSndParen 1 xs --- takeSndParen 0 ((_, _) : xs) = takeSndParen 0 xs --- takeSndParen 1 ((a, _) : xs) = a : takeSndParen 1 xs --- takeSndParen _ _ = [] - --- dropLast :: [Char] -> [Char] --- dropLast [] = [] --- dropLast [x] = [] --- dropLast (x:xs) = x : dropLast xs - diff --git a/src/Data/TypedEncoding/Instances/Restriction/CHAR8.hs b/src/Data/TypedEncoding/Instances/Restriction/CHAR8.hs --- a/src/Data/TypedEncoding/Instances/Restriction/CHAR8.hs +++ b/src/Data/TypedEncoding/Instances/Restriction/CHAR8.hs @@ -9,11 +9,11 @@ -- | -- --- Should not be used directly, only as superset +-- "r-CHAR8" should not be used directly, only as superset. -- --- Checks if all chars are @< \'\256\'@ +-- This module includes tests that verify that all chars are @< \'\256\'@ -- --- Encoding functions are here for test support only, no instances +-- Encoding functions are here for test support only, no instances. -- -- @since 0.3.1.0 module Data.TypedEncoding.Instances.Restriction.CHAR8 where diff --git a/src/Data/TypedEncoding/Instances/Restriction/D76.hs b/src/Data/TypedEncoding/Instances/Restriction/D76.hs --- a/src/Data/TypedEncoding/Instances/Restriction/D76.hs +++ b/src/Data/TypedEncoding/Instances/Restriction/D76.hs @@ -8,13 +8,16 @@ {-# LANGUAGE ScopedTypeVariables #-} -- | --- Checks that satisfy D76 Unicode standard (/text/ replaces chars that are in range --- U+D800 to U+DFFF inclusive) +-- "r-UNICODE.D76" restricts Unicode characters by excluding the range U+D800 to U+DFFF. -- --- Note, no IsSuperset "r-UNICODE.D76" "r-CHAR8" mapping even though the numeric range of D76 includes all CHAR8 bytes. +-- This is important because the commonly used @Text@ type from /text/ package replaces chars that are in range +-- U+D800 to U+DFFF (inclusive). +-- +-- Note, there is no @IsSuperset "r-UNICODE.D76" "r-CHAR8"@ mapping even though the numeric range of D76 includes all CHAR8 bytes. -- This is more /nominal/ decision that prevents certain unwanted conversions from being possible. -- --- Similarly no IsSuperset "r-UNICODE.D76" "r-ByteRep", this annotation acts as a guard to what can go into @Text@. +-- Similarly there is no IsSuperset "r-UNICODE.D76" "r-ByteRep", "r-UNICODE.D76" acts as a guard to what can go into @Text@ +-- and this prevents some unwanted conversions. -- -- @since 0.4.0.0 module Data.TypedEncoding.Instances.Restriction.D76 where diff --git a/src/Data/TypedEncoding/Instances/Restriction/Misc.hs b/src/Data/TypedEncoding/Instances/Restriction/Misc.hs --- a/src/Data/TypedEncoding/Instances/Restriction/Misc.hs +++ b/src/Data/TypedEncoding/Instances/Restriction/Misc.hs @@ -10,13 +10,13 @@ -- | Common /restriction/ "r-" instances -- --- Before v0.3 @Data.TypedEncoding.Instances.Restriction.Common@ +-- Renamed from @Data.TypedEncoding.Instances.Restriction.Common@ (v0.3) -- -- @since 0.2.0.0 module Data.TypedEncoding.Instances.Restriction.Misc where import Data.Word -import Data.Functor.Identity +-- import Data.Functor.Identity import Data.String import Data.Proxy import Text.Read @@ -27,20 +27,17 @@ -- $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 (IsString str, Applicative f) => ToEncString f "r-Word8-decimal" "r-Word8-decimal" Word8 str where + toEncF i = pure $ 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 + 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") @@ -52,8 +49,8 @@ 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) +instance (IsString str, Applicative f) => ToEncString f "r-Int-decimal" "r-Int-decimal" Int str where + toEncF i = pure $ 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") diff --git a/src/Data/TypedEncoding/Instances/Restriction/UTF8.hs b/src/Data/TypedEncoding/Instances/Restriction/UTF8.hs --- a/src/Data/TypedEncoding/Instances/Restriction/UTF8.hs +++ b/src/Data/TypedEncoding/Instances/Restriction/UTF8.hs @@ -16,7 +16,11 @@ -- conversion to @Text@ to work. -- -- @since 0.1.0.0 -module Data.TypedEncoding.Instances.Restriction.UTF8 where +module Data.TypedEncoding.Instances.Restriction.UTF8 ( + module Data.TypedEncoding.Instances.Restriction.UTF8 + -- * reexported for backward compatibility, will be removed in the future + , implVerifyR + ) where import Data.TypedEncoding.Instances.Support @@ -35,7 +39,6 @@ -- >>> import Test.QuickCheck.Instances.Text() -- >>> import Test.QuickCheck.Instances.ByteString() -- >>> import Data.TypedEncoding --- >>> import Data.TypedEncoding.Internal.Util (proxiedId) -- >>> let emptyUTF8B = unsafeSetPayload () "" :: Enc '["r-UTF8"] () B.ByteString -- >>> :{ -- instance Arbitrary (Enc '["r-UTF8"] () B.ByteString) where @@ -55,10 +58,10 @@ -- | 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) +-- >>> _runEncodings encodings . toEncoding () $ "\xc3\xb1" :: Either EncodeEx (Enc '["r-UTF8"] () B.ByteString) -- Right (UnsafeMkEnc Proxy () "\195\177") -- --- >>> encodeFAll . toEncoding () $ "\xc3\x28" :: Either EncodeEx (Enc '["r-UTF8"] () B.ByteString) +-- >>> _runEncodings encodings . toEncoding () $ "\xc3\x28" :: Either EncodeEx (Enc '["r-UTF8"] () B.ByteString) -- Left (EncodeEx "r-UTF8" (Cannot decode byte '\xc3': ... -- -- Following test uses 'verEncoding' helper that checks that bytes are encoded as Right iff they are valid UTF8 bytes @@ -81,7 +84,6 @@ -- using lazy decoding to detect errors seems to be the fastest option that is not super hard to code --- TODO v0.4.1 test performance encUTF8B :: Encoding (Either EncodeEx) "r-UTF8" "r-UTF8" c B.ByteString encUTF8B = _implEncodingEx (implVerifyR (TEL.decodeUtf8' . BL.fromStrict)) @@ -111,9 +113,3 @@ verEncoding bs (Left _) = isLeft . TE.decodeUtf8' $ bs verEncoding bs (Right _) = isRight . TE.decodeUtf8' $ bs --- | private implementation helper -implVerifyR :: (a -> Either err b) -> a -> Either err a -implVerifyR fn a = - case fn a of - Left err -> Left err - Right _ -> Right a diff --git a/src/Data/TypedEncoding/Instances/Support.hs b/src/Data/TypedEncoding/Instances/Support.hs --- a/src/Data/TypedEncoding/Instances/Support.hs +++ b/src/Data/TypedEncoding/Instances/Support.hs @@ -10,7 +10,6 @@ -- * Classes , module Data.TypedEncoding.Common.Class -- * 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 @@ -20,7 +19,6 @@ , module Data.TypedEncoding.Common.Util.TypeLits ) where -import Data.TypedEncoding.Instances.Support.Common import Data.TypedEncoding.Instances.Support.Helpers import Data.TypedEncoding.Instances.Support.Encode import Data.TypedEncoding.Instances.Support.Decode diff --git a/src/Data/TypedEncoding/Instances/Support/Common.hs b/src/Data/TypedEncoding/Instances/Support/Common.hs deleted file mode 100644 --- a/src/Data/TypedEncoding/Instances/Support/Common.hs +++ /dev/null @@ -1,42 +0,0 @@ - -{-# 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 --- --- @since 0.3.0.0 -decAnyR :: forall r f c str . (Restriction r, Applicative f) => Decoding f r r c str -decAnyR = decAnyR' @r @r - --- | --- @since 0.3.0.0 -decAnyR' :: forall alg r f c str . (Restriction r, Applicative f) => Decoding f r alg c str -decAnyR' = UnsafeMkDecoding Proxy (implTranP id) - --- | --- @since 0.3.0.0 -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 --- a/src/Data/TypedEncoding/Instances/Support/Decode.hs +++ b/src/Data/TypedEncoding/Instances/Support/Decode.hs @@ -3,12 +3,12 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} --- {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} --- | v0.2 style decoding combinators +-- | Common decoding combinators -- -- @since 0.3.0.0 module Data.TypedEncoding.Instances.Support.Decode where @@ -18,15 +18,34 @@ import Data.Proxy import Data.TypedEncoding.Common.Types +-- * Universal decoding for all "r-" types +-- | +-- +-- @since 0.3.0.0 +decAnyR :: forall r f c str . (Restriction r, Applicative f) => Decoding f r r c str +decAnyR = decAnyR' @r @r +-- | +-- @since 0.3.0.0 +decAnyR' :: forall alg r f c str . (Restriction r, Applicative f) => Decoding f r alg c str +decAnyR' = UnsafeMkDecoding Proxy (implTranP id) + +-- | +-- @since 0.3.0.0 +decAnyR_ :: forall r f c str alg . (Restriction r, Algorithm r alg, Applicative f) => Decoding f r alg c str +decAnyR_ = _mkDecoding $ implTranP id + + +-- * v0.2 style decoding combinators + -- * 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 +_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 +_implDecodingConfF f = _mkDecoding $ implTranF' f -- * Assume @alg ~ nm@ or explicit @alg@ diff --git a/src/Data/TypedEncoding/Instances/Support/Encode.hs b/src/Data/TypedEncoding/Instances/Support/Encode.hs --- a/src/Data/TypedEncoding/Instances/Support/Encode.hs +++ b/src/Data/TypedEncoding/Instances/Support/Encode.hs @@ -84,3 +84,10 @@ p = Proxy :: Proxy nm +-- | +-- @since 0.5.1.0 +implVerifyR :: (a -> Either err b) -> a -> Either err a +implVerifyR fn a = + case fn a of + Left err -> Left err + Right _ -> Right a diff --git a/src/Data/TypedEncoding/Instances/Support/Helpers.hs b/src/Data/TypedEncoding/Instances/Support/Helpers.hs --- a/src/Data/TypedEncoding/Instances/Support/Helpers.hs +++ b/src/Data/TypedEncoding/Instances/Support/Helpers.hs @@ -8,11 +8,12 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleContexts #-} --- | Support for mostly creating instances ToEncString and FromEncString conversions +-- | Various helper functions. +-- There are mostly for for creating @ToEncString@ and @FromEncString@ instances module Data.TypedEncoding.Instances.Support.Helpers where -import Data.String +-- import Data.String import Data.Proxy import Text.Read import Data.TypedEncoding.Common.Types @@ -39,13 +40,6 @@ => c -> (s1 -> s2 -> s2) -> s2 -> f (Enc xs1 c s1) -> Enc xs2 c s2 foldEnc c f sinit = unsafeSetPayload c . foldr f sinit . fmap getPayload --- | Similar to 'foldEnc', assumes that destination payload has @IsString@ instance and uses @""@ as base case. --- --- @since 0.2.0.0 -foldEncStr :: forall (xs2 :: [Symbol]) (xs1 :: [Symbol]) f c s1 s2 - . (Foldable f, Functor f, IsString s2) - => c -> (s1 -> s2 -> s2) -> f (Enc xs1 c s1) -> Enc xs2 c s2 -foldEncStr c f = foldEnc c f "" -- | Similar to 'foldEnc', works with untyped 'CheckedEnc' -- @@ -55,16 +49,11 @@ => c -> ([EncAnn] -> s1 -> s2 -> s2) -> s2 -> f (CheckedEnc c s1) -> Enc xs2 c s2 foldCheckedEnc c f sinit = unsafeSetPayload c . foldr (uncurry f) sinit . fmap getCheckedEncPayload --- | Similar to 'foldEncStr', works with untyped 'CheckedEnc' --- --- @since 0.2.0.0 -foldCheckedEncStr :: forall (xs2 :: [Symbol]) f c s1 s2 . (Foldable f, Functor f, IsString s2) => c -> ([EncAnn] -> s1 -> s2 -> s2) -> f (CheckedEnc c s1) -> Enc xs2 c s2 -foldCheckedEncStr c f = foldCheckedEnc c f "" -- * Composite encoding: Recreate and Encode helpers --- | Splits composite payload into homogenious chunks +-- | Splits composite payload into homogeneous chunks -- -- @since 0.2.0.0 splitPayload :: forall (xs2 :: [Symbol]) (xs1 :: [Symbol]) c s1 s2 . @@ -75,12 +64,13 @@ -- | Untyped version of 'splitPayload' -- --- @since 0.2.0.0 -splitSomePayload :: forall c s1 s2 . +-- (renamed from @splitCheckedPayload@ in previous versions) +-- @since 0.5.0.0 +splitCheckedPayload :: forall c s1 s2 . ([EncAnn] -> s1 -> [([EncAnn], s2)]) -> CheckedEnc c s1 -> [CheckedEnc c s2] -splitSomePayload f (UnsafeMkCheckedEnc ann1 c s1) = map (\(ann2, s2) -> UnsafeMkCheckedEnc ann2 c s2) (f ann1 s1) +splitCheckedPayload f (UnsafeMkCheckedEnc ann1 c s1) = map (\(ann2, s2) -> UnsafeMkCheckedEnc ann2 c s2) (f ann1 s1) -- * Utility combinators @@ -108,14 +98,14 @@ -- | Convenience function for checking if @str@ decodes without error --- using @enc@ encoding markers and decoders that can pick decoder based +-- using @dec@ encoding markers and decoders that can pick decoder based -- on that marker -- -- @since 0.3.0.0 -verifyDynEnc :: forall s str err1 err2 enc a. (KnownSymbol s, Show err1, Show err2) => +verifyDynEnc :: forall s str err1 err2 dec a. (KnownSymbol s, Show err1, Show err2) => Proxy s -- ^ proxy defining encoding annotation - -> (Proxy s -> Either err1 enc) -- ^ finds encoding marker @enc@ for given annotation or fails - -> (enc -> str -> Either err2 a) -- ^ decoder based on @enc@ marker + -> (Proxy s -> Either err1 dec) -- ^ finds encoding marker @dec@ for given annotation or fails + -> (dec -> str -> Either err2 a) -- ^ decoder based on @dec@ marker -> str -- ^ input -> Either EncodeEx str verifyDynEnc p findenc decoder str = diff --git a/src/Data/TypedEncoding/Instances/Support/Unsafe.hs b/src/Data/TypedEncoding/Instances/Support/Unsafe.hs --- a/src/Data/TypedEncoding/Instances/Support/Unsafe.hs +++ b/src/Data/TypedEncoding/Instances/Support/Unsafe.hs @@ -10,6 +10,7 @@ -- | Direct use of these methods is discouraged. -- Use "Data.TypedEncoding.Instances.Support.Encode" or "Data.TypedEncoding.Instances.Support.Decode" +-- instead. module Data.TypedEncoding.Instances.Support.Unsafe where import Data.Proxy diff --git a/src/Data/TypedEncoding/Instances/Support/Validate.hs b/src/Data/TypedEncoding/Instances/Support/Validate.hs --- a/src/Data/TypedEncoding/Instances/Support/Validate.hs +++ b/src/Data/TypedEncoding/Instances/Support/Validate.hs @@ -8,10 +8,8 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeApplications #-} --- | Exports for instance creation. --- --- Contains typical things needed when implementing --- encoding, decoding, recreate, or type to string conversions. +-- | +-- Convenience validation utilities. module Data.TypedEncoding.Instances.Support.Validate where import Data.TypedEncoding.Common.Types import Data.TypedEncoding.Common.Class @@ -45,14 +43,13 @@ validR = validRFromEnc' @nm @nm --- TODO rename for consistency to _ - -- | Can cause slow compilation if used --- --- @since 0.3.0.0 -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' = validRFromEnc' @alg @nm - +-- +-- (renamed from validR defined in pre 0.5 versions) +-- +-- @since 0.5.0.0 +_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 = validRFromEnc' @alg @nm -- | @@ -60,18 +57,10 @@ -- -- @since 0.3.0.0 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 - +validFromEnc' = validRFromEnc' + -{-# DEPRECATED validFromEnc' "Use validR' instead (valid for r- encodings only)" #-} +{-# DEPRECATED validFromEnc' "Use _validR instead (valid for r- encodings only)" #-} validRFromEnc' :: 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 diff --git a/src/Data/TypedEncoding/Internal/Util.hs b/src/Data/TypedEncoding/Internal/Util.hs --- a/src/Data/TypedEncoding/Internal/Util.hs +++ b/src/Data/TypedEncoding/Internal/Util.hs @@ -1,26 +1,16 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE RankNTypes #-} + + module Data.TypedEncoding.Internal.Util where -import Data.Proxy -import GHC.TypeLits explainBool :: (a -> err) -> (a, Bool) -> Either err a explainBool _ (a, True) = Right a explainBool f (a, False) = Left $ f a --- | Sometimes is easier to pass around a proxy than do TypeApplications -proxiedId :: Proxy a -> a -> a -proxiedId _ = id - --- | explicit mapM -extractEither :: Traversable t => t (Either err a) -> Either err (t a) -extractEither = sequence -- mapM id +-- -- | explicit mapM +-- extractEither :: Traversable t => t (Either err a) -> Either err (t a) +-- extractEither = sequence -- mapM id -withSomeSymbol :: SomeSymbol -> (forall x. KnownSymbol x => Proxy x -> r) -> r -withSomeSymbol s fn = case s of - SomeSymbol p -> fn p diff --git a/src/Examples/TypedEncoding.hs b/src/Examples/TypedEncoding.hs --- a/src/Examples/TypedEncoding.hs +++ b/src/Examples/TypedEncoding.hs @@ -4,15 +4,21 @@ -- * Conversions between encodings , module Examples.TypedEncoding.Conversions -- * Adding new encodings, error handling - , module Examples.TypedEncoding.DiySignEncoding + , module Examples.TypedEncoding.Instances.DiySignEncoding + -- * Examples of "do-" encodings that perform some string transformation such as title-casing + , module Examples.TypedEncoding.Instances.Do.Sample -- * Converting other types to and from encoded strings , module Examples.TypedEncoding.ToEncString -- * Modifying encoded payload - , module Examples.TypedEncoding.Unsafe + , module Examples.TypedEncoding.Unsafe + -- * a more dependently typed alternative to @CheckedEnc@ + , module Examples.TypedEncoding.SomeEnc ) where import Examples.TypedEncoding.Overview import Examples.TypedEncoding.Conversions -import Examples.TypedEncoding.DiySignEncoding +import Examples.TypedEncoding.Instances.DiySignEncoding +import Examples.TypedEncoding.Instances.Do.Sample import Examples.TypedEncoding.Unsafe import Examples.TypedEncoding.ToEncString +import Examples.TypedEncoding.SomeEnc diff --git a/src/Examples/TypedEncoding/Conversions.hs b/src/Examples/TypedEncoding/Conversions.hs --- a/src/Examples/TypedEncoding/Conversions.hs +++ b/src/Examples/TypedEncoding/Conversions.hs @@ -10,6 +10,8 @@ -- | Examples or moving between type annotated encodings -- +-- Please also see documentation in "Data.TypedEncoding.Conv". +-- -- Haskell programs typically make these imports to do String, ByteString, and Text conversions: -- -- @ @@ -30,7 +32,7 @@ -- -- Conversions aim at providing type safety when moving between encoded string-like types. -- --- __The assumption__ made by `typed-encoding` is that @"enc-"@ encodings work in an equivalent way independently of the payload type. +-- __The assumption__ made by /typed-encoding/ is that @"enc-"@ encodings work in an equivalent way independently of the payload type. -- For example, if the following instances exist: -- -- @ @@ -65,6 +67,7 @@ import Data.TypedEncoding import Data.TypedEncoding.Instances.Enc.Base64 () +import Data.TypedEncoding.Instances.Restriction.Base64 () import Data.TypedEncoding.Instances.Restriction.ASCII () import Data.TypedEncoding.Instances.Restriction.UTF8 () import Data.TypedEncoding.Instances.Restriction.D76 () @@ -97,10 +100,10 @@ -- * Moving between Text and ByteString eHelloAsciiB :: Either EncodeEx (Enc '["r-ASCII"] () B.ByteString) -eHelloAsciiB = encodeFAll . toEncoding () $ "HeLlo world" +eHelloAsciiB = _runEncodings encodings . toEncoding () $ "HeLlo world" -- ^ Example value to play with -- --- >>> encodeFAll . toEncoding () $ "HeLlo world" :: Either EncodeEx (Enc '["r-ASCII"] () B.ByteString) +-- >>> _runEncodings encodings . toEncoding () $ "HeLlo world" :: Either EncodeEx (Enc '["r-ASCII"] () B.ByteString) -- Right (UnsafeMkEnc Proxy () "HeLlo world") Right helloAsciiB = eHelloAsciiB @@ -196,8 +199,7 @@ -- -- >>> :t EncTe.encodeUtf8 helloUtf8B64T -- ... --- ... Couldn't match type ‘IsSupersetOpen --- ... "r-UTF8" "enc-B64" ... +-- ... Couldn't match type ... -- ... -- -- This is not allowed! We need to add the redundant "r-UTF8" back: @@ -222,7 +224,6 @@ -- ... -- ... error: -- ... Couldn't match type ... --- ... "r-UTF8" "enc-B64" ... -- ... -- -- This is good because having the payload inside of @Enc '["enc-B64"] () Text@ would allow us @@ -247,7 +248,7 @@ -- -- @injectInto@ method accepts proxy to specify superset to use. -- --- >>> displ $ injectInto @ "r-UTF8" helloAsciiB +-- >>> displ $ injectInto @"r-UTF8" helloAsciiB -- "Enc '[r-UTF8] () (ByteString HeLlo world)" -- -- Superset is intended for @"r-"@ annotations only, should not be used @@ -278,7 +279,15 @@ -- +notTextB64AsTxt :: Enc '["r-B64"] () T.Text +notTextB64AsTxt = EncTe.decodeUtf8 $ flattenAs notTextB +-- ^ /Base64/ encoding of a non-text binary data can still be converted to Text format +-- @Enc '["r-B64"] () T.Text@ signifies that the value is B64 encoding but it cannot be decoded to a Text. + +-- tst = encodeAll . toEncoding () $ "" :: Enc '["enc-B64"] () B.ByteString +-- tst2 = EncTe.decodeUtf8 $ flattenAs $ tst :: Enc '["r-B64"] () T.Text + -- * Lenient recovery lenientSomething :: Enc '["enc-B64-len"] () B.ByteString @@ -291,7 +300,7 @@ -- lenient algorithms are not partial and automatically fix invalid input: -- -- >>> recreateFAll . toEncoding () $ "abc==CB" :: Either RecreateEx (Enc '["enc-B64"] () B.ByteString) --- Left (RecreateEx "enc-B64" ("invalid padding")) +-- Left (RecreateEx "enc-B64" ("Base64-encoded bytestring is unpadded or has invalid padding")) -- -- This library allows to recover to "enc-B64-len" which is different than "enc-B64" -- @@ -319,6 +328,6 @@ -- thus, we should be able to treat "enc-B64" as "r-ASCII" losing some information. -- this is done using 'FlattenAs' type class -- --- >>> :t flattenAs @ "r-ASCII" helloUtf8B64B --- flattenAs @ "r-ASCII" helloUtf8B64B +-- >>> :t flattenAs @"r-ASCII" helloUtf8B64B +-- flattenAs @"r-ASCII" helloUtf8B64B -- ... :: Enc '["r-ASCII"] () B.ByteString diff --git a/src/Examples/TypedEncoding/DiySignEncoding.hs b/src/Examples/TypedEncoding/DiySignEncoding.hs deleted file mode 100644 --- a/src/Examples/TypedEncoding/DiySignEncoding.hs +++ /dev/null @@ -1,130 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} - --- {-# LANGUAGE PartialTypeSignatures #-} - --- | Simple DIY encoding example that "signs" Text with its length. --- --- Documentation includes discussion of error handling options. --- --- My current thinking: --- --- Stronger type level information about encoding provides type safety over decoding process. --- 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 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'. - -module Examples.TypedEncoding.DiySignEncoding where - -import Data.TypedEncoding -import qualified Data.TypedEncoding.Instances.Support as EnT - -import qualified Data.Text as T -import Data.Char -import Data.Semigroup ((<>)) -import Text.Read (readMaybe) - --- $setup --- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds --- >>> import Test.QuickCheck.Instances.Text() - --- | encoding function, typically should be module private -encodeSign :: T.Text -> T.Text -encodeSign t = (T.pack . show . T.length $ t) <> ":" <> t - - --- | dual purpose decoding and recovery function. --- --- This typically should be module private. --- --- >>> decodeSign "3:abc" --- Right "abc" --- --- >>> decodeSign "4:abc" --- Left "Corrupted Signature" -decodeSign :: T.Text -> Either String T.Text -decodeSign t = - let (sdit, rest) = T.span isDigit $ t - actsize = T.length rest - 1 - msize = readMaybe . T.unpack $ sdit - checkDelimit = T.isInfixOf ":" rest - in if msize == Just actsize && checkDelimit - then Right $ T.drop 1 rest - else Left $ "Corrupted Signature" - - --- | Encoded hello world example. --- --- >>> helloSigned --- UnsafeMkEnc Proxy () "11:Hello World" --- --- >>> fromEncoding . decodeAll $ helloSigned --- "Hello World" -helloSigned :: Enc '["my-sign"] () T.Text -helloSigned = encodeAll . toEncoding () $ "Hello World" - --- | property checks that 'T.Text' values are expected to decode --- without error after encoding. --- --- prop> \t -> propEncDec -propEncDec :: T.Text -> Bool -propEncDec t = - let enc = encodeAll . toEncoding () $ t :: Enc '["my-sign"] () T.Text - in t == (fromEncoding . decodeAll $ enc) - -hacker :: Either RecreateEx (Enc '["my-sign"] () T.Text) -hacker = - let payload = getPayload $ helloSigned :: T.Text - -- | payload is sent over network and get corrupted - newpay = payload <> " corruption" - -- | boundary check recovers the data - newdata = recreateFAll . toEncoding () $ newpay :: Either RecreateEx (Enc '["my-sign"] () T.Text) - in newdata --- ^ Hacker example --- The data was transmitted over a network and got corrupted. --- --- >>> let payload = getPayload $ helloSigned :: T.Text --- >>> let newpay = payload <> " corruption" --- >>> recreateFAll . toEncoding () $ newpay :: Either RecreateEx (Enc '["my-sign"] () T.Text) --- Left (RecreateEx "my-sign" ("Corrupted Signature")) --- --- >>> recreateFAll . toEncoding () $ payload :: Either RecreateEx (Enc '["my-sign"] () T.Text) --- Right (UnsafeMkEnc Proxy () "11:Hello World") - - --- | Because encoding function is pure we can create instance of 'Encode' --- that is polymorphic in effect @f@. --- --- This is done using 'EnT.implTranP' combinator. -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.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) => 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.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/Instances/DiySignEncoding.hs b/src/Examples/TypedEncoding/Instances/DiySignEncoding.hs new file mode 100644 --- /dev/null +++ b/src/Examples/TypedEncoding/Instances/DiySignEncoding.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +-- {-# LANGUAGE PartialTypeSignatures #-} + +-- | Simple DIY encoding example that "signs" Text with its length. +-- +-- Documentation includes discussion of error handling options. +-- +-- My current thinking: +-- +-- Stronger type level information about encoding provides type safety over decoding process. +-- 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 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'. + +module Examples.TypedEncoding.Instances.DiySignEncoding where + +import Data.TypedEncoding +import qualified Data.TypedEncoding.Instances.Support as EnT + +import qualified Data.Text as T +import Data.Char +import Data.Semigroup ((<>)) +import Text.Read (readMaybe) + +-- $setup +-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds +-- >>> import Test.QuickCheck.Instances.Text() + +-- | encoding function, typically should be module private +encodeSign :: T.Text -> T.Text +encodeSign t = (T.pack . show . T.length $ t) <> ":" <> t + + +-- | dual purpose decoding and recovery function. +-- +-- This typically should be module private. +-- +-- >>> decodeSign "3:abc" +-- Right "abc" +-- +-- >>> decodeSign "4:abc" +-- Left "Corrupted Signature" +decodeSign :: T.Text -> Either String T.Text +decodeSign t = + let (sdit, rest) = T.span isDigit $ t + actsize = T.length rest - 1 + msize = readMaybe . T.unpack $ sdit + checkDelimit = T.isInfixOf ":" rest + in if msize == Just actsize && checkDelimit + then Right $ T.drop 1 rest + else Left $ "Corrupted Signature" + + +-- | Encoded hello world example. +-- +-- >>> helloSigned +-- UnsafeMkEnc Proxy () "11:Hello World" +-- +-- >>> fromEncoding . decodeAll $ helloSigned +-- "Hello World" +helloSigned :: Enc '["my-sign"] () T.Text +helloSigned = encodeAll . toEncoding () $ "Hello World" + +-- | property checks that 'T.Text' values are expected to decode +-- without error after encoding. +-- +-- prop> \t -> propEncDec +propEncDec :: T.Text -> Bool +propEncDec t = + let enc = encodeAll . toEncoding () $ t :: Enc '["my-sign"] () T.Text + in t == (fromEncoding . decodeAll $ enc) + +hacker :: Either RecreateEx (Enc '["my-sign"] () T.Text) +hacker = + let payload = getPayload $ helloSigned :: T.Text + -- | payload is sent over network and get corrupted + newpay = payload <> " corruption" + -- | boundary check recovers the data + newdata = recreateFAll . toEncoding () $ newpay :: Either RecreateEx (Enc '["my-sign"] () T.Text) + in newdata +-- ^ Hacker example +-- The data was transmitted over a network and got corrupted. +-- +-- >>> let payload = getPayload $ helloSigned :: T.Text +-- >>> let newpay = payload <> " corruption" +-- >>> recreateFAll . toEncoding () $ newpay :: Either RecreateEx (Enc '["my-sign"] () T.Text) +-- Left (RecreateEx "my-sign" ("Corrupted Signature")) +-- +-- >>> recreateFAll . toEncoding () $ payload :: Either RecreateEx (Enc '["my-sign"] () T.Text) +-- Right (UnsafeMkEnc Proxy () "11:Hello World") + + +-- | Because encoding function is pure we can create instance of 'Encode' +-- that is polymorphic in effect @f@. +-- +-- This is done using 'EnT.implTranP' combinator. +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.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) => 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.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/Instances/Do/Sample.hs b/src/Examples/TypedEncoding/Instances/Do/Sample.hs new file mode 100644 --- /dev/null +++ b/src/Examples/TypedEncoding/Instances/Do/Sample.hs @@ -0,0 +1,81 @@ + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +-- | This module defines some example "do-" encodings +-- +-- See "Examples.TypedEncoding.Overview" for usage examples. +-- +-- (moved from @Data.TypedEncoding.Instances.Do.Sample@) +-- +-- @since 0.5.0.0 +module Examples.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 Data.Char + +import Data.TypedEncoding.Instances.Support +import Data.TypedEncoding.Instances.Support.Unsafe +import Examples.TypedEncoding.Util (HasA (..)) +-- | +-- @since 0.3.0.0 +instance Applicative f => Encode f "do-UPPER" "do-UPPER" c T.Text where + encoding = _implEncodingP T.toUpper + +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 => Encode f "do-UPPER" "do-UPPER" c TL.Text where + encoding = _implEncodingP TL.toUpper + + +-- | +-- @since 0.3.0.0 +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 + +-- | +-- @since 0.3.0.0 +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 + +-- | +-- @since 0.3.0.0 +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 + +-- | +-- @since 0.1.0.0 +newtype SizeLimit = SizeLimit {unSizeLimit :: Int} deriving (Eq, Show) + +-- | +-- @since 0.3.0.0 +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/Examples/TypedEncoding/Overview.hs b/src/Examples/TypedEncoding/Overview.hs --- a/src/Examples/TypedEncoding/Overview.hs +++ b/src/Examples/TypedEncoding/Overview.hs @@ -3,8 +3,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeApplications #-} --- {-# LANGUAGE PartialTypeSignatures #-} --- {-# OPTIONS_GHC -Wno-partial-type-signatures #-} +{-# OPTIONS_GHC -Wno-deprecations #-} -- | type-encoding overview examples. -- @@ -16,15 +15,17 @@ -- -- * "Data.TypedEncoding.Instances.Enc.Base64" -- * "Data.TypedEncoding.Instances.Restriction.ASCII" --- * "Data.TypedEncoding.Instances.Do.Sample" +-- * "Examples.TypedEncoding.Instances.Do.Sample" -- module Examples.TypedEncoding.Overview where import Data.TypedEncoding import Data.TypedEncoding.Instances.Enc.Base64 () +import Data.TypedEncoding.Instances.Enc.Warn.Base64 () import Data.TypedEncoding.Instances.Restriction.ASCII () -import Data.TypedEncoding.Instances.Do.Sample +import Examples.TypedEncoding.Instances.Do.Sample +import Examples.TypedEncoding.Util (HasA (..)) import qualified Data.ByteString as B import qualified Data.Text as T @@ -90,7 +91,7 @@ -- Right (UnsafeMkEnc Proxy () "SGVsbG8gV29ybGQ=") -- -- >>> recreateFAll . toEncoding () $ "SGVsbG8gV29ybGQ" :: Either RecreateEx (Enc '["enc-B64"] () B.ByteString) --- Left (RecreateEx "enc-B64" ("invalid padding")) +-- Left (RecreateEx "enc-B64" ("Base64-encoded bytestring is unpadded or has invalid padding")) -- -- The above example start by placing payload in zero-encoded @Enc '[] ()@ type and then apply 'recreateFAll' -- this is a good way to recreate encoded type if encoding is known. @@ -142,7 +143,7 @@ -- Again, notice the same expression is used as in previous recovery. -- -- >>> recreateFAll . toEncoding () $ "SGVsbG8gV29ybGQ=" :: Either RecreateEx (Enc '["enc-B64", "enc-B64"] () B.ByteString) --- Left (RecreateEx "enc-B64" ("invalid padding")) +-- Left (RecreateEx "enc-B64" ("Base64-encoded bytestring is unpadded or has invalid padding")) helloB64B64RecoveredErr :: Either RecreateEx (Enc '["enc-B64", "enc-B64"] () B.ByteString) helloB64B64RecoveredErr = recreateFAll . toEncoding () $ "SGVsbG8gV29ybGQ=" @@ -151,7 +152,7 @@ -- * "do-" Encodings -- | --- "do-UPPER" (from 'Data.TypedEncoding.Instances.Do.Sample' module) encoding applied to "Hello World" +-- "do-UPPER" (from 'Examples.TypedEncoding.Instances.Do.Sample' module) encoding applied to "Hello World" -- -- Notice a namespace thing going on, "enc-" is encoding, "do-" is some transformation. -- These are typically not reversible, some could be recoverable. @@ -183,7 +184,7 @@ instance HasA SizeLimit Config where has = sizeLimit --- | `helloTitle' is needed in following examples +-- | @helloTitle'@ is needed in following examples -- helloTitle :: Enc '["do-Title"] Config T.Text helloTitle = encodeAll . toEncoding exampleConf $ "hello wOrld" @@ -238,6 +239,11 @@ -- is outside of ASCII range (in @Either@ monad). -- -- Note naming thing: "r-" is partial identity ("r-" is from restriction). +-- +-- >>> _runEncodings encodings . toEncoding () $ "HeLlo world" :: Either EncodeEx (Enc '["r-ASCII"] () B.ByteString) +-- Right (UnsafeMkEnc Proxy () "HeLlo world") +-- +-- or equivalently -- -- >>> encodeFAll . toEncoding () $ "HeLlo world" :: Either EncodeEx (Enc '["r-ASCII"] () B.ByteString) -- Right (UnsafeMkEnc Proxy () "HeLlo world") diff --git a/src/Examples/TypedEncoding/SomeEnc.hs b/src/Examples/TypedEncoding/SomeEnc.hs new file mode 100644 --- /dev/null +++ b/src/Examples/TypedEncoding/SomeEnc.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE RankNTypes #-} + +-- | +-- This module defines 'SomeEnc' - existentially quantified version of @Enc@ +-- and basic combinators. +-- +-- This construction is common to more dependently typed Haskell but is +-- isomorphic to 'Data.TypedEncoding.Common.Types.CheckedEnc.CheckedEnc'. +-- +-- Post v0.4 /typed-encoding/ supports @CheckedEnc@ while @SomeEnc@ remains as +-- as example. +-- +-- (Moved from @Data.TypedEncoding.Common.Types.SomeEnc@ in previous versions) +-- +-- @since 0.5.0.0 + +module Examples.TypedEncoding.SomeEnc where + +import Data.TypedEncoding.Common.Types.Enc +import Data.TypedEncoding.Common.Class.Common +import Data.TypedEncoding.Common.Types.CheckedEnc +import Examples.TypedEncoding.SomeEnc.SomeAnnotation + +-- $setup +-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XAllowAmbiguousTypes +-- >>> import qualified Data.Text as T +-- >>> import Data.TypedEncoding.Combinators.Unsafe + + + +-- | Existentially quantified quantified @Enc@ +-- effectively isomorphic to 'CheckedEnc' +-- +-- @since 0.2.0.0 +data SomeEnc conf str where + MkSomeEnc :: SymbolList xs => Enc xs conf str -> SomeEnc conf str + +-- | +-- @since 0.2.0.0 +withSomeEnc :: SomeEnc conf str -> (forall xs . SymbolList xs => Enc xs conf str -> r) -> r +withSomeEnc (MkSomeEnc enc) f = f enc + +-- | +-- @since 0.2.0.0 +toSome :: SymbolList xs => Enc xs conf str -> SomeEnc conf str +toSome = MkSomeEnc + +-- | +-- >>> let enctest = unsafeSetPayload () "hello" :: Enc '["TEST"] () T.Text +-- >>> someToChecked . MkSomeEnc $ enctest +-- UnsafeMkCheckedEnc ["TEST"] () "hello" +-- +-- @since 0.2.0.0 +someToChecked :: SomeEnc conf str -> CheckedEnc conf str +someToChecked se = withSomeEnc se toCheckedEnc + +-- | +-- >>> let tst = unsafeCheckedEnc ["TEST"] () "test" +-- >>> displ $ checkedToSome tst +-- "Some (Enc '[TEST] () (String test))" +-- +-- @since 0.2.0.0 s +checkedToSome :: CheckedEnc conf str -> SomeEnc conf str +checkedToSome (UnsafeMkCheckedEnc xs c s) = withSomeAnnotation (someAnnValue xs) (\p -> MkSomeEnc (UnsafeMkEnc p c s)) + + +-- | +-- >>> let enctest = unsafeSetPayload () "hello" :: Enc '["TEST"] () T.Text +-- >>> displ $ MkSomeEnc enctest +-- "Some (Enc '[TEST] () (Text hello))" +instance (Show c, Displ str) => Displ (SomeEnc c str) where + displ (MkSomeEnc en) = + "Some (" ++ displ en ++ ")" diff --git a/src/Examples/TypedEncoding/SomeEnc/SomeAnnotation.hs b/src/Examples/TypedEncoding/SomeEnc/SomeAnnotation.hs new file mode 100644 --- /dev/null +++ b/src/Examples/TypedEncoding/SomeEnc/SomeAnnotation.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE RankNTypes #-} + +-- | Internally used existential type for tracking of annotations +-- +-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly. + +module Examples.TypedEncoding.SomeEnc.SomeAnnotation where + +import Data.TypedEncoding.Common.Types.Common +import Data.TypedEncoding.Common.Class.Common +import Data.TypedEncoding.Common.Util.TypeLits (withSomeSymbol, proxyCons) +import Data.Proxy +import GHC.TypeLits + +-- | +-- @since 0.2.0.0 +data SomeAnnotation where + MkSomeAnnotation :: SymbolList xs => Proxy xs -> SomeAnnotation + +-- | +-- @since 0.2.0.0 +withSomeAnnotation :: SomeAnnotation -> (forall xs . SymbolList xs => Proxy xs -> r) -> r +withSomeAnnotation (MkSomeAnnotation p) fn = fn p + + +-- | folds over SomeSymbol list +-- @since 0.2.0.0 +someAnnValue :: [EncAnn] -> SomeAnnotation +someAnnValue xs = + foldr (fn . someSymbolVal) (MkSomeAnnotation (Proxy :: Proxy '[])) xs + where + somesymbs = map someSymbolVal xs + fn ss (MkSomeAnnotation pxs) = withSomeSymbol ss (\px -> MkSomeAnnotation (px `proxyCons` pxs)) + + diff --git a/src/Examples/TypedEncoding/ToEncString.hs b/src/Examples/TypedEncoding/ToEncString.hs --- a/src/Examples/TypedEncoding/ToEncString.hs +++ b/src/Examples/TypedEncoding/ToEncString.hs @@ -30,7 +30,7 @@ -- Current version of typed-encoding does not have dependencies on such types. -- -- These examples use 'CheckedEnc' when untyped version of 'Enc' is needed. --- Alternatively, an existentially quantified 'SomeEnc' type could have been used. +-- Alternatively, an existentially quantified 'Examples.TypedEncoding.SomeEnc' type could have been used. -- Both are isomorphic. module Examples.TypedEncoding.ToEncString where @@ -47,10 +47,10 @@ import qualified Data.ByteString as B import Control.Applicative -- ((<|>)) import Data.Maybe -import Data.Semigroup ((<>)) + -- $setup -- >>> :set -XMultiParamTypeClasses -XDataKinds -XPolyKinds -XFlexibleInstances -XTypeApplications -XOverloadedStrings -- >>> import qualified Data.List as L @@ -77,8 +77,8 @@ -- | --- In this example @toEncString@ converts 'IpV4' to @Enc '["r-IPv4"] Text@. --- +-- In this example @toEncString@ converts our example 'IpV4' type to @Enc '["r-IPv4"] Text@. +-- -- This is done with help of existing @"r-Word8-decimal"@ annotation defined -- in "Data.TypedEncoding.Instances.Restriction.Misc" -- @@ -86,10 +86,10 @@ -- UnsafeMkEnc Proxy () "128.1.1.10" -- -- Implementation is a classic map reduce where reduce is done with help of --- 'EnT.foldEncStr' +-- 'EnT.foldEnc' -- -- >>> let fn a b = if b == "" then a else a <> "." <> b --- >>> let reduce = EnT.foldEncStr @'["r-IPv4"] @'["r-Word8-decimal"] () fn +-- >>> let reduce = EnT.foldEnc @'["r-IPv4"] @'["r-Word8-decimal"] () fn "" -- >>> displ . reduce . fmap toEncString $ tstIp -- "Enc '[r-IPv4] () (String 128.1.1.10)" -- @@ -112,7 +112,7 @@ map = fmap toEncString reduce :: IpV4F (Enc '["r-Word8-decimal"] () T.Text) -> Enc '["r-IPv4"] () T.Text - reduce = EnT.foldEncStr () (\a b-> if b == "" then a else a <> "." <> b) + reduce = EnT.foldEnc () (\a b-> if b == "" then a else a <> "." <> b) "" -- | -- @@ -123,7 +123,7 @@ -- 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 +-- >>> EnT.splitPayload @'["r-Word8-decimal"] (T.splitOn $ T.pack ".") $ enc -- [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 @@ -134,7 +134,7 @@ 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 ".") + unreduce = asUnexpected @"r-IPv4" . recover . EnT.splitPayload @'["r-Word8-decimal"] (T.splitOn ".") map :: IpV4F (Enc '["r-Word8-decimal"] () T.Text) -> IpV4F Word8 map = fmap fromEncString @@ -265,25 +265,25 @@ -- -- This code will not pick it up: -- --- >>> fromCheckedEnc @ '["enc-B64", "r-UTF8"] $ piece +-- >>> fromCheckedEnc @'["enc-B64", "r-UTF8"] $ piece -- Nothing -- -- But this one will: -- --- >>> fromCheckedEnc @ '["enc-B64", "r-ASCII"] $ piece +-- >>> fromCheckedEnc @'["enc-B64", "r-ASCII"] $ piece -- 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 +-- >>> fmap (toCheckedEnc . decodePart @'["enc-B64"]) . fromCheckedEnc @'["enc-B64", "r-ASCII"] $ piece -- Just (UnsafeMkCheckedEnc ["r-ASCII"] () "Some ASCII Text") decodeB64ForTextOnly :: SimplifiedEmailEncB -> SimplifiedEmailEncB decodeB64ForTextOnly = fmap (runAlternatives fromMaybe [tryUtf8, tryAscii]) where tryUtf8, tryAscii :: CheckedEnc c B.ByteString -> Maybe (CheckedEnc c B.ByteString) - tryUtf8 = fmap (toCheckedEnc . decodeToUtf8) . fromCheckedEnc @ '["enc-B64", "r-UTF8"] - tryAscii = fmap (toCheckedEnc . decodeToAscii) . fromCheckedEnc @ '["enc-B64", "r-ASCII"] + tryUtf8 = fmap (toCheckedEnc . decodeToUtf8) . fromCheckedEnc @'["enc-B64", "r-UTF8"] + tryAscii = fmap (toCheckedEnc . decodeToAscii) . fromCheckedEnc @'["enc-B64", "r-ASCII"] decodeToUtf8 :: Enc '["enc-B64", "r-UTF8"] c B.ByteString -> _ decodeToUtf8 = decodePart @'["enc-B64"] diff --git a/src/Examples/TypedEncoding/Util.hs b/src/Examples/TypedEncoding/Util.hs new file mode 100644 --- /dev/null +++ b/src/Examples/TypedEncoding/Util.hs @@ -0,0 +1,20 @@ + +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} + +-- | Some helper definitions used in /Examples/ +module Examples.TypedEncoding.Util where + + +-- | Polymorphic data payloads used to encode/decode +-- +-- This class is intended for example use only and will be moved to Example modules. +-- +-- Use your favorite polymorphic records / ad-hock product polymorphism library. +-- +-- @since 0.1.0.0 +class HasA a c where + has :: c -> a + +instance HasA () c where + has = const () diff --git a/test/Test/SupersetSpec.hs b/test/Test/SupersetSpec.hs --- a/test/Test/SupersetSpec.hs +++ b/test/Test/SupersetSpec.hs @@ -37,6 +37,6 @@ describe "String based" $ it "r-UNICODE.D76 > r-ASCII" $ property $ propSuperset_ @"r-UNICODE.D76" @"r-ASCII" @String encoding encoding describe "EncodingSuperset test" $ - it "enc-B64 < r-ASCII" $ property $ propEncodesInto_ @"enc-B64" @"r-ASCII" @B.ByteString encoding encoding + it "enc-B64 < r-ASCII" $ property $ propEncodesInto_ @"enc-B64" @"r-B64" @B.ByteString encoding encoding runSpec :: IO () runSpec = hspec spec diff --git a/typed-encoding.cabal b/typed-encoding.cabal --- a/typed-encoding.cabal +++ b/typed-encoding.cabal @@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.1. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack --- --- hash: d82580e7a0363bd4ef2af6a3a7d41d10d0cb724efc6066bc066c3d91ded51810 name: typed-encoding -version: 0.4.2.0 +version: 0.5.2.3 synopsis: Type safe string transformations description: See README.md in the project github repository. category: Data, Text @@ -39,11 +37,11 @@ Data.TypedEncoding.Combinators.Unsafe Data.TypedEncoding.Combinators.Validate Data.TypedEncoding.Common.Class + Data.TypedEncoding.Common.Class.Common 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 @@ -52,8 +50,6 @@ 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 @@ -65,10 +61,10 @@ Data.TypedEncoding.Conv.Text.Encoding Data.TypedEncoding.Conv.Text.Lazy Data.TypedEncoding.Conv.Text.Lazy.Encoding - Data.TypedEncoding.Instances.Do.Sample Data.TypedEncoding.Instances.Enc.Base64 + Data.TypedEncoding.Instances.Enc.Warn.Base64 Data.TypedEncoding.Instances.Restriction.ASCII - Data.TypedEncoding.Instances.Restriction.Bool + Data.TypedEncoding.Instances.Restriction.Base64 Data.TypedEncoding.Instances.Restriction.BoundedAlphaNums Data.TypedEncoding.Instances.Restriction.ByteRep Data.TypedEncoding.Instances.Restriction.CHAR8 @@ -77,7 +73,6 @@ Data.TypedEncoding.Instances.Restriction.UTF8 Data.TypedEncoding.Instances.Support Data.TypedEncoding.Instances.Support.Bool - Data.TypedEncoding.Instances.Support.Common Data.TypedEncoding.Instances.Support.Decode Data.TypedEncoding.Instances.Support.Encode Data.TypedEncoding.Instances.Support.Helpers @@ -87,10 +82,14 @@ Data.TypedEncoding.Unsafe Examples.TypedEncoding Examples.TypedEncoding.Conversions - Examples.TypedEncoding.DiySignEncoding + Examples.TypedEncoding.Instances.DiySignEncoding + Examples.TypedEncoding.Instances.Do.Sample Examples.TypedEncoding.Overview + Examples.TypedEncoding.SomeEnc + Examples.TypedEncoding.SomeEnc.SomeAnnotation Examples.TypedEncoding.ToEncString Examples.TypedEncoding.Unsafe + Examples.TypedEncoding.Util other-modules: Paths_typed_encoding hs-source-dirs: @@ -98,10 +97,10 @@ ghc-options: -fwarn-unused-imports -fwarn-incomplete-patterns -fprint-explicit-kinds build-depends: base >=4.10 && <5 - , base64-bytestring >=1.0 && <1.1 - , bytestring >=0.10 && <0.11 + , base64-bytestring >=1.0 && <1.3 + , bytestring >=0.10 && <0.13 , symbols >=0.3 && <0.3.1 - , text >=1.2 && <1.3 + , text >=1.2 && <3 default-language: Haskell2010 test-suite typed-encoding-doctest @@ -113,15 +112,15 @@ doctest ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - QuickCheck >=2.13.1 && <2.14 + QuickCheck >=2.13.1 && <3 , base >=4.10 && <5 - , base64-bytestring >=1.0 && <1.1 - , bytestring >=0.10 && <0.11 - , doctest >=0.16 && <0.17 - , doctest-discover >=0.2 && <0.3 + , base64-bytestring >=1.0 && <1.3 + , bytestring >=0.10 && <0.13 + , doctest >=0.16 && <1 + , doctest-discover ==0.2.* , quickcheck-instances >=0.3.20 && <0.4 , symbols >=0.3 && <0.3.1 - , text >=1.2 && <1.3 + , text >=1.2 && <3 , typed-encoding default-language: Haskell2010 @@ -136,13 +135,13 @@ test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - QuickCheck >=2.13.1 && <2.14 + QuickCheck >=2.13.1 && <3 , base >=4.10 && <5 - , base64-bytestring >=1.0 && <1.1 - , bytestring >=0.10 && <0.11 + , base64-bytestring >=1.0 && <1.3 + , bytestring >=0.10 && <0.13 , hspec , quickcheck-instances >=0.3.20 && <0.4 , symbols >=0.3 && <0.3.1 - , text >=1.2 && <1.3 + , text >=1.2 && <3 , typed-encoding default-language: Haskell2010