aelve/guide
1
1
Fork 0
mirror of https://github.com/aelve/guide.git synced 2024-12-23 12:52:31 +03:00
Code Issues Projects Releases Wiki Activity

Merge category{ProsCons|Ecosystem|Notes}Enabled fields

Browse Source 
Changing 'Edit' is annoying, so maybe now we'll have to do it less often
This commit is contained in:
Artyom 2017-02-18 13:52:23 +03:00
parent d94a2ccc99
commit 9511810b3d
No known key found for this signature in database
GPG Key ID: B8E35A33FF522710
10 changed files with 138 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/Guide/Handlers.hs
View File

@ -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)

26
src/Guide/ServerStuff.hs
View File

@ -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]

43
src/Guide/State.hs
View File

@ -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,

48
src/Guide/Types/Core.hs
View File

@ -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

71
src/Guide/Types/Edit.hs
View File

@ -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,
editCategoryNewProsConsEnabled :: Bool }
| Edit'SetCategoryEcosystemEnabled {
editCategoryUid :: Uid Category,
editCategoryEcosystemEnabled :: Bool,
editCategoryNewEcosystemEnabled :: Bool }
| Edit'SetCategoryNotesEnabled {
editCategoryUid :: Uid Category,
editCategoryNotesEnabled :: Bool,
editCategoryNewNotesEnabled :: Bool }
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{..} =

10
src/Guide/Utils.hs
View File

@ -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 ->

25
src/Guide/Views.hs
View File

@ -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

6
src/Guide/Views/Category.hs
View File

@ -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"]

10
src/Guide/Views/Item.hs
View File

@ -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)

3
src/Imports.hs
View File

@ -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