From c56c792f9e5b576859d987f22b4051c2790fc129 Mon Sep 17 00:00:00 2001 From: Artyom Kazak Date: Sat, 22 Sep 2018 21:12:21 +0200 Subject: [PATCH] Add categories to the right groups (#218) * Add categories to the right groups --- src/Guide/Handlers.hs | 2 +- src/Guide/ServerStuff.hs | 4 +-- src/Guide/State.hs | 7 +++-- src/Guide/Types/Edit.hs | 59 +++++++++++++--------------------------- src/Guide/Views.hs | 3 +- 5 files changed, 28 insertions(+), 47 deletions(-) diff --git a/src/Guide/Handlers.hs b/src/Guide/Handlers.hs index 606dc75..0dc5400 100644 --- a/src/Guide/Handlers.hs +++ b/src/Guide/Handlers.hs @@ -274,7 +274,7 @@ addMethods = do Nothing -> do catId <- randomShortUid time <- liftIO getCurrentTime - (edit, newCategory) <- dbUpdate (AddCategory catId title' time) + (edit, newCategory) <- dbUpdate (AddCategory catId title' "Miscellaneous" time) invalidateCache' (CacheCategory catId) addEdit edit return newCategory diff --git a/src/Guide/ServerStuff.hs b/src/Guide/ServerStuff.hs index 1ac62eb..3bd6bc2 100644 --- a/src/Guide/ServerStuff.hs +++ b/src/Guide/ServerStuff.hs @@ -153,7 +153,7 @@ addEdit ed = do -- been deleted; this should change. undoEdit :: (MonadIO m, HasSpock m, SpockState m ~ ServerState) => Edit -> m (Either String ()) -undoEdit (Edit'AddCategory catId _) = do +undoEdit (Edit'AddCategory catId _ _) = do void <$> dbUpdate (DeleteCategory catId) undoEdit (Edit'AddItem _catId itemId _) = do void <$> dbUpdate (DeleteItem itemId) @@ -245,7 +245,7 @@ invalidateCacheForEdit invalidateCacheForEdit ed = do gs <- dbQuery GetGlobalState mapM_ (invalidateCache gs) $ case ed of - Edit'AddCategory catId _ -> + Edit'AddCategory catId _ _ -> [CacheCategory catId] -- Normally invalidateCache should invalidate item's category -- automatically, but in this case it's *maybe* possible that the item diff --git a/src/Guide/State.hs b/src/Guide/State.hs index b9f803b..b4bc440 100644 --- a/src/Guide/State.hs +++ b/src/Guide/State.hs @@ -345,13 +345,14 @@ getTrait itemId traitId = view (itemById itemId . traitById traitId) addCategory :: Uid Category -- ^ New category's id -> Text -- ^ Title + -> Text -- ^ Group -> UTCTime -- ^ Creation time -> Acid.Update GlobalState (Edit, Category) -addCategory catId title' created' = do +addCategory catId title' group' created' = do let newCategory = Category { _categoryUid = catId, _categoryTitle = title', - _categoryGroup_ = "Miscellaneous", + _categoryGroup_ = group', _categoryEnabledSections = S.fromList [ ItemProsConsSection, ItemEcosystemSection, @@ -363,7 +364,7 @@ addCategory catId title' created' = do _categoryItems = [], _categoryItemsDeleted = [] } categories %= (newCategory :) - let edit = Edit'AddCategory catId title' + let edit = Edit'AddCategory catId title' group' return (edit, newCategory) addItem diff --git a/src/Guide/Types/Edit.hs b/src/Guide/Types/Edit.hs index 000da98..4ecdc86 100644 --- a/src/Guide/Types/Edit.hs +++ b/src/Guide/Types/Edit.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE OverloadedStrings #-} {- | @@ -19,8 +20,6 @@ where import Imports --- Containers -import qualified Data.Set as S -- Network import Data.IP -- acid-state @@ -36,7 +35,8 @@ data Edit -- Add = Edit'AddCategory { editCategoryUid :: Uid Category, - editCategoryTitle :: Text } + editCategoryTitle :: Text, + editCategoryGroup :: Text } | Edit'AddItem { editCategoryUid :: Uid Category, editItemUid :: Uid Item, @@ -133,11 +133,13 @@ data Edit deriving (Eq, Show) -deriveSafeCopySimple 7 'extension ''Edit +deriveSafeCopySimple 8 'extension ''Edit -genVer ''Edit 6 [ +genVer ''Edit 7 [ -- Add - Copy 'Edit'AddCategory, + Custom "Edit'AddCategory" [ + ("editCategoryUid" , [t|Uid Category|]), + ("editCategoryTitle", [t|Text|]) ], Copy 'Edit'AddItem, Copy 'Edit'AddPro, Copy 'Edit'AddCon, @@ -146,18 +148,7 @@ genVer ''Edit 6 [ Copy 'Edit'SetCategoryGroup, Copy 'Edit'SetCategoryNotes, Copy 'Edit'SetCategoryStatus, - Custom "Edit'SetCategoryProsConsEnabled" [ - ("editCategoryUid" , [t|Uid Category|]), - ("_editCategoryProsConsEnabled" , [t|Bool|]), - ("editCategoryNewProsConsEnabled" , [t|Bool|]) ], - Custom "Edit'SetCategoryEcosystemEnabled" [ - ("editCategoryUid" , [t|Uid Category|]), - ("_editCategoryEcosystemEnabled" , [t|Bool|]), - ("editCategoryNewEcosystemEnabled", [t|Bool|]) ], - Custom "Edit'SetCategoryNotesEnabled" [ - ("editCategoryUid" , [t|Uid Category|]), - ("_editCategoryNotesEnabled" , [t|Bool|]), - ("editCategoryNewNotesEnabled" , [t|Bool|]) ], + Copy 'Edit'ChangeCategoryEnabledSections, -- Change item properties Copy 'Edit'SetItemName, Copy 'Edit'SetItemLink, @@ -176,12 +167,17 @@ genVer ''Edit 6 [ Copy 'Edit'MoveItem, Copy 'Edit'MoveTrait ] -deriveSafeCopySimple 6 'base ''Edit_v6 +deriveSafeCopySimple 7 'base ''Edit_v7 instance Migrate Edit where - type MigrateFrom Edit = Edit_v6 - migrate = $(migrateVer ''Edit 6 [ - CopyM 'Edit'AddCategory, + type MigrateFrom Edit = Edit_v7 + migrate = $(migrateVer ''Edit 7 [ + CustomM "Edit'AddCategory" [|\x -> + Edit'AddCategory + { editCategoryUid = editCategoryUid_v7 x + , editCategoryTitle = editCategoryTitle_v7 x + , editCategoryGroup = "Miscellaneous" + } |], CopyM 'Edit'AddItem, CopyM 'Edit'AddPro, CopyM 'Edit'AddCon, @@ -190,24 +186,7 @@ instance Migrate Edit where CopyM 'Edit'SetCategoryGroup, CopyM 'Edit'SetCategoryNotes, CopyM 'Edit'SetCategoryStatus, - CustomM "Edit'SetCategoryProsConsEnabled" [|\x -> - if editCategoryNewProsConsEnabled_v6 x - then Edit'ChangeCategoryEnabledSections (editCategoryUid_v6 x) - (S.singleton ItemProsConsSection) mempty - else Edit'ChangeCategoryEnabledSections (editCategoryUid_v6 x) - mempty (S.singleton ItemProsConsSection) |], - CustomM "Edit'SetCategoryEcosystemEnabled" [|\x -> - if editCategoryNewEcosystemEnabled_v6 x - then Edit'ChangeCategoryEnabledSections (editCategoryUid_v6 x) - (S.singleton ItemEcosystemSection) mempty - else Edit'ChangeCategoryEnabledSections (editCategoryUid_v6 x) - mempty (S.singleton ItemEcosystemSection) |], - CustomM "Edit'SetCategoryNotesEnabled" [|\x -> - if editCategoryNewNotesEnabled_v6 x - then Edit'ChangeCategoryEnabledSections (editCategoryUid_v6 x) - (S.singleton ItemNotesSection) mempty - else Edit'ChangeCategoryEnabledSections (editCategoryUid_v6 x) - mempty (S.singleton ItemNotesSection) |], + CopyM 'Edit'ChangeCategoryEnabledSections, -- Change item properties CopyM 'Edit'SetItemName, CopyM 'Edit'SetItemLink, diff --git a/src/Guide/Views.hs b/src/Guide/Views.hs index 32451aa..1781501 100644 --- a/src/Guide/Views.hs +++ b/src/Guide/Views.hs @@ -411,8 +411,9 @@ renderEdit globalState edit = do case edit of -- Add - Edit'AddCategory _catId title' -> p_ $ do + Edit'AddCategory _catId title' group' -> p_ $ do "added category " >> quote (toHtml title') + " to group " >> quote (toHtml group') Edit'AddItem catId _itemId name' -> p_ $ do "added item " >> printItem _itemId " (initially called " >> quote (toHtml name') >> ")"