diff --git a/guide.cabal b/guide.cabal index 52cf9da9..dac51331 100644 --- a/guide.cabal +++ b/guide.cabal @@ -65,8 +65,6 @@ executable guide , mtl >= 2.1.1 , neat-interpolation == 0.3.* , network - -- not needed once the migration of EditDetails is done - , network-info , path-pieces , random >= 1.1 , safecopy diff --git a/src/Main.hs b/src/Main.hs index 4255cd69..e70d741a 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -72,7 +72,7 @@ This application doesn't use a database – instead, it uses acid-state. Acid-st * The data is kept in-memory, but all changes are logged to the disk (which lets us recover the state in case of a crash by reapplying the changes) and you can't access the state directly. When the application exits, it creates a snapshot of the state (called “checkpoint”) and writes it to the disk. Additionally, a checkpoint is created every hour (grep for “createCheckpoint”). - * When any type is changed, we have to write a migration function that would read the old version of the type and turn it into the new version. It's enough to keep just one old version (and even that isn't needed after the migration happened and a new checkpoint has been created). For examples, look at “instance Migrate” in Types.hs. Also, all types involved in acid-state (whether migrate-able or not) have to have a SafeCopy instance, which is generated by 'deriveSafeCopy'. + * When any type is changed, we have to write a migration function that would read the old version of the type and turn it into the new version. It's enough to keep just one old version (and even that isn't needed after the migration happened and a new checkpoint has been created). For examples, look at “instance Migrate” in Types.hs. Also, all types involved in acid-state (whether migrate-able or not) have to have a SafeCopy instance, which is generated by 'deriveSafeCopySimple'. * There are actually ways to access the state directly (GetGlobalState and SetGlobalState), but the latter should only be used when doing something one-off (like migrating all IDs to a different ID scheme, or whatever). diff --git a/src/Types.hs b/src/Types.hs index c1a5af7e..6d4f6776 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -127,7 +127,6 @@ import Data.Text (Text) import Data.Time -- Network import Data.IP -import qualified Network.Info as Network -- acid-state import Data.SafeCopy hiding (kind) import Data.Acid as Acid @@ -143,7 +142,7 @@ data Trait = Trait { deriving (Eq, Show) -- See Note [acid-state] -deriveSafeCopy 1 'extension ''Trait +deriveSafeCopySimple 2 'extension ''Trait makeFields ''Trait -- Old version, needed for safe migration. It can most likely be already @@ -151,17 +150,18 @@ makeFields ''Trait -- template for future migrations. -- -- Again, see Note [acid-state]. -data Trait_v0 = Trait_v0 { - _traitUid_v0 :: Uid Trait, - _traitContent_v0 :: Text } +data Trait_v1 = Trait_v1 { + _traitUid_v1 :: Uid Trait, + _traitContent_v1 :: MarkdownInline } -deriveSafeCopy 0 'base ''Trait_v0 +-- TODO: at the next migration change this to deriveSafeCopySimple! +deriveSafeCopy 1 'base ''Trait_v1 instance Migrate Trait where - type MigrateFrom Trait = Trait_v0 - migrate Trait_v0{..} = Trait { - _traitUid = _traitUid_v0, - _traitContent = renderMarkdownInline _traitContent_v0 } + type MigrateFrom Trait = Trait_v1 + migrate Trait_v1{..} = Trait { + _traitUid = _traitUid_v1, + _traitContent = _traitContent_v1 } -- @@ -171,9 +171,25 @@ data ItemKind | Other deriving (Eq, Show) -deriveSafeCopy 2 'base ''ItemKind +deriveSafeCopySimple 3 'extension ''ItemKind makeFields ''ItemKind +data ItemKind_v2 + = Library_v2 {_itemKindHackageName_v2 :: Maybe Text} + | Tool_v2 {_itemKindHackageName_v2 :: Maybe Text} + | Other_v2 + +-- TODO: at the next migration change this to deriveSafeCopySimple! +deriveSafeCopy 2 'base ''ItemKind_v2 + +instance Migrate ItemKind where + type MigrateFrom ItemKind = ItemKind_v2 + migrate Library_v2{..} = Library { + _itemKindHackageName = _itemKindHackageName_v2 } + migrate Tool_v2{..} = Tool { + _itemKindHackageName = _itemKindHackageName_v2 } + migrate Other_v2 = Other + -- -- TODO: add a field like “people to ask on IRC about this library if you @@ -194,50 +210,63 @@ data Item = Item { _itemKind :: ItemKind } deriving (Eq, Show) -deriveSafeCopy 7 'extension ''Item +deriveSafeCopySimple 8 'extension ''Item makeFields ''Item -- Old version, needed for safe migration. It can most likely be already -- deleted (if a checkpoint has been created), but it's been left here as a -- template for future migrations. -data Item_v6 = Item_v6 { - _itemUid_v6 :: Uid Item, - _itemName_v6 :: Text, - _itemCreated_v6 :: UTCTime, - _itemGroup__v6 :: Maybe Text, - _itemDescription_v6 :: MarkdownBlock, - _itemPros_v6 :: [Trait], - _itemCons_v6 :: [Trait], - _itemEcosystem_v6 :: MarkdownBlock, - _itemNotes_v6 :: MarkdownBlock, - _itemLink_v6 :: Maybe Url, - _itemKind_v6 :: ItemKind } - -deriveSafeCopy 6 'base ''Item_v6 +data Item_v7 = Item_v7 { + _itemUid_v7 :: Uid Item, + _itemName_v7 :: Text, + _itemCreated_v7 :: UTCTime, + _itemGroup__v7 :: Maybe Text, + _itemDescription_v7 :: MarkdownBlock, + _itemPros_v7 :: [Trait], + _itemProsDeleted_v7 :: [Trait], + _itemCons_v7 :: [Trait], + _itemConsDeleted_v7 :: [Trait], + _itemEcosystem_v7 :: MarkdownBlock, + _itemNotes_v7 :: MarkdownBlock, + _itemLink_v7 :: Maybe Url, + _itemKind_v7 :: ItemKind } + +-- TODO: at the next migration change this to deriveSafeCopySimple! +deriveSafeCopy 7 'base ''Item_v7 instance Migrate Item where - type MigrateFrom Item = Item_v6 - migrate Item_v6{..} = Item { - _itemUid = _itemUid_v6, - _itemName = _itemName_v6, - _itemCreated = _itemCreated_v6, - _itemGroup_ = _itemGroup__v6, - _itemDescription = _itemDescription_v6, - _itemPros = _itemPros_v6, - _itemProsDeleted = [], - _itemCons = _itemCons_v6, - _itemConsDeleted = [], - _itemEcosystem = _itemEcosystem_v6, - _itemNotes = _itemNotes_v6, - _itemLink = _itemLink_v6, - _itemKind = _itemKind_v6 } + type MigrateFrom Item = Item_v7 + migrate Item_v7{..} = Item { + _itemUid = _itemUid_v7, + _itemName = _itemName_v7, + _itemCreated = _itemCreated_v7, + _itemGroup_ = _itemGroup__v7, + _itemDescription = _itemDescription_v7, + _itemPros = _itemPros_v7, + _itemProsDeleted = _itemProsDeleted_v7, + _itemCons = _itemCons_v7, + _itemConsDeleted = _itemConsDeleted_v7, + _itemEcosystem = _itemEcosystem_v7, + _itemNotes = _itemNotes_v7, + _itemLink = _itemLink_v7, + _itemKind = _itemKind_v7 } -- data Hue = NoHue | Hue Int deriving (Eq, Ord) -deriveSafeCopy 0 'base ''Hue +deriveSafeCopySimple 1 'extension ''Hue + +data Hue_v0 = NoHue_v0 | Hue_v0 Int + +-- TODO: at the next migration change this to deriveSafeCopySimple! +deriveSafeCopy 0 'base ''Hue_v0 + +instance Migrate Hue where + type MigrateFrom Hue = Hue_v0 + migrate NoHue_v0 = NoHue + migrate (Hue_v0 i) = Hue i instance Show Hue where show NoHue = "0" @@ -305,7 +334,7 @@ data Category = Category { _categoryItemsDeleted :: [Item] } deriving (Eq, Show) -deriveSafeCopy 3 'extension ''Category +deriveSafeCopySimple 4 'extension ''Category makeFields ''Category categorySlug :: Category -> Text @@ -315,26 +344,28 @@ categorySlug category = -- Old version, needed for safe migration. It can most likely be already -- deleted (if a checkpoint has been created), but it's been left here as a -- template for future migrations. -data Category_v2 = Category_v2 { - _categoryUid_v2 :: Uid Category, - _categoryTitle_v2 :: Text, - _categoryCreated_v2 :: UTCTime, - _categoryNotes_v2 :: MarkdownBlock, - _categoryGroups_v2 :: Map Text Hue, - _categoryItems_v2 :: [Item] } - -deriveSafeCopy 2 'base ''Category_v2 +data Category_v3 = Category_v3 { + _categoryUid_v3 :: Uid Category, + _categoryTitle_v3 :: Text, + _categoryCreated_v3 :: UTCTime, + _categoryNotes_v3 :: MarkdownBlock, + _categoryGroups_v3 :: Map Text Hue, + _categoryItems_v3 :: [Item], + _categoryItemsDeleted_v3 :: [Item] } + +-- TODO: at the next migration change this to deriveSafeCopySimple! +deriveSafeCopy 3 'base ''Category_v3 instance Migrate Category where - type MigrateFrom Category = Category_v2 - migrate Category_v2{..} = Category { - _categoryUid = _categoryUid_v2, - _categoryTitle = _categoryTitle_v2, - _categoryCreated = _categoryCreated_v2, - _categoryNotes = _categoryNotes_v2, - _categoryGroups = _categoryGroups_v2, - _categoryItems = _categoryItems_v2, - _categoryItemsDeleted = [] } + type MigrateFrom Category = Category_v3 + migrate Category_v3{..} = Category { + _categoryUid = _categoryUid_v3, + _categoryTitle = _categoryTitle_v3, + _categoryCreated = _categoryCreated_v3, + _categoryNotes = _categoryNotes_v3, + _categoryGroups = _categoryGroups_v3, + _categoryItems = _categoryItems_v3, + _categoryItemsDeleted = _categoryItemsDeleted_v3 } -- Edits @@ -427,9 +458,9 @@ data Edit deriving (Eq, Show) -deriveSafeCopy 1 'extension ''Edit +deriveSafeCopySimple 2 'extension ''Edit -genVer ''Edit 0 [ +genVer ''Edit 1 [ -- Add Copy 'Edit'AddCategory, Copy 'Edit'AddItem, @@ -456,11 +487,12 @@ genVer ''Edit 0 [ Copy 'Edit'MoveItem, Copy 'Edit'MoveTrait ] -deriveSafeCopy 0 'base ''Edit_v0 +-- TODO: at the next migration change this to deriveSafeCopySimple! +deriveSafeCopy 1 'base ''Edit_v1 instance Migrate Edit where - type MigrateFrom Edit = Edit_v0 - migrate = $(migrateVer ''Edit 0 [ + type MigrateFrom Edit = Edit_v1 + migrate = $(migrateVer ''Edit 1 [ CopyM 'Edit'AddCategory, CopyM 'Edit'AddItem, CopyM 'Edit'AddPro, @@ -518,31 +550,22 @@ data EditDetails = EditDetails { editId :: Int } deriving (Eq, Show) -deriveSafeCopy 1 'extension ''EditDetails - -data IP_v0 = IPv4_v0 Network.IPv4 | IPv6_v0 Network.IPv6 - -deriveSafeCopy 0 'base ''Network.IPv4 -deriveSafeCopy 0 'base ''Network.IPv6 -deriveSafeCopy 0 'base ''IP_v0 +deriveSafeCopySimple 2 'extension ''EditDetails --- TODO: When this goes away, remove the dependency on network-info -data EditDetails_v0 = EditDetails_v0 { - editIP_v0 :: Maybe IP_v0, - editDate_v0 :: UTCTime, - editId_v0 :: Int } +data EditDetails_v1 = EditDetails_v1 { + editIP_v1 :: Maybe IP, + editDate_v1 :: UTCTime, + editId_v1 :: Int } -deriveSafeCopy 0 'base ''EditDetails_v0 +-- TODO: at the next migration change this to deriveSafeCopySimple! +deriveSafeCopy 1 'base ''EditDetails_v1 instance Migrate EditDetails where - type MigrateFrom EditDetails = EditDetails_v0 - migrate EditDetails_v0{..} = EditDetails { - editIP = migrateIP <$> editIP_v0, - editDate = editDate_v0, - editId = editId_v0 } - where - migrateIP (IPv4_v0 ip) = IPv4 (read (show ip)) - migrateIP (IPv6_v0 ip) = IPv6 (read (show ip)) + type MigrateFrom EditDetails = EditDetails_v1 + migrate EditDetails_v1{..} = EditDetails { + editIP = editIP_v1, + editDate = editDate_v1, + editId = editId_v1 } -- TODO: add a function to create a checkpoint to the admin panel? @@ -555,22 +578,25 @@ data GlobalState = GlobalState { _editIdCounter :: Int } -- ID of next edit that will be made deriving (Show) -deriveSafeCopy 2 'extension ''GlobalState +deriveSafeCopySimple 3 'extension ''GlobalState makeLenses ''GlobalState -data GlobalState_v1 = GlobalState_v1 { - _categories_v1 :: [Category], - _categoriesDeleted_v1 :: [Category] } +data GlobalState_v2 = GlobalState_v2 { + _categories_v2 :: [Category], + _categoriesDeleted_v2 :: [Category], + _pendingEdits_v2 :: [(Edit, EditDetails)], + _editIdCounter_v2 :: Int } -deriveSafeCopy 1 'base ''GlobalState_v1 +-- TODO: at the next migration change this to deriveSafeCopySimple! +deriveSafeCopy 2 'base ''GlobalState_v2 instance Migrate GlobalState where - type MigrateFrom GlobalState = GlobalState_v1 - migrate GlobalState_v1{..} = GlobalState { - _categories = _categories_v1, - _categoriesDeleted = _categoriesDeleted_v1, - _pendingEdits = [], - _editIdCounter = 0 } + type MigrateFrom GlobalState = GlobalState_v2 + migrate GlobalState_v2{..} = GlobalState { + _categories = _categories_v2, + _categoriesDeleted = _categoriesDeleted_v2, + _pendingEdits = _pendingEdits_v2, + _editIdCounter = _editIdCounter_v2 } addGroupIfDoesNotExist :: Text -> Map Text Hue -> Map Text Hue addGroupIfDoesNotExist g gs diff --git a/src/Utils.hs b/src/Utils.hs index 4adc4529..b22f8560 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -143,9 +143,9 @@ makeSlug = T.filter (\c -> isLetter c || isDigit c || c == ' ' || c == '-') . T.map (\x -> if x == '_' then '-' else x) -deriveSafeCopy 0 'base ''IPv4 -deriveSafeCopy 0 'base ''IPv6 -deriveSafeCopy 0 'base ''IP +deriveSafeCopySimple 0 'base ''IPv4 +deriveSafeCopySimple 0 'base ''IPv6 +deriveSafeCopySimple 0 'base ''IP sockAddrToIP :: Network.SockAddr -> Maybe IP sockAddrToIP (Network.SockAddrInet _ x) = Just (IPv4 (fromHostAddress x)) @@ -157,16 +157,17 @@ newtype Uid a = Uid {uidToText :: Text} deriving (Eq, Ord, Show, PathPiece, Format.Buildable) -- See Note [acid-state] -deriveSafeCopy 1 'extension ''Uid +deriveSafeCopySimple 2 'extension ''Uid -newtype Uid_v0 = Uid_v0 {uidToText_v0 :: Text} +newtype Uid_v1 a = Uid_v1 {uidToText_v1 :: Text} -deriveSafeCopy 0 'base ''Uid_v0 +-- TODO: at the next migration change this to deriveSafeCopySimple! +deriveSafeCopy 1 'base ''Uid_v1 -instance Migrate (Uid a) where - type MigrateFrom (Uid a) = Uid_v0 - migrate Uid_v0{..} = Uid { - uidToText = uidToText_v0 } +instance SafeCopy a => Migrate (Uid a) where + type MigrateFrom (Uid a) = Uid_v1 a + migrate Uid_v1{..} = Uid { + uidToText = uidToText_v1 } instance IsString (Uid a) where fromString = Uid . T.pack