diff --git a/src/Guide/Handlers.hs b/src/Guide/Handlers.hs index 0c579d3..24c9224 100644 --- a/src/Guide/Handlers.hs +++ b/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 $ - SetCategoryProsConsEnabled catId prosConsEnabled' - addEdit edit - do (edit, _) <- dbUpdate $ - SetCategoryEcosystemEnabled catId ecosystemEnabled' - addEdit edit - do (edit, _) <- dbUpdate $ - SetCategoryNotesEnabled catId notesEnabled' + do oldEnabledSections <- view enabledSections <$> dbQuery (GetCategory catId) + let newEnabledSections = S.fromList . concat $ + [ [ItemProsConsSection | prosConsEnabled'] + , [ItemEcosystemSection | ecosystemEnabled'] + , [ItemNotesSection | notesEnabled'] ] + (edit, _) <- dbUpdate $ + ChangeCategoryEnabledSections catId + (newEnabledSections S.\\ oldEnabledSections) + (oldEnabledSections S.\\ newEnabledSections) addEdit edit -- After all these edits we can render the category header category <- dbQuery (GetCategory catId) diff --git a/src/Guide/ServerStuff.hs b/src/Guide/ServerStuff.hs index 7393199..0b1056c 100644 --- a/src/Guide/ServerStuff.hs +++ b/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 - now <- view prosConsEnabled <$> dbQuery (GetCategory catId) - if now /= new - then return (Left "pros-cons-enabled has been changed further") - else Right () <$ dbUpdate (SetCategoryProsConsEnabled catId old) -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'ChangeCategoryEnabledSections catId toEnable toDisable) = do + enabledNow <- view enabledSections <$> dbQuery (GetCategory catId) + if any (`elem` enabledNow) toDisable || any (`notElem` enabledNow) toEnable + then return (Left "enabled-sections has been changed further") + else Right () <$ dbUpdate (ChangeCategoryEnabledSections catId toDisable toEnable) 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 _ _ -> - [CacheCategoryInfo catId] - Edit'SetCategoryEcosystemEnabled catId _ _ -> - [CacheCategoryInfo catId] - Edit'SetCategoryNotesEnabled catId _ _ -> + Edit'ChangeCategoryEnabledSections catId _ _ -> [CacheCategoryInfo catId] Edit'SetCategoryNotes catId _ _ -> [CacheCategoryNotes catId] diff --git a/src/Guide/State.hs b/src/Guide/State.hs index 6d02790..4bc8bba 100644 --- a/src/Guide/State.hs +++ b/src/Guide/State.hs @@ -43,9 +43,7 @@ module Guide.State SetCategoryGroup(..), SetCategoryNotes(..), SetCategoryStatus(..), - SetCategoryProsConsEnabled(..), - SetCategoryEcosystemEnabled(..), - SetCategoryNotesEnabled(..), + ChangeCategoryEnabledSections(..), -- *** '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, - _categoryEcosystemEnabled = True, - _categoryNotesEnabled = True, + _categoryEnabledSections = S.fromList [ + ItemProsConsSection, + 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 - :: Uid Category -> Bool -> Acid.Update GlobalState (Edit, Category) -setCategoryProsConsEnabled catId val = do - oldVal <- categoryById catId . prosConsEnabled <<.= val - let edit = Edit'SetCategoryProsConsEnabled catId oldVal val - (edit,) <$> use (categoryById catId) - -setCategoryEcosystemEnabled - :: Uid Category -> Bool -> Acid.Update GlobalState (Edit, Category) -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 +changeCategoryEnabledSections + :: Uid Category + -> Set ItemSection -- ^ Sections to enable + -> Set ItemSection -- ^ Sections to disable + -> Acid.Update GlobalState (Edit, Category) +changeCategoryEnabledSections catId toEnable toDisable = do + categoryById catId . enabledSections %= \sections -> + (sections <> toEnable) S.\\ toDisable + let edit = Edit'ChangeCategoryEnabledSections catId toEnable toDisable (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, - 'setCategoryNotesEnabled, + 'changeCategoryEnabledSections, 'setItemName, 'setItemLink, 'setItemGroup, 'setItemKind, 'setItemDescription, 'setItemNotes, 'setItemEcosystem, 'setTraitContent, diff --git a/src/Guide/Types/Core.hs b/src/Guide/Types/Core.hs index 29d6364..c47f0e4 100644 --- a/src/Guide/Types/Core.hs +++ b/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, - ecosystemEnabled, - notesEnabled, + enabledSections, 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 - -- e.g. lists of people, or lists of successful projects written in Haskell - _categoryProsConsEnabled :: Bool, - -- | 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, + -- | Enabled sections in this category. For instance, if this set contains + -- 'ItemNotesSection', then notes will be shown for each item. + _categoryEnabledSections :: Set ItemSection, _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 diff --git a/src/Guide/Types/Edit.hs b/src/Guide/Types/Edit.hs index 1a053ed..8576fc7 100644 --- a/src/Guide/Types/Edit.hs +++ b/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 { - editCategoryUid :: Uid Category, - editCategoryProsConsEnabled :: Bool, - editCategoryNewProsConsEnabled :: Bool } - | Edit'SetCategoryEcosystemEnabled { - editCategoryUid :: Uid Category, - editCategoryEcosystemEnabled :: Bool, - editCategoryNewEcosystemEnabled :: Bool } - | Edit'SetCategoryNotesEnabled { - editCategoryUid :: Uid Category, - editCategoryNotesEnabled :: Bool, - editCategoryNewNotesEnabled :: Bool } + | Edit'ChangeCategoryEnabledSections { + editCategoryUid :: Uid Category, + editCategoryEnableSections :: Set ItemSection, + editCategoryDisableSections :: Set ItemSection } -- 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, - Copy 'Edit'SetCategoryEcosystemEnabled, - -- Copy 'Edit'SetCategoryNotesEnabled, + 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|]) ], -- 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 - migrate = $(migrateVer ''Edit 5 [ + type MigrateFrom Edit = Edit_v6 + 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, - CopyM 'Edit'SetCategoryEcosystemEnabled, - -- CopyM 'Edit'SetCategoryNotesEnabled, + 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) |], -- 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 {..} = - editCategoryProsConsEnabled == editCategoryNewProsConsEnabled -isVacuousEdit Edit'SetCategoryEcosystemEnabled {..} = - editCategoryEcosystemEnabled == editCategoryNewEcosystemEnabled -isVacuousEdit Edit'SetCategoryNotesEnabled {..} = - editCategoryNotesEnabled == editCategoryNewNotesEnabled +isVacuousEdit Edit'ChangeCategoryEnabledSections {..} = + null editCategoryEnableSections && + null editCategoryDisableSections isVacuousEdit Edit'SetItemName{..} = editItemName == editItemNewName isVacuousEdit Edit'SetItemLink{..} = diff --git a/src/Guide/Utils.hs b/src/Guide/Utils.hs index aa501ed..d22d1bc 100644 --- a/src/Guide/Utils.hs +++ b/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) []) - (normalB res) + match (recP (oldName (mkName conName)) []) + (normalB (res `appE` varE arg)) [] branches' <- for constructors $ \genCons -> diff --git a/src/Guide/Views.hs b/src/Guide/Views.hs index a4552b2..e6073aa 100644 --- a/src/Guide/Views.hs +++ b/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 - if newVal == True - then p_ $ "enabled pros/cons for category " >> printCategory catId - else p_ $ "disabled pros/cons for category " >> printCategory catId - Edit'SetCategoryEcosystemEnabled catId _oldVal newVal -> do - if newVal == True - then p_ $ "enabled ecosystem for category " >> printCategory catId - else p_ $ "disabled ecosystem for category " >> printCategory catId - Edit'SetCategoryNotesEnabled catId _oldVal newVal -> do - if newVal == True - then p_ $ "enabled notes for category " >> printCategory catId - else p_ $ "disabled notes for category " >> printCategory catId + Edit'ChangeCategoryEnabledSections catId toEnable toDisable -> do + let sectName ItemProsConsSection = "pros/cons" + sectName ItemEcosystemSection = "ecosystem" + sectName ItemNotesSection = "notes" + let list = toHtml . T.intercalate ", " + unless (null toEnable) $ + p_ $ "enabled " >> + strong_ (list (map sectName (toList toEnable))) >> + " for category " >> printCategory catId + unless (null toDisable) $ + p_ $ "disabled " >> + strong_ (list (map sectName (toList toDisable))) >> + " for category " >> printCategory catId -- Change item properties Edit'SetItemName _itemId oldName newName -> p_ $ do diff --git a/src/Guide/Views/Category.hs b/src/Guide/Views/Category.hs index 9b011d7..fa4f7c8 100644 --- a/src/Guide/Views/Category.hs +++ b/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"] diff --git a/src/Guide/Views/Item.hs b/src/Guide/Views/Item.hs index a4f4c50..cb9e724 100644 --- a/src/Guide/Views/Item.hs +++ b/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) diff --git a/src/Imports.hs b/src/Imports.hs index a91fc9c..e7e2f73 100644 --- a/src/Imports.hs +++ b/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