1
1
mirror of https://github.com/aelve/guide.git synced 2024-11-23 12:15:06 +03:00

Allow hiding ecosystem/pros/cons

This commit is contained in:
Artyom 2016-05-22 14:43:46 +03:00
parent 3a38c3de54
commit e1a6245afc
5 changed files with 220 additions and 68 deletions

View File

@ -60,7 +60,13 @@ cacheDepends :: GlobalState -> CacheKey -> [CacheKey]
cacheDepends gs key = case key of
CacheCategoryList -> [key]
CacheCategory _ -> [key, CacheCategoryList]
CacheCategoryInfo x -> [key, CacheCategory x, CacheCategoryList]
-- If the category's prosConsEnabled/ecosystemEnabled have changed, we'd
-- have to render *all* items differently (and CacheCategoryInfo includes
-- prosConsEnabled/ecosystemEnabled). See Note [enabled sections].
CacheCategoryInfo x ->
[key, CacheCategory x, CacheCategoryList] ++
-- A convoluted way to say “find category with uid x”
map CacheItem (gs ^.. categories.each.filtered(hasUid x).items.each.uid)
CacheCategoryNotes x -> [key, CacheCategory x, CacheCategoryList]
-- If the item's group has been changed, it can influence how other items
-- in the same category are rendered (specifically, their lists of groups

View File

@ -404,6 +404,15 @@ submitCategoryInfo =
$.post("/haskell/set/category/"+catId+"/info", $(form).serialize())
.done(function (data) {
$(infoNode).replaceWith(data);
// If pros-cons-enabled and ecosystem-enabled were changed, we
// have to show/hide relevant sections in all items of the category.
// See Note [enabled sections] for details.
if ($(form)[0]["pros-cons-enabled"].checked)
$(".pros-cons-wrapper").show();
else $(".pros-cons-wrapper").hide();
if ($(form)[0]["ecosystem-enabled"].checked)
$(".ecosystem-wrapper").show();
else $(".ecosystem-wrapper").hide();
});
|]

View File

