Merge category{ProsCons|Ecosystem|Notes}Enabled fields

Changing 'Edit' is annoying, so maybe now we'll have to do it less often

src/Guide/Handlers.hs

@@ -18,6 +18,7 @@ import Imports
 
 -- Containers
 import qualified Data.Map as M
+import qualified Data.Set as S
 -- Feeds
 import qualified Text.Feed.Types as Feed
 import qualified Text.Feed.Util  as Feed
@@ -113,14 +114,15 @@ setMethods = Spock.subcomponent "set" $ do
         addEdit edit
       do (edit, _) <- dbUpdate (SetCategoryStatus catId status')
          addEdit edit
-      do (edit, _) <- dbUpdate $
+      do oldEnabledSections <- view enabledSections <$> dbQuery (GetCategory catId)
-                      SetCategoryProsConsEnabled catId prosConsEnabled'
+         let newEnabledSections = S.fromList . concat $
-         addEdit edit
+               [ [ItemProsConsSection  | prosConsEnabled']
-      do (edit, _) <- dbUpdate $
+               , [ItemEcosystemSection | ecosystemEnabled']
-                      SetCategoryEcosystemEnabled catId ecosystemEnabled'
+               , [ItemNotesSection     | notesEnabled'] ]
-         addEdit edit
+         (edit, _) <- dbUpdate $
-      do (edit, _) <- dbUpdate $
+                      ChangeCategoryEnabledSections catId
-                      SetCategoryNotesEnabled catId notesEnabled'
+                        (newEnabledSections S.\\ oldEnabledSections)
+                        (oldEnabledSections S.\\ newEnabledSections)
          addEdit edit
     -- After all these edits we can render the category header
     category <- dbQuery (GetCategory catId)

src/Guide/ServerStuff.hs

@@ -175,21 +175,11 @@ undoEdit (Edit'SetCategoryStatus catId old new) = do
   if now /= new
     then return (Left "status has been changed further")
     else Right () <$ dbUpdate (SetCategoryStatus catId old)
-undoEdit (Edit'SetCategoryProsConsEnabled catId old new) = do
+undoEdit (Edit'ChangeCategoryEnabledSections catId toEnable toDisable) = do
-  now <- view prosConsEnabled <$> dbQuery (GetCategory catId)
+  enabledNow <- view enabledSections <$> dbQuery (GetCategory catId)
-  if now /= new
+  if any (`elem` enabledNow) toDisable || any (`notElem` enabledNow) toEnable
-    then return (Left "pros-cons-enabled has been changed further")
+    then return (Left "enabled-sections has been changed further")
-    else Right () <$ dbUpdate (SetCategoryProsConsEnabled catId old)
+    else Right () <$ dbUpdate (ChangeCategoryEnabledSections catId toDisable toEnable)
-undoEdit (Edit'SetCategoryEcosystemEnabled catId old new) = do
-  now <- view ecosystemEnabled <$> dbQuery (GetCategory catId)
-  if now /= new
-    then return (Left "ecosystem-enabled has been changed further")
-    else Right () <$ dbUpdate (SetCategoryEcosystemEnabled catId old)
-undoEdit (Edit'SetCategoryNotesEnabled catId old new) = do
-  now <- view notesEnabled <$> dbQuery (GetCategory catId)
-  if now /= new
-    then return (Left "notes-enabled has been changed further")
-    else Right () <$ dbUpdate (SetCategoryNotesEnabled catId old)
 undoEdit (Edit'SetCategoryNotes catId old new) = do
   now <- view (notes.mdText) <$> dbQuery (GetCategory catId)
   if now /= new
@@ -270,11 +260,7 @@ invalidateCacheForEdit ed = do
         [CacheCategoryInfo catId]
     Edit'SetCategoryStatus catId _ _ ->
         [CacheCategoryInfo catId]
-    Edit'SetCategoryProsConsEnabled catId _ _ ->
+    Edit'ChangeCategoryEnabledSections catId _ _ ->
-        [CacheCategoryInfo catId]
-    Edit'SetCategoryEcosystemEnabled catId _ _ ->
-        [CacheCategoryInfo catId]
-    Edit'SetCategoryNotesEnabled catId _ _ ->
         [CacheCategoryInfo catId]
     Edit'SetCategoryNotes catId _ _ ->
         [CacheCategoryNotes catId]

src/Guide/State.hs

@@ -43,9 +43,7 @@ module Guide.State
   SetCategoryGroup(..),
   SetCategoryNotes(..),
   SetCategoryStatus(..),
-  SetCategoryProsConsEnabled(..),
+  ChangeCategoryEnabledSections(..),
-  SetCategoryEcosystemEnabled(..),
-  SetCategoryNotesEnabled(..),
   -- *** 'Item'
   SetItemName(..),
   SetItemLink(..),
@@ -85,6 +83,7 @@ import Imports
 
 -- Containers
 import qualified Data.Map as M
+import qualified Data.Set as S
 -- Text
 import qualified Data.Text.All as T
 -- Network
@@ -255,9 +254,10 @@ addCategory catId title' created' = do
         _categoryUid = catId,
         _categoryTitle = title',
         _categoryGroup_ = "Miscellaneous",
-        _categoryProsConsEnabled = True,
+        _categoryEnabledSections = S.fromList [
-        _categoryEcosystemEnabled = True,
+            ItemProsConsSection,
-        _categoryNotesEnabled = True,
+            ItemEcosystemSection,
+            ItemNotesSection ],
         _categoryCreated = created',
         _categoryStatus = CategoryStub,
         _categoryNotes = toMarkdownBlock "",
@@ -351,25 +351,15 @@ setCategoryStatus catId status' = do
   let edit = Edit'SetCategoryStatus catId oldStatus status'
   (edit,) <$> use (categoryById catId)
 
-setCategoryProsConsEnabled
+changeCategoryEnabledSections
-  :: Uid Category -> Bool -> Acid.Update GlobalState (Edit, Category)
+  :: Uid Category
-setCategoryProsConsEnabled catId val = do
+  -> Set ItemSection     -- ^ Sections to enable
-  oldVal <- categoryById catId . prosConsEnabled <<.= val
+  -> Set ItemSection     -- ^ Sections to disable
-  let edit = Edit'SetCategoryProsConsEnabled catId oldVal val
+  -> Acid.Update GlobalState (Edit, Category)
-  (edit,) <$> use (categoryById catId)
+changeCategoryEnabledSections catId toEnable toDisable = do
-
+  categoryById catId . enabledSections %= \sections ->
-setCategoryEcosystemEnabled
+    (sections <> toEnable) S.\\ toDisable
-  :: Uid Category -> Bool -> Acid.Update GlobalState (Edit, Category)
+  let edit = Edit'ChangeCategoryEnabledSections catId toEnable toDisable
-setCategoryEcosystemEnabled catId val = do
-  oldVal <- categoryById catId . ecosystemEnabled <<.= val
-  let edit = Edit'SetCategoryEcosystemEnabled catId oldVal val
-  (edit,) <$> use (categoryById catId)
-
-setCategoryNotesEnabled
-  :: Uid Category -> Bool -> Acid.Update GlobalState (Edit, Category)
-setCategoryNotesEnabled catId val = do
-  oldVal <- categoryById catId . notesEnabled <<.= val
-  let edit = Edit'SetCategoryNotesEnabled catId oldVal val
   (edit,) <$> use (categoryById catId)
 
 setItemName :: Uid Item -> Text -> Acid.Update GlobalState (Edit, Item)
@@ -708,8 +698,7 @@ makeAcidic ''GlobalState [
   -- set
   'setGlobalState,
   'setCategoryTitle, 'setCategoryGroup, 'setCategoryNotes, 'setCategoryStatus,
-    'setCategoryProsConsEnabled, 'setCategoryEcosystemEnabled,
+    'changeCategoryEnabledSections,
-    'setCategoryNotesEnabled,
   'setItemName, 'setItemLink, 'setItemGroup, 'setItemKind,
     'setItemDescription, 'setItemNotes, 'setItemEcosystem,
   'setTraitContent,

src/Guide/Types/Core.hs

@@ -21,6 +21,7 @@ module Guide.Types.Core
   Trait(..),
   ItemKind(..),
     hackageName,
+  ItemSection(..),
   Item(..),
     pros,
     prosDeleted,
@@ -36,9 +37,7 @@ module Guide.Types.Core
   Category(..),
     title,
     status,
-    prosConsEnabled,
+    enabledSections,
-    ecosystemEnabled,
-    notesEnabled,
     groups,
     items,
     itemsDeleted,
@@ -61,6 +60,8 @@ import Imports
 
 -- Text
 import qualified Data.Text.All as T
+-- Containers
+import qualified Data.Set as S
 -- JSON
 import qualified Data.Aeson as A
 import qualified Data.Aeson.Types as A
@@ -137,6 +138,19 @@ instance Migrate ItemKind where
     _itemKindHackageName = _itemKindHackageName_v2 }
   migrate Other_v2 = Other
 
+-- | Different kinds of sections inside items. This type is only used for
+-- '_categoryEnabledSections'.
+data ItemSection
+  = ItemProsConsSection
+  | ItemEcosystemSection
+  | ItemNotesSection
+  deriving (Eq, Ord, Show, Generic)
+
+deriveSafeCopySimple 0 'base ''ItemSection
+
+instance A.ToJSON ItemSection where
+  toJSON = A.genericToJSON A.defaultOptions
+
 -- TODO: add a field like “people to ask on IRC about this library if you
 -- need help”
 
@@ -202,14 +216,9 @@ data Category = Category {
   -- | The “grandcategory” of the category (“meta”, “basics”, “specialised
   -- needs”, etc)
   _categoryGroup_ :: Text,
-  -- | Whether to show items' pros and cons. This would be 'False' for
+  -- | Enabled sections in this category. For instance, if this set contains
-  -- e.g. lists of people, or lists of successful projects written in Haskell
+  -- 'ItemNotesSection', then notes will be shown for each item.
-  _categoryProsConsEnabled :: Bool,
+  _categoryEnabledSections :: Set ItemSection,
-  -- | Whether to show items' ecosystem fields. This would be 'False' for
-  -- lists of people, or for books
-  _categoryEcosystemEnabled :: Bool,
-  -- | Whether to show notes.
-  _categoryNotesEnabled :: Bool,
   _categoryCreated :: UTCTime,
   _categoryStatus :: CategoryStatus,
   _categoryNotes :: MarkdownBlock,
@@ -224,12 +233,23 @@ data Category = Category {
   _categoryItemsDeleted :: [Item] }
   deriving (Show, Generic)
 
-deriveSafeCopySorted 10 'extension ''Category
+deriveSafeCopySorted 11 'extension ''Category
 makeFields ''Category
 
-changelog ''Category (Current 10, Past 9)
+changelog ''Category (Current 11, Past 10)
+  [Removed "_categoryProsConsEnabled"  [t|Bool|],
+   Removed "_categoryEcosystemEnabled" [t|Bool|],
+   Removed "_categoryNotesEnabled"     [t|Bool|],
+   Added   "_categoryEnabledSections"  [hs|
+     S.fromList $ concat
+       [ [ItemProsConsSection  | _categoryProsConsEnabled]
+       , [ItemEcosystemSection | _categoryEcosystemEnabled]
+       , [ItemNotesSection     | _categoryNotesEnabled] ] |] ]
+deriveSafeCopySorted 10 'extension ''Category_v10
+
+changelog ''Category (Past 10, Past 9)
   [Added "_categoryNotesEnabled" [hs|True|]]
-deriveSafeCopySorted 9 'base ''Category_v9
+deriveSafeCopySorted 9 'extension ''Category_v9
 
 changelog ''Category (Past 9, Past 8) []
 deriveSafeCopySorted 8 'base ''Category_v8

src/Guide/Types/Edit.hs

@@ -19,6 +19,8 @@ where
 
 import Imports
 
+-- Containers
+import qualified Data.Set as S
 -- Network
 import Data.IP
 -- acid-state
@@ -65,18 +67,10 @@ data Edit
       editCategoryUid       :: Uid Category,
       editCategoryStatus    :: CategoryStatus,
       editCategoryNewStatus :: CategoryStatus }
-  | Edit'SetCategoryProsConsEnabled {
+  | Edit'ChangeCategoryEnabledSections {
       editCategoryUid             :: Uid Category,
-      editCategoryProsConsEnabled     :: Bool,
+      editCategoryEnableSections  :: Set ItemSection,
-      editCategoryNewProsConsEnabled  :: Bool }
+      editCategoryDisableSections :: Set ItemSection }
-  | Edit'SetCategoryEcosystemEnabled {
-      editCategoryUid                 :: Uid Category,
-      editCategoryEcosystemEnabled    :: Bool,
-      editCategoryNewEcosystemEnabled :: Bool }
-  | Edit'SetCategoryNotesEnabled {
-      editCategoryUid                 :: Uid Category,
-      editCategoryNotesEnabled        :: Bool,
-      editCategoryNewNotesEnabled     :: Bool }
 
   -- Change item properties
   | Edit'SetItemName {
@@ -139,9 +133,9 @@ data Edit
 
   deriving (Eq, Show)
 
-deriveSafeCopySimple 6 'extension ''Edit
+deriveSafeCopySimple 7 'extension ''Edit
 
-genVer ''Edit 5 [
+genVer ''Edit 6 [
   -- Add
   Copy 'Edit'AddCategory,
   Copy 'Edit'AddItem,
@@ -152,9 +146,18 @@ genVer ''Edit 5 [
   Copy 'Edit'SetCategoryGroup,
   Copy 'Edit'SetCategoryNotes,
   Copy 'Edit'SetCategoryStatus,
-  Copy 'Edit'SetCategoryProsConsEnabled,
+  Custom "Edit'SetCategoryProsConsEnabled" [
-  Copy 'Edit'SetCategoryEcosystemEnabled,
+      ("editCategoryUid"                , [t|Uid Category|]),
-  -- Copy 'Edit'SetCategoryNotesEnabled,
+      ("_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|]) ],
   -- Change item properties
   Copy 'Edit'SetItemName,
   Copy 'Edit'SetItemLink,
@@ -173,11 +176,11 @@ genVer ''Edit 5 [
   Copy 'Edit'MoveItem,
   Copy 'Edit'MoveTrait ]
 
-deriveSafeCopySimple 5 'base ''Edit_v5
+deriveSafeCopySimple 6 'base ''Edit_v6
 
 instance Migrate Edit where
-  type MigrateFrom Edit = Edit_v5
+  type MigrateFrom Edit = Edit_v6
-  migrate = $(migrateVer ''Edit 5 [
+  migrate = $(migrateVer ''Edit 6 [
     CopyM 'Edit'AddCategory,
     CopyM 'Edit'AddItem,
     CopyM 'Edit'AddPro,
@@ -187,9 +190,24 @@ instance Migrate Edit where
     CopyM 'Edit'SetCategoryGroup,
     CopyM 'Edit'SetCategoryNotes,
     CopyM 'Edit'SetCategoryStatus,
-    CopyM 'Edit'SetCategoryProsConsEnabled,
+    CustomM "Edit'SetCategoryProsConsEnabled" [|\x ->
-    CopyM 'Edit'SetCategoryEcosystemEnabled,
+        if editCategoryNewProsConsEnabled_v6 x
-    -- CopyM 'Edit'SetCategoryNotesEnabled,
+          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) |],
     -- Change item properties
     CopyM 'Edit'SetItemName,
     CopyM 'Edit'SetItemLink,
@@ -220,12 +238,9 @@ isVacuousEdit Edit'SetCategoryNotes{..} =
   editCategoryNotes == editCategoryNewNotes
 isVacuousEdit Edit'SetCategoryStatus{..} =
   editCategoryStatus == editCategoryNewStatus
-isVacuousEdit Edit'SetCategoryProsConsEnabled {..} =
+isVacuousEdit Edit'ChangeCategoryEnabledSections {..} =
-  editCategoryProsConsEnabled == editCategoryNewProsConsEnabled
+  null editCategoryEnableSections &&
-isVacuousEdit Edit'SetCategoryEcosystemEnabled {..} =
+  null editCategoryDisableSections
-  editCategoryEcosystemEnabled == editCategoryNewEcosystemEnabled
-isVacuousEdit Edit'SetCategoryNotesEnabled {..} =
-  editCategoryNotesEnabled == editCategoryNewNotesEnabled
 isVacuousEdit Edit'SetItemName{..} =
   editItemName == editItemNewName
 isVacuousEdit Edit'SetItemLink{..} =

src/Guide/Utils.hs

@@ -517,7 +517,7 @@ changelog bareTyName (newVer, Past oldVer) changes = do
   -- Return everything
   sequence [oldTypeDecl, migrateInstanceDecl]
 
-data GenConstructor = Copy Name | Custom String [(String, Name)]
+data GenConstructor = Copy Name | Custom String [(String, Q Type)]
 
 genVer :: Name -> Int -> [GenConstructor] -> Q [Dec]
 genVer tyName ver constructors = do
@@ -545,7 +545,7 @@ genVer tyName ver constructors = do
   let customConstructor conName fields =
         recC (oldName (mkName conName))
              [varBangType (oldName (mkName fName))
-                          (bangType bangNotStrict (conT fType))
+                          (bangType bangNotStrict fType)
                | (fName, fType) <- fields]
 
   cons' <- for constructors $ \genCons ->
@@ -568,7 +568,7 @@ genVer tyName ver constructors = do
     (cxt [])
   return [decl]
 
-data MigrateConstructor = CopyM Name | CustomM Name ExpQ
+data MigrateConstructor = CopyM Name | CustomM String ExpQ
 
 migrateVer :: Name -> Int -> [MigrateConstructor] -> Q Exp
 migrateVer tyName ver constructors = do
@@ -599,8 +599,8 @@ migrateVer tyName ver constructors = do
           other -> fail ("migrateVer: copyConstructor: got " ++ show other)
 
   let customConstructor conName res =
-        match (recP (oldName conName) [])
+        match (recP (oldName (mkName conName)) [])
-              (normalB res)
+              (normalB (res `appE` varE arg))
               []
 
   branches' <- for constructors $ \genCons ->

src/Guide/Views.hs

@@ -417,18 +417,19 @@ renderEdit globalState edit = do
         unless (T.null oldNotes) $
           td_ $ blockquote_ $ toHtml (toMarkdownBlock oldNotes)
         td_ $ blockquote_ $ toHtml (toMarkdownBlock newNotes)
-    Edit'SetCategoryProsConsEnabled catId _oldVal newVal -> do
+    Edit'ChangeCategoryEnabledSections catId toEnable toDisable -> do
-      if newVal == True
+      let sectName ItemProsConsSection  = "pros/cons"
-        then p_ $ "enabled pros/cons for category " >> printCategory catId
+          sectName ItemEcosystemSection = "ecosystem"
-        else p_ $ "disabled pros/cons for category " >> printCategory catId
+          sectName ItemNotesSection     = "notes"
-    Edit'SetCategoryEcosystemEnabled catId _oldVal newVal -> do
+      let list = toHtml . T.intercalate ", "
-      if newVal == True
+      unless (null toEnable) $
-        then p_ $ "enabled ecosystem for category " >> printCategory catId
+        p_ $ "enabled " >>
-        else p_ $ "disabled ecosystem for category " >> printCategory catId
+             strong_ (list (map sectName (toList toEnable))) >>
-    Edit'SetCategoryNotesEnabled catId _oldVal newVal -> do
+             " for category " >> printCategory catId
-      if newVal == True
+      unless (null toDisable) $
-        then p_ $ "enabled notes for category " >> printCategory catId
+        p_ $ "disabled " >>
-        else p_ $ "disabled notes for category " >> printCategory catId
+             strong_ (list (map sectName (toList toDisable))) >>
+             " for category " >> printCategory catId
 
     -- Change item properties
     Edit'SetItemName _itemId oldName newName -> p_ $ do

src/Guide/Views/Category.hs

@@ -120,19 +120,19 @@ renderCategoryInfo category = cached (CacheCategoryInfo (category^.uid)) $ do
         label_ $ do
           input_ [type_ "checkbox", name_ "pros-cons-enabled",
                   autocomplete_ "off"]
-            & checkedIf (category^.prosConsEnabled)
+            & checkedIf (ItemProsConsSection `elem` category^.enabledSections)
           "Pros/cons enabled"
         br_ []
         label_ $ do
           input_ [type_ "checkbox", name_ "ecosystem-enabled",
                   autocomplete_ "off"]
-            & checkedIf (category^.ecosystemEnabled)
+            & checkedIf (ItemEcosystemSection `elem` category^.enabledSections)
           "“Ecosystem” field enabled"
         br_ []
         label_ $ do
           input_ [type_ "checkbox", name_ "notes-enabled",
                   autocomplete_ "off"]
-            & checkedIf (category^.notesEnabled)
+            & checkedIf (ItemNotesSection `elem` category^.enabledSections)
           "“Notes” field enabled"
         br_ []
         input_ [type_ "submit", value_ "Save", class_ "save"]

src/Guide/Views/Item.hs

@@ -67,13 +67,13 @@ renderItem category item = cached (CacheItem (item^.uid)) $ do
     div_ [class_ "item-body", style_ ("background-color:" <> bg)] $ do
       -- See Note [enabled sections]
       renderItemDescription item
-      hiddenIf (not (category^.prosConsEnabled)) $
+      hiddenIf (ItemProsConsSection `notElem` category^.enabledSections) $
         div_ [class_ "pros-cons-wrapper"] $
           renderItemTraits item
-      hiddenIf (not (category^.ecosystemEnabled)) $
+      hiddenIf (ItemEcosystemSection `notElem` category^.enabledSections) $
         div_ [class_ "ecosystem-wrapper"] $
           renderItemEcosystem item
-      hiddenIf (not (category^.notesEnabled)) $
+      hiddenIf (ItemNotesSection `notElem` category^.enabledSections) $
         div_ [class_ "notes-wrapper"] $
           renderItemNotes category item
 
@@ -85,12 +85,12 @@ renderItemForFeed category item = do
   h1_ $ renderItemTitle item
   unless (markdownNull (item^.description)) $
     toHtml (item^.description)
-  when (category^.prosConsEnabled) $ do
+  when (ItemProsConsSection `elem` category^.enabledSections) $ do
     h2_ "Pros"
     ul_ $ mapM_ (p_ . li_ . toHtml . view content) (item^.pros)
     h2_ "Cons"
     ul_ $ mapM_ (p_ . li_ . toHtml . view content) (item^.cons)
-  when (category^.ecosystemEnabled) $ do
+  when (ItemEcosystemSection `elem` category^.enabledSections) $ do
     unless (markdownNull (item^.ecosystem)) $ do
       h2_ "Ecosystem"
       toHtml (item^.ecosystem)

src/Imports.hs

@@ -8,7 +8,7 @@ the "Prelude".)
 module Imports
 (
   module X,
-  LByteString
+  LByteString,
 )
 where
 
@@ -41,3 +41,4 @@ import qualified Data.ByteString.Lazy as BSL
 
 
 type LByteString = BSL.ByteString
+-- LText is already provided by Data.Text.All