Skip to content
This repository has been archived by the owner on Dec 11, 2019. It is now read-only.

Commit

Permalink
Use deriveSafeCopySimple as workaround for a bug
Browse files Browse the repository at this point in the history 
See acid-state/safecopy#41
  • Loading branch information
Artyom committed Apr 11, 2016
1 parent 2e0e6dc commit f0d67cb
Show file tree
Hide file tree
Showing 4 changed files with 136 additions and 111 deletions.
2 changes: 0 additions & 2 deletions guide.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion src/Main.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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).
Expand Down
222 changes: 124 additions & 98 deletions src/Types.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -143,25 +142,26 @@ 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
-- deleted (if a checkpoint has been created), but it's been left here as a
-- 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 }

--

Expand All @@ -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
Expand All @@ -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"
Expand Down Expand Up @@ -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
Expand All @@ -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

Expand Down Expand Up @@ -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,
Expand All @@ -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,
Expand Down Expand Up @@ -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?

Expand All @@ -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
Expand Down
21 changes: 11 additions & 10 deletions src/Utils.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand All @@ -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
Expand Down

0 comments on commit f0d67cb

Please sign in to comment.