@ -187,32 +187,56 @@ invalidateCacheForEdit
invalidateCacheForEdit ed = do
gs <- dbQuery GetGlobalState
mapM_ (invalidateCache gs) $ case ed of
Edit'AddCategory catId _ -> [CacheCategory 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
-- has already been moved somewhere else and so we invalidate both just
-- in case.
Edit'AddItem catId itemId _ -> [CacheCategory catId,
CacheItem itemId]
Edit'AddPro itemId _ _ -> [CacheItemTraits itemId]
Edit'AddCon itemId _ _ -> [CacheItemTraits itemId]
Edit'SetCategoryTitle catId _ _ -> [CacheCategoryInfo catId]
Edit'SetCategoryGroup catId _ _ -> [CacheCategoryInfo catId]
Edit'SetCategoryStatus catId _ _ -> [CacheCategoryInfo catId]
Edit'SetCategoryNotes catId _ _ -> [CacheCategoryNotes catId]
Edit'SetItemName itemId _ _ -> [CacheItemInfo itemId]
Edit'SetItemLink itemId _ _ -> [CacheItemInfo itemId]
Edit'SetItemGroup itemId _ _ -> [CacheItemInfo itemId]
Edit'SetItemKind itemId _ _ -> [CacheItemInfo itemId]
Edit'SetItemDescription itemId _ _ -> [CacheItemDescription itemId]
Edit'SetItemNotes itemId _ _ -> [CacheItemNotes itemId]
Edit'SetItemEcosystem itemId _ _ -> [CacheItemEcosystem itemId]
Edit'SetTraitContent itemId _ _ _ -> [CacheItemTraits itemId]
Edit'DeleteCategory catId _ -> [CacheCategory catId]
Edit'DeleteItem itemId _ -> [CacheItem itemId]
Edit'DeleteTrait itemId _ _ -> [CacheItemTraits itemId]
Edit'MoveItem itemId _ -> [CacheItem itemId]
Edit'MoveTrait itemId _ _ -> [CacheItemTraits itemId]
Edit'AddItem catId itemId _ ->
[CacheCategory catId, CacheItem itemId]
Edit'AddPro itemId _ _ ->
[CacheItemTraits itemId]
Edit'AddCon itemId _ _ ->
[CacheItemTraits itemId]
Edit'SetCategoryTitle catId _ _ ->
[CacheCategoryInfo catId]
Edit'SetCategoryGroup catId _ _ ->
[CacheCategoryInfo catId]
Edit'SetCategoryStatus catId _ _ ->
[CacheCategoryInfo catId]
Edit'SetCategoryProsConsEnabled catId _ _ ->
[CacheCategoryInfo catId]
Edit'SetCategoryEcosystemEnabled catId _ _ ->
[CacheCategoryInfo catId]
Edit'SetCategoryNotes catId _ _ ->
[CacheCategoryNotes catId]
Edit'SetItemName itemId _ _ ->
[CacheItemInfo itemId]
Edit'SetItemLink itemId _ _ ->
[CacheItemInfo itemId]
Edit'SetItemGroup itemId _ _ ->
[CacheItemInfo itemId]
Edit'SetItemKind itemId _ _ ->
[CacheItemInfo itemId]
Edit'SetItemDescription itemId _ _ ->
[CacheItemDescription itemId]
Edit'SetItemNotes itemId _ _ ->
[CacheItemNotes itemId]
Edit'SetItemEcosystem itemId _ _ ->
[CacheItemEcosystem itemId]
Edit'SetTraitContent itemId _ _ _ ->
[CacheItemTraits itemId]
Edit'DeleteCategory catId _ ->
[CacheCategory catId]
Edit'DeleteItem itemId _ ->
[CacheItem itemId]
Edit'DeleteTrait itemId _ _ ->
[CacheItemTraits itemId]
Edit'MoveItem itemId _ ->
[CacheItem itemId]
Edit'MoveTrait itemId _ _ ->
[CacheItemTraits itemId]
-- | Do an action that would undo an edit.
--
@ -250,6 +274,16 @@ 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'SetCategoryNotes catId old new) = do
now <- view (notes.mdText) <$> dbQuery (GetCategory catId)
if now /= new
@ -346,6 +380,8 @@ setMethods = Spock.subcomponent "set" $ do
invalidateCache' (CacheCategoryInfo catId)
title' <- T.strip <$> param' "title"
group' <- T.strip <$> param' "group"
prosConsEnabled' <- (Just ("on" :: Text) ==) <$> param "pros-cons-enabled"
ecosystemEnabled' <- (Just ("on" :: Text) ==) <$> param "ecosystem-enabled"
status' <- do
statusName :: Text <- param' "status"
return $ case statusName of
@ -364,6 +400,10 @@ 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
-- After all these edits we can render the category header
category <- dbQuery (GetCategory catId)
lucidIO $ renderCategoryInfo category
@ -606,7 +646,7 @@ itemToFeedEntry baseUrl category item =
entryLink = baseUrl </>
T.unpack (format "{}#item-{}"
(categorySlug category, item^.uid))
entryContent = Lucid.renderText (renderItemForFeed item)
entryContent = Lucid.renderText (renderItemForFeed category item)
entryBase = Atom.nullEntry
(T.unpack (uidToText (item^.uid)))
(Atom.TextString (T.unpack (item^.name)))

View File

