Use deriveSafeCopySimple as workaround for a bug

See https://github.com/acid-state/safecopy/issues/41

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

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).
 

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 {
+data Trait_v1 = Trait_v1 {
-  _traitUid_v0 :: Uid Trait,
+  _traitUid_v1 :: Uid Trait,
-  _traitContent_v0 :: Text }
+  _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
+  type MigrateFrom Trait = Trait_v1
-  migrate Trait_v0{..} = Trait {
+  migrate Trait_v1{..} = Trait {
-    _traitUid = _traitUid_v0,
+    _traitUid = _traitUid_v1,
-    _traitContent = renderMarkdownInline _traitContent_v0 }
+    _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 {
+data Item_v7 = Item_v7 {
-  _itemUid_v6         :: Uid Item,
+  _itemUid_v7         :: Uid Item,
-  _itemName_v6        :: Text,
+  _itemName_v7        :: Text,
-  _itemCreated_v6     :: UTCTime,
+  _itemCreated_v7     :: UTCTime,
-  _itemGroup__v6      :: Maybe Text,
+  _itemGroup__v7      :: Maybe Text,
-  _itemDescription_v6 :: MarkdownBlock,
+  _itemDescription_v7 :: MarkdownBlock,
-  _itemPros_v6        :: [Trait],
+  _itemPros_v7        :: [Trait],
-  _itemCons_v6        :: [Trait],
+  _itemProsDeleted_v7 :: [Trait],
-  _itemEcosystem_v6   :: MarkdownBlock,
+  _itemCons_v7        :: [Trait],
-  _itemNotes_v6       :: MarkdownBlock,
+  _itemConsDeleted_v7 :: [Trait],
-  _itemLink_v6        :: Maybe Url,
+  _itemEcosystem_v7   :: MarkdownBlock,
-  _itemKind_v6        :: ItemKind }
+  _itemNotes_v7       :: MarkdownBlock,
+  _itemLink_v7        :: Maybe Url,
+  _itemKind_v7        :: ItemKind }
 
-deriveSafeCopy 6 'base ''Item_v6
+-- TODO: at the next migration change this to deriveSafeCopySimple!
+deriveSafeCopy 7 'base ''Item_v7
 
 instance Migrate Item where
-  type MigrateFrom Item = Item_v6
+  type MigrateFrom Item = Item_v7
-  migrate Item_v6{..} = Item {
+  migrate Item_v7{..} = Item {
-    _itemUid = _itemUid_v6,
+    _itemUid = _itemUid_v7,
-    _itemName = _itemName_v6,
+    _itemName = _itemName_v7,
-    _itemCreated = _itemCreated_v6,
+    _itemCreated = _itemCreated_v7,
-    _itemGroup_ = _itemGroup__v6,
+    _itemGroup_ = _itemGroup__v7,
-    _itemDescription = _itemDescription_v6,
+    _itemDescription = _itemDescription_v7,
-    _itemPros = _itemPros_v6,
+    _itemPros = _itemPros_v7,
-    _itemProsDeleted = [],
+    _itemProsDeleted = _itemProsDeleted_v7,
-    _itemCons = _itemCons_v6,
+    _itemCons = _itemCons_v7,
-    _itemConsDeleted = [],
+    _itemConsDeleted = _itemConsDeleted_v7,
-    _itemEcosystem = _itemEcosystem_v6,
+    _itemEcosystem = _itemEcosystem_v7,
-    _itemNotes = _itemNotes_v6,
+    _itemNotes = _itemNotes_v7,
-    _itemLink = _itemLink_v6,
+    _itemLink = _itemLink_v7,
-    _itemKind = _itemKind_v6 }
+    _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 {
+data Category_v3 = Category_v3 {
-  _categoryUid_v2 :: Uid Category,
+  _categoryUid_v3 :: Uid Category,
-  _categoryTitle_v2 :: Text,
+  _categoryTitle_v3 :: Text,
-  _categoryCreated_v2 :: UTCTime,
+  _categoryCreated_v3 :: UTCTime,
-  _categoryNotes_v2 :: MarkdownBlock,
+  _categoryNotes_v3 :: MarkdownBlock,
-  _categoryGroups_v2 :: Map Text Hue,
+  _categoryGroups_v3 :: Map Text Hue,
-  _categoryItems_v2 :: [Item] }
+  _categoryItems_v3 :: [Item],
+  _categoryItemsDeleted_v3 :: [Item] }
 
-deriveSafeCopy 2 'base ''Category_v2
+-- TODO: at the next migration change this to deriveSafeCopySimple!
+deriveSafeCopy 3 'base ''Category_v3
 
 instance Migrate Category where
-  type MigrateFrom Category = Category_v2
+  type MigrateFrom Category = Category_v3
-  migrate Category_v2{..} = Category {
+  migrate Category_v3{..} = Category {
-    _categoryUid = _categoryUid_v2,
+    _categoryUid = _categoryUid_v3,
-    _categoryTitle = _categoryTitle_v2,
+    _categoryTitle = _categoryTitle_v3,
-    _categoryCreated = _categoryCreated_v2,
+    _categoryCreated = _categoryCreated_v3,
-    _categoryNotes = _categoryNotes_v2,
+    _categoryNotes = _categoryNotes_v3,
-    _categoryGroups = _categoryGroups_v2,
+    _categoryGroups = _categoryGroups_v3,
-    _categoryItems = _categoryItems_v2,
+    _categoryItems = _categoryItems_v3,
-    _categoryItemsDeleted = [] }
+    _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
+  type MigrateFrom Edit = Edit_v1
-  migrate = $(migrateVer ''Edit 0 [
+  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
+deriveSafeCopySimple 2 'extension ''EditDetails
 
-data IP_v0 = IPv4_v0 Network.IPv4 | IPv6_v0 Network.IPv6
+data EditDetails_v1 = EditDetails_v1 {
+  editIP_v1   :: Maybe IP,
+  editDate_v1 :: UTCTime,
+  editId_v1   :: Int }
 
-deriveSafeCopy 0 'base ''Network.IPv4
+-- TODO: at the next migration change this to deriveSafeCopySimple!
-deriveSafeCopy 0 'base ''Network.IPv6
+deriveSafeCopy 1 'base ''EditDetails_v1
-deriveSafeCopy 0 'base ''IP_v0
-
--- 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 }
-
-deriveSafeCopy 0 'base ''EditDetails_v0
 
 instance Migrate EditDetails where
-  type MigrateFrom EditDetails = EditDetails_v0
+  type MigrateFrom EditDetails = EditDetails_v1
-  migrate EditDetails_v0{..} = EditDetails {
+  migrate EditDetails_v1{..} = EditDetails {
-    editIP = migrateIP <$> editIP_v0,
+    editIP = editIP_v1,
-    editDate = editDate_v0,
+    editDate = editDate_v1,
-    editId = editId_v0 }
+    editId = editId_v1 }
-    where
-      migrateIP (IPv4_v0 ip) = IPv4 (read (show ip))
-      migrateIP (IPv6_v0 ip) = IPv6 (read (show ip))
 
 -- 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 {
+data GlobalState_v2 = GlobalState_v2 {
-  _categories_v1 :: [Category],
+  _categories_v2 :: [Category],
-  _categoriesDeleted_v1 :: [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
+  type MigrateFrom GlobalState = GlobalState_v2
-  migrate GlobalState_v1{..} = GlobalState {
+  migrate GlobalState_v2{..} = GlobalState {
-    _categories = _categories_v1,
+    _categories = _categories_v2,
-    _categoriesDeleted = _categoriesDeleted_v1,
+    _categoriesDeleted = _categoriesDeleted_v2,
-    _pendingEdits = [],
+    _pendingEdits = _pendingEdits_v2,
-    _editIdCounter = 0 }
+    _editIdCounter = _editIdCounter_v2 }
 
 addGroupIfDoesNotExist :: Text -> Map Text Hue -> Map Text Hue
 addGroupIfDoesNotExist g gs

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
+deriveSafeCopySimple 0 'base ''IPv4
-deriveSafeCopy 0 'base ''IPv6
+deriveSafeCopySimple 0 'base ''IPv6
-deriveSafeCopy 0 'base ''IP
+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
+instance SafeCopy a => Migrate (Uid a) where
-  type MigrateFrom (Uid a) = Uid_v0
+  type MigrateFrom (Uid a) = Uid_v1 a
-  migrate Uid_v0{..} = Uid {
+  migrate Uid_v1{..} = Uid {
-    uidToText = uidToText_v0 }
+    uidToText = uidToText_v1 }
 
 instance IsString (Uid a) where
   fromString = Uid . T.pack