versioning 0.1.0.0 → 0.2.0.0
raw patch · 9 files changed
+385/−133 lines, 9 filesdep +semigroupoidsdep ~base
Dependencies added: semigroupoids
Dependency ranges changed: base
Files
- ChangeLog.md +19/−3
- src/Versioning/Base.hs +39/−38
- src/Versioning/Internal/Base.hs +33/−0
- src/Versioning/Internal/Decoding.hs +118/−0
- src/Versioning/Internal/Folding.hs +41/−0
- src/Versioning/JSON.hs +118/−63
- src/Versioning/Upgrade.hs +1/−14
- tests/Main.hs +9/−12
- versioning.cabal +7/−3
ChangeLog.md view
@@ -1,5 +1,21 @@-# Revision history for version+# Revision history -## 0.1.0.0 -- 2018-06-06+## 0.2.0.0 -* First version. Released on an unsuspecting world.+- Get the version number of a versioned value++- Decouple the decoding logic from the actual encoding++- Provide two families of functions for decoding JSON:+ `fromJsonAnyVersionX` and `withJsonAnyVersionX`++### Breaking changes++- `decodeAnyVersion` is now called `fromJsonAnyVersion`++- `withAnyVersion` is now called `withJsonAnyVersion`++- `withAnyVersionM` is now called `withJsonAnyVersionM`+## 0.1.0.0++- First version
src/Versioning/Base.hs view
@@ -4,32 +4,39 @@ -- 'Since' and 'Until' type families. -- -- Example:--- data Rec v = Rec--- { foo :: Int -- this field exists in all versions--- , bar :: Since V2 v Bool -- this field has been introduced in V2--- , baz :: Until V2 v Double -- this field has been removed in V3--- } --+-- > data Rec v = Rec+-- > { foo :: Int -- this field exists in all versions+-- > , bar :: Since V2 v Bool -- this field has been introduced in V2+-- > , baz :: Until V2 v Double -- this field has been removed in V3+-- > }+-- -- Besides reducing the number of data declarations, -- this approach also has other advantages:+-- -- * It makes migrations declarative and self-documenting.+-- -- * It allows for less verbose version-upcasting functions, -- since the fields that have a non-parametric type do not need to be copied.+-- -- * It is a foundation on which other useful abstractions can be built.--- However there are also some drawbacks to consider:--- some classes may require a separate standalone deriving clause for each version.--- Moreover the usage of type-level computations can make the error messages--- harder to understand.+--+-- Please note that some classes may require a separate standalone deriving clause+-- for each version of a data-type or some kind of inductive deriving mechanism. {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} module Versioning.Base ( V(..)+ , GetV+ , versionNumber , Since , Until , NA@@ -57,13 +64,23 @@ ) where -import Data.Aeson (FromJSON (..), ToJSON (..), Value (..))-import GHC.Generics (Generic)-import GHC.TypeNats+import Data.Proxy (Proxy (..))+import GHC.TypeNats (type (-), KnownNat, Nat, natVal)+import Numeric.Natural (Natural) +import Versioning.Internal.Base (Bare)+ -- | The version of a data model newtype V = V Nat +-- | Get the type-level natural of a version+type family GetV (v :: V) :: Nat where+ GetV ('V n) = n++-- | Get the version number of a versioned value+versionNumber :: forall a v. KnownNat (GetV v) => a v -> Natural+versionNumber _ = natVal (Proxy :: Proxy (GetV v))+ -- | This allows us to express that a field is only present since -- a given version. -- The first parameter is the version in which the field has been introduced,@@ -83,36 +100,20 @@ Until ('V u) ('V v) a = Until ('V (u - 1)) ('V (v - 1)) a -- | A type indicating absence.--- The 'Maybe' is a hack needed to let aeson parse a record even--- if a field is missing.+-- The 'Maybe' is a hack needed to let aeson parse a record successfully even+-- if a field of type 'NA' is missing.+--+-- Ideally we would like to define it as+--+-- > data NA = NA+--+-- but this would not work with 'FromJSON' instances that are derived+-- with Generic. type NA = Maybe Bare -- | A placeholder for an absent value. na :: NA na = Nothing---- | An uninhabited type.--- We define our own type instead of using "Data.Void"--- because we need additional instances.--- Moreover this type is hidden to force users to use 'NA',--- which is needed because of the 'Maybe' hack.-data Bare--deriving instance Eq Bare--deriving instance Generic Bare--deriving instance Show Bare---- Attempting to supply a value for an absent field must produce a--- parsing failure-instance FromJSON Bare where- parseJSON _ = fail "An NA field should be absent or null"---- We provide an instance to make the compiler happy.--- In practice it will never be used.-instance ToJSON Bare where- toJSON _ = Null -- Handy type synonyms to minimize parenthesis type V1 = 'V 1
+ src/Versioning/Internal/Base.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE StandaloneDeriving #-}+module Versioning.Internal.Base+ ( Bare+ )+where+++import Data.Aeson (FromJSON (..), ToJSON (..), Value (..))+import GHC.Generics (Generic)++-- | An uninhabited type.+-- We define our own type instead of using "Data.Void"+-- because we need additional instances.+-- Moreover this type is internal.+-- Users are supposed to use 'NA' to express absence.+data Bare++deriving instance Eq Bare++deriving instance Generic Bare++deriving instance Show Bare++-- Attempting to supply a value for an absent field must produce a+-- parsing failure+instance FromJSON Bare where+ parseJSON _ = fail "An NA field should be absent or null"++-- We provide an instance to make the compiler happy.+-- In practice it will never be used.+instance ToJSON Bare where+ toJSON _ = Null
+ src/Versioning/Internal/Decoding.hs view
@@ -0,0 +1,118 @@+-- | Encoding-agnosting deserialization utilities.+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+module Versioning.Internal.Decoding+ ( Applied+ , Apply+ , ApplyM+ , DecodableTo+ , DecodeAnyVersion+ , Decoder (..)+ , WithAnyVersion+ , decodeAnyVersion+ , withAnyVersion+ , withAnyVersionM+ )+where++import Data.Functor.Alt (Alt (..))+import Data.Functor.Identity (Identity (..))+import Data.Kind (Constraint, Type)++import Versioning.Base+import Versioning.Internal.Folding (Decr)+import Versioning.Upgrade++-- | The result type of the action that has been applied to the decoded object+-- with 'withAnyVersion' or 'withAnyVersionM'.+type family Applied (c :: Type -> Constraint) (a :: V -> Type) :: Type++-- | The pure function to apply to the decoded object with 'withAnyVersion'+type Apply a c = forall v. c (a v) => a v -> Applied c a++-- | The action to apply to the decoded object with 'withAnyVersionM'+type ApplyM m a c = forall v. c (a v) => a v -> m (Applied c a)++-- | The function that will perform the actual decoding+newtype Decoder dec enc t a = Decoder (forall v. dec (a v) => enc -> t (a v))++-- | Handy constraint synonym to be used with 'decodeAnyVersion'+type DecodableTo dec v a = DecodeAnyVersion v v a dec++-- | Decode by trying all the versions decrementally+-- and upgrade the decoded object to the newest version.+decodeAnyVersion+ :: forall v a dec enc t+ . (Alt t, Applicative t, DecodableTo dec v a)+ => Decoder dec enc t a+ -> enc+ -> t (a v)+decodeAnyVersion = decodeAnyVersion' @v @v @a @dec++-- | Decode by trying all the versions decrementally+-- and apply an action to the decoded object at its original version.+withAnyVersionM+ :: forall v c a dec enc m t+ . (WithAnyVersion v a c dec, Alt t, Applicative t, Traversable t, Applicative m, c (a v))+ => Decoder dec enc t a+ -> ApplyM m a c+ -> enc+ -> m (t (Applied c a))+withAnyVersionM = withAnyVersion' @v @a @c @dec++-- | Pure version of 'withAnyVersionM'.+withAnyVersion+ :: forall v c a dec enc t+ . (WithAnyVersion v a c dec, c (a v), Alt t, Applicative t, Traversable t)+ => Decoder dec enc t a+ -> Apply a c+ -> enc+ -> t (Applied c a)+withAnyVersion dec action =+ runIdentity . withAnyVersionM @v @c @a dec (Identity . action)++class DecodeAnyVersion (v :: V) (w :: V) (a :: V -> Type) dec where+ decodeAnyVersion'+ :: (Alt t, Applicative t)+ => Decoder dec enc t a+ -> enc+ -> t (a w)++instance {-# OVERLAPPING #-} (dec (a V1), Upgrade V1 w a)+ => DecodeAnyVersion V1 w a dec where+ decodeAnyVersion' (Decoder decode) bs = upgrade @V1 @w <$> decode @V1 bs++instance {-# OVERLAPPABLE #-} (DecodeAnyVersion (Decr v V1) w a dec, dec (a v), dec (a (Decr v V1)), Upgrade v w a)+ => DecodeAnyVersion v w a dec where+ decodeAnyVersion' decoder@(Decoder decode) bs = upgrade @v @w <$> decode @v bs+ <!> decodeAnyVersion' @(Decr v V1) @w decoder bs++class WithAnyVersion (v :: V) (a :: V -> Type) c dec where+ withAnyVersion' :: (Applicative m, Alt t, Applicative t, Traversable t, c (a v))+ => Decoder dec enc t a+ -> ApplyM m a c+ -> enc+ -> m (t (Applied c a))++instance {-# OVERLAPPING #-} (dec (a V1), c (a V1))+ => WithAnyVersion V1 a c dec where+ withAnyVersion' (Decoder decode) action bs = traverse action (decode @V1 bs)++instance {-# OVERLAPPABLE #-} (WithAnyVersion (Decr v V1) a c dec, dec (a v), dec (a (Decr v V1)), c (a v), c (a (Decr v V1)))+ => WithAnyVersion v a c dec where+ withAnyVersion' dec@(Decoder decode) action bs = do+ res <- traverse action (decode @v bs)+ next <- withAnyVersion' @(Decr v V1) @a @c dec action bs+ pure (res <!> next)
+ src/Versioning/Internal/Folding.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+module Versioning.Internal.Folding+ ( Decr+ , Incr+ )+where++import GHC.TypeLits+import GHC.TypeNats (type (-), type (+))++import Versioning.Base (V (..))++-- | Decrement version until the target version is reached+type family Decr (c :: V) (v :: V) :: V where+ Decr ('V c) ('V v) = Decr' (CmpNat c v) ('V c)++type family Decr' (o :: Ordering) (c :: V) :: V where+ Decr' 'GT ('V c) = 'V (c - 1)+ Decr' 'EQ ('V c) = 'V c+ Decr' 'LT ('V c) = TypeError+ ( 'Text "Cannot decrement "+ ':<>: 'ShowType ('V c)+ ':<>: 'Text " because the target is a higher version"+ )++-- | Increment version until the target version is reached+type family Incr (c :: V) (v :: V) :: V where+ Incr ('V c) ('V v) = Incr' (CmpNat c v) ('V c)++type family Incr' (o :: Ordering) (c :: V) :: V where+ Incr' 'LT ('V c) = 'V (c + 1)+ Incr' 'EQ ('V c) = 'V c+ Incr' 'GT ('V c) = TypeError+ ( 'Text "Cannot increment "+ ':<>: 'ShowType ('V c)+ ':<>: 'Text " because the target is a lower version"+ )
src/Versioning/JSON.hs view
@@ -1,3 +1,4 @@+-- | JSON-specific deserialization utilities. {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}@@ -13,91 +14,145 @@ {-# LANGUAGE UndecidableInstances #-} module Versioning.JSON ( Applied- , DecodeAnyVersion- , WithAnyVersion- , decodeAnyVersion- , withAnyVersion- , withAnyVersionM+ , JsonDecodableTo+ , fromJsonAnyVersion+ , fromJsonAnyVersionStrict+ , fromJsonAnyVersionEither+ , fromJsonAnyVersionEitherStrict+ , withJsonAnyVersion+ , withJsonAnyVersionStrict+ , withJsonAnyVersionEither+ , withJsonAnyVersionEitherStrict+ , withJsonAnyVersionM+ , withJsonAnyVersionStrictM+ , withJsonAnyVersionEitherM+ , withJsonAnyVersionEitherStrictM ) where -import Control.Applicative ((<|>))-import Data.Aeson (FromJSON, decode)-import qualified Data.ByteString.Lazy as LazyBS-import Data.Functor.Identity (Identity (..))-import Data.Kind (Constraint, Type)-import GHC.TypeLits+import Data.Aeson (FromJSON, decode, decodeStrict,+ eitherDecode, eitherDecodeStrict)+import qualified Data.ByteString as StrictBS+import qualified Data.ByteString.Lazy as LazyBS -import Versioning.Base-import Versioning.Upgrade+import Versioning.Internal.Decoding -- | Decode a JSON string by trying all the versions decrementally -- and upgrade the decoded object to the newest version.-decodeAnyVersion- :: forall v a . DecodeAnyVersion v v a => LazyBS.ByteString -> Maybe (a v)-decodeAnyVersion = decodeAnyVersion' @v @v+fromJsonAnyVersion+ :: forall v a . JsonDecodableTo v a => LazyBS.ByteString -> Maybe (a v)+fromJsonAnyVersion = decodeAnyVersion jsonDecode +-- | Like 'fromJsonAnyVersion' but it reads from a strict 'ByteString'+fromJsonAnyVersionStrict+ :: forall v a . JsonDecodableTo v a => StrictBS.ByteString -> Maybe (a v)+fromJsonAnyVersionStrict = decodeAnyVersion jsonDecodeStrict++-- | Like 'fromJsonAnyVersion' but returns a message when decoding fails+fromJsonAnyVersionEither+ :: forall v a+ . JsonDecodableTo v a+ => LazyBS.ByteString+ -> Either String (a v)+fromJsonAnyVersionEither = decodeAnyVersion jsonEitherDecode++-- | Like 'fromJsonAnyVersionStrict' but returns a message when decoding fails+fromJsonAnyVersionEitherStrict+ :: forall v a+ . JsonDecodableTo v a+ => StrictBS.ByteString+ -> Either String (a v)+fromJsonAnyVersionEitherStrict = decodeAnyVersion jsonEitherDecodeStrict+ -- | Decode a JSON string by trying all the versions decrementally -- and apply an action to the decoded object at its original version.-withAnyVersionM- :: forall c v a m- . (WithAnyVersion v a c, Applicative m, c a v)+withJsonAnyVersionM+ :: forall c a v m+ . (WithAnyVersion v a c FromJSON, Applicative m, c (a v)) => ApplyM m a c -> LazyBS.ByteString -> m (Maybe (Applied c a))-withAnyVersionM = withAnyVersion' @v @a @c+withJsonAnyVersionM = withAnyVersionM @v @c @a jsonDecode --- | Pure version of 'withAnyVersionM'.-withAnyVersion- :: forall c v a- . (WithAnyVersion v a c, c a v)- => Apply a c- -> LazyBS.ByteString- -> Maybe (Applied c a)-withAnyVersion action = runIdentity . withAnyVersionM @c @v @a (Identity . action)+-- | Like 'withJsonAnyVersionM' but it reads from a strict 'ByteString'+withJsonAnyVersionStrictM+ :: forall c a v m+ . (WithAnyVersion v a c FromJSON, Applicative m, c (a v))+ => ApplyM m a c+ -> StrictBS.ByteString+ -> m (Maybe (Applied c a))+withJsonAnyVersionStrictM = withAnyVersionM @v @c @a jsonDecodeStrict --- | The result type of the action that has been applied to the decoded object--- with 'withAnyVersion'.-type family Applied (c :: (V -> Type) -> V -> Constraint) (a :: V -> Type) :: Type+-- | Like 'withJsonAnyVersionM' but returns a message when decoding fails+withJsonAnyVersionEitherM+ :: forall c a v m+ . (WithAnyVersion v a c FromJSON, Applicative m, c (a v))+ => ApplyM m a c+ -> LazyBS.ByteString+ -> m (Either String (Applied c a))+withJsonAnyVersionEitherM = withAnyVersionM @v @c @a jsonEitherDecode -type ApplyM m a c = forall v. c a v => a v -> m (Applied c a)+-- | Like 'withJsonAnyVersionStrictM' but returns a message when decoding fails+withJsonAnyVersionEitherStrictM+ :: forall c a v m+ . (WithAnyVersion v a c FromJSON, Applicative m, c (a v))+ => ApplyM m a c+ -> StrictBS.ByteString+ -> m (Either String (Applied c a))+withJsonAnyVersionEitherStrictM = withAnyVersionM @v @c @a jsonEitherDecodeStrict -type Apply a c = forall v. c a v => a v -> Applied c a+-- | Decode a JSON string by trying all the versions decrementally+-- and apply a pure function to the decoded object at its original version.+withJsonAnyVersion+ :: forall c a v+ . (WithAnyVersion v a c FromJSON, c (a v))+ => Apply a c+ -> LazyBS.ByteString+ -> Maybe (Applied c a)+withJsonAnyVersion = withAnyVersion @v @c @a jsonDecode -class DecodeAnyVersion (v :: V) (w :: V) (a :: V -> Type) where- decodeAnyVersion' :: LazyBS.ByteString -> Maybe (a w)+-- | Like 'withJsonAnyVersion' but it reads from a strict 'ByteString'+withJsonAnyVersionStrict+ :: forall c a v+ . (WithAnyVersion v a c FromJSON, c (a v))+ => Apply a c+ -> StrictBS.ByteString+ -> Maybe (Applied c a)+withJsonAnyVersionStrict = withAnyVersion @v @c @a jsonDecodeStrict -instance {-# OVERLAPPING #-} (FromJSON (a V1), Upgrade V1 w a) => DecodeAnyVersion V1 w a where- decodeAnyVersion' bs = upgrade @V1 @w <$> decode @(a V1) bs+-- | Like 'withJsonAnyVersion' but returns a message when decoding fails+withJsonAnyVersionEither+ :: forall c a v+ . (WithAnyVersion v a c FromJSON, c (a v))+ => Apply a c+ -> LazyBS.ByteString+ -> Either String (Applied c a)+withJsonAnyVersionEither = withAnyVersion @v @c @a jsonEitherDecode -instance {-# OVERLAPPABLE #-} (DecodeAnyVersion (Decr v V1) w a, FromJSON (a v), FromJSON (a (Decr v V1)), Upgrade v w a)- => DecodeAnyVersion v w a where- decodeAnyVersion' bs = upgrade @v @w <$> decode @(a v) bs- <|> decodeAnyVersion' @(Decr v V1) @w bs+-- | Like 'withJsonAnyVersionStrict' but returns a message when decoding fails+withJsonAnyVersionEitherStrict+ :: forall c a v+ . (WithAnyVersion v a c FromJSON, c (a v))+ => Apply a c+ -> StrictBS.ByteString+ -> Either String (Applied c a)+withJsonAnyVersionEitherStrict = withAnyVersion @v @c @a jsonEitherDecodeStrict -class WithAnyVersion (v :: V) (a :: V -> Type) c where- withAnyVersion' :: (Applicative m, c a v) => ApplyM m a c -> LazyBS.ByteString -> m (Maybe (Applied c a))+-- | Decode with the aeson 'decode' function+jsonDecode :: Decoder FromJSON LazyBS.ByteString Maybe a+jsonDecode = Decoder decode -instance {-# OVERLAPPING #-} (FromJSON (a V1), c a V1) => WithAnyVersion V1 a c where- withAnyVersion' action bs = case decode @(a V1) bs of- Just doc -> Just <$> action doc- Nothing -> pure Nothing+-- | Decode with the aeson 'decodeStrict' function+jsonDecodeStrict :: Decoder FromJSON StrictBS.ByteString Maybe a+jsonDecodeStrict = Decoder decodeStrict -instance {-# OVERLAPPABLE #-} (WithAnyVersion (Decr v V1) a c, FromJSON (a v), FromJSON (a (Decr v V1)), c a v, c a (Decr v V1))- => WithAnyVersion v a c where- withAnyVersion' action bs = case decode @(a v) bs of- Just doc -> Just <$> action doc- Nothing -> withAnyVersion' @(Decr v V1) @a @c action bs+-- | Decode with the aeson 'eitherDecode' function+jsonEitherDecode :: Decoder FromJSON LazyBS.ByteString (Either String) a+jsonEitherDecode = Decoder eitherDecode --- | Decrement version until the target version is reached-type family Decr (c :: V) (v :: V) :: V where- Decr ('V c) ('V v) = Decr' (CmpNat c v) ('V c)+-- | Decode with the aeson 'eitherDecodeStrict' function+jsonEitherDecodeStrict :: Decoder FromJSON StrictBS.ByteString (Either String) a+jsonEitherDecodeStrict = Decoder eitherDecodeStrict -type family Decr' (o :: Ordering) (c :: V) :: V where- Decr' 'GT ('V c) = 'V (c - 1)- Decr' 'EQ ('V c) = 'V c- Decr' 'LT ('V c) = TypeError- ( 'Text "Cannot decrement "- ':<>: 'ShowType ('V c)- ':<>: 'Text " because the target is a higher version"- )+-- | Handy constraint synonym to be used with 'fromJsonAnyVersion'+type JsonDecodableTo v a = DecodableTo FromJSON v a
src/Versioning/Upgrade.hs view
@@ -15,9 +15,9 @@ where import Data.Kind (Type)-import GHC.TypeLits import Versioning.Base+import Versioning.Internal.Folding (Incr) -- | Adapt from a version to another class Adapt (v :: V) (w :: V) (a :: V -> Type) where@@ -42,16 +42,3 @@ instance {-# OVERLAPPABLE #-} (Adapt v (Incr v w) a, Upgrade (Incr v w) w a) => Upgrade v w a where upgrade' x = upgrade' @(Incr v w) @w (adapt @v @(Incr v w) x)---- | Increment version until the target version is reached-type family Incr (c :: V) (v :: V) :: V where- Incr ('V c) ('V v) = Incr' (CmpNat c v) ('V c)--type family Incr' (o :: Ordering) (c :: V) :: V where- Incr' 'LT ('V c) = 'V (c + 1)- Incr' 'EQ ('V c) = 'V c- Incr' 'GT ('V c) = TypeError- ( 'Text "Cannot increment "- ':<>: 'ShowType ('V c)- ':<>: 'Text " because the target is a lower version"- )
tests/Main.hs view
@@ -16,28 +16,32 @@ import qualified Data.ByteString.Lazy as LazyBS import GHC.Generics (Generic) import Test.Hspec+ import Versioning.Base import Versioning.JSON import Versioning.Upgrade main :: IO () main = hspec $ do+ describe "Versioning" $ do+ it "Can get the version number of a record" $+ versionNumber foo1 `shouldBe` 1+ describe "Upgrade" $ do it "Can upgrade across two versions" $ upgrade @V1 foo1 `shouldBe` foo3 describe "DecodeAnyVersion" $ do it "Can decode from V1" $- decodeAnyVersion @V3 fooJsonV1 `shouldBe` Just foo3+ fromJsonAnyVersion @V3 fooJsonV1 `shouldBe` Just foo3 - describe "DecodeAnyVersion" $ do it "Can decode from V3" $- decodeAnyVersion @V3 fooJsonV3 `shouldBe` Just foo3+ fromJsonAnyVersion @V3 fooJsonV3 `shouldBe` Just foo3 describe "WithAnyVersion" $ do -- Decode a Foo and return its string representation without upgrading it it "Can apply a function on the decoded object" $ do- let Just res = withAnyVersion @ShowAnyVersion @V3 @Foo showAnyVersion fooJsonV1+ let Just res = withJsonAnyVersion @Show @Foo @V3 show fooJsonV1 res `shouldBe` show foo1 data Foo v = Foo@@ -79,14 +83,7 @@ , untilV2 = na } -type instance Applied ShowAnyVersion a = String---- | Show an object, whatever its version-class ShowAnyVersion (a :: V -> *) (v :: V) where- showAnyVersion :: a v -> String--instance Show (Foo v) => ShowAnyVersion Foo v where- showAnyVersion = show+type instance Applied Show a = String -- | A 'Foo' at version V1 foo1 :: Foo V1
versioning.cabal view
@@ -1,5 +1,5 @@ name: versioning-version: 0.1.0.0+version: 0.2.0.0 synopsis: Type-safe data versioning. description: This package provides various tools to deal with data versioning in a type-safe way.@@ -16,11 +16,15 @@ library exposed-modules: Versioning.Base+ , Versioning.Internal.Base+ , Versioning.Internal.Decoding+ , Versioning.Internal.Folding , Versioning.Upgrade , Versioning.JSON- build-depends: base >=4.11 && <4.12+ build-depends: base >=4.10 && <4.12 , aeson >=1.0 && <1.5 , bytestring >=0.10 && <0.11+ , semigroupoids >=5 && <6 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall@@ -28,7 +32,7 @@ test-suite tests type: exitcode-stdio-1.0 main-is: Main.hs- build-depends: base >=4.11 && <4.12+ build-depends: base >=4.10 && <4.12 , aeson >=1.0 && <1.5 , bytestring >=0.10 && <0.11 , hspec >=2.0 && <2.6