From 41c3523323867b8f4effad0d0a0edbfd09f672f1 Mon Sep 17 00:00:00 2001 From: Artyom Kazak Date: Fri, 26 Jul 2019 20:00:22 +0300 Subject: [PATCH] Remove item groups (#347) --- back/guide.cabal | 2 +- back/src/Guide/Api/Methods.hs | 3 - back/src/Guide/Api/Types.hs | 13 ---- back/src/Guide/Database/Get.hs | 5 +- back/src/Guide/Database/Schema.hs | 1 - back/src/Guide/Handlers.hs | 18 ----- back/src/Guide/ServerStuff.hs | 7 +- back/src/Guide/State.hs | 56 +--------------- back/src/Guide/Types/Core.hs | 29 ++++---- back/src/Guide/Types/Edit.hs | 2 +- back/src/Guide/Types/Hue.hs | 42 ++---------- back/src/Guide/Views/Item.hs | 26 +------- back/templates/item-info.widget | 84 +----------------------- back/tests/ApiSpec.hs | 1 - back/tests/WebSpec.hs | 78 ---------------------- front/client/components/CategoryItem.vue | 2 - front/client/service/CategoryItem.ts | 1 - stack.yaml | 1 + 18 files changed, 32 insertions(+), 339 deletions(-) diff --git a/back/guide.cabal b/back/guide.cabal index afaf2c8..cbe666e 100644 --- a/back/guide.cabal +++ b/back/guide.cabal @@ -249,7 +249,7 @@ test-suite tests , text , temporary , transformers - , webdriver >= 0.8.4 && < 0.9 + , webdriver , yaml hs-source-dirs: tests default-language: Haskell2010 diff --git a/back/src/Guide/Api/Methods.hs b/back/src/Guide/Api/Methods.hs index 9772043..54b3478 100644 --- a/back/src/Guide/Api/Methods.hs +++ b/back/src/Guide/Api/Methods.hs @@ -117,7 +117,6 @@ createItem catId CCreateItem{..} = itemId <- randomShortUid time <- liftIO getCurrentTime addEdit . fst =<< dbUpdate (AddItem catId itemId cciName time) - addEdit . fst =<< dbUpdate (SetItemGroup itemId cciGroup) addEdit . fst =<< dbUpdate (SetItemHackage itemId cciHackage) addEdit . fst =<< dbUpdate (SetItemLink itemId cciLink) pure itemId @@ -130,8 +129,6 @@ setItemInfo itemId CItemInfoEdit{..} = -- TODO diff and merge whenJust ciieName $ \ciieName' -> addEdit . fst =<< dbUpdate (SetItemName itemId ciieName') - whenJust ciieGroup $ \ciieGroup' -> - addEdit . fst =<< dbUpdate (SetItemGroup itemId ciieGroup') whenJust ciieHackage $ \ciieHackage' -> addEdit . fst =<< dbUpdate (SetItemHackage itemId ciieHackage') whenJust ciieLink $ \ciieLink' -> do diff --git a/back/src/Guide/Api/Types.hs b/back/src/Guide/Api/Types.hs index 39d51e0..263ae0c 100644 --- a/back/src/Guide/Api/Types.hs +++ b/back/src/Guide/Api/Types.hs @@ -364,7 +364,6 @@ instance A.FromJSON CDirection where -- | Client type to create new item. data CCreateItem = CCreateItem { cciName :: Text - , cciGroup :: Maybe Text , cciHackage :: Maybe Text , cciLink :: Maybe Url } deriving (Show, Generic) @@ -381,7 +380,6 @@ instance ToSchema CCreateItem where pure $ schema_ &~ do zoom (S.schema . properties) $ do field "name" . inlineSchema . description ?= "Item name" - field "group" . inlineSchema . description ?= "Item group" field "hackage" . inlineSchema . description ?= "Package name on Hackage" field "link" . inlineSchema . description ?= "Link to the official site, if exists" @@ -552,7 +550,6 @@ data CItemInfo = CItemInfo { ciiId :: Uid Item , ciiCreated :: UTCTime , ciiName :: Text - , ciiGroup :: Maybe Text , ciiHackage :: Maybe Text , ciiLink :: Maybe Url } deriving (Show, Generic) @@ -568,7 +565,6 @@ instance ToSchema CItemInfo where field "created" .= Inline (toSchema (Proxy @UTCTime)) field "created" . inlineSchema . description ?= "When the item was created" field "name" . inlineSchema . description ?= "Item name" - field "group" . inlineSchema . description ?= "Item group" field "hackage" . inlineSchema . description ?= "Package name on Hackage" field "link" . inlineSchema . description ?= "Link to the official site, if exists" @@ -579,7 +575,6 @@ toCItemInfo Item{..} = CItemInfo { ciiId = _itemUid , ciiCreated = _itemCreated , ciiName = _itemName - , ciiGroup = _itemGroup_ , ciiHackage = _itemHackage , ciiLink = _itemLink } @@ -592,7 +587,6 @@ toCItemInfo Item{..} = CItemInfo -- left untouched; @Just Nothing@ means that the field should be erased. data CItemInfoEdit = CItemInfoEdit { ciieName :: Maybe Text - , ciieGroup :: Maybe (Maybe Text) , ciieHackage :: Maybe (Maybe Text) , ciieLink :: Maybe (Maybe Url) } deriving (Show, Generic) @@ -601,7 +595,6 @@ data CItemInfoEdit = CItemInfoEdit instance A.ToJSON CItemInfoEdit where toJSON ciie = A.object $ catMaybes [ ("name" A..=) <$> ciieName ciie - , ("group" A..=) <$> ciieGroup ciie , ("hackage" A..=) <$> ciieHackage ciie , ("link" A..=) <$> ciieLink ciie ] @@ -609,12 +602,10 @@ instance A.ToJSON CItemInfoEdit where instance A.FromJSON CItemInfoEdit where parseJSON = A.withObject "CItemInfoEdit" $ \o -> do ciieName' <- o A..:! "name" - ciieGroup' <- o A..:! "group" ciieHackage' <- o A..:! "hackage" ciieLink' <- o A..:! "link" return CItemInfoEdit { ciieName = ciieName' - , ciieGroup = ciieGroup' , ciieHackage = ciieHackage' , ciieLink = ciieLink' } @@ -625,7 +616,6 @@ instance ToSchema CItemInfoEdit where pure $ schema_ &~ do zoom (S.schema . properties) $ do field "name" . inlineSchema . description ?= "Item name" - field "group" . inlineSchema . description ?= "Item group" field "hackage" . inlineSchema . description ?= "Package name on Hackage" field "link" . inlineSchema . description ?= "Link to the official site, if exists" @@ -639,7 +629,6 @@ data CItemFull = CItemFull { cifId :: Uid Item , cifName :: Text , cifCreated :: UTCTime - , cifGroup :: Maybe Text , cifHackage :: Maybe Text , cifSummary :: CMarkdown , cifPros :: [CTrait] @@ -664,7 +653,6 @@ instance ToSchema CItemFull where field "name" . inlineSchema . description ?= "Item name" field "created" .= Inline (toSchema (Proxy @UTCTime)) field "created" . inlineSchema . description ?= "When the item was created" - field "group" . inlineSchema . description ?= "Item group" field "hackage" . inlineSchema . description ?= "Package name on Hackage" field "pros" . inlineSchema . description ?= "Pros (positive traits)" field "cons" . inlineSchema . description ?= "Cons (negative traits)" @@ -678,7 +666,6 @@ toCItemFull Item{..} = CItemFull { cifId = _itemUid , cifName = _itemName , cifCreated = _itemCreated - , cifGroup = _itemGroup_ , cifHackage = _itemHackage , cifSummary = toCMarkdown _itemSummary , cifPros = fmap toCTrait _itemPros diff --git a/back/src/Guide/Database/Get.hs b/back/src/Guide/Database/Get.hs index 3c34cf5..31be691 100644 --- a/back/src/Guide/Database/Get.hs +++ b/back/src/Guide/Database/Get.hs @@ -34,7 +34,6 @@ import Hasql.Transaction.Sessions (Mode(Read)) import Named import Text.RawString.QQ (r) -import qualified Data.Map as Map import qualified Hasql.Decoders as HD import qualified Hasql.Encoders as HE import qualified Hasql.Transaction as HT @@ -139,7 +138,7 @@ getItemMaybe itemId = do _itemConsDeleted <- getTraitsByItem itemId (#deleted True) (#traitType Con) let prefix = "item-notes-" <> uidToText itemId <> "-" let sql = [r| - SELECT uid, name, created, group_, link, hackage, summary, ecosystem, notes + SELECT uid, name, created, link, hackage, summary, ecosystem, notes FROM items WHERE uid = $1 |] @@ -148,7 +147,6 @@ getItemMaybe itemId = do _itemUid <- uidColumn _itemName <- textColumn _itemCreated <- timestamptzColumn - _itemGroup_ <- textColumnNullable _itemLink <- textColumnNullable _itemHackage <- textColumnNullable _itemSummary <- toMarkdownBlock <$> textColumn @@ -216,7 +214,6 @@ getCategoryMaybe catId = do _categoryStatus <- categoryStatusColumn _categoryNotes <- toMarkdownBlock <$> textColumn _categoryEnabledSections <- itemSectionSetColumn - let _categoryGroups = Map.empty -- TODO fix pure $ Category{..} lift $ HT.statement catId (Statement sql encoder decoder False) diff --git a/back/src/Guide/Database/Schema.hs b/back/src/Guide/Database/Schema.hs index ba102cb..a364293 100644 --- a/back/src/Guide/Database/Schema.hs +++ b/back/src/Guide/Database/Schema.hs @@ -130,7 +130,6 @@ v0_createTableItems = HS.sql [r| uid text PRIMARY KEY, -- Unique item ID name text NOT NULL, -- Item title created timestamptz NOT NULL, -- When the item was created - group_ text, -- Optional group link text, -- Optional URL hackage text, -- Package name on Hackage summary text NOT NULL, -- Item summary as Markdown diff --git a/back/src/Guide/Handlers.hs b/back/src/Guide/Handlers.hs index ca5cdc7..e4b1439 100644 --- a/back/src/Guide/Handlers.hs +++ b/back/src/Guide/Handlers.hs @@ -52,13 +52,6 @@ renderMethods = do Spock.get (renderRoute categoryVar "notes") $ \catId -> do category <- dbQuery (GetCategory catId) lucidIO $ renderCategoryNotes category - -- Item colors - Spock.get (renderRoute itemVar "colors") $ \itemId -> do - item <- dbQuery (GetItem itemId) - category <- dbQuery (GetCategoryByItem itemId) - let hue = getItemHue category item - json $ M.fromList [("light" :: Text, hueToLightColor hue), - ("dark" :: Text, hueToDarkColor hue)] -- Item info Spock.get (renderRoute itemVar "info") $ \itemId -> do item <- dbQuery (GetItem itemId) @@ -144,16 +137,8 @@ setMethods = do link' <- T.strip <$> param' "link" hackage' <- (\x -> if T.null x then Nothing else Just x) . T.strip <$> param' "hackage" - group' <- do - groupField <- param' "group" - customGroupField <- param' "custom-group" - return $ case groupField of - "-" -> Nothing - "" -> Just customGroupField - _ -> Just groupField -- Modify the item -- TODO: actually validate the form and report errors - -- (don't forget to check that custom-group ≠ "") unless (T.null name') $ do (edit, _) <- dbUpdate (SetItemName itemId name') addEdit edit @@ -168,9 +153,6 @@ setMethods = do return () do (edit, _) <- dbUpdate (SetItemHackage itemId hackage') addEdit edit - -- This does all the work of assigning new colors, etc. automatically - do (edit, _) <- dbUpdate (SetItemGroup itemId group') - addEdit edit -- After all these edits we can render the item item <- dbQuery (GetItem itemId) category <- dbQuery (GetCategoryByItem itemId) diff --git a/back/src/Guide/ServerStuff.hs b/back/src/Guide/ServerStuff.hs index a526efd..47fb90a 100644 --- a/back/src/Guide/ServerStuff.hs +++ b/back/src/Guide/ServerStuff.hs @@ -142,11 +142,8 @@ undoEdit (Edit'SetItemLink itemId old new) = do if now /= new then return (Left "link has been changed further") else Right () <$ dbUpdate (SetItemLink itemId old) -undoEdit (Edit'SetItemGroup itemId old new) = do - now <- view group_ <$> dbQuery (GetItem itemId) - if now /= new - then return (Left "group has been changed further") - else Right () <$ dbUpdate (SetItemGroup itemId old) +undoEdit (Edit'SetItemGroup _ _ _) = do + return (Left "groups are not supported anymore") undoEdit (Edit'SetItemHackage itemId old new) = do now <- view hackage <$> dbQuery (GetItem itemId) if now /= new diff --git a/back/src/Guide/State.hs b/back/src/Guide/State.hs index 19caf4c..0f88591 100644 --- a/back/src/Guide/State.hs +++ b/back/src/Guide/State.hs @@ -52,7 +52,6 @@ module Guide.State -- *** 'Item' SetItemName(..), SetItemLink(..), - SetItemGroup(..), SetItemHackage(..), SetItemSummary(..), SetItemNotes(..), @@ -220,13 +219,6 @@ changelog ''GlobalState (Past 8, Past 7) [ ] deriveSafeCopySorted 7 'base ''GlobalState_v7 -addGroupIfDoesNotExist :: Text -> Map Text Hue -> Map Text Hue -addGroupIfDoesNotExist g gs - | M.member g gs = gs - | otherwise = M.insert g firstNotTaken gs - where - firstNotTaken = head $ map Hue [1..] \\ M.elems gs - traitById :: Uid Trait -> Lens' Item Trait traitById traitId = singular $ maybeTraitById traitId `failing` @@ -360,7 +352,6 @@ addCategory catId title' group' created' = do _categoryCreated = created', _categoryStatus = CategoryStub, _categoryNotes = toMarkdownBlock "", - _categoryGroups = mempty, _categoryItems = [], _categoryItemsDeleted = [] } categories %= (newCategory :) @@ -378,7 +369,6 @@ addItem catId itemId name' created' = do _itemUid = itemId, _itemName = name', _itemCreated = created', - _itemGroup_ = Nothing, _itemHackage = Nothing, _itemSummary = toMarkdownBlock "", _itemPros = [], @@ -472,39 +462,6 @@ setItemLink itemId link' = do let edit = Edit'SetItemLink itemId oldLink link' (edit,) <$> use (itemById itemId) --- Also updates the list of groups in the category -setItemGroup :: Uid Item -> Maybe Text -> Acid.Update GlobalState (Edit, Item) -setItemGroup itemId newGroup = do - catId <- view uid . findCategoryByItem itemId <$> get - let categoryLens :: Lens' GlobalState Category - categoryLens = categoryById catId - let itemLens :: Lens' GlobalState Item - itemLens = itemById itemId - -- If the group is new, add it to the list of groups in the category (which - -- causes a new hue to be generated, too) - case newGroup of - Nothing -> return () - Just x -> categoryLens.groups %= addGroupIfDoesNotExist x - -- Update list of groups if the group is going to be empty after the item - -- is moved to a different group. Note that this is done after adding a new - -- group because we also want the color to change. So, if the item was the - -- only item in its group, the sequence of actions is as follows: - -- - -- * new group is added (and hence a new color is assigned) - -- * old group is deleted (and now the old color is unused) - oldGroup <- use (itemLens.group_) - case oldGroup of - Nothing -> return () - Just g -> when (oldGroup /= newGroup) $ do - allItems <- use (categoryLens.items) - let inOurGroup item = item^.group_ == Just g - when (length (filter inOurGroup allItems) == 1) $ - categoryLens.groups %= M.delete g - -- Now we can actually change the group - itemLens.group_ .= newGroup - let edit = Edit'SetItemGroup itemId oldGroup newGroup - (edit,) <$> use itemLens - setItemHackage :: Uid Item -> Maybe Text -> Acid.Update GlobalState (Edit, Item) setItemHackage itemId hackage' = do oldName <- itemById itemId . hackage <<.= hackage' @@ -571,16 +528,6 @@ deleteItem itemId = do Nothing -> return (Left "item not found") Just item -> do allItems <- use (categoryLens.items) - -- If the item was the only item in its group, delete the group (and - -- make the hue available for new items) - case item^.group_ of - Nothing -> return () - Just oldGroup -> do - let itemsInOurGroup = [item' | item' <- allItems, - item'^.group_ == Just oldGroup] - when (length itemsInOurGroup == 1) $ - categoryLens.groups %= M.delete oldGroup - -- And now delete the item (i.e. move it to “deleted”) case findIndex (hasUid itemId) allItems of Nothing -> return (Left "item not found") Just itemPos -> do @@ -865,7 +812,7 @@ makeAcidic ''GlobalState [ 'setGlobalState, 'setCategoryTitle, 'setCategoryGroup, 'setCategoryNotes, 'setCategoryStatus, 'changeCategoryEnabledSections, - 'setItemName, 'setItemLink, 'setItemGroup, 'setItemHackage, 'setItemSummary, 'setItemNotes, 'setItemEcosystem, + 'setItemName, 'setItemLink, 'setItemHackage, 'setItemSummary, 'setItemNotes, 'setItemEcosystem, 'setTraitContent, -- delete 'deleteCategory, @@ -914,7 +861,6 @@ deriving instance Show AddItem deriving instance Show SetItemName deriving instance Show SetItemNotes deriving instance Show SetItemLink -deriving instance Show SetItemGroup deriving instance Show SetItemEcosystem deriving instance Show SetItemHackage deriving instance Show SetItemSummary diff --git a/back/src/Guide/Types/Core.hs b/back/src/Guide/Types/Core.hs index 0d0c813..2c743c0 100644 --- a/back/src/Guide/Types/Core.hs +++ b/back/src/Guide/Types/Core.hs @@ -32,15 +32,12 @@ module Guide.Types.Core ecosystem, hackage, link, - Hue(..), - hueToDarkColor, - hueToLightColor, CategoryStatus(..), Category(..), title, + group_, status, enabledSections, - groups, items, itemsDeleted, categorySlug, @@ -53,7 +50,6 @@ module Guide.Types.Core summary, notes, created, - group_, ) where @@ -182,7 +178,6 @@ data Item = Item { _itemUid :: Uid Item, -- ^ Item ID _itemName :: Text, -- ^ Item title _itemCreated :: UTCTime, -- ^ When the item was created - _itemGroup_ :: Maybe Text, -- ^ Item group (affects item's color) _itemHackage :: Maybe Text, -- ^ Package name on Hackage _itemSummary :: MarkdownBlock, -- ^ Item summary _itemPros :: [Trait], -- ^ Pros (positive traits) @@ -196,10 +191,14 @@ data Item = Item { } deriving (Show, Generic, Data) -deriveSafeCopySorted 12 'extension ''Item +deriveSafeCopySorted 13 'extension ''Item makeFields ''Item -changelog ''Item (Current 12, Past 11) +changelog ''Item (Current 13, Past 12) + [Removed "_itemGroup_" [t|Maybe Text|] ] +deriveSafeCopySorted 12 'extension ''Item_v12 + +changelog ''Item (Past 12, Past 11) [Removed "_itemKind" [t|ItemKind|], Added "_itemHackage" [hs| case _itemKind of @@ -269,18 +268,18 @@ data Category = Category { _categoryItemsDeleted :: [Item], -- | Enabled sections in this category. E.g, if this set contains -- 'ItemNotesSection', then notes will be shown for each item - _categoryEnabledSections :: Set ItemSection, - -- | All groups of items belonging to the category, as well as their - -- colors. Storing colors explicitly lets us keep colors consistent when - -- all items in a group are deleted - _categoryGroups :: Map Text Hue + _categoryEnabledSections :: Set ItemSection } deriving (Show, Generic, Data) -deriveSafeCopySorted 11 'extension ''Category +deriveSafeCopySorted 12 'extension ''Category makeFields ''Category -changelog ''Category (Current 11, Past 10) +changelog ''Category (Current 12, Past 11) + [Removed "_categoryGroups" [t|Map Text Hue|] ] +deriveSafeCopySorted 11 'extension ''Category_v11 + +changelog ''Category (Past 11, Past 10) [Removed "_categoryProsConsEnabled" [t|Bool|], Removed "_categoryEcosystemEnabled" [t|Bool|], Removed "_categoryNotesEnabled" [t|Bool|], diff --git a/back/src/Guide/Types/Edit.hs b/back/src/Guide/Types/Edit.hs index 2e02a64..f24525b 100644 --- a/back/src/Guide/Types/Edit.hs +++ b/back/src/Guide/Types/Edit.hs @@ -79,7 +79,7 @@ data Edit editItemUid :: Uid Item, editItemLink :: Maybe Url, editItemNewLink :: Maybe Url } - | Edit'SetItemGroup { + | Edit'SetItemGroup { -- TODO: remove after migration to Postgres editItemUid :: Uid Item, editItemGroup :: Maybe Text, editItemNewGroup :: Maybe Text } diff --git a/back/src/Guide/Types/Hue.hs b/back/src/Guide/Types/Hue.hs index c6586ac..b2a0d13 100644 --- a/back/src/Guide/Types/Hue.hs +++ b/back/src/Guide/Types/Hue.hs @@ -4,13 +4,15 @@ {-# LANGUAGE TypeFamilies #-} --- | Items can have different colors; this module provides type 'Hue' and a --- palette for turning hues into actual colors. +-- | Deprecated as of 2019-07-25. +-- +-- TODO: remove after we have migrated from acid-state. +-- +-- Items could have different colors; this module provides type 'Hue' and +-- used to provide a palette for turning hues into actual colors. module Guide.Types.Hue ( Hue(..), - hueToDarkColor, - hueToLightColor, ) where @@ -43,35 +45,3 @@ instance Migrate Hue where instance Show Hue where show NoHue = "0" show (Hue n) = show n - --- Colors taken from: --- -hueToDarkColor :: Hue -> Text -hueToDarkColor NoHue = "#D6D6D6" -- the color for gray isn't from Google's - -- palette, since their “100” is too light -hueToDarkColor (Hue i) = table !! ((i-1) `mod` length table) - where - -- the “100” colors - table = ["#D1C4E9", -- deep purple - "#C8E6C9", -- green - "#FFECB3", -- amber - "#BBDEFB", -- blue - "#FFCDD2", -- red - "#D7CCC8", -- brown - "#B2DFDB", -- teal - "#F0F4C3"] -- lime - -hueToLightColor :: Hue -> Text -hueToLightColor NoHue = "#F0F0F0" -- the color for gray isn't from Google's - -- palette, since their “50” is too light -hueToLightColor (Hue i) = table !! ((i-1) `mod` length table) - where - -- the “50” colors - table = ["#EDE7F6", -- deep purple - "#E8F5E9", -- green - "#FFF8E1", -- amber - "#E3F2FD", -- blue - "#FFEBEE", -- red - "#EFEBE9", -- brown - "#E0F2F1", -- teal - "#F9FBE7"] -- lime diff --git a/back/src/Guide/Views/Item.hs b/back/src/Guide/Views/Item.hs index 6a96bfb..0c247b2 100644 --- a/back/src/Guide/Views/Item.hs +++ b/back/src/Guide/Views/Item.hs @@ -20,7 +20,6 @@ module Guide.Views.Item -- * Helpers that should probably be moved somewhere renderTrait, - getItemHue, ) where @@ -39,7 +38,6 @@ import Guide.Utils import Guide.Views.Utils import qualified Data.Aeson as A -import qualified Data.Map as M import qualified Data.Text.IO as T import qualified Guide.JS as JS @@ -57,8 +55,7 @@ renderItem category item = -- The id is used for links in feeds, and for anchor links div_ [id_ (itemNodeId item), class_ "item"] $ do renderItemInfo category item - let bg = hueToLightColor $ getItemHue category item - div_ [class_ "item-body", style_ ("background-color:" <> bg)] $ do + div_ [class_ "item-body", style_ ("background-color:#F0F0F0")] $ do -- See Note [enabled sections] renderItemDescription item hiddenIf (ItemProsConsSection `notElem` category^.enabledSections) $ @@ -104,26 +101,16 @@ renderItemTitle item = "item" A..= item ] -- TODO: warn when a library isn't on Hackage but is supposed to be +-- TODO: give a link to oldest available docs when the new docs aren't there -- | Render item info. --- --- TODO: give a link to oldest available docs when the new docs aren't there renderItemInfo :: (MonadIO m) => Category -> Item -> HtmlT m () renderItemInfo cat item = mustache "item-info" $ A.object [ "category" A..= cat, "item" A..= item, "link_to_item" A..= itemLink cat item, - "hackage" A..= (item^.hackage), - "category_groups" A..= do - gr <- M.keys (cat^.groups) - return $ A.object [ - "name" A..= gr, - "selected" A..= (Just gr == item^.group_) ], - "item_no_group" A..= isNothing (item^.group_), - "item_color" A..= A.object [ - "dark" A..= hueToDarkColor (getItemHue cat item), - "light" A..= hueToLightColor (getItemHue cat item) ] ] + "hackage" A..= (item^.hackage) ] -- | Render item description. renderItemDescription :: MonadIO m => Item -> HtmlT m () @@ -311,10 +298,3 @@ renderItemNotes category item = do section "editing" [uid_ editingSectionUid] $ return () - --- | Decide what color should an item have. (Requires looking at its parent --- category.) -getItemHue :: Category -> Item -> Hue -getItemHue category item = case item^.group_ of - Nothing -> NoHue - Just s -> M.findWithDefault NoHue s (category^.groups) diff --git a/back/templates/item-info.widget b/back/templates/item-info.widget index 33d9e00..1d6b4bd 100644 --- a/back/templates/item-info.widget +++ b/back/templates/item-info.widget @@ -7,25 +7,13 @@ Required context: * item * category - - * item_color.light - item_color.dark - * link_to_item = e.g. /haskell/lenses-pt3tvnwt#item-e4t2tv2n - * hackage - * category_groups = e.g. - [ {"name": "POSIX", "selected": false} - , {"name": "PCRE", "selected": true} - ... ] - - * item_no_group = true if the item's group is Nothing - HTML ============================================================ -
+
{{> item-info-anchor }} {{> item-info-title }} @@ -60,15 +48,6 @@ HTML: item-info-title
{{> item-title}}
-
- {{#item.group_}}{{.}}{{/item.group_}}{{^item.group_}}other{{/item.group_}} -
- -CSS ------------------------------------------------------------- -.item-group { - padding-left: 2em; -} HTML: item-info-controls ------------------------------------------------------------ @@ -164,15 +143,6 @@ CSS margin-bottom: 5px; } -.form-btn-group { - margin-top: 20px; - margin-bottom: 5px; -} - -.form-btn-group .save { - margin-right: 25px; -} - HTML: item-info-edit-form ------------------------------------------------------------ {{! "autocomplete=off" everywhere: http://stackoverflow.com/q/8311455 }} @@ -195,25 +165,6 @@ HTML: item-info-edit-form -
- - {{! When “new group” is selected in the list, we show a field for - entering new group's name }} - - - -
-
.item-info", "normal"); } -function itemGroupSelectHandler(select) { - var customInput = $(select).closest("form").find(".custom-group-input"); - if ($(select)[0].value == "") { - customInput.show(); - customInput.focus(); - } else { - customInput.hide(); - } -} - function submitItemInfo(itemUid, form) { - custom = $(form)[0].elements["custom-group"].value; - // If the group was changed, we need to recolor the whole item, - // but we don't want to rerender the item on the server because - // it would lose the item's state (e.g. what if the traits were - // being edited? etc). So, instead we query colors from the server - // and change the color of the item's body manually. var url = "/haskell/set/item/" + itemUid + "/info"; itemNode = '#item-' + itemUid; $.post(url, $(form).serialize()) .done(function (data) { - $.get("/haskell/render/item/"+itemUid+"/colors") - .done(function (colors) { - $(itemNode + " .item-body").css("background-color", colors.light); - $(itemNode + " .item-info").replaceWith(data); - }); - // And now, if a custom group was created, we should add it to other - // items' lists. - if (custom != "") { - $(".item").each(function (i, item) { - groups = $(item).find("select[name=group]")[0]; - isOurOption = function (opt) {return opt.text == custom}; - alreadyExists = $.grep(groups.options, isOurOption).length > 0; - if (!alreadyExists) { - groups.add(new Option(custom, custom), 1); } - }); - } + $(itemNode + " .item-info").replaceWith(data); }); } diff --git a/back/tests/ApiSpec.hs b/back/tests/ApiSpec.hs index 07b32a7..2f7d640 100644 --- a/back/tests/ApiSpec.hs +++ b/back/tests/ApiSpec.hs @@ -235,7 +235,6 @@ deleteItem (Uid itemId) = do itemInfo :: Value itemInfo = object [ "name" .= ("exampleName" :: String) - , "group" .= ("exampleGroup" :: String) , "hackage" .= ("string" :: String) , "link" .= ("http:/link.exp" :: String) ] diff --git a/back/tests/WebSpec.hs b/back/tests/WebSpec.hs index f5b8c72..e9422cb 100644 --- a/back/tests/WebSpec.hs +++ b/back/tests/WebSpec.hs @@ -254,63 +254,6 @@ itemTests = session "items" $ using [chromeCaps] $ do form <- openItemEditForm item1 enterInput "New item" (form :// ByName "name") itemName item1 `shouldHaveText` "New item" - describe "group" $ do - wd "is present and “other” by default" $ do - itemGroup item1 `shouldHaveText` "other" - fs <- fontSize (itemGroup item1); fs `shouldBeInRange` (15,17) - form <- openItemEditForm item1 - (form :// ByName "group" :// ":checked") `shouldHaveText` "-" - click (form :// ".cancel") - wd "custom group input is hidden but then shows" $ do - form <- openItemEditForm item1 - sel <- select (form :// ByName "group") - opt <- select (sel :// HasText "New group...") - shouldBeHidden (form :// ByName "custom-group") - selectDropdown sel opt - shouldBeDisplayed (form :// ByName "custom-group") - click (form :// ".cancel") - wd "can be changed to a custom group" $ do - setItemCustomGroup "some group" item1 - -- TODO: check that it works with 2 groups etc - wd "is automatically put into all items' choosers" $ do - createItem "Another item" - -- TODO: make a combinator for this - items <- selectAll ".item" - waitUntil wait_delay $ expect (length items >= 2) - for_ items $ \item -> do - form <- openItemEditForm item - checkPresent $ - form :// ByName "group" :// "option" :& HasText "some group" - click (form :// ".cancel") - wd "is present in the chooser after a refresh" $ do - refresh - form <- openItemEditForm item1 - sel <- select (form :// ByName "group") - (sel :// ":checked") `shouldHaveText` "some group" - click (form :// ".cancel") - -- TODO: more convoluted change scenarious - -- TODO: setting custom group to something that already exists - -- doesn't result in two equal groups - wd "changing it changes the color" $ do - [itemA, itemB, itemC] <- replicateM 3 (createItem "blah") - setItemCustomGroup "one" itemA - setItemGroup "one" itemB - setItemCustomGroup "two" itemC - let getColors = for [itemA, itemB, itemC] $ \item -> - (,) <$> cssProp (item :// ".item-info") "background-color" - <*> cssProp (item :// ".item-body") "background-color" - -- A=1,B=1,C=2; check that A=B, A≠C - do [aCol, bCol, cCol] <- getColors - aCol `shouldBe` bCol; aCol `shouldNotBe` cCol - -- A:=2; now A=2,B=1,C=2; check that A≠B, A=C - setItemCustomGroup "two" itemA - do [aCol, bCol, cCol] <- getColors - aCol `shouldNotBe` bCol; aCol `shouldBe` cCol - -- C:=1; now A=2,B=1,C=1; check that A≠C, B=C - setItemGroup "one" itemC - do [aCol, bCol, cCol] <- getColors - aCol `shouldNotBe` cCol; bCol `shouldBe` cCol - -- TODO: kind -- TODO: site @@ -492,27 +435,6 @@ createItem t = do itemName :: CanSelect s => s -> ComplexSelector itemName item = item :// ".item-name" -itemGroup :: CanSelect s => s -> ComplexSelector -itemGroup item = item :// ".item-group" - -setItemGroup :: CanSelect s => Text -> s -> WD () -setItemGroup g item = do - form <- openItemEditForm item - sel <- select (form :// ByName "group") - opt <- select (sel :// HasText g) - selectDropdown sel opt - saveForm form - itemGroup item `shouldHaveText` g - -setItemCustomGroup :: CanSelect s => Text -> s -> WD () -setItemCustomGroup g item = do - form <- openItemEditForm item - sel <- select (form :// ByName "group") - opt <- select (sel :// HasText "New group...") - selectDropdown sel opt - enterInput g (form :// ByName "custom-group") - itemGroup item `shouldHaveText` g - categoryTitle :: Selector categoryTitle = ByCSS ".category-title" diff --git a/front/client/components/CategoryItem.vue b/front/client/components/CategoryItem.vue index b2bc737..1bab0e0 100644 --- a/front/client/components/CategoryItem.vue +++ b/front/client/components/CategoryItem.vue @@ -10,7 +10,6 @@ :itemUid="itemUid" :itemName="name" :itemLink="link" - :itemGroup="group" :itemHackage="hackage" /> @@ -132,7 +131,6 @@ import CatchConflictDecorator from 'client/helpers/CatchConflictDecorator' export default class CategoryItem extends Vue { // TODO get rid of so many props get data from Vuex @Prop(String) name!: string - @Prop(String) group!: string @Prop(Object) summary!: { text: string, html: string } @Prop(Array) pros!: any[] @Prop(Array) cons!: any[] diff --git a/front/client/service/CategoryItem.ts b/front/client/service/CategoryItem.ts index a46edf4..bbed9b8 100644 --- a/front/client/service/CategoryItem.ts +++ b/front/client/service/CategoryItem.ts @@ -116,7 +116,6 @@ export interface ICategoryItem { id: string name: string created: string - group?: string // TODO add appropriate types for summary, ecosystem and other properties with structure like // { text: string, html: string } summary: object diff --git a/stack.yaml b/stack.yaml index ebc9fde..f3317cb 100644 --- a/stack.yaml +++ b/stack.yaml @@ -22,6 +22,7 @@ extra-deps: - regex-1.0.1.5 - hasql-1.4 - hasql-transaction-0.7.2 +- webdriver-0.9.0.1 # Old versions from LTS 12+ (can and should be upgraded) - megaparsec-6.5.0