public
Created

Datatype versioning using type families

  • Download Gist
gistfile1.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
{-# LANGUAGE EmptyDataDecls
, TypeFamilies
, MultiParamTypeClasses
, FlexibleContexts
, FlexibleInstances
, UndecidableInstances
, ScopedTypeVariables
#-}
 
import Control.Applicative
 
 
-- * Helpers
 
 
-- Maybe lifted to the type level.
data Nothing
data Just a
 
-- Type proxy, used to pass a type to a function.
data Proxy a = Proxy
 
-- A mapping from a type to the previous version of it.
type family PrevVersion a :: * -- Maybe *
 
-- Migrations between types.
class Migrate a b where
migrate :: a -> b
 
-- We can migrate every type to itself.
instance Migrate a a where
migrate = id
 
-- A total (safe) version of 'read'.
readMay :: Read a => String -> Maybe a
readMay s = case [x | (x,t) <- reads s, ("","") <- lex t] of
[x] -> Just x
_ -> Nothing
 
 
-- * Pattern matching on the Maybe kind.
 
 
-- 'a' is (Maybe (PrevVersion r)), 'r' is the result of the read.
class ReadVersioned a r where
readVersioned' :: Proxy a -> String -> Maybe r
 
-- If there is no previous version, we can't do anything.
instance ReadVersioned Nothing r where
readVersioned' _ _ = Nothing
 
-- We try to read the 'a', which is PrevVersion r. If that doesn't
-- work, we recurse trying to read older versions of 'a'. Finally, we
-- migrate the 'a' to an 'r'.
instance (Read a, Migrate a r, ReadVersioned (PrevVersion a) a) => ReadVersioned (Just a) r where
readVersioned' _ str = migrate <$> (readMay str <|> readVersioned' prevProxy str :: Maybe a)
where
prevProxy = Proxy :: Proxy (PrevVersion a)
 
 
-- * The top level function
 
 
readVersioned :: forall a. (Read a, ReadVersioned (PrevVersion a) a) => String -> Maybe a
readVersioned str = readVersioned' proxy str
where
proxy = Proxy :: Proxy (Just a)
 
 
-- * Some examples and tests
 
 
data User0 = User0
{ name0 :: String
, password0 :: String
} deriving (Show, Read, Eq)
 
type instance PrevVersion User0 = Nothing
 
data User1 = User1
{ name1 :: String
, password1 :: String
, admin1 :: Bool
} deriving (Show, Read, Eq)
 
type instance PrevVersion User1 = Just User0
instance Migrate User0 User1 where
migrate u0 = User1
{ name1 = name0 u0
, password1 = password0 u0
, admin1 = False
}
 
newtype Name = Name String deriving (Show, Read, Eq)
newtype Password = Password String deriving (Show, Read, Eq)
data Role = NormalUser | PowerUser | Admin deriving (Show, Read, Eq)
 
data User2 = User2
{ name2 :: Name
, password2 :: Password
, role2 :: Role
} deriving (Show, Read, Eq)
 
type instance PrevVersion User2 = Just User1
instance Migrate User1 User2 where
migrate u1 = User2
{ name2 = Name (name1 u1)
, password2 = Password (password1 u1)
, role2 = if admin1 u1 then Admin else NormalUser
}
 
user0 = User0 { name0 = "Erik Hesselink", password0 = "password" }
user1 = User1 { name1 = "Erik Hesselink", password1 = "password", admin1 = False }
user1' = User1 { name1 = "Erik Hesselink", password1 = "password", admin1 = True }
user2 = User2 { name2 = Name "Erik Hesselink", password2 = Password "password", role2 = NormalUser }
user2' = User2 { name2 = Name "Erik Hesselink", password2 = Password "password", role2 = Admin }
 
test0 = readVersioned (show user0) == Just user1
test1 = readVersioned (show user0) == Just user2
test2 = readVersioned (show user1) == Just user2
test3 = readVersioned (show user1') == Just user2'
tests = (test0, test1, test2, test3)

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.