versioning 0.3.0.1 → 0.3.1.0
raw patch · 6 files changed
+101/−18 lines, 6 files
Files
- ChangeLog.md +6/−0
- src/Versioning/Base.hs +24/−10
- src/Versioning/Upgrade.hs +28/−0
- tests/Main.hs +13/−3
- tests/Tests/Versioning/Fixtures.hs +29/−4
- versioning.cabal +1/−1
ChangeLog.md view
@@ -1,5 +1,11 @@ # Revision history +## 0.3.1.0++- Add `SinceS` to version sum types++- Add `downgrade` for version downcasting+ ## 0.3.0.0 - Encode `V` inductively
src/Versioning/Base.hs view
@@ -39,7 +39,9 @@ , VNat , VCmp , Since+ , SinceS , Until+ , UntilS , NA , na , V0@@ -107,24 +109,36 @@ -- The first parameter is the version in which the field has been introduced, -- the second parameter is the actual version of the data-type. type family Since (s :: V) (v :: V) a where- Since s v a = Since' (VCmp s v) a+ Since s v a = Since' (VCmp s v) a NA -type family Since' (o :: Ordering) a :: * where- Since' 'LT a = a- Since' 'EQ a = a- Since' 'GT a = NA+-- | Same as 'Since', for sum types.+-- The only difference between 'Since' and 'SinceS' is in the type used to+-- indicate absence.+-- In 'Since' absence is expressed with 'NA', which is isomorphic to '()'.+-- In 'SinceS' it is expressed with 'Bare', which is isomorphic to 'Void'.+type family SinceS (s :: V) (v :: V) a where+ SinceS s v a = Since' (VCmp s v) a Bare +type family Since' (o :: Ordering) a absent :: * where+ Since' 'LT a _ = a+ Since' 'EQ a _ = a+ Since' 'GT a absent = absent+ -- | This allows us to express that a field is only present until -- a given version. -- The first parameter is the last version in which the field is present, -- the second parameter is the actual version of the data-type. type family Until (u :: V) (v :: V) a where- Until u v a = Until' (VCmp u v) a+ Until u v a = Until' (VCmp u v) a NA -type family Until' (o :: Ordering) a :: * where- Until' 'GT a = a- Until' 'EQ a = a- Until' 'LT a = NA+-- | Same as 'Until', for sum types.+type family UntilS (u :: V) (v :: V) a where+ UntilS u v a = Until' (VCmp u v) a Bare++type family Until' (o :: Ordering) a absent :: * where+ Until' 'GT a _ = a+ Until' 'EQ a _ = a+ Until' 'LT a absent = absent -- | A type indicating absence. -- The 'Maybe' is a hack needed to let aeson parse a record successfully even
src/Versioning/Upgrade.hs view
@@ -12,8 +12,12 @@ {-# LANGUAGE UndecidableInstances #-} module Versioning.Upgrade ( Adapt (..)+ -- * Upgrading , Upgrade , upgrade+ -- * Downgrading+ , Downgrade+ , downgrade ) where @@ -49,3 +53,27 @@ instance (Adapt v (VSucc v) a, Upgrade' (VSucc v == w) (VSucc v) w a) => Upgrade' 'False v w a where upgrade' x = upgrade' @(VSucc v == w) @(VSucc v) @w (adapt @v @(VSucc v) x)++-- | Downgrade from a higher to a lower version by calling 'adapt' on all+-- the intermediary steps.+downgrade :: forall v w a. Downgrade v w a => a v -> a w+downgrade = downgrade' @(v == w)++-- | This constraint specifies that a value of type 'a' can be downgraded+-- from version 'v' to version 'w'.+type Downgrade v w a = Downgrade' (v == w) v w a++-- | Downgrade from a higher to a lower version by calling 'adapt' on all+-- the intermediary steps.+-- You do not need to define any instance.+-- They are derived automatically if all the intermediary+-- 'Adapt' instances are defined.+class Downgrade' (eq :: Bool) (v :: V) (w :: V) (a :: V -> Type) where+ downgrade' :: a v -> a w++instance (v ~ w) => Downgrade' 'True v w a where+ downgrade' x = x++instance (Adapt v (VPred v) a, Downgrade' (VPred v == w) (VPred v) w a)+ => Downgrade' 'False v w a where+ downgrade' x = downgrade' @(VPred v == w) @(VPred v) @w (adapt @v @(VPred v) x)
tests/Main.hs view
@@ -7,8 +7,8 @@ import Versioning.JSON import Versioning.Upgrade -import Tests.Versioning.Fixtures (Foo (..), foo0, foo2, fooJsonV0,- fooJsonV2)+import Tests.Versioning.Fixtures (Foo (..), SumType (..), foo0, foo2,+ fooJsonV0, fooJsonV2, sumType) main :: IO () main = hspec $ do@@ -16,9 +16,19 @@ it "Can get the version number of a record" $ versionNumber foo0 `shouldBe` 0 + it "Can read versioned record fields if present at given version" $+ sinceV2 foo2 `shouldBe` "hello"++ it "Can read versioned sum-type constructors if present at given version" $+ sumType `shouldBe` MkFoo ()+ describe "Upgrade" $ do it "Can upgrade across two versions" $- upgrade @V0 foo0 `shouldBe` foo2+ upgrade foo0 `shouldBe` foo2++ describe "Downgrade" $ do+ it "Can downgrade across two versions" $+ downgrade foo2 `shouldBe` foo0 describe "DecodeAnyVersion" $ do it "Can decode from V0" $
tests/Tests/Versioning/Fixtures.hs view
@@ -13,8 +13,8 @@ module Tests.Versioning.Fixtures where import Data.Aeson-import qualified Data.ByteString.Lazy as LazyBS-import GHC.Generics (Generic)+import qualified Data.ByteString.Lazy as LazyBS+import GHC.Generics (Generic) import Versioning.Base import Versioning.JSON@@ -45,18 +45,43 @@ deriving instance Show (Foo V2) --- How to upcast from V1 to V2+data SumType v = A+ | B+ | MkFoo (SinceS V1 v ()) -- This constructor cannot be used before V1++sumType :: SumType V1+sumType = MkFoo ()++deriving instance Eq (SumType V1)++deriving instance Show (SumType V1)++-- How to upcast from V0 to V1 instance Adapt V0 V1 Foo where adapt foo = foo { sinceV1 = True , sinceV2 = na , untilV1 = untilV1 foo } --- How to upcast from V2 to V3+-- How to upcast from V1 to V2 instance Adapt V1 V2 Foo where adapt foo = foo { sinceV1 = sinceV1 foo , sinceV2 = "hello" , untilV1 = na+ }++-- How to downcast from V2 to V1+instance Adapt V2 V1 Foo where+ adapt foo = foo { sinceV1 = sinceV1 foo+ , sinceV2 = na+ , untilV1 = 3.14+ }++-- How to downcast from V1 to V0+instance Adapt V1 V0 Foo where+ adapt foo = foo { sinceV1 = na+ , sinceV2 = na+ , untilV1 = untilV1 foo } type instance Applied Show a = String
versioning.cabal view
@@ -1,5 +1,5 @@ name: versioning-version: 0.3.0.1+version: 0.3.1.0 synopsis: Type-safe data versioning. description: This package provides various tools to deal with data versioning in a type-safe way.