packages feed

typed-encoding (empty) → 0.1.0.0

raw patch · 22 files changed

+1780/−0 lines, 22 filesdep +QuickCheckdep +basedep +base64-bytestringsetup-changed

Dependencies added: QuickCheck, base, base64-bytestring, bytestring, doctest, doctest-discover, quickcheck-instances, text, typed-encoding

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Changelog for typed-encoding++## 0.1.0.0+ - initial release+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,57 @@+# typed-encoding+Type level annotations, string transformations, and other goodies that make programming strings safer.++## Motivation+I have recently spent a lot of time troubleshooting various `Base64`, `quoted-printable`, and `Utf8` encoding issues.  +I decided to write a library that will help avoiding issues like these.++This library allows to specify and work with types like++```Haskell+-- some data encoded in base 64+mydata :: Enc '["enc-B64"] ByteString++-- some text (utf8) data encoded in base 64 +myData :: Enc '["enc-B64", "r-UTF8"] ByteString+```++and provides ways for +   - encoding+   - decoding+   - recreation (encoding validation)+   - type conversions++... but this approach seems to be a bit more...++```Haskell+-- upper cased text encoded as base64+example :: Enc '["enc-B64", "do-UPPER"] () T.Text+example = encodeAll . toEncoding () $ "some text goes here"+```++It becomes a type directed, declarative approach to string transformations.++Transformations can be+   - used with parameters.+   - applied or undone partially (if encoding is reversible)+ +## Examples ++Please see `Examples.TypedEncoding` it the module list.+ +## Dependencies on other encoding libs++Currently it uses+   - `base64-bytestring` because it was my driving example+   - I will try to separate other deps like `servant`, specific encoding libraries, etc into separate libs if there is interest. I consider orphan instances to be OK in this context. (GHC will classify them as such despite use of unique symbols.)++## Plans, some TODOs+   - lensifying conversions +   - better implementation type safety++## Tested with+   - stack (1.9.3) lts-14.27 (ghc-8.6.5)++## Known issues+   - running test suite: cabal has problems with doctest, use stack  +   https://github.com/haskell/cabal/issues/6087
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ doctest/Spec.hs view
@@ -0,0 +1,3 @@+{-# OPTIONS_GHC -F -pgmF doctest-discover #-}+-- main :: IO ()+-- main = putStrLn "Test suite not yet implemented"
+ src/Data/TypedEncoding.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}++-- |+-- Main Module in typed-encoding. +--+-- = Overview+--+-- This library allows to specify and work with types like+--+-- @+-- -- Base 64 encoded bytes (could represent binary files)+-- Enc '["enc-B64"] ByteString+--+-- -- Base 64 encoded UTF8 bytes+-- Enc '["enc-B64", "r-UTF8"] ByteString+--+-- -- Text that contains only ASCII characters+-- Enc '["r-ASCII"] Text+-- @+--+-- or to do transformations to strings like+--+-- @+-- upper :: Text -> Enc '["do-UPPER"] Text+-- upper = ...+-- @+--+-- Primary focus of type-encodings is to provide type safe+--+-- * /encoding/+-- * /decoding/+-- * /recreation/ (verification of existing payload)+-- * type conversions between encoded types+--+-- of string-like data (@ByteString@, @Text@) that is subject of some+-- encoding or formatting restrictions.+--+-- = Groups of annotations+--+-- typed-encoding uses type annotations grouped into semantic categories+--+-- == "r-" restriction / predicate+--+-- * /encoding/ is a partial identity+-- * /recreation/ is a partial identity (matching encoding)+-- * /decoding/ is identity+--+-- Examples: @"r-UTF8"@, @"r-ASCII"@+--+-- == "do-" transformations+--+-- * /encoding/ applies transformation to the string (could be partial)+-- * /decoding/ - typically none+-- * /recreation/ - typically none but, if present, verifies the payload has expected data (e.g. only uppercase chars for "do-UPPER")+--+-- Examples: @"do-UPPER"@, @"do-lower"@, @"do-reverse"@+--+-- == "enc-" data encoding that is not "r-"+--+-- * /encoding/ applies encoding transformation to the string (could be partial)+-- * /decoding/ reverses the transformation (can be used as pure function)+-- * /recreation/ verifies that the payload has correctly encoded data+--+-- Examples: @"enc-B64"@+-- +-- = Usage+--+-- To use this library import this module and one or more "instance" modules.+--+-- Here is list of instance modules available in typed-encoding library itself+--+-- * "Data.TypedEncoding.Instances.Base64"+-- * "Data.TypedEncoding.Instances.ASCII" +-- * "Data.TypedEncoding.Instances.UTF8" +-- * "Data.TypedEncoding.Instances.Encode.Sample" +-- +-- This list is not intended to be exhaustive, rather separate libraries+-- can provide instances for other encodings and transformations.+--+-- To implement a new encoding import this module and+--+-- * "Data.TypedEncoding.Instances.Support"+--+-- = Examples+--+-- Examples of how to use this library are included in+--+-- * "Examples.TypedEncoding"    +module Data.TypedEncoding (+    module Data.TypedEncoding+    -- * Classes+    , module Data.TypedEncoding.Internal.Class+    -- * Types+    , Enc+    , EncodeEx(..)+    , RecreateEx(..)+    , UnexpectedDecodeEx(..)+    -- * Combinators+    , getPayload +    , unsafeSetPayload+    , fromEncoding+    , toEncoding+ ) where++import           Data.TypedEncoding.Internal.Types (Enc+                                              , RecreateEx(..)+                                              , UnexpectedDecodeEx(..)+                                              , EncodeEx(..)+                                              , getPayload+                                              , unsafeSetPayload+                                              , toEncoding+                                              , fromEncoding+                                               )+import           Data.TypedEncoding.Internal.Class
+ src/Data/TypedEncoding/Instances/ASCII.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Strings can move to 'Enc "r-ASCII' only if they contain only ascii characters.+-- they always decode back+-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds+-- >>> encodeFAll . toEncoding () $ "Hello World" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text)+-- Right (MkEnc Proxy () "Hello World")+--+-- >>> encodeFAll . toEncoding () $ "\194\160" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text)+-- Left (EncodeEx "r-ASCII" (NonAsciiChar '\194'))+module Data.TypedEncoding.Instances.ASCII where++import           Data.TypedEncoding.Instances.Support++import           Data.Proxy+import           Data.Functor.Identity+import           GHC.TypeLits++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Encoding as TE +import qualified Data.Text.Lazy.Encoding as TEL ++import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy.Char8 as BL8++import           Data.Char+import           Data.TypedEncoding.Internal.Utils (explainBool)+import           Data.TypedEncoding.Unsafe (withUnsafe)+import           Control.Arrow++-- tst = encodeFAll . toEncoding () $ "Hello World" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text)+-- tst2 = encodeFAll . toEncoding () $ "\194\160" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text)+-- tst3 = encodeFAll . toEncoding () $ "\194\160" :: Either EncodeEx (Enc '["r-ASCII"] () B.ByteString)++-----------------+-- Conversions --+-----------------++byteString2TextS :: Enc ("r-ASCII" ': ys) c B.ByteString -> Enc ("r-ASCII" ': ys) c T.Text +byteString2TextS = withUnsafe (fmap TE.decodeUtf8)++byteString2TextL :: Enc ("r-ASCII" ': ys) c BL.ByteString -> Enc ("r-ASCII" ': ys) c TL.Text +byteString2TextL = withUnsafe (fmap TEL.decodeUtf8)++text2ByteStringS :: Enc ("r-ASCII" ': ys) c T.Text -> Enc ("r-ASCII" ': ys) c B.ByteString +text2ByteStringS = withUnsafe (fmap TE.encodeUtf8)++text2ByteStringL  :: Enc ("r-ASCII" ': ys) c TL.Text -> Enc ("r-ASCII" ': ys) c BL.ByteString +text2ByteStringL  = withUnsafe (fmap TEL.encodeUtf8)+++-- | allow to treat ASCII encodings as UTF8 forgetting about B64 encoding+-- +-- >>> let Right tstAscii = encodeFAll . toEncoding () $ "Hello World" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text)+-- >>> displ (inject (Proxy :: Proxy "r-UTF8") tstAscii)+-- "MkEnc '[r-UTF8] () (Text Hello World)"+instance Subset "r-ASCII" "r-UTF8" where++-----------------+-- Encondings  --+-----------------++data NonAsciiChar = NonAsciiChar Char deriving (Eq, Show)++prxyAscii = Proxy :: Proxy "r-ASCII"++instance EncodeF (Either EncodeEx) (Enc xs c Char) (Enc ("r-ASCII" ': xs) c Char) where+    encodeF = implEncodeF prxyAscii (\c -> explainBool NonAsciiChar (c, isAscii c))    +instance Applicative f => DecodeF f (Enc ("r-ASCII" ': xs) c Char) (Enc xs c Char) where+    decodeF = implTranP id ++instance EncodeF (Either EncodeEx) (Enc xs c T.Text) (Enc ("r-ASCII" ': xs) c T.Text) where+    encodeF = implEncodeF prxyAscii (encodeImpl T.partition T.head T.null)+instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c T.Text) (Enc ("r-ASCII" ': xs) c T.Text) where+    checkPrevF = implCheckPrevF (asRecreateErr prxyAscii . encodeImpl T.partition T.head T.null)+instance Applicative f => DecodeF f (Enc ("r-ASCII" ': xs) c T.Text) (Enc xs c T.Text) where+    decodeF = implTranP id ++instance EncodeF (Either EncodeEx) (Enc xs c TL.Text) (Enc ("r-ASCII" ': xs) c TL.Text) where+    encodeF = implEncodeF prxyAscii (encodeImpl TL.partition TL.head TL.null)+instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c TL.Text) (Enc ("r-ASCII" ': xs) c TL.Text) where +    checkPrevF = implCheckPrevF (asRecreateErr prxyAscii . encodeImpl TL.partition TL.head TL.null)+instance Applicative f => DecodeF f (Enc ("r-ASCII" ': xs) c TL.Text) (Enc xs c TL.Text) where+    decodeF = implTranP id ++instance EncodeF (Either EncodeEx) (Enc xs c B.ByteString) (Enc ("r-ASCII" ': xs) c B.ByteString) where+    encodeF = implEncodeF prxyAscii (encodeImpl (\p -> B8.filter p &&& B8.filter (not . p)) B8.head B8.null)+instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c B.ByteString) (Enc ("r-ASCII" ': xs) c B.ByteString) where+    checkPrevF = implCheckPrevF (asRecreateErr prxyAscii . encodeImpl (\p -> B8.filter p &&& B8.filter (not . p)) B8.head B8.null)+instance Applicative f => DecodeF f (Enc ("r-ASCII" ': xs) c B.ByteString) (Enc xs c B.ByteString) where+    decodeF = implTranP id ++instance EncodeF (Either EncodeEx) (Enc xs c BL.ByteString) (Enc ("r-ASCII" ': xs) c BL.ByteString) where+    encodeF = implEncodeF prxyAscii (encodeImpl (\p -> BL8.filter p &&& BL8.filter (not . p)) BL8.head BL8.null)+instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c BL.ByteString) (Enc ("r-ASCII" ': xs) c BL.ByteString) where+    checkPrevF = implCheckPrevF (asRecreateErr prxyAscii . encodeImpl (\p -> BL8.filter p &&& BL8.filter (not . p)) BL8.head BL8.null)+instance Applicative f => DecodeF f (Enc ("r-ASCII" ': xs) c BL.ByteString) (Enc xs c BL.ByteString) where+    decodeF = implTranP id ++encodeImpl :: +   ((Char -> Bool) -> a -> (a, a))+   -> (a -> Char)+   -> (a -> Bool)+   -> a+   -> Either NonAsciiChar a+encodeImpl partitionf headf nullf t = +                 let (tascii, nonascii) = partitionf isAscii t +                 in if nullf nonascii +                    then Right tascii+                    else Left . NonAsciiChar $ headf nonascii +
+ src/Data/TypedEncoding/Instances/Base64.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+++module Data.TypedEncoding.Instances.Base64 where++import           Data.TypedEncoding+import           Data.TypedEncoding.Instances.Support++import           Data.Proxy+import           Data.Functor.Identity+import           GHC.TypeLits++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Encoding as TE +import qualified Data.Text.Lazy.Encoding as TEL ++import qualified Data.ByteString.Base64 as B64+import qualified Data.ByteString.Base64.Lazy as BL64++import qualified Data.ByteString.Base64.URL as B64URL+import qualified Data.ByteString.Base64.URL.Lazy as BL64URL++-- $setup+-- >>> :set -XScopedTypeVariables -XKindSignatures -XMultiParamTypeClasses -XDataKinds -XPolyKinds -XPartialTypeSignatures -XFlexibleInstances+-- >>> import Test.QuickCheck+-- >>> import Test.QuickCheck.Instances.Text()+-- >>> import Test.QuickCheck.Instances.ByteString()+++-----------------+-- Conversions --+-----------------++-- | Type-safer version of Byte-string to text conversion that prevent invalid UTF8 bytestrings+-- to be conversted to B64 encoded Text.+byteString2TextS :: Enc ("enc-B64" ': "r-UTF8" ': ys) c B.ByteString -> Enc ("enc-B64" ': ys) c T.Text +byteString2TextS = withUnsafeCoerce (TE.decodeUtf8)++byteString2TextL :: Enc ("enc-B64" ': "r-UTF8" ': ys) c BL.ByteString -> Enc ("enc-B64" ': ys) c TL.Text +byteString2TextL = withUnsafeCoerce (TEL.decodeUtf8)++-- | Converts encoded text to ByteString adding "r-UTF8" annotation.+-- The question is why "r-UTF8", not for example, "r-UTF16"?+-- No reason, there maybe a diffrent combinator for that in the future or one that accepts a proxy.+text2ByteStringS :: Enc ("enc-B64" ': ys) c T.Text -> Enc ("enc-B64" ': "r-UTF8" ': ys) c B.ByteString +text2ByteStringS = withUnsafeCoerce (TE.encodeUtf8)++text2ByteStringL  :: Enc ("enc-B64" ': ys) c TL.Text -> Enc ("enc-B64" ': "r-UTF8" ': ys) c BL.ByteString +text2ByteStringL  = withUnsafeCoerce (TEL.encodeUtf8)+++-- | B64 encoded bytestring can be converted to Text as "enc-B64-nontext" preventing it from +-- being B64-decoded directly to Text+byteString2TextS' :: Enc ("enc-B64" ': ys) c B.ByteString -> Enc ("enc-B64-nontext" ': ys) c T.Text +byteString2TextS' = withUnsafeCoerce (TE.decodeUtf8)++byteString2TextL' :: Enc ("enc-B64" ': ys) c BL.ByteString -> Enc ("enc-B64-nontext" ': ys) c TL.Text +byteString2TextL' = withUnsafeCoerce (TEL.decodeUtf8)++text2ByteStringS' :: Enc ("enc-B64-nontext" ': ys) c T.Text -> Enc ("enc-B64" ': ys) c B.ByteString +text2ByteStringS' = withUnsafeCoerce (TE.encodeUtf8)++text2ByteStringL'  :: Enc ("enc-B64-nontext" ': ys) c TL.Text -> Enc ("enc-B64" ': ys) c BL.ByteString +text2ByteStringL'  = withUnsafeCoerce (TEL.encodeUtf8)++acceptLenientS :: Enc ("enc-B64-len" ': ys) c B.ByteString -> Enc ("enc-B64" ': ys) c B.ByteString +acceptLenientS = withUnsafeCoerce (B64.encode . B64.decodeLenient)++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+-- +--+-- >>> let tstB64 = encodeAll . toEncoding () $ "Hello World" :: Enc '["enc-B64"] () B.ByteString+-- >>> displ (flattenAs (Proxy :: Proxy "r-ASCII") tstB64 :: Enc '["r-ASCII"] () B.ByteString)+-- "MkEnc '[r-ASCII] () (ByteString SGVsbG8gV29ybGQ=)"+instance FlattenAs "enc-B64-nontext" "r-ASCII" where+instance FlattenAs "enc-B64" "r-ASCII" where+++-----------------+-- Encodings   --+-----------------++prxyB64 = Proxy :: Proxy "enc-B64"++instance Applicative f => EncodeF f (Enc xs c B.ByteString) (Enc ("enc-B64" ': xs) c B.ByteString) where+    encodeF = implEncodeP B64.encode +        +-- | Effectful instance for corruption detection.+-- This protocol is used, for example, in emails. +-- It is a well known encoding and hackers will have no problem +-- making undetectable changes, but error handling at this stage+-- could verify that email was corrupted.+instance (UnexpectedDecodeErr f, Applicative f) => DecodeF f (Enc ("enc-B64" ': xs) c B.ByteString) (Enc xs c B.ByteString) where+    decodeF = implDecodeF (asUnexpected prxyB64 . B64.decode) ++instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c B.ByteString) (Enc ("enc-B64" ': xs) c B.ByteString) where+    checkPrevF = implCheckPrevF (asRecreateErr prxyB64 .  B64.decode) ++instance Applicative f => RecreateF f (Enc xs c B.ByteString) (Enc ("enc-B64-len" ': xs) c B.ByteString) where+    checkPrevF = implTranP (id) ++instance Applicative f => EncodeF f  (Enc xs c BL.ByteString) (Enc ("enc-B64" ': xs) c BL.ByteString) where+    encodeF = implEncodeP BL64.encode ++instance (UnexpectedDecodeErr f, Applicative f) => DecodeF f  (Enc ("enc-B64" ': xs) c BL.ByteString) (Enc xs c BL.ByteString) where+    decodeF = implDecodeF (asUnexpected prxyB64 . BL64.decode)++instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c BL.ByteString) (Enc ("enc-B64" ': xs) c BL.ByteString) where+    checkPrevF = implCheckPrevF (asRecreateErr prxyB64 .  BL64.decode) ++instance Applicative f => RecreateF f (Enc xs c BL.ByteString) (Enc ("enc-B64-len" ': xs) c BL.ByteString) where+    checkPrevF = implTranP (id) ++-- B64URL currently not supported+-- instance Applicative f => EncodeF f (Enc xs c B.ByteString) (Enc ("enc-B64URL" ': xs) c B.ByteString) where+--     encodeF = implEncodeP B64URL.encode +-- instance DecodeF (Either String) (Enc ("enc-B64URL" ': xs) c B.ByteString) (Enc xs c B.ByteString) where+--     decodeF = implDecodeF B64URL.decode +-- instance DecodeF Identity (Enc ("enc-B64URL" ': xs) c B.ByteString) (Enc xs c B.ByteString) where+--     decodeF = implTranP B64URL.decodeLenient ++-- instance Applicative f => EncodeF f (Enc xs c BL.ByteString) (Enc ("enc-B64URL" ': xs) c BL.ByteString) where+--     encodeF = implEncodeP BL64URL.encode +-- instance DecodeF (Either String) (Enc ("enc-B64URL" ': xs) c BL.ByteString) (Enc xs c BL.ByteString) where+--     decodeF = implDecodeF BL64URL.decode +-- instance DecodeF Identity (Enc ("enc-B64URL" ': xs) c BL.ByteString) (Enc xs c BL.ByteString) where+--     decodeF = implTranP BL64URL.decodeLenient ++instance Applicative f => EncodeF f (Enc xs c T.Text) (Enc ("enc-B64" ': xs) c T.Text) where+    encodeF = implEncodeP (TE.decodeUtf8 . B64.encode . TE.encodeUtf8)   ++instance (UnexpectedDecodeErr f, Applicative f) => DecodeF f (Enc ("enc-B64" ': xs) c T.Text) (Enc xs c T.Text) where+    decodeF = implDecodeF (asUnexpected prxyB64 . fmap TE.decodeUtf8 . B64.decode . TE.encodeUtf8) ++instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c T.Text) (Enc ("enc-B64" ': xs) c T.Text) where+    checkPrevF = implCheckPrevF (asRecreateErr prxyB64 . fmap TE.decodeUtf8 .  B64.decode . TE.encodeUtf8) ++instance Applicative f => EncodeF f (Enc xs c TL.Text) (Enc ("enc-B64" ': xs) c TL.Text) where+    encodeF = implEncodeP (TEL.decodeUtf8 . BL64.encode . TEL.encodeUtf8)   ++instance (UnexpectedDecodeErr f, Applicative f) => DecodeF f (Enc ("enc-B64" ': xs) c TL.Text) (Enc xs c TL.Text) where+    decodeF = implDecodeF (asUnexpected prxyB64 . fmap TEL.decodeUtf8 . BL64.decode . TEL.encodeUtf8) ++instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c TL.Text) (Enc ("enc-B64" ': xs) c TL.Text) where+    checkPrevF = implCheckPrevF (asRecreateErr prxyB64 . fmap TEL.decodeUtf8 .  BL64.decode . TEL.encodeUtf8)
+ src/Data/TypedEncoding/Instances/Encode/Sample.hs view
@@ -0,0 +1,59 @@++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | This module defines some sample "do-" encodings+-- currently for example use only.+module Data.TypedEncoding.Instances.Encode.Sample where++import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.ByteString as B+-- import qualified Data.ByteString.Lazy as BL++import           Data.TypedEncoding.Instances.Support++import           Data.Proxy+import           GHC.TypeLits+import           Data.Char+++instance Applicative f => EncodeF f (Enc xs c T.Text) (Enc ("do-UPPER" ': xs) c T.Text) where+    encodeF = implEncodeP T.toUpper+instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c T.Text) (Enc ("do-UPPER" ': xs) c T.Text) where+    checkPrevF = implCheckPrevF (asRecreateErr (Proxy :: Proxy "do-UPPER") . (\t -> +                                 let (g,b) = T.partition isUpper t+                                 in if T.null b+                                    then Right t+                                    else Left $ "Found not upper case chars " ++ T.unpack b)+                           )+instance Applicative f => EncodeF f (Enc xs c TL.Text) (Enc ("do-UPPER" ': xs) c TL.Text) where+    encodeF = implEncodeP TL.toUpper ++instance Applicative f => EncodeF f (Enc xs c T.Text) (Enc ("do-lower" ': xs) c T.Text) where+    encodeF = implEncodeP T.toLower    +instance Applicative f => EncodeF f (Enc xs c TL.Text) (Enc ("do-lower" ': xs) c TL.Text) where+    encodeF = implEncodeP TL.toLower ++instance Applicative f => EncodeF f (Enc xs c T.Text) (Enc ("do-Title" ': xs) c T.Text) where+    encodeF = implEncodeP T.toTitle   +instance Applicative f => EncodeF f (Enc xs c TL.Text) (Enc ("do-Title" ': xs) c TL.Text) where+    encodeF = implEncodeP TL.toTitle   ++instance Applicative f => EncodeF f (Enc xs c T.Text) (Enc ("do-reverse" ': xs) c T.Text) where+    encodeF = implEncodeP T.reverse +instance Applicative f => EncodeF f (Enc xs c TL.Text) (Enc ("do-reverse" ': xs) c TL.Text) where+    encodeF = implEncodeP TL.reverse    ++newtype SizeLimit = SizeLimit {unSizeLimit :: Int} deriving (Eq, Show)+instance (HasA c SizeLimit, Applicative f) => EncodeF f (Enc xs c T.Text) (Enc ("do-size-limit" ': xs) c T.Text) where+    encodeF =  implEncodeP' (T.take . unSizeLimit . has (Proxy :: Proxy SizeLimit)) +instance (HasA c SizeLimit, Applicative f) => EncodeF f (Enc xs c B.ByteString) (Enc ("do-size-limit" ': xs) c B.ByteString) where+    encodeF =  implEncodeP' (B.take . unSizeLimit . has (Proxy :: Proxy SizeLimit)) +
+ src/Data/TypedEncoding/Instances/Support.hs view
@@ -0,0 +1,11 @@++-- | Exports for encoding instance creation+module Data.TypedEncoding.Instances.Support (+    -- * Types+    module Data.TypedEncoding.Internal.Types+    -- * Classes+    , module Data.TypedEncoding.Internal.Class+   ) where+import           Data.TypedEncoding.Internal.Types+import           Data.TypedEncoding.Internal.Class +
+ src/Data/TypedEncoding/Instances/UTF8.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE PartialTypeSignatures #-}+-- | +module Data.TypedEncoding.Instances.UTF8 where++import           Data.TypedEncoding.Instances.Support+-- import           Data.TypedEncoding.Internal.Utils (proxiedId)+import           Data.TypedEncoding.Unsafe (withUnsafe)++import           Data.Proxy+import           Data.Functor.Identity+import           GHC.TypeLits++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Encoding as TE +import qualified Data.Text.Lazy.Encoding as TEL ++import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy.Char8 as BL8++import           GHC.TypeLits+import           Data.Char+import           Control.Arrow+import           Data.Text.Encoding.Error (UnicodeException)++import           Data.Either++-- $setup+-- >>> :set -XScopedTypeVariables -XKindSignatures -XMultiParamTypeClasses -XDataKinds -XPolyKinds -XPartialTypeSignatures -XFlexibleInstances+-- >>> import Test.QuickCheck+-- >>> import Test.QuickCheck.Instances.Text()+-- >>> import Test.QuickCheck.Instances.ByteString()+-- >>> import Data.TypedEncoding.Internal.Utils (proxiedId)+-- >>> let prxyArb = Proxy :: Proxy (Either EncodeEx (Enc '["r-UTF8"] () B.ByteString))+-- >>> :{+-- >>> instance Arbitrary (Enc '["r-UTF8"] () B.ByteString) where +--      arbitrary =  fmap (fromRight (emptyUTF8B ())) +--                   . flip suchThat isRight +--                   . fmap (proxiedId prxyArb . encodeFAll . toEncoding ()) $ arbitrary +-- :}++-- | empty string is valid utf8+emptyUTF8B :: c -> Enc '["r-UTF8"] c B.ByteString+emptyUTF8B c = unsafeSetPayload c ""   ++-----------------+-- Conversions --+-----------------++-- Right tst = encodeFAll . toEncoding () $ "Hello World" :: Either EncodeEx (Enc '["r-UTF8"] () B.ByteString)+-- tstTxt = byteString2TextS tst++-- | Type-safer version of @Data.Text.Encoding.encodeUtf8@+--+-- >>> displ $ text2ByteStringS $ toEncoding () ("text" :: T.Text)+-- "MkEnc '[r-UTF8] () (ByteString text)"+text2ByteStringS :: Enc ys c T.Text -> Enc ("r-UTF8" ': ys) c B.ByteString+text2ByteStringS = withUnsafeCoerce TE.encodeUtf8++-- | Type-safer version of Data.Text.Encoding.decodeUtf8+--+-- >>> let Right tst = encodeFAll . toEncoding () $ "Hello World" :: Either EncodeEx (Enc '["r-UTF8"] () B.ByteString)+-- >>> displ $ byteString2TextS tst+-- "MkEnc '[] () (Text Hello World)"+byteString2TextS :: Enc ("r-UTF8" ': ys) c B.ByteString -> Enc ys c T.Text +byteString2TextS = withUnsafeCoerce TE.decodeUtf8++-- | Identity property "byteString2TextS . text2ByteStringS == id"+-- prop> \t -> t == (fromEncoding . txtBsSIdProp (Proxy :: Proxy '[]) . toEncoding () $ t)+txtBsSIdProp :: Proxy (ys :: [Symbol]) -> Enc ys c T.Text -> Enc ys c T.Text+txtBsSIdProp _ = byteString2TextS . text2ByteStringS ++-- | Identity property "text2ByteStringS . byteString2TextS == id".+--+-- prop> \(t :: Enc '["r-UTF8"] () B.ByteString) -> t == (bsTxtIdProp (Proxy :: Proxy '[]) $ t)+bsTxtIdProp :: Proxy (ys :: [Symbol]) -> Enc ("r-UTF8" ': ys) c B.ByteString -> Enc ("r-UTF8" ': ys) c B.ByteString+bsTxtIdProp _ = text2ByteStringS . byteString2TextS++text2ByteStringL :: Enc ys c TL.Text -> Enc ("r-UTF8" ': ys) c BL.ByteString+text2ByteStringL = withUnsafeCoerce TEL.encodeUtf8++byteString2TextL :: Enc ("r-UTF8" ': ys) c BL.ByteString -> Enc ys c TL.Text +byteString2TextL = withUnsafeCoerce TEL.decodeUtf8++-----------------+-- Encondings  --+-----------------++prxyUtf8 = Proxy :: Proxy "r-UTF8"++-- TODO these are quick and dirty++-- | UTF8 encodings are defined for ByteString only as that would not make much sense for Text+--+-- >>> encodeFAll . toEncoding () $ "\xc3\xb1" :: Either EncodeEx (Enc '["r-UTF8"] () B.ByteString)+-- Right (MkEnc Proxy () "\195\177")+-- >>> encodeFAll . toEncoding () $ "\xc3\x28" :: Either EncodeEx (Enc '["r-UTF8"] () B.ByteString)+-- Left (EncodeEx "r-UTF8" (Cannot decode byte '\xc3': Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream))+--+-- Following test uses 'verEncoding' helper that checks that bytes are encoded as Right iff they are valid UTF8 bytes+--+-- prop> \(b :: B.ByteString) -> verEncoding b (fmap (fromEncoding . decodeAll . proxiedId (Proxy :: Proxy (Enc '["r-UTF8"] _ _))) . (encodeFAll :: _ -> Either EncodeEx _). toEncoding () $ b)++instance EncodeF (Either EncodeEx) (Enc xs c B.ByteString) (Enc ("r-UTF8" ': xs) c B.ByteString) where+    encodeF = implEncodeF prxyUtf8 (fmap TE.encodeUtf8 . TE.decodeUtf8')+instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c B.ByteString) (Enc ("r-UTF8" ': xs) c B.ByteString) where+    checkPrevF = implCheckPrevF (asRecreateErr prxyUtf8 . fmap TE.encodeUtf8 . TE.decodeUtf8')+instance Applicative f => DecodeF f (Enc ("r-UTF8" ': xs) c B.ByteString) (Enc xs c B.ByteString) where+    decodeF = implTranP id ++instance EncodeF (Either EncodeEx) (Enc xs c BL.ByteString) (Enc ("r-UTF8" ': xs) c BL.ByteString) where+    encodeF = implEncodeF prxyUtf8 (fmap TEL.encodeUtf8 . TEL.decodeUtf8')+instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c BL.ByteString) (Enc ("r-UTF8" ': xs) c BL.ByteString) where+    checkPrevF = implCheckPrevF (asRecreateErr prxyUtf8 . fmap TEL.encodeUtf8 . TEL.decodeUtf8')+instance Applicative f => DecodeF f (Enc ("r-UTF8" ': xs) c BL.ByteString) (Enc xs c BL.ByteString) where+    decodeF = implTranP id ++--- Utilities ---++-- | helper function checks that given ByteString, +-- if is encoded as Left is must be not Utf8 decodable+-- is is encoded as Right is must be Utf8 encodable +verEncoding :: B.ByteString -> Either err B.ByteString -> Bool+verEncoding bs (Left _) = isLeft . TE.decodeUtf8' $ bs+verEncoding bs (Right _) = isRight . TE.decodeUtf8' $ bs
+ src/Data/TypedEncoding/Internal/Class.hs view
@@ -0,0 +1,222 @@++{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+-- {-# LANGUAGE PartialTypeSignatures #-}++module Data.TypedEncoding.Internal.Class where++import           Data.TypedEncoding.Internal.Types (Enc(..) +                                              , toEncoding+                                              , getPayload+                                              , withUnsafeCoerce+                                              , unsafeChangePayload+                                              , RecreateEx(..)+                                              , UnexpectedDecodeEx(..))+import           Data.Proxy+import           Data.Functor.Identity+import           GHC.TypeLits+import           Data.Semigroup ((<>))+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 qualified Data.List as L+++-- $setup+-- >>> :set -XScopedTypeVariables -XKindSignatures -XMultiParamTypeClasses -XDataKinds -XPolyKinds -XFlexibleInstances -XFlexibleContexts+-- >>> import Data.TypedEncoding.Internal.Types (unsafeSetPayload)++class EncodeF f instr outstr where    +    encodeF :: instr -> f outstr++class EncodeFAll f (xs :: [k]) c str where+    encodeFAll :: (Enc '[] c str) -> f (Enc xs c str)++instance Applicative f => EncodeFAll f '[] c str where+    encodeFAll (MkEnc _ c str) = pure $ toEncoding c str ++instance (Monad f, EncodeFAll f xs c str, EncodeF f (Enc xs c str) (Enc (x ': xs) c str)) => EncodeFAll f (x ': xs) c str where+    encodeFAll str = +        let re :: f (Enc xs c str) = encodeFAll str+        in re >>= encodeF+++encodeAll :: EncodeFAll Identity (xs :: [k]) c str => +              (Enc '[] c str) +              -> (Enc xs c str)+encodeAll = runIdentity . encodeFAll             ++++class DecodeF f instr outstr where    +    decodeF :: instr -> f outstr++class DecodeFAll f (xs :: [k]) c str where+    decodeFAll :: (Enc xs c str) ->  f (Enc '[] c str)++instance Applicative f => DecodeFAll f '[] c str where+    decodeFAll (MkEnc _ c str) = pure $ toEncoding c str ++instance (Monad f, DecodeFAll f xs c str, DecodeF f (Enc (x ': xs) c str) (Enc (xs) c str)) => DecodeFAll f (x ': xs) c str where+    decodeFAll str = +        let re :: f (Enc xs c str) = decodeF str+        in re >>= decodeFAll++decodeAll :: DecodeFAll Identity (xs :: [k]) c str => +              (Enc xs c str)+              -> (Enc '[] c str) +decodeAll = runIdentity . decodeFAll ++-- | Used to safely recover encoded data validating all encodingss+class RecreateF f instr outstr where    +    checkPrevF :: outstr -> f instr++class (Functor f) => RecreateFAll f (xs :: [k]) c str where+    checkFAll :: (Enc xs c str) -> f (Enc '[] c str)+    recreateFAll :: (Enc '[] c str) -> f (Enc xs c str)+    recreateFAll str@(MkEnc _ _ pay) = +        let str0 :: Enc xs c str = withUnsafeCoerce id str+        in fmap (withUnsafeCoerce (const pay)) $ checkFAll str0    ++instance Applicative f => RecreateFAll f '[] c str where+    checkFAll (MkEnc _ c str) = pure $ toEncoding c str +++instance (Monad f, RecreateFAll f xs c str, RecreateF f (Enc xs c str) (Enc (x ': xs) c str)) => RecreateFAll f (x ': xs) c str where+    checkFAll str = +        let re :: f (Enc xs c str) = checkPrevF str+        in re >>= checkFAll+++recreateAll :: RecreateFAll Identity (xs :: [k]) c str => +              (Enc '[] c str) +              -> (Enc xs c str)+recreateAll = runIdentity . recreateFAll             ++                    ++-- | TODO use singletons definition instead?+type family Append (xs :: [k]) (ys :: [k]) :: [k] where+    Append '[] xs = xs+    Append (y ': ys) xs = y ': (Append ys xs)++encodeFPart :: forall f xs xsf c str . (Functor f, EncodeFAll f xs c str) => Proxy xs -> (Enc xsf c str) -> f (Enc (Append xs xsf) c str)+encodeFPart p (MkEnc _ conf str) = +    let re :: f (Enc xs c str) = encodeFAll $ MkEnc Proxy conf str+    in  (MkEnc Proxy conf . getPayload) <$> re ++encodePart :: EncodeFAll Identity (xs :: [k]) c str => +              Proxy xs +              -> (Enc xsf c str)+              -> (Enc (Append xs xsf) c str) +encodePart p = runIdentity . encodeFPart p++-- | Unsafe implementation guarded by safe type definition+decodeFPart :: forall f xs xsf c str . (Functor f, DecodeFAll f xs c str) => Proxy xs -> (Enc (Append xs xsf) c str) -> f (Enc xsf c str)+decodeFPart p (MkEnc _ conf str) = +    let re :: f (Enc '[] c str) = decodeFAll $ MkEnc (Proxy :: Proxy xs) conf str+    in  (MkEnc Proxy conf . getPayload) <$> re + +decodePart :: DecodeFAll Identity (xs :: [k]) c str => +              Proxy xs +              -> (Enc (Append xs xsf) c str) +              -> (Enc xsf c str) +decodePart p = runIdentity . decodeFPart p++-- Other classes --++-- subsets are useful for restriction encodings+-- like r-UFT8 but not for other encodings.+class Subset (x :: k) (y :: k) where+    inject :: Proxy y -> Enc (x ': xs) c str ->  Enc (y ': xs) c str+    inject _ = withUnsafeCoerce id++class FlattenAs (x :: k) (y :: k) where+    flattenAs :: Proxy y -> Enc (x ': xs) c str ->  Enc '[y] c str+    flattenAs _ = withUnsafeCoerce id++-- | Polymorphic data payloads used to encode/decode+class HasA c a where+    has :: Proxy a -> c -> a++instance HasA a () where+    has _ = const ()++-- | With type safety in pace decoding errors should be unexpected+-- this class can be used to provide extra info if decoding could fail+class UnexpectedDecodeErr f where +    unexpectedDecodeErr :: UnexpectedDecodeEx -> f a++instance UnexpectedDecodeErr Identity where+    unexpectedDecodeErr x = fail $ show x++instance UnexpectedDecodeErr (Either UnexpectedDecodeEx) where+    unexpectedDecodeErr = Left ++asUnexpected :: (UnexpectedDecodeErr f, Applicative f, Show err, KnownSymbol x) => Proxy x -> Either err a -> f a+asUnexpected p (Left err) = unexpectedDecodeErr $ UnexpectedDecodeEx p err+asUnexpected _ (Right r) = pure r++-- TODO using RecreateErr typeclass is overkill++-- | Recovery errors are expected unless Recovery allows Identity instance+class RecreateErr f where +    recoveryErr :: RecreateEx -> f a++instance RecreateErr (Either RecreateEx) where+    recoveryErr = Left  ++asRecreateErr :: (RecreateErr f, Applicative f, Show err, KnownSymbol x) => Proxy x -> Either err a -> f a+asRecreateErr p (Left err) = recoveryErr $ RecreateEx p err+asRecreateErr _ (Right r) = pure r+++-- * Display ++-- | Human friendly version of Show+class Displ x where +    displ :: x -> String++instance Displ String where+    displ = id    +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 (Proxy '[]) where+    displ _ = ""++-- |+-- >>> displ (Proxy :: Proxy ["FIRST", "SECOND"])+-- "FIRST,SECOND"+instance (pxs ~ Proxy xs, Displ pxs, KnownSymbol x) => Displ (Proxy (x ': xs)) where+    displ _ =  L.dropWhileEnd (',' ==) $  symbolVal (Proxy :: Proxy x) ++ "," ++ displ (Proxy :: Proxy xs)++-- >>> let disptest = unsafeSetPayload () "hello" :: Enc '["TEST"] () T.Text+-- >>> displ disptest+-- "MkEnc '[TEST] () hello"+instance (Displ (Proxy xs), Show c, Displ str) => Displ ( Enc xs c str) where+    displ (MkEnc p c s) = +        "MkEnc '[" ++ displ p ++ "] " ++ show c ++ " " ++ displ s+++-- Utils --++errorOnLeft :: Show err => Either err a -> a+errorOnLeft (Left e) = error $ "You trusted encodings too much " <> show e+errorOnLeft (Right r) =  r
+ src/Data/TypedEncoding/Internal/Types.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Internal definition of types++module Data.TypedEncoding.Internal.Types where++import           Data.Proxy+import           Data.Functor.Identity+import           GHC.TypeLits++-- Not a Functor on purpose+data Enc enc conf str where+    -- | constructor is to be treated as Unsafe to Encode and Decode instance implementations+    -- particular encoding instances may expose smart constructors for limited data types+    MkEnc :: Proxy enc -> conf -> str -> Enc enc conf str+    deriving (Show, Eq) + +toEncoding :: conf -> str -> Enc '[] conf str+toEncoding conf str = MkEnc Proxy conf str++fromEncoding :: Enc '[] conf str -> str+fromEncoding = getPayload++-- TODO make all implTran functions module-private+-- TODO disambiguate implEncode from implDecode, from implCheckPrevF for type safety+-- especially since these are always used in combo with asRecreateErr or asUnexpected ++implTranF :: Functor f => (str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str)+implTranF f  = implTranF' (\c -> f)++-- TODO could this type be more precise?+implEncodeF :: (Show err, KnownSymbol x) => Proxy x -> (str -> Either err str) ->  Enc enc1 conf str -> Either EncodeEx (Enc enc2 conf str) +implEncodeF p f = implTranF (either (Left . EncodeEx p) Right . f) ++implDecodeF :: Functor f => (str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str)+implDecodeF = implTranF++implCheckPrevF :: Functor f => (str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str)+implCheckPrevF = implTranF+++implTranF' :: Functor f =>  (conf -> str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str)+implTranF' f (MkEnc _ conf str) = (MkEnc Proxy conf) <$> f conf str++implEncodeF' :: (Show err, KnownSymbol x) => Proxy x -> (conf -> str -> Either err str) ->  Enc enc1 conf str -> Either EncodeEx (Enc enc2 conf str) +implEncodeF' p f = implTranF' (\c -> either (Left . EncodeEx p) Right . f c) ++implDecodeF' :: Functor f =>  (conf -> str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str)+implDecodeF' = implTranF'++implTranP :: Applicative f => (str -> str) -> Enc enc1 conf str -> f (Enc enc2 conf str)+implTranP f  = implTranF' (\c -> pure . f)++implEncodeP :: Applicative f => (str -> str) -> Enc enc1 conf str -> f (Enc enc2 conf str)+implEncodeP = implTranP++implTranP' :: Applicative f => (conf -> str -> str) -> Enc enc1 conf str -> f (Enc enc2 conf str)+implTranP' f  = implTranF' (\c -> pure . f c)++implEncodeP' :: Applicative f => (conf -> str -> str) -> Enc enc1 conf str -> f (Enc enc2 conf str)+implEncodeP' = implTranP'+++getPayload :: Enc enc conf str -> str  +getPayload (MkEnc _ _ str) = str++unsafeSetPayload :: conf -> str -> Enc enc conf str +unsafeSetPayload c str = MkEnc Proxy c str++withUnsafeCoerce ::  (s1 -> s2) -> Enc e1 c s1 -> Enc e2 c s2+withUnsafeCoerce f (MkEnc _ conf str)  = (MkEnc Proxy conf (f str)) ++unsafeChangePayload ::  (s1 -> s2) -> Enc e c s1 -> Enc e c s2+unsafeChangePayload f (MkEnc p conf str)  = (MkEnc p conf (f str)) ++++-- | Represents errors in recovery (recreation of encoded types).+data RecreateEx where+    RecreateEx:: (Show e, KnownSymbol x) => Proxy x -> e -> RecreateEx ++instance Show RecreateEx where+    show (RecreateEx prxy a) = "(RecreateEx \"" ++ symbolVal prxy ++ "\" (" ++ show a ++ "))"+++-- | Represents errors in encoding+data EncodeEx where+    EncodeEx:: (Show a, KnownSymbol x) => Proxy x -> a -> EncodeEx ++instance Show EncodeEx where+    show (EncodeEx prxy a) = "(EncodeEx \"" ++ symbolVal prxy ++ "\" (" ++ show a ++ "))"++++-- | Type safety over encodings makes decoding process safe.+-- However failures are still possible due to bugs or unsafe payload modifications.+-- UnexpectedDecodeEx represents such errors.+data UnexpectedDecodeEx where+    UnexpectedDecodeEx :: (Show a, KnownSymbol x) => Proxy x -> a -> UnexpectedDecodeEx++instance Show UnexpectedDecodeEx where+    show (UnexpectedDecodeEx prxy a) = "(UnexpectedDecodeEx \"" ++ symbolVal prxy ++ "\" (" ++ show a ++ "))"
+ src/Data/TypedEncoding/Internal/Utils.hs view
@@ -0,0 +1,13 @@+module Data.TypedEncoding.Internal.Utils where++import           Data.Proxy++explainBool :: (a -> err) -> (a, Bool) -> Either err a+explainBool _ (a, True) = Right a+explainBool f (a, False) = Left $ f a +++proxiedId :: Proxy a -> a -> a+proxiedId _ = id++
+ src/Data/TypedEncoding/Unsafe.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}++module Data.TypedEncoding.Unsafe where++import           Data.Proxy+import           Data.Functor.Identity+import           Data.TypedEncoding.Internal.Types++ +-- | Allows to operate within Enc. These are considered unsafe.+-- keeping the same list of encodings +newtype Unsafe enc conf str = Unsafe {runUnsafe :: Enc enc conf str} deriving (Show)++withUnsafe :: (Unsafe e c s1 -> Unsafe e c s2) -> Enc e c s1 -> Enc e c s2+withUnsafe f enc = runUnsafe . f $ Unsafe enc++instance Functor (Unsafe enc conf) where+    fmap f (Unsafe (MkEnc p c x)) = Unsafe (MkEnc p c (f x))+  +instance Applicative (Unsafe enc ()) where+    pure = Unsafe . MkEnc Proxy ()  +    Unsafe (MkEnc p c1 f) <*> Unsafe (MkEnc _ c2 x) = Unsafe (MkEnc p () (f x))  ++instance Monad (Unsafe enc ()) where +    Unsafe (MkEnc _ _ x) >>= f = f x     ++--TODO JSON instances    ++
+ src/Examples/TypedEncoding.hs view
@@ -0,0 +1,15 @@+module Examples.TypedEncoding (+   -- * Overview Examples +   module Examples.TypedEncoding.Overview+   -- * Conversions between encodings +   , module Examples.TypedEncoding.Conversions+   -- * Adding new encodings, error handling      +   , module Examples.TypedEncoding.DiySignEncoding+   -- * Modifying encoded payload    +   , module Examples.TypedEncoding.Unsafe +  ) where++import           Examples.TypedEncoding.Overview+import           Examples.TypedEncoding.Conversions     +import           Examples.TypedEncoding.DiySignEncoding  +import           Examples.TypedEncoding.Unsafe
+ src/Examples/TypedEncoding/Conversions.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Examples or moving between type annotated encodings+--+-- Modules that define encoding and decoding instances also provide conversion functions.+-- +-- Currently, these are separate functions, generalization of conversions seems hard.+--+-- These examples discuss handling of __subsets__ (for character sets), __leniency__, and __flattening__. +module Examples.TypedEncoding.Conversions where++import           Data.TypedEncoding+import qualified Data.TypedEncoding.Instances.Base64 as EnB64+import qualified Data.TypedEncoding.Instances.ASCII as EnASCII+import qualified Data.TypedEncoding.Instances.UTF8  as EnUTF8++import           Data.Proxy++import qualified Data.Text as T+import qualified Data.ByteString as B++-- $setup+-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds+--+-- This module contains some ghci friendly values to play with.+--+-- Each value is documented in a doctest style by including an equivalent ghci ready expression.+-- These documents generate a test suite for this library as well.+++-- * Moving between Text and ByteString+++eHelloAsciiB :: Either EncodeEx (Enc '["r-ASCII"] () B.ByteString)+eHelloAsciiB = encodeFAll . toEncoding () $ "HeLlo world" +-- ^ Example value to play with+--+-- >>>  encodeFAll . toEncoding () $ "HeLlo world" :: Either EncodeEx (Enc '["r-ASCII"] () B.ByteString) +-- Right (MkEnc Proxy () "HeLlo world")++Right helloAsciiB = eHelloAsciiB+-- ^ above with either removed++helloAsciiT :: Enc '["r-ASCII"] () T.Text+helloAsciiT = EnASCII.byteString2TextS helloAsciiB+-- ^ When converted to Text the annotation is preserved.+--+-- Currently separate function is defined for each allowed conversion. +--+-- >>> displ $ EnASCII.byteString2TextS helloAsciiB+-- "MkEnc '[r-ASCII] () (Text HeLlo world)"++-- * Subsets++helloUtf8B :: Enc '["r-UTF8"] () B.ByteString+helloUtf8B = inject Proxy helloAsciiB+-- ^ To get UTF8 annotation, instead of doing this: +--+-- >>> encodeFAll . toEncoding () $ "HeLlo world" :: Either EncodeEx (Enc '["r-UTF8"] () B.ByteString)+-- Right (MkEnc Proxy () "HeLlo world")+-- +-- We should be able to convert the ASCII version.+--+-- This is done using 'Subset' typeclass.+--+-- @inject@ method accepts proxy to specify superset to use.+--+-- >>> displ $ inject (Proxy :: Proxy "r-UTF8") helloAsciiB+-- "MkEnc '[r-UTF8] () (ByteString HeLlo world)"++++-- * More complex rules++helloUtf8B64B :: Enc '["enc-B64", "r-UTF8"] () B.ByteString+helloUtf8B64B = encodePart (Proxy :: Proxy '["enc-B64"]) helloUtf8B +-- ^ We put Base64 on the UFT8 ByteString+--+-- >>> displ $ encodePart (Proxy :: Proxy '["enc-B64"]) helloUtf8B+-- "MkEnc '[enc-B64,r-UTF8] () (ByteString SGVMbG8gd29ybGQ=)"++helloUtf8B64T :: Enc '["enc-B64"] () T.Text+helloUtf8B64T = EnB64.byteString2TextS helloUtf8B64B  +-- ^ .. and copy it over to Text.+-- but UTF8 would be redundant in Text so the "r-UTF8" is dropped+--+-- >>> :t EnB64.byteString2TextS helloUtf8B64B+-- EnB64.byteString2TextS helloUtf8B64B :: Enc '["enc-B64"] () T.Text+--+-- Conversely moving back to ByteString recovers the annotation.+-- (there could be a choice of a UTF annotation to recover in the future)+-- +-- >>> :t EnB64.text2ByteStringS helloUtf8B64T+-- EnB64.text2ByteStringS helloUtf8B64T+-- ... :: Enc '["enc-B64", "r-UTF8"] () B.ByteString++notTextB :: Enc '["enc-B64"] () B.ByteString+notTextB = encodeAll . toEncoding () $ "\195\177"+-- ^ 'notTextB' a binary, one that does not even represent valid UTF8.+-- +-- >>> encodeAll . toEncoding () $ "\195\177" :: Enc '["enc-B64"] () B.ByteString+-- MkEnc Proxy () "w7E="+--+-- 'EnB64.byteString2TextS'' is a fuction that allows to convert Base 64 ByteString that is not UTF8.+-- +-- >>> :t EnB64.byteString2TextS' notTextB+-- EnB64.byteString2TextS' notTextB+-- ... :: Enc '["enc-B64-nontext"] () T.Text+--+-- The result is annotated as "enc-B64-nontext" which prevents decoding it within 'T.Text' type.+-- We can only move it back to ByteString as "enc-B64".++++-- * Lenient recovery++lenientSomething :: Enc '["enc-B64-len"] () B.ByteString+lenientSomething = recreateAll . toEncoding () $ "abc==CB"+-- ^ +-- >>> recreateAll . toEncoding () $ "abc==CB" :: Enc '["enc-B64-len"] () B.ByteString+-- MkEnc Proxy () "abc==CB"+--+-- The rest of Haskell does lenient decoding, type safety allows this library to use it for recovery.+-- lenient algorithms are not partial and automatically fix invalid input:+--+-- >>> recreateFAll . toEncoding () $ "abc==CB" :: Either RecreateEx (Enc '["enc-B64"] () B.ByteString)+-- Left (RecreateEx "enc-B64" ("invalid padding"))+--+-- This library allows to recover to "enc-B64-len" which is different than "enc-B64"+--+-- 'EnB64.acceptLenientS' allows to convert "enc-B64-len" to "enc-B64"+--+-- >>> displ $ EnB64.acceptLenientS lenientSomething+-- "MkEnc '[enc-B64] () (ByteString abc=)"+--+-- This is now properly encoded data+--+-- >>> recreateFAll . toEncoding () $ "abc=" :: Either RecreateEx (Enc '["enc-B64"] () B.ByteString)+-- Right (MkEnc Proxy () "abc=")+--+-- Except the content could be surprising+--+-- >>> decodeAll $ EnB64.acceptLenientS lenientSomething+-- MkEnc Proxy () "i\183"+++-- * Flattening++b64IsAscii :: Enc '["r-ASCII"] () B.ByteString+b64IsAscii = flattenAs Proxy helloUtf8B64B+-- ^ Base 64 encodes binary data as ASCII text. +-- thus, we should be able to treat "enc-B64" as "r-ASCII" losing some information.+-- this is done using 'FlattenAs' type class+--+-- >>> :t flattenAs (Proxy :: Proxy "r-ASCII") helloUtf8B64B+-- flattenAs (Proxy :: Proxy "r-ASCII") helloUtf8B64B+-- ... :: Enc '["r-ASCII"] () B.ByteString
+ src/Examples/TypedEncoding/DiySignEncoding.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- {-# 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 'RecreateF' typeclass.+-- +-- 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           Data.Proxy+import           Data.Functor.Identity+import           GHC.TypeLits++import qualified Data.Text as T+import           Data.Char+import           Data.Semigroup ((<>))+import           Control.Arrow+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+-- MkEnc 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 exected 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 (MkEnc Proxy () "11:Hello World")++prxyMySign = Proxy :: Proxy "my-sign"++-- | Because encoding function is pure we can create instance of EncodeF +-- that is polymorphic in effect @f@. This is done using 'EnT.implTranP' combinator.+instance Applicative f => EncodeF f (Enc xs c T.Text) (Enc ("my-sign" ': xs) c T.Text) where+    encodeF = EnT.implEncodeP encodeSign    ++-- | Decoding allows effectful @f@ to allow for troubleshooting and unsafe payload changes.+--+-- Implementation simply uses 'EnT.implDecodeF' combinator on the 'asUnexpected' composed with decoding function.+-- 'UnexpectedDecodeErr' has Identity instance allowing for decoding that assumes errors are not possible.+-- For debugging purposes or when unsafe changes to "my-sign" @Error UnexpectedDecodeEx@ instance can be used.+instance (UnexpectedDecodeErr f, Applicative f) => DecodeF f (Enc ("my-sign" ': xs) c T.Text) (Enc xs c T.Text) where+    decodeF = EnT.implDecodeF (asUnexpected prxyMySign . decodeSign) ++-- | Recreation allows effectful @f@ to check for tampering with data.+-- Implementation simply uses 'EnT.implCheckPrevF' combinator on the recovery function.+instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c T.Text) (Enc ("my-sign" ': xs) c T.Text) where   +    checkPrevF = EnT.implCheckPrevF (asRecreateErr prxyMySign . decodeSign)
+ src/Examples/TypedEncoding/Overview.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}++-- | type-encoding overview examples. +--+-- This library is concerned with 3 main operations done on strings:+-- __encoding__, __decoding__, and __recovery__.  Examples in this module cover all+-- of these base cases.+--+-- This module uses encoding instances found in +--+-- * "Data.TypedEncoding.Instances.Base64"+-- * "Data.TypedEncoding.Instances.ASCII"+-- * "Data.TypedEncoding.Instances.Encode.Sample"+--++module Examples.TypedEncoding.Overview where++import           Data.TypedEncoding+import           Data.TypedEncoding.Instances.Base64+import           Data.TypedEncoding.Instances.ASCII+import           Data.TypedEncoding.Instances.Encode.Sample+ +import           GHC.TypeLits+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import           Data.Proxy+import           Data.Functor.Identity+++-- $setup+-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds+--+-- This module contains some ghci friendly values to play with.+--+-- Each value is documented in a doctest style by including an equivalent ghci ready expression.+-- These documents generate a test suite for this library as well.++-- * Basics++-- | "Hello World" encoded as Base64+--+-- >>> helloB64 +-- MkEnc Proxy () "SGVsbG8gV29ybGQ="+--+-- >>> displ helloB64+-- "MkEnc '[enc-B64] () (ByteString SGVsbG8gV29ybGQ=)"+-- +-- >>> encodeAll . toEncoding () $ "Hello World" :: Enc '["enc-B64"] () B.ByteString+-- MkEnc Proxy () "SGVsbG8gV29ybGQ="+helloB64 :: Enc '["enc-B64"] () B.ByteString+helloB64 = encodeAll . toEncoding () $ "Hello World"++-- | Previous text decoded from Base64+--+-- >>> fromEncoding . decodeAll $ helloB64 +-- "Hello World"+helloB64Decoded :: B.ByteString+helloB64Decoded = fromEncoding . decodeAll $ helloB64++-- | 'recreateFAll' allows for recovering data at program boundaries (for example, when parsing JSON input).+-- It makes sure that the content satisfies specified encodings.+-- +-- >>> recreateFAll . toEncoding () $ "SGVsbG8gV29ybGQ=" :: Either RecreateEx (Enc '["enc-B64"] () B.ByteString)+-- Right (MkEnc Proxy () "SGVsbG8gV29ybGQ=")+--+-- >>> recreateFAll . toEncoding () $ "SGVsbG8gV29ybGQ" :: Either RecreateEx (Enc '["enc-B64"] () B.ByteString)+-- Left (RecreateEx "enc-B64" ("invalid padding"))+helloB64Recovered :: Either RecreateEx (Enc '["enc-B64"] () B.ByteString)+helloB64Recovered = recreateFAll . toEncoding () $ "SGVsbG8gV29ybGQ="++-- | "Hello World" double-Base64 encoded.+-- Notice the same code used as in single encoding, the game is played at type level.+--+-- >>> encodeAll . toEncoding () $ "Hello World" :: Enc '["enc-B64","enc-B64"] () B.ByteString  +-- MkEnc Proxy () "U0dWc2JHOGdWMjl5YkdRPQ=="+--+-- >>> displ helloB64B64+-- "MkEnc '[enc-B64,enc-B64] () (ByteString U0dWc2JHOGdWMjl5YkdRPQ==)"+helloB64B64 :: Enc '["enc-B64","enc-B64"] () B.ByteString+helloB64B64 = encodeAll . toEncoding () $ "Hello World"++-- | Double Base64 encoded "Hello World" with one layer of encoding removed+--+-- >>> decodePart (Proxy :: Proxy '["enc-B64"]) $ helloB64B64 :: Enc '["enc-B64"] () B.ByteString+-- MkEnc Proxy () "SGVsbG8gV29ybGQ="+--+-- >>> helloB64B64PartDecode == helloB64+-- True+helloB64B64PartDecode :: Enc '["enc-B64"] () B.ByteString+helloB64B64PartDecode = decodePart (Proxy :: Proxy '["enc-B64"]) $ helloB64B64++-- | 'helloB64B64' all the way to 'B.ByteString'+--+-- Notice a similar polymorphism in decoding.+--+-- >>> fromEncoding . decodeAll $ helloB64B64 :: B.ByteString +-- "Hello World"+-- +-- We can also decode all the parts: +--+-- >>> fromEncoding . decodePart (Proxy :: Proxy '["enc-B64","enc-B64"]) $ helloB64B64+-- "Hello World"+helloB64B64Decoded :: B.ByteString+helloB64B64Decoded = fromEncoding . decodeAll $ helloB64B64++-- | what happens when we try to recover encoded once text to @Enc '["enc-B64", "enc-B64"]@. +--+-- 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"))+helloB64B64RecoveredErr :: Either RecreateEx (Enc '["enc-B64", "enc-B64"] () B.ByteString)+helloB64B64RecoveredErr = recreateFAll . toEncoding () $ "SGVsbG8gV29ybGQ="++++-- * "do-" Encodings++-- |+-- "do-UPPER" (from 'Data.TypedEncoding.Instances.Encode.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.+--  +-- The same code is used as in "enc-" examples to encode (now transform).+--+-- >>> encodeAll . toEncoding () $ "Hello World" :: Enc '["do-UPPER"] () T.Text+-- MkEnc Proxy () "HELLO WORLD"+helloUPP :: Enc '["do-UPPER"] () T.Text+helloUPP = encodeAll . toEncoding () $ "Hello World"++-- | Sample compound transformation +-- +-- >>> encodeAll . toEncoding () $ "HeLLo world" :: Enc '["do-reverse", "do-Title"] () T.Text+-- MkEnc Proxy () "dlroW olleH" +helloTitleRev :: Enc '["do-reverse", "do-Title"] () T.Text+helloTitleRev = encodeAll . toEncoding () $ "HeLLo world"++++-- * Configuration++-- | Example configuration+data Config = Config {+    sizeLimit :: SizeLimit+  } deriving (Show)+exampleConf = Config (SizeLimit 8) ++instance HasA Config SizeLimit where+   has _ = sizeLimit  ++-- | `helloTitle' is needed in following examples+--+helloTitle :: Enc '["do-Title"] Config T.Text+helloTitle = encodeAll . toEncoding exampleConf $ "hello wOrld"++-- | Configuration can be used to impact the encoding process.+--+-- So far we had used @()@ as configuration of all encodings.+-- But since both "do-reverse", "do-Title" are polymorphic in +-- configuration we can also do this:+--+-- >>> encodeAll . toEncoding exampleConf $ "HeLLo world" :: Enc '["do-reverse", "do-Title"] Config T.Text+-- MkEnc Proxy (Config {sizeLimit = SizeLimit {unSizeLimit = 8}}) "dlroW olleH"+--+-- >>> encodeAll . toEncoding exampleConf $ "HeLlo world" :: Enc '["do-size-limit", "do-reverse", "do-Title"] Config T.Text+-- MkEnc Proxy (Config {sizeLimit = SizeLimit {unSizeLimit = 8}}) "dlroW ol"+--+-- Instead, encode previously defined 'helloTitle' by reversing it and adding size limit+--+-- >>> encodePart (Proxy :: Proxy '["do-size-limit", "do-reverse"]) helloTitle :: Enc '["do-size-limit", "do-reverse", "do-Title"] Config T.Text+-- MkEnc Proxy (Config {sizeLimit = SizeLimit {unSizeLimit = 8}}) "dlroW ol"+helloRevLimit :: Enc '["do-size-limit", "do-reverse", "do-Title"] Config T.Text+helloRevLimit = encodePart (Proxy :: Proxy '["do-size-limit", "do-reverse"]) helloTitle++-- >>> encodeAll . toEncoding exampleConf $ "HeLlo world" :: Enc '["enc-B64", "do-size-limit"] Config B.ByteString+-- MkEnc Proxy (Config {sizeLimit = SizeLimit {unSizeLimit = 8}}) "SGVMbG8gd28="+helloLimitB64 :: Enc '["enc-B64", "do-size-limit"] Config B.ByteString+helloLimitB64 = encodeAll . toEncoding exampleConf $ "HeLlo world"++-- | ... and we unwrap the B64 part only+-- +-- >>> decodePart (Proxy :: Proxy '["enc-B64"]) $ helloLimitB64+-- MkEnc Proxy (Config {sizeLimit = SizeLimit {unSizeLimit = 8}}) "HeLlo wo"+helloRevLimitParDec :: Enc '["do-size-limit"] Config B.ByteString+helloRevLimitParDec =  decodePart (Proxy :: Proxy '["enc-B64"]) $ helloLimitB64+++++-- * "r-" encodings section++-- | ASCII char set+-- ByteStrings are sequences of Bytes ('Data.Word.Word8'). The type+-- is very permissive, it may contain binary data such as jpeg picture.+--+-- "r-ASCII" encoding acts as partial identity function+-- it does not change any bytes in bytestring but it fails if a byte+-- is outside of ASCII range (in @Either@ monad).+--+-- Note naming thing: "r-" is partial identity ("r-" is from restriction).+--+-- >>>  encodeFAll . toEncoding () $ "HeLlo world" :: Either EncodeEx (Enc '["r-ASCII"] () B.ByteString) +-- Right (MkEnc Proxy () "HeLlo world")+helloAscii :: Either EncodeEx (Enc '["r-ASCII"] () B.ByteString)+helloAscii = encodeFAll . toEncoding () $ "HeLlo world" ++-- | Arguably the type we used for helloB64 was too permissive.+-- a better version is here:+--+-- >>> encodeFAll . toEncoding () $ "Hello World" :: Either EncodeEx (Enc '["enc-B64", "r-ASCII"] () B.ByteString)+-- Right (MkEnc Proxy () "SGVsbG8gV29ybGQ=") +helloAsciiB64 :: Either EncodeEx (Enc '["enc-B64", "r-ASCII"] () B.ByteString)+helloAsciiB64 = encodeFAll . toEncoding () $ "Hello World"++-- |+-- >>> decodePart (Proxy :: Proxy '["enc-B64"]) <$> helloAsciiB64+-- Right (MkEnc Proxy () "Hello World")+helloAsciiB64PartDec :: Either EncodeEx (Enc '["r-ASCII"] () B.ByteString)+helloAsciiB64PartDec = decodePart (Proxy :: Proxy '["enc-B64"]) <$> helloAsciiB64
+ src/Examples/TypedEncoding/Unsafe.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Examples about how to work with encoded data.+-- This topic is (an interesting) work-in-progress.+--+-- Modifying encoded data would typically corrupt the encoding. +-- Current approach is to use 'Data.TypedEncoding.Unsafe.Unsafe' wrapping class that exposes+-- Functor and (limited) Applicative and Monad instances.++module Examples.TypedEncoding.Unsafe where+++import           Data.Proxy++import qualified Data.Text as T++import           Data.Char++import           Data.TypedEncoding+import qualified Data.TypedEncoding.Instances.ASCII as EnASCII+import qualified Data.TypedEncoding.Unsafe as Unsafe++import           Data.Semigroup ((<>))++-- $setup+-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds++-- | Starting example+exAsciiTE :: Either EncodeEx (Enc '["r-ASCII"] () T.Text)+exAsciiTE = encodeFAll . toEncoding () $ "HELLO" ++-- | with either removed+exAsciiT :: Enc '["r-ASCII"] () T.Text+Right exAsciiT = exAsciiTE++-- * Safe and Slow approach++-- |+-- 'recreateFAll' is the way to recover encoding in a safe way+--+-- >>> let payload = getPayload exAsciiT+-- >>> let newPayload = payload <> " some extra stuff"+-- >>> recreateFAll . toEncoding () $ newPayload :: Either RecreateEx (Enc '["r-ASCII"] () T.Text)+-- Right (MkEnc Proxy () "HELLO some extra stuff")+--+modifiedAsciiT :: Either RecreateEx (Enc '["r-ASCII"] () T.Text)+modifiedAsciiT =  recreateFAll . toEncoding () . ( <> " some extra stuff") . getPayload $ exAsciiT+  ++-- * Unsafe but fast++-- |+-- The issue with 'recreateFAll' is that it may be expensive.+--+-- This apprach uses 'Data.TypedEncoding.Unsafe.Unsafe' to perform (in general risky) operation on+-- the internal payload.+--  +-- >>> exAsciiTE+-- Right (MkEnc Proxy () "HELLO")+-- >>> exAsciiTE >>= pure . Unsafe.withUnsafe (fmap T.toLower)+-- Right (MkEnc Proxy () "hello")+--+-- Example uses of 'T.toLower' within encoded data+-- this operation is safe for ASCII restriction+-- but @Enc '["r-ASCII"] () T.Text@ does not expose it+-- We use Functor instance of Unsafe wrapper type to accomplish this+toLowerAscii :: Either EncodeEx (Enc '["r-ASCII"] () T.Text)+toLowerAscii = exAsciiTE >>= pure . Unsafe.withUnsafe (fmap T.toLower)++-- | +-- Similar example uses applicative instance of 'Unsafe.Unsafe'+--+-- >>> let Right hELLO = exAsciiTE+-- >>> let Right hello = toLowerAscii+-- >>> displ $ Unsafe.runUnsafe ((<>) <$> Unsafe.Unsafe hELLO <*> Unsafe.Unsafe hello)+-- "MkEnc '[r-ASCII] () (Text HELLOhello)"+appendAscii :: Either EncodeEx (Enc '["r-ASCII"] () T.Text)+appendAscii = do +    hELLO <- exAsciiTE+    hello <- toLowerAscii+    pure $ Unsafe.runUnsafe ((<>) <$> Unsafe.Unsafe hELLO <*> Unsafe.Unsafe hello)+
+ test/Spec.hs view
@@ -0,0 +1,3 @@+-- {-# OPTIONS_GHC -F -pgmF doctest-discover #-}+main :: IO ()+main = putStrLn "Test suite not yet implemented"
+ typed-encoding.cabal view
@@ -0,0 +1,94 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: e2dc0ab6f8312959f012e795327b2395efd87de964449886a61a2cc19f64accd++name:           typed-encoding+version:        0.1.0.0+synopsis:       Type safe string transformations+description:    See README.md in the project github repository.+category:       Data, Text+homepage:       https://github.com/rpeszek/typed-encoding#readme+bug-reports:    https://github.com/rpeszek/typed-encoding/issues+author:         Robert Peszek+maintainer:     robpeszek@gmail.com+copyright:      2020 Robert Peszek+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/rpeszek/typed-encoding++library+  exposed-modules:+      Data.TypedEncoding+      Data.TypedEncoding.Instances.ASCII+      Data.TypedEncoding.Instances.Base64+      Data.TypedEncoding.Instances.Encode.Sample+      Data.TypedEncoding.Instances.Support+      Data.TypedEncoding.Instances.UTF8+      Data.TypedEncoding.Internal.Class+      Data.TypedEncoding.Internal.Types+      Data.TypedEncoding.Internal.Utils+      Data.TypedEncoding.Unsafe+      Examples.TypedEncoding+      Examples.TypedEncoding.Conversions+      Examples.TypedEncoding.DiySignEncoding+      Examples.TypedEncoding.Overview+      Examples.TypedEncoding.Unsafe+  other-modules:+      Paths_typed_encoding+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , base64-bytestring >=1.0 && <1.1+    , bytestring >=0.10 && <0.11+    , text >=1.2 && <1.3+  default-language: Haskell2010++test-suite typed-encoding-doctest+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_typed_encoding+  hs-source-dirs:+      doctest+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      QuickCheck >=2.13.1 && <2.14+    , base >=4.7 && <5+    , base64-bytestring >=1.0 && <1.1+    , bytestring >=0.10 && <0.11+    , doctest >=0.16 && <0.17+    , doctest-discover >=0.2 && <0.3+    , quickcheck-instances >=0.3.20 && <0.4+    , text >=1.2 && <1.3+    , typed-encoding+  default-language: Haskell2010++test-suite typed-encoding-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_typed_encoding+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      QuickCheck+    , base >=4.7 && <5+    , base64-bytestring >=1.0 && <1.1+    , bytestring >=0.10 && <0.11+    , quickcheck-instances+    , text >=1.2 && <1.3+    , typed-encoding+  default-language: Haskell2010