Add categories to the right groups (#218)

* Add categories to the right groups

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

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

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

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,

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') >> ")"