@ -36,6 +36,8 @@ module Types
Category(..),
title,
status,
prosConsEnabled,
ecosystemEnabled,
groups,
items,
itemsDeleted,
@ -90,6 +92,8 @@ module Types
SetCategoryGroup(..),
SetCategoryNotes(..),
SetCategoryStatus(..),
SetCategoryProsConsEnabled(..),
SetCategoryEcosystemEnabled(..),
-- *** 'Item'
SetItemName(..),
SetItemLink(..),
@ -406,16 +410,30 @@ instance Migrate CategoryStatus where
data Category = Category {
_categoryUid :: Uid Category,
_categoryTitle :: Text,
-- | 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,
_categoryCreated :: UTCTime,
_categoryStatus :: CategoryStatus,
_categoryNotes :: MarkdownBlock,
-- | All groups of items belonging to the category, as well as their
-- colors. We could assign colors to items when we render the category
-- (something like “if haven't seen this group yet, assign a new color to
-- it and render it with this color”, but this way is easier and also
-- allows us to keep the colors of all other groups the same when one item
-- has been deleted.
_categoryGroups :: Map Text Hue,
_categoryItems :: [Item],
_categoryItemsDeleted :: [Item] }
deriving (Show)
deriveSafeCopySimple 6 'extension ''Category
deriveSafeCopySimple 7 'extension ''Category
makeFields ''Category
categorySlug :: Category -> Text
@ -425,32 +443,35 @@ 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_v5 = Category_v5 {
_categoryUid_v5 :: Uid Category,
_categoryTitle_v5 :: Text,
_categoryGroup_v5 :: Text,
_categoryCreated_v5 :: UTCTime,
-- _categoryStatus_v5 :: CategoryStatus,
_categoryNotes_v5 :: MarkdownBlock,
_categoryGroups_v5 :: Map Text Hue,
_categoryItems_v5 :: [Item],
_categoryItemsDeleted_v5 :: [Item] }
data Category_v6 = Category_v6 {
_categoryUid_v6 :: Uid Category,
_categoryTitle_v6 :: Text,
_categoryGroup_v6 :: Text,
_categoryCreated_v6 :: UTCTime,
_categoryStatus_v6 :: CategoryStatus,
_categoryNotes_v6 :: MarkdownBlock,
_categoryGroups_v6 :: Map Text Hue,
_categoryItems_v6 :: [Item],
_categoryItemsDeleted_v6 :: [Item] }
deriveSafeCopySimple 5 'base ''Category_v5
deriveSafeCopySimple 6 'base ''Category_v6
instance Migrate Category where
type MigrateFrom Category = Category_v5
migrate Category_v5{..} = Category {
_categoryUid = _categoryUid_v5,
_categoryTitle = _categoryTitle_v5,
_categoryGroup_ = _categoryGroup_v5,
_categoryCreated = _categoryCreated_v5,
-- _categoryStatus = _categoryStatus_v5,
_categoryStatus = CategoryFinished,
_categoryNotes = _categoryNotes_v5,
_categoryGroups = _categoryGroups_v5,
_categoryItems = _categoryItems_v5,
_categoryItemsDeleted = _categoryItemsDeleted_v5 }
type MigrateFrom Category = Category_v6
migrate Category_v6{..} = Category {
_categoryUid = _categoryUid_v6,
_categoryTitle = _categoryTitle_v6,
_categoryGroup_ = _categoryGroup_v6,
-- _categoryProsConsEnabled = _categoryProsConsEnabled_v6,
_categoryProsConsEnabled = True,
-- _categoryEcosystemEnabled = _categoryEcosystemEnabled_v6,
_categoryEcosystemEnabled = True,
_categoryCreated = _categoryCreated_v6,
_categoryStatus = _categoryStatus_v6,
_categoryNotes = _categoryNotes_v6,
_categoryGroups = _categoryGroups_v6,
_categoryItems = _categoryItems_v6,
_categoryItemsDeleted = _categoryItemsDeleted_v6 }
-- Edits
@ -490,6 +511,14 @@ 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 }
-- Change item properties
| Edit'SetItemName {
@ -551,9 +580,9 @@ data Edit
deriving (Eq, Show)
deriveSafeCopySimple 4 'extension ''Edit
deriveSafeCopySimple 5 'extension ''Edit
genVer ''Edit 3 [
genVer ''Edit 4 [
-- Add
Copy 'Edit'AddCategory,
Copy 'Edit'AddItem,
@ -563,7 +592,9 @@ genVer ''Edit 3 [
Copy 'Edit'SetCategoryTitle,
Copy 'Edit'SetCategoryGroup,
Copy 'Edit'SetCategoryNotes,
-- Copy 'Edit'SetCategoryStatus,
Copy 'Edit'SetCategoryStatus,
-- Copy 'Edit'SetCategoryProsConsEnabled,
-- Copy 'Edit'SetCategoryEcosystemEnabled,
-- Change item properties
Copy 'Edit'SetItemName,
Copy 'Edit'SetItemLink,
@ -582,11 +613,11 @@ genVer ''Edit 3 [
Copy 'Edit'MoveItem,
Copy 'Edit'MoveTrait ]
deriveSafeCopySimple 3 'base ''Edit_v3
deriveSafeCopySimple 4 'base ''Edit_v4
instance Migrate Edit where
type MigrateFrom Edit = Edit_v3
migrate = $(migrateVer ''Edit 3 [
type MigrateFrom Edit = Edit_v4
migrate = $(migrateVer ''Edit 4 [
CopyM 'Edit'AddCategory,
CopyM 'Edit'AddItem,
CopyM 'Edit'AddPro,
@ -595,7 +626,9 @@ instance Migrate Edit where
CopyM 'Edit'SetCategoryTitle,
CopyM 'Edit'SetCategoryGroup,
CopyM 'Edit'SetCategoryNotes,
-- CopyM 'Edit'SetCategoryStatus,
CopyM 'Edit'SetCategoryStatus,
-- CopyM 'Edit'SetCategoryProsConsEnabled
-- CopyM 'Edit'SetCategoryEcosystemEnabled
-- Change item properties
CopyM 'Edit'SetItemName,
CopyM 'Edit'SetItemLink,
@ -626,6 +659,10 @@ isVacuousEdit Edit'SetCategoryNotes{..} =
editCategoryNotes == editCategoryNewNotes
isVacuousEdit Edit'SetCategoryStatus{..} =
editCategoryStatus == editCategoryNewStatus
isVacuousEdit Edit'SetCategoryProsConsEnabled {..} =
editCategoryProsConsEnabled == editCategoryNewProsConsEnabled
isVacuousEdit Edit'SetCategoryEcosystemEnabled {..} =
editCategoryEcosystemEnabled == editCategoryNewEcosystemEnabled
isVacuousEdit Edit'SetItemName{..} =
editItemName == editItemNewName
isVacuousEdit Edit'SetItemLink{..} =
@ -807,6 +844,8 @@ addCategory catId title' created' = do
_categoryUid = catId,
_categoryTitle = title',
_categoryGroup_ = "Miscellaneous",
_categoryProsConsEnabled = True,
_categoryEcosystemEnabled = True,
_categoryCreated = created',
_categoryStatus = CategoryStub,
_categoryNotes = renderMarkdownBlock "",
@ -900,6 +939,20 @@ 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)
setItemName :: Uid Item -> Text -> Acid.Update GlobalState (Edit, Item)
setItemName itemId name' = do
oldName <- itemById itemId . name <<.= name'
@ -1234,6 +1287,7 @@ makeAcidic ''GlobalState [
-- set
'setGlobalState,
'setCategoryTitle, 'setCategoryGroup, 'setCategoryNotes, 'setCategoryStatus,
'setCategoryProsConsEnabled, 'setCategoryEcosystemEnabled,
'setItemName, 'setItemLink, 'setItemGroup, 'setItemKind,
'setItemDescription, 'setItemNotes, 'setItemEcosystem,
'setTraitContent,

View File

@ -396,6 +396,14 @@ renderEdit globalState edit = do
table_ $ tr_ $ do
td_ $ blockquote_ $ toHtml (renderMarkdownBlock oldNotes)
td_ $ blockquote_ $ toHtml (renderMarkdownBlock 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
-- Change item properties
Edit'SetItemName _itemId oldName newName -> p_ $ do
@ -683,7 +691,7 @@ renderCategoryInfo category = cached (CacheCategoryInfo (category^.uid)) $ do
br_ []
label_ $ do
"Status" >> br_ []
select_ [name_ "status"] $ do
select_ [name_ "status", autocomplete_ "off"] $ do
option_ [value_ "finished"] "Complete"
& selectedIf (category^.status == CategoryFinished)
option_ [value_ "mostly-done"] "Mostly done/usable"
@ -693,6 +701,18 @@ renderCategoryInfo category = cached (CacheCategoryInfo (category^.uid)) $ do
option_ [value_ "stub"] "Stub"
& selectedIf (category^.status == CategoryStub)
br_ []
label_ $ do
input_ [type_ "checkbox", name_ "pros-cons-enabled",
autocomplete_ "off"]
& checkedIf (category^.prosConsEnabled)
"Pros/cons enabled"
br_ []
label_ $ do
input_ [type_ "checkbox", name_ "ecosystem-enabled",
autocomplete_ "off"]
& checkedIf (category^.ecosystemEnabled)
"“Ecosystem” field enabled"
br_ []
input_ [type_ "submit", value_ "Save"]
button "Cancel" [] $
JS.switchSection (this, "normal" :: Text)
@ -741,6 +761,16 @@ getItemHue category item = case item^.group_ of
Nothing -> NoHue
Just s -> M.findWithDefault NoHue s (category^.groups)
{- Note [enabled sections]
~~~~~~~~~~~~~~~~~~~~~~~~~~
Categories have flags that enable/disable showing some sections of the items (currently pros/cons and ecosystem); this is done because for some items (like books, or people) ecosystem might not make any sense, and pros/cons don't make sense for categories that contain diverse items.
When we change those flags (by editing category info), we want to update the way items are shown (without reloading the page). So, if the show ecosystem flag has been set and we unset it, we want to hide the ecosystem section in all items belonging to the category. This happens in 'JS.submitCategoryInfo'.
If the category has showing pros/cons (or ecosystem, or both) disabled, we have to render traits and ecosystem as hidden (we can't just not render them at all, because then we wouldn't be able to un-hide them). How could we do it? If we do it in 'renderItemTraits' or 'renderItemEcosystem', this would mean that cached versions of traits/ecosystem would have to be rerendered whenever prosConsEnabled/ecosystemEnabled is changed. So, instead we do a somewhat inelegant thing: we wrap traits/ecosystem into yet another <div>, and set display:none on it. 'JS.submitCategoryInfo' operates on those <div>s.
-}
-- TODO: perhaps use jQuery Touch Punch or something to allow dragging items
-- instead of using arrows? Touch Punch works on mobile, too
renderItem :: (MonadIO m, MonadRandom m) => Category -> Item -> HtmlT m ()
@ -750,9 +780,14 @@ renderItem category item = cached (CacheItem (item^.uid)) $ do
renderItemInfo category item
let bg = hueToLightColor $ getItemHue category item
div_ [class_ "item-body", style_ ("background-color:" <> bg)] $ do
-- See Note [enabled sections]
renderItemDescription item
renderItemTraits item
renderItemEcosystem item
hiddenIf (not (category^.prosConsEnabled)) $
div_ [class_ "pros-cons-wrapper"] $
renderItemTraits item
hiddenIf (not (category^.ecosystemEnabled)) $
div_ [class_ "ecosystem-wrapper"] $
renderItemEcosystem item
renderItemNotes category item
-- TODO: warn when a library isn't on Hackage but is supposed to be
@ -814,7 +849,7 @@ renderItemInfo cat item = cached (CacheItemInfo (item^.uid)) $ do
br_ []
label_ $ do
"Kind" >> br_ []
select_ [name_ "kind"] $ do
select_ [name_ "kind", autocomplete_ "off"] $ do
option_ [value_ "library"] "Library"
& selectedIf (case item^.kind of Library{} -> True; _ -> False)
option_ [value_ "tool"] "Tool"
@ -1109,18 +1144,20 @@ renderItemNotes category item = cached (CacheItemNotes (item^.uid)) $ do
-- TODO: a shortcut for editing (when you press Ctrl-something, whatever was
-- selected becomes editable)
renderItemForFeed :: Monad m => Item -> HtmlT m ()
renderItemForFeed item = do
renderItemForFeed :: Monad m => Category -> Item -> HtmlT m ()
renderItemForFeed category item = do
h1_ $ renderItemTitle item
unless (markdownNull (item^.description)) $
toHtml (item^.description)
h2_ "Pros"
ul_ $ mapM_ (p_ . li_ . toHtml . view content) (item^.pros)
h2_ "Cons"
ul_ $ mapM_ (p_ . li_ . toHtml . view content) (item^.cons)
unless (markdownNull (item^.ecosystem)) $ do
h2_ "Ecosystem"
toHtml (item^.ecosystem)
when (category^.prosConsEnabled) $ 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
unless (markdownNull (item^.ecosystem)) $ do
h2_ "Ecosystem"
toHtml (item^.ecosystem)
-- TODO: include .notes-like style here? otherwise the headers are too big
unless (markdownNull (item^.notes)) $ do
h2_ "Notes"
@ -1182,6 +1219,12 @@ mkLink x src = a_ [href_ src] x
selectedIf :: With w => Bool -> w -> w
selectedIf p x = if p then with x [selected_ "selected"] else x
checkedIf :: With w => Bool -> w -> w
checkedIf p x = if p then with x [checked_] else x
hiddenIf :: With w => Bool -> w -> w
hiddenIf p x = if p then with x [style_ "display:none;"] else x
markdownEditor
:: MonadRandom m
=> [Attribute]