typed-encoding 0.4.1.0 → 0.4.2.0

raw patch · 12 files changed

+261/−25 lines, 12 files

Files

• ChangeLog.md +13/−3
• README.md +0/−1
• src/Data/TypedEncoding.hs +1/−1
• src/Data/TypedEncoding/Combinators/ToEncStr.hs +2/−1
• src/Data/TypedEncoding/Common/Class/Superset.hs +20/−12
• src/Data/TypedEncoding/Common/Class/Util.hs +4/−0
• src/Data/TypedEncoding/Instances/Do/Sample.hs +2/−0
• src/Data/TypedEncoding/Instances/Restriction/Bool.hs +5/−1
• src/Data/TypedEncoding/Instances/Restriction/BoundedAlphaNums.hs +2/−2
• src/Data/TypedEncoding/Instances/Support/Bool.hs +186/−0
• src/Data/TypedEncoding/Instances/Support/Encode.hs +23/−2
• typed-encoding.cabal +3/−2

@@ -2,9 +2,19 @@  ## Anticipated future breaking changes -- `Data.TypedEncoding.Internal.Class.IsStringR` expected to be be changed / replaced-- (post 0.3) "enc-B64" will be moved to a different package (more distant goal)-- Improved constrains in `Data.TypedEncoding.Conv` modules+- `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)+++## 0.4.2++- `Data.TypedEncoding.Instances.Support.Bool` combinators ("r-bool" remains experimental)+- Correction in `r-ban` error message typo ("'G' not bounded by 'F'")+- `_implEncFromString` creates "r-" encoding from `FromEncString` definition+- property changes: `propEncodesIntoCheck` added; `propSuperset'`,  `propEncodesInto'` deprecated  ## 0.4.1 

@@ -72,7 +72,6 @@  Please see `Examples.TypedEncoding` it the module list. - ## Other encoding packages  My approach will be to write specific encodings (e.g. _HTTP_) or wrap encodings from other packages using separate "bridge" projects.

@@ -103,7 +103,7 @@ -- * "Data.TypedEncoding.Instances.Restriction.UTF8"  -- * "Data.TypedEncoding.Instances.Restriction.Bool" (experimental / early alpha version, moved from @Combinators@ to @Instances@ in v0.3) -- * "Data.TypedEncoding.Instances.Restriction.BoundedAlphaNums" (moved from @Combinators@ to @Instances@ in v0.3)--- * "Data.TypedEncoding.Instances.Do.Sample" +-- * "Data.TypedEncoding.Instances.Do.Sample" - This module is intended as example code and will be moved under 'Examples.TypedEncoding' in the future --  -- ... and needed conversions.  --

@@ -23,6 +23,8 @@  import           Data.Functor.Identity +-- * backward compatible v0.2 like combinators+ toEncStringF :: forall nm f a str  . (ToEncString f nm nm a str) => a -> f (Enc '[nm] () str) toEncStringF = toEncStringF' @nm @nm @@ -37,7 +39,6 @@   --- backward compatible v0.2 like combinators fromEncStringF :: forall nm f a str  . (FromEncString f nm nm a str) => Enc '[nm] () str -> f a fromEncStringF = fromEncStringF' @nm @nm 

@@ -91,10 +91,6 @@ -- _injectInto ::forall y x xs c str . (IsSuperset y x ~ 'True) =>  Enc (x ': xs) c str ->  Enc (Replace x y xs) c str  --- |--- Test for Supersets defined in this module------ Actual tests in the project /test/ suite. propSuperset' :: forall algb algs b s str . (Superset b s, Eq str)                   =>                   Encoding (Either EncodeEx) b algb () str @@ -102,10 +98,15 @@                  -> str                   -> Bool propSuperset' = propSupersetCheck @algb @algs+{-# DEPRECATED propSuperset' "Use propSupersetCheck or propSuperset_" #-}          propSuperset_ :: forall b s str algb algs. (Superset b s, Eq str, AlgNm b ~ algb, AlgNm s ~ algs) => Encoding (Either EncodeEx) b algb () str -> Encoding (Either EncodeEx) s algs () str -> str -> Bool propSuperset_ = propSupersetCheck @algb @algs +-- |+-- Test for Supersets defined in this module+--+-- Actual tests in the project /test/ suite. propSupersetCheck :: forall algb algs b s str . (Eq str)                   =>                   Encoding (Either EncodeEx) b algb () str @@ -147,13 +148,9 @@ --  -- 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' encb encr str = -   case runEncoding' @algb encb . toEncoding () $ str of-            Right r -> case runEncoding' @algr encr . toEncoding () $ getPayload r of-                Left _ -> False-                Right _ -> True-            Left _ -> True  - +propEncodesInto' = propEncodesIntoCheck+{-# DEPRECATED propEncodesInto' "Use propEncodesIntoCheck or propEncodesInto_" #-}+ propEncodesInto_ :: forall b r str algb algr. (     EncodingSuperset b     , r ~ EncSuperset b@@ -164,8 +161,19 @@        -> Encoding (Either EncodeEx) r algr () str         -> str         -> Bool-propEncodesInto_ = propEncodesInto' @algb @algr+propEncodesInto_ = propEncodesIntoCheck @algb @algr +-- |+-- validates superset restriction+-- +-- Actual tests 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+            Right r -> case runEncoding' @algr encr . toEncoding () $ getPayload r of+                Left _ -> False+                Right _ -> True+            Left _ -> True    -- | Checks if first encoding exceptions less often than second (has bigger domain). propCompEncoding :: forall algb algr b r str .  Encoding (Either EncodeEx) b algb () str -> Encoding (Either EncodeEx) r algr () str -> str -> Bool

@@ -96,6 +96,10 @@  -- | 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

@@ -11,6 +11,8 @@  -- | 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

@@ -15,7 +15,11 @@ -- -- @since 0.2.1.0 -- --- /(Experimental, early alpha development stage)/ This module was not converted to v0.3 style yet.+-- /(Experimental, early alpha development stage)/ +--+-- Use 'Data.TypedEncoding.Instances.Support.Bool' instead.+-- +-- This module was not converted to v0.3 style yet. -- -- == Grammar -- 

@@ -94,7 +94,7 @@ -- >>> verifyBoundedAlphaNum (Proxy :: Proxy "r-ban:FF-FF") (T.pack "12-3E") -- Right "12-3E" -- >>> verifyBoundedAlphaNum (Proxy :: Proxy "r-ban:FF-FF") (T.pack "1G-3E")--- Left "'G' not boulded by 'F'"+-- Left "'G' not bounded by 'F'" -- >>> verifyBoundedAlphaNum (Proxy :: Proxy "r-ban:FF-FF") (T.pack "13G3E") -- Left "'G' not matching '-'" -- >>> verifyBoundedAlphaNum (Proxy :: Proxy "r-ban:FFяFF") (T.pack "13я234")@@ -119,5 +119,5 @@         fn ci cp = case (isAlphaNum ci, isAlphaNum cp, ci <= cp, ci == cp) of             (True, True, True, _) -> Right ()             (_, _, _, True) -> Right ()-            (_, True, _, False) -> Left $ show ci ++ " not boulded by " ++ show cp+            (_, True, _, False) -> Left $ show ci ++ " not bounded by " ++ show cp             (_, False, _, False) -> Left $ show ci ++ " not matching " ++ show cp

@@ -0,0 +1,186 @@++-- {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}++-- | Combinators for creating encoding using existing encodings.+-- +-- @since 0.4.2.0+module Data.TypedEncoding.Instances.Support.Bool where++import           Data.TypedEncoding.Combinators.Unsafe+import           Data.TypedEncoding.Common.Types.Enc+import           Data.Proxy+import           Data.TypedEncoding.Common.Types+import           GHC.TypeLits++-- import           Data.TypedEncoding.Instances.Restriction.BoundedAlphaNums (encFBan)+-- import           Data.TypedEncoding++-- $setup+-- >>> :set -XDataKinds -XFlexibleInstances -XFlexibleContexts -XOverloadedStrings -XTypeApplications -XScopedTypeVariables+-- >>> import           Data.TypedEncoding+-- >>> import           Data.TypedEncoding.Instances.Restriction.BoundedAlphaNums (encFBan)++-- | Defines new encoding by specifying 2 encodings, one needs to succeed.+--  +-- @since 0.4.2.0+implEncOr' :: forall alg alg1 alg2 nm nm1 nm2 c str . (KnownSymbol nm) =>+               Encoding (Either EncodeEx) nm1 alg1 c str +               -> Encoding (Either EncodeEx) nm2 alg2 c str +               -> Encoding (Either EncodeEx) nm alg c str +implEncOr' enc1 enc2 = UnsafeMkEncoding Proxy f+   where +       f :: forall xs . Enc xs c str -> Either EncodeEx (Enc (nm ': xs) c str)+       f enc = +           case runEncoding' @alg1 @nm1 enc1 enc of+               Right r -> Right $ withUnsafeCoerce id r+               Left (EncodeEx _ err1) -> +                   case runEncoding' @alg2 @nm2 enc2 enc of +                       Right r -> Right $ withUnsafeCoerce id r+                       Left (EncodeEx _ err2) -> Left $ EncodeEx (Proxy :: Proxy nm) (err1, err2)++implEncOr :: forall nm nm1 nm2 c str . (KnownSymbol nm) =>+               Encoding (Either EncodeEx) nm1 nm1 c str +               -> Encoding (Either EncodeEx) nm2 nm2 c str +               -> Encoding (Either EncodeEx) nm nm c str +implEncOr = implEncOr' @nm @nm1 @nm2             ++++-- |+-- +-- >>> let tst = _implEncOr @"r-tst:999(9)" @"r-ban:9999" @"r-ban:999" @() @String encFBan encFBan+--+-- >>> fmap displ $ _runEncoding tst $ toEncoding () "123"+-- Right "Enc '[r-tst:999(9)] () (String 123)"+--+-- >>> fmap displ $ _runEncoding tst $ toEncoding () "1234"+-- Right "Enc '[r-tst:999(9)] () (String 1234)"+--+-- >>> fmap displ $ _runEncoding tst $ toEncoding () "12345"+-- Left (EncodeEx "r-tst:999(9)" (("Input list has wrong size expecting 4 but length \"12345\" == 5","Input list has wrong size expecting 3 but length \"12345\" == 5")))+--+-- @since 0.4.2.0+_implEncOr :: forall nm nm1 nm2 c str alg alg1 alg2. +              (+                KnownSymbol nm+              , Algorithm nm alg+              , Algorithm nm1 alg1+              , Algorithm nm2 alg2+               ) =>+               Encoding (Either EncodeEx) nm1 alg1 c str +               -> Encoding (Either EncodeEx) nm2 alg2 c str +               -> Encoding (Either EncodeEx) nm alg c str +_implEncOr = implEncOr' @alg @alg1 @alg2      +++-- | Defines new encoding by specifying 2 encodings, both needs to succeed and produce the same payload.+--  +-- @since 0.4.2.0+implEncAnd' :: forall alg alg1 alg2 nm nm1 nm2 c str . (KnownSymbol nm, Eq str) =>+               Encoding (Either EncodeEx) nm1 alg1 c str +               -> Encoding (Either EncodeEx) nm2 alg2 c str +               -> Encoding (Either EncodeEx) nm alg c str +implEncAnd' enc1 enc2 = UnsafeMkEncoding Proxy f+   where +       f :: forall xs . Enc xs c str -> Either EncodeEx (Enc (nm ': xs) c str)+       f enc = +            case (runEncoding' @alg1 @nm1 enc1 enc, runEncoding' @alg2 @nm2 enc2 enc) of+                (Right r1, Right r2) -> if getPayload r1 == getPayload r2 +                                       then Right $ withUnsafeCoerce id r1+                                       else Left $ EncodeEx (Proxy :: Proxy nm) "Non-matching encodings"+                (Left (EncodeEx _ err1), Left (EncodeEx _ err2)) -> Left $ EncodeEx (Proxy :: Proxy nm) (err1, err2)+                (Left (EncodeEx _ err), _) -> Left $ EncodeEx (Proxy :: Proxy nm) (err, ())+                (_, Left (EncodeEx _ err)) -> Left $ EncodeEx (Proxy :: Proxy nm) ((), err)++implEncAnd :: forall nm nm1 nm2 c str . (KnownSymbol nm, Eq str) =>+               Encoding (Either EncodeEx) nm1 nm1 c str +               -> Encoding (Either EncodeEx) nm2 nm2 c str +               -> Encoding (Either EncodeEx) nm nm c str +implEncAnd = implEncAnd' @nm @nm1 @nm2             ++-- | +--+-- >>> let tst2 = _implEncAnd @"r-tst:99" @"r-ban:9Z" @"r-ban:Z9" @() @String encFBan encFBan+--+-- >>> fmap displ $ _runEncoding tst2 $ toEncoding () "99"+-- Right "Enc '[r-tst:99] () (String 99)"+--+-- >>> fmap displ $ _runEncoding tst2 $ toEncoding () "AB"+-- Left (EncodeEx "r-tst:99" (("'A' not bounded by '9'","'B' not bounded by '9'")))+--+-- @since 0.4.2.0+_implEncAnd :: forall nm nm1 nm2 c str alg alg1 alg2. +              (+                KnownSymbol nm+              , Eq str+              , Algorithm nm alg+              , Algorithm nm1 alg1+              , Algorithm nm2 alg2+               ) =>+               Encoding (Either EncodeEx) nm1 alg1 c str +               -> Encoding (Either EncodeEx) nm2 alg2 c str +               -> Encoding (Either EncodeEx) nm alg c str +_implEncAnd = implEncAnd' @alg @alg1 @alg2++-- | Defines new encoding which succeeds only if specified encoding fails.+-- It that happens, it applies given transformation function.    +--  +-- @since 0.4.2.0+implEncNot' :: forall alg alg1 nm nm1 c str . (KnownSymbol nm) =>+               (str -> str)+               -> Encoding (Either EncodeEx) nm1 alg1 c str +               -> Encoding (Either EncodeEx) nm alg c str +implEncNot' fn enc1 = UnsafeMkEncoding Proxy f+   where +       f :: forall xs . Enc xs c str -> Either EncodeEx (Enc (nm ': xs) c str)+       f enc = +           case runEncoding' @alg1 @nm1 enc1 enc of+               Left _ -> Right $ withUnsafeCoerce fn enc+               Right _ ->  Left $ EncodeEx (Proxy :: Proxy nm) "Negated encoding succeeded"++implEncNot :: forall nm nm1 c str . (KnownSymbol nm) =>+               (str -> str)+               -> Encoding (Either EncodeEx) nm1 nm1 c str +               -> Encoding (Either EncodeEx) nm nm c str +implEncNot = implEncNot' @nm @nm1             ++_implEncNot :: forall nm nm1 c str alg alg1 . +              (+                KnownSymbol nm+              , Algorithm nm alg+              , Algorithm nm1 alg1+               ) =>+               (str -> str)+               -> Encoding (Either EncodeEx) nm1 alg1 c str +               -> Encoding (Either EncodeEx) nm alg c str +_implEncNot = implEncNot' @alg @alg1++-- | Defines restriction encoding that succeeds when specified encoding fails+--  +--+-- >>> let tst3 = _implREncNot @"r-tstnot:99" @"r-ban:99" @() @String encFBan +--+-- >>> fmap displ $ _runEncoding tst3 $ toEncoding () "AA"+-- Right "Enc '[r-tstnot:99] () (String AA)"+--+-- >>> fmap displ $ _runEncoding tst3 $ toEncoding () "99"+-- Left (EncodeEx "r-tstnot:99" ("Negated encoding succeeded"))+--+-- @since 0.4.2.0+_implREncNot :: forall nm nm1 c str alg alg1 . +              (+                KnownSymbol nm+              , Algorithm nm alg+              , Algorithm nm1 alg1+               ) =>+               Encoding (Either EncodeEx) nm1 alg1 c str +               -> Encoding (Either EncodeEx) nm alg c str +_implREncNot = implEncNot' @alg @alg1 id

@@ -3,7 +3,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}--- {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleContexts #-}@@ -14,13 +14,34 @@ module Data.TypedEncoding.Instances.Support.Encode where  import           Data.TypedEncoding.Instances.Support.Unsafe+import           Data.TypedEncoding.Combinators.Unsafe import           Data.TypedEncoding.Common.Types.Enc import           Data.Proxy import           Data.TypedEncoding.Common.Types import           GHC.TypeLits +-- | +-- Create @"r-"@ - like encoding based on 'Data.TypedEncoding.Common.Class.fromEncF' like function. +-- +-- Useful for small not performance critical encoding since it executed provided @fromEnc@ function+-- to verify the encoding+--+-- this method does not restrict @nm@ to follow "r-" naming convention but is expected to be used to define @"r-"@ encoding. +_implEncFromString :: forall nm err a c str . +                       (KnownSymbol nm+                       , Show err) +                       => +                       (Enc '[nm] () str -> Either err a) +                       -> Encoding (Either EncodeEx) nm (AlgNm nm) c str+_implEncFromString fn = UnsafeMkEncoding Proxy f+   where +       f :: forall xs . Enc xs c str -> Either EncodeEx (Enc (nm ': xs) c str)+       f enc = +           case fn (unsafeSetPayload () $ getPayload enc) of+               Right _ -> Right $ withUnsafeCoerce id enc+               Left err ->  Left $ EncodeEx (Proxy :: Proxy nm) err --- * Compiler figure out algorithm, these appear fast enough +-- * Compiler figures out algorithm, these appear fast enough   _implEncodingP :: forall nm f c str . Applicative f => (str -> str) -> Encoding f nm (AlgNm nm)  c str _implEncodingP f = _mkEncoding $ implTranF (pure . f)

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 401999e1b4cdce2d71a8bd02cb005f7f4632cd9bb8f1629e5d54b0a5be76f2d4+-- hash: d82580e7a0363bd4ef2af6a3a7d41d10d0cb724efc6066bc066c3d91ded51810  name:           typed-encoding-version:        0.4.1.0+version:        0.4.2.0 synopsis:       Type safe string transformations description:    See README.md in the project github repository. category:       Data, Text@@ -76,6 +76,7 @@       Data.TypedEncoding.Instances.Restriction.Misc       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