aelve/guide
1
1
Fork 0
mirror of https://github.com/aelve/guide.git synced 2024-11-27 00:14:03 +03:00
Code Issues Projects Releases Wiki Activity

Use deriveSafeCopySimple as workaround for a bug

Browse Source 
See https://github.com/acid-state/safecopy/issues/41
This commit is contained in:
Artyom 2016-04-11 16:05:45 +03:00
parent 2e0e6dcc8b
commit f0d67cbb75
4 changed files with 134 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
guide.cabal
View File

@ -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

2
src/Main.hs
View File

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

218
src/Types.hs
View File

@ -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 }
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 }
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
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] }
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] }
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
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
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
deriveSafeCopy 0 'base ''Network.IPv6
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
-- 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

21
src/Utils.hs
View File

@ -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