From e59032d3ee5a90603ef8fdbd4aafe46ac79ef253 Mon Sep 17 00:00:00 2001 From: vrom911 Date: Fri, 29 Sep 2017 02:17:30 +0300 Subject: [PATCH] [#169] [WIP] Replace Ecosystem with EcosystemTabs in Item --- src/Guide/Handlers.hs | 13 ++++--- src/Guide/JS.hs | 38 +++++++++++++++---- src/Guide/Markdown.hs | 6 +++ src/Guide/Search.hs | 11 ++++-- src/Guide/ServerStuff.hs | 24 ++++++++++-- src/Guide/State.hs | 80 +++++++++++++++++++++++++++------------- src/Guide/Types/Core.hs | 73 +++++++++++++++++++++++++++--------- src/Guide/Types/Edit.hs | 14 ++++++- src/Guide/Views.hs | 8 ++-- src/Guide/Views/Item.hs | 75 ++++++++++++++++++++++++++++--------- 10 files changed, 254 insertions(+), 88 deletions(-) diff --git a/src/Guide/Handlers.hs b/src/Guide/Handlers.hs index d04fc0a..6f7f4ef 100644 --- a/src/Guide/Handlers.hs +++ b/src/Guide/Handlers.hs @@ -210,17 +210,18 @@ setMethods = do ("modified" :: Text, modified), ("merged" :: Text, merge original content' modified)] -- Item ecosystem - Spock.post (setRoute itemVar "ecosystem") $ \itemId -> do + Spock.post (setRoute itemVar ecosystemTabVar) $ \itemId tabId -> do original <- param' "original" content' <- param' "content" - modified <- view (ecosystem.mdText) <$> dbQuery (GetItem itemId) + itm <- dbQuery (GetItem itemId) + modified <- view (block.mdText) <$> dbQuery (GetEcosystemTab itemId tabId) if modified == original then do - item <- uncache (CacheItemEcosystem itemId) $ do - (edit, item) <- dbUpdate (SetItemEcosystem itemId content') + tab <- uncache (CacheItemEcosystem itemId) $ do + (edit, tab) <- dbUpdate (SetItemEcosystemTabBlock itemId tabId content') addEdit edit - return item - lucidIO $ renderItemEcosystem item + return tab + lucidIO $ renderItemEcosystemTab itm tab else do setStatus HTTP.status409 json $ M.fromList [ diff --git a/src/Guide/JS.hs b/src/Guide/JS.hs index 28a70a6..b9c9791 100644 --- a/src/Guide/JS.hs +++ b/src/Guide/JS.hs @@ -52,7 +52,9 @@ allJSFunctions = JS . T.unlines . map fromJS $ [ -- Set methods submitCategoryInfo, submitCategoryNotes, submitItemDescription, - submitItemNotes, submitItemEcosystem, + submitItemNotes, + -- submitItemEcosystem, + submitItemEcosystemTab, -- Other things deleteCategoryAndRedirect, -- Admin things @@ -536,13 +538,35 @@ submitItemDescription = }); |] -submitItemEcosystem :: JSFunction a => a -submitItemEcosystem = - makeJSFunction "submitItemEcosystem" - ["node", "itemId", "original", "ours"] +-- submitItemEcosystem :: JSFunction a => a +-- submitItemEcosystem = +-- makeJSFunction "submitItemEcosystem" +-- ["node", "itemId", "original", "ours"] +-- [text| +-- $.post({ +-- url: "/haskell/set/item/"+itemId+"/ecosystem", +-- data: { +-- original: original, +-- content: ours }, +-- success: function (data) { +-- $.magnificPopup.close(); +-- $(node).replaceWith(data); }, +-- statusCode: { +-- 409: function (xhr, st, err) { +-- modified = xhr.responseJSON["modified"]; +-- merged = xhr.responseJSON["merged"]; +-- showDiffPopup(ours, modified, merged, function (x) { +-- submitItemEcosystem(node, itemId, modified, x) }); } } +-- }); +-- |] + +submitItemEcosystemTab :: JSFunction a => a +submitItemEcosystemTab = + makeJSFunction "submitItemEcosystemTab" + ["node", "itemId", "tabId", "original", "ours"] [text| $.post({ - url: "/haskell/set/item/"+itemId+"/ecosystem", + url: "/haskell/set/item/"+itemId+"/ecosystemTab/"+tabId, data: { original: original, content: ours }, @@ -554,7 +578,7 @@ submitItemEcosystem = modified = xhr.responseJSON["modified"]; merged = xhr.responseJSON["merged"]; showDiffPopup(ours, modified, merged, function (x) { - submitItemEcosystem(node, itemId, modified, x) }); } } + submitItemEcosystemTab(node, itemId, tabId, modified, x) }); } } }); |] diff --git a/src/Guide/Markdown.hs b/src/Guide/Markdown.hs index 57c55ea..a2429ac 100644 --- a/src/Guide/Markdown.hs +++ b/src/Guide/Markdown.hs @@ -34,6 +34,8 @@ module Guide.Markdown renderMD, markdownNull, extractPreface, + stringify, + listFromMarkdownList ) where @@ -366,3 +368,7 @@ instance SafeCopy MarkdownTree where -- | Is a piece of Markdown empty? markdownNull :: HasMdText a Text => a -> Bool markdownNull = T.null . view mdText + +listFromMarkdownList :: [MD.Node] -> [[MD.Node]] +listFromMarkdownList [MD.Node _ (MD.LIST _) items] = map (\(MD.Node _ MD.ITEM i) -> i) items +listFromMarkdownList _ = [] diff --git a/src/Guide/Search.hs b/src/Guide/Search.hs index 1feab8e..a01ffc7 100644 --- a/src/Guide/Search.hs +++ b/src/Guide/Search.hs @@ -26,7 +26,7 @@ data SearchResult -- | Item's name matches the query | SRItem Category Item -- | Item's ecosystem matches the query - | SRItemEcosystem Category Item + | SRItemEcosystemTab Category Item EcosystemTab deriving (Show, Generic) {- | Find things matching a simple text query, and return results ranked by @@ -50,11 +50,14 @@ search query gs = , let rank = match query (item^.name) , rank > 0 ] ++ -- item ecosystems - sortByRank [(SRItemEcosystem cat item, rank) + sortByRank [(SRItemEcosystemTab cat item tab, max contentRank nameRank) | cat <- gs^.categories , item <- cat^.items - , let rank = match query (item^.ecosystem.mdText) - , rank > 0 ] + , tab <- item^.ecosystemTabs + , let contentRank = match query (tab^.block.mdText) + , let nameRank = match query (tab^.name) + , contentRank > 0 || nameRank > 0 + ] where sortByRank :: [(a, Int)] -> [a] sortByRank = map fst . sortOn (Down . snd) diff --git a/src/Guide/ServerStuff.hs b/src/Guide/ServerStuff.hs index 7a6e59c..f205187 100644 --- a/src/Guide/ServerStuff.hs +++ b/src/Guide/ServerStuff.hs @@ -25,11 +25,12 @@ module Guide.ServerStuff addEdit, undoEdit, invalidateCacheForEdit, - + -- * Handler helpers itemVar, categoryVar, traitVar, + ecosystemTabVar, -- * Other helpers createCheckpoint', @@ -47,7 +48,8 @@ import Web.Routing.Combinators (PathState(..)) -- acid-state import Data.Acid as Acid import Data.Acid.Local as Acid - +-- Text +import qualified Data.Text as T import Guide.Config import Guide.State import Guide.Types @@ -227,10 +229,21 @@ undoEdit (Edit'SetItemNotes itemId old new) = do then return (Left "notes have been changed further") else Right () <$ dbUpdate (SetItemNotes itemId old) undoEdit (Edit'SetItemEcosystem itemId old new) = do - now <- view (ecosystem.mdText) <$> dbQuery (GetItem itemId) - if now /= new + now <- view (ecosystemTabs) <$> dbQuery (GetItem itemId) + let nowText = T.concat $ map (^.block.mdText) now + if nowText /= new then return (Left "ecosystem has been changed further") else Right () <$ dbUpdate (SetItemEcosystem itemId old) +undoEdit (Edit'SetItemEcosystemTabName itemId tabId oldName newName) = do + now <- view name <$> dbQuery (GetEcosystemTab itemId tabId) + if now /= newName + then return (Left "ecosysten tab's name has been changed further") + else Right () <$ dbUpdate (SetItemEcosystemTabName itemId tabId oldName) +undoEdit (Edit'SetItemEcosystemTabBlock itemId tabId oldBlock newBlock) = do + now <- view (block.mdText) <$> dbQuery (GetEcosystemTab itemId tabId) + if now /= newBlock + then return (Left "ecosysten tab's block has been changed further") + else Right () <$ dbUpdate (SetItemEcosystemTabBlock itemId tabId oldBlock) undoEdit (Edit'SetTraitContent itemId traitId old new) = do now <- view (content.mdText) <$> dbQuery (GetTrait itemId traitId) if now /= new @@ -320,6 +333,9 @@ categoryVar = "category" var traitVar :: Path '[Uid Trait] 'Open traitVar = "trait" var +ecosystemTabVar :: Path '[Uid EcosystemTab] 'Open +ecosystemTabVar = "ecosystemTab" var + ---------------------------------------------------------------------------- -- Other helpers ---------------------------------------------------------------------------- diff --git a/src/Guide/State.hs b/src/Guide/State.hs index 1ac8288..64dd8bb 100644 --- a/src/Guide/State.hs +++ b/src/Guide/State.hs @@ -28,6 +28,7 @@ module Guide.State GetCategory(..), GetCategoryMaybe(..), GetCategoryByItem(..), GetItem(..), + GetEcosystemTab(..), GetTrait(..), -- ** add @@ -51,7 +52,9 @@ module Guide.State SetItemKind(..), SetItemDescription(..), SetItemNotes(..), - SetItemEcosystem(..), + SetItemEcosystem (..), + SetItemEcosystemTabName(..), + SetItemEcosystemTabBlock(..), -- *** 'Trait' SetTraitContent(..), @@ -75,7 +78,7 @@ module Guide.State RestoreItem(..), RestoreTrait(..), SetDirty(..), UnsetDirty(..), - + LoadSession(..), StoreSession(..), DeleteSession(..), GetSessions(..), @@ -223,6 +226,12 @@ traitById uid' = singular $ error ("traitById: couldn't find trait with uid " ++ T.unpack (uidToText uid')) +ecosystemTabById :: Uid EcosystemTab -> Lens' Item EcosystemTab +ecosystemTabById uid' = singular $ + (ecosystemTabs.each . filtered (hasUid uid')) `failing` + error ("ecosystemTabById: couldn't find ecosystemTab with uid " ++ + T.unpack (uidToText uid')) + categoryById :: Uid Category -> Lens' GlobalState Category categoryById catId = singular $ categories.each . filtered (hasUid catId) `failing` @@ -310,6 +319,9 @@ getCategoryByItem uid' = findCategoryByItem uid' <$> ask getItem :: Uid Item -> Acid.Query GlobalState Item getItem uid' = view (itemById uid') +getEcosystemTab :: Uid Item -> Uid EcosystemTab -> Acid.Query GlobalState EcosystemTab +getEcosystemTab itemId tabId = view (itemById itemId . ecosystemTabById tabId) + -- TODO: this doesn't need the item id, but then we have to be a bit cleverer -- and store a (TraitId -> ItemId) map in global state (and update it -- accordingly whenever anything happens, so perhaps let's not do it!) @@ -351,20 +363,20 @@ addItem -> Acid.Update GlobalState (Edit, Item) addItem catId itemId name' created' kind' = do let newItem = Item { - _itemUid = itemId, - _itemName = name', - _itemCreated = created', - _itemGroup_ = Nothing, - _itemDescription = toMarkdownBlock "", - _itemPros = [], - _itemProsDeleted = [], - _itemCons = [], - _itemConsDeleted = [], - _itemEcosystem = toMarkdownBlock "", - _itemNotes = let pref = "item-notes-" <> uidToText itemId <> "-" - in toMarkdownTree pref "", - _itemLink = Nothing, - _itemKind = kind' } + _itemUid = itemId, + _itemName = name', + _itemCreated = created', + _itemGroup_ = Nothing, + _itemDescription = toMarkdownBlock "", + _itemPros = [], + _itemProsDeleted = [], + _itemCons = [], + _itemConsDeleted = [], + _itemEcosystemTabs = [], + _itemNotes = let pref = "item-notes-" <> uidToText itemId <> "-" + in toMarkdownTree pref "", + _itemLink = Nothing, + _itemKind = kind' } categoryById catId . items %= (++ [newItem]) let edit = Edit'AddItem catId itemId name' return (edit, newItem) @@ -505,12 +517,25 @@ setItemNotes itemId notes' = do setItemEcosystem :: Uid Item -> Text -> Acid.Update GlobalState (Edit, Item) setItemEcosystem itemId ecosystem' = do - oldEcosystem <- itemById itemId . ecosystem <<.= - toMarkdownBlock ecosystem' + let newEco = [EcosystemTab (Uid "sadsad") "TabName" (toMarkdownBlock ecosystem')] + + oldEcosystem <- itemById itemId . ecosystemTabs <<.= newEco let edit = Edit'SetItemEcosystem itemId - (oldEcosystem ^. mdText) ecosystem' + (T.concat $ map (^. block.mdText) oldEcosystem) ecosystem' (edit,) <$> use (itemById itemId) +setItemEcosystemTabName :: Uid Item -> Uid EcosystemTab -> Text -> Acid.Update GlobalState (Edit, EcosystemTab) +setItemEcosystemTabName itemId tabId tabName' = do + oldTabName <- itemById itemId . ecosystemTabById tabId . name <<.= tabName' + let edit = Edit'SetItemEcosystemTabName itemId tabId oldTabName tabName' + (edit,) <$> use (itemById itemId . ecosystemTabById tabId) + +setItemEcosystemTabBlock :: Uid Item -> Uid EcosystemTab -> Text -> Acid.Update GlobalState (Edit, EcosystemTab) +setItemEcosystemTabBlock itemId tabId block' = do + oldTabBlock <- itemById itemId . ecosystemTabById tabId . block <<.= toMarkdownBlock block' + let edit = Edit'SetItemEcosystemTabBlock itemId tabId (oldTabBlock ^. mdText) block' + (edit,) <$> use (itemById itemId . ecosystemTabById tabId) + setTraitContent :: Uid Item -> Uid Trait -> Text -> Acid.Update GlobalState (Edit, Trait) setTraitContent itemId traitId content' = do oldContent <- itemById itemId . traitById traitId . content <<.= @@ -757,26 +782,26 @@ setDirty = dirty .= True unsetDirty :: Acid.Update GlobalState Bool unsetDirty = dirty <<.= False --- | Retrieves a session by 'SessionID'. +-- | Retrieves a session by 'SessionID'. -- Note: This utilizes a "wrapper" around Spock.Session, 'GuideSession'. loadSession :: SessionId -> Acid.Query GlobalState (Maybe GuideSession) loadSession key = view (sessionStore . at key) --- | Stores a session object. +-- | Stores a session object. -- Note: This utilizes a "wrapper" around Spock.Session, 'GuideSession'. storeSession :: GuideSession -> Acid.Update GlobalState () storeSession sess = do sessionStore %= M.insert (sess ^. sess_id) sess setDirty --- | Deletes a session by 'SessionID'. +-- | Deletes a session by 'SessionID'. -- Note: This utilizes a "wrapper" around Spock.Session, 'GuideSession'. deleteSession :: SessionId -> Acid.Update GlobalState () deleteSession key = do sessionStore %= M.delete key setDirty --- | Retrieves all sessions. +-- | Retrieves all sessions. -- Note: This utilizes a "wrapper" around Spock.Session, 'GuideSession'. getSessions :: Acid.Query GlobalState [GuideSession] getSessions = do @@ -791,7 +816,7 @@ getUser key = view (users . at key) createUser :: User -> Acid.Update GlobalState Bool createUser user = do m <- toList <$> use users - if all (canCreateUser user) (m ^.. each) + if all (canCreateUser user) (m ^.. each) then do users %= M.insert (user ^. userID) user return True @@ -817,7 +842,7 @@ loginUser :: Text -> ByteString -> Acid.Query GlobalState (Either String User) loginUser email password = do matches <- filter (\u -> u ^. userEmail == email) . toList <$> view users case matches of - [user] -> + [user] -> if verifyUser user password then return $ Right user else return $ Left "wrong password" @@ -852,6 +877,7 @@ makeAcidic ''GlobalState [ 'getCategoryByItem, 'getItem, 'getTrait, + 'getEcosystemTab, -- add 'addCategory, 'addItem, @@ -861,7 +887,9 @@ makeAcidic ''GlobalState [ 'setCategoryTitle, 'setCategoryGroup, 'setCategoryNotes, 'setCategoryStatus, 'changeCategoryEnabledSections, 'setItemName, 'setItemLink, 'setItemGroup, 'setItemKind, - 'setItemDescription, 'setItemNotes, 'setItemEcosystem, + 'setItemDescription, 'setItemNotes, + 'setItemEcosystemTabName, 'setItemEcosystemTabBlock, + 'setItemEcosystem, 'setTraitContent, -- delete 'deleteCategory, diff --git a/src/Guide/Types/Core.hs b/src/Guide/Types/Core.hs index 5967a64..5519c29 100644 --- a/src/Guide/Types/Core.hs +++ b/src/Guide/Types/Core.hs @@ -20,6 +20,8 @@ overloaded and can be used with many types. module Guide.Types.Core ( Trait(..), + EcosystemTab(..), + block, ItemKind(..), hackageName, ItemSection(..), @@ -28,7 +30,7 @@ module Guide.Types.Core prosDeleted, cons, consDeleted, - ecosystem, + ecosystemTabs, link, kind, Hue(..), @@ -74,6 +76,8 @@ import Guide.Markdown import Guide.Utils import Guide.Types.Hue +import qualified CMark as MD + ---------------------------------------------------------------------------- -- General notes on code @@ -157,30 +161,63 @@ instance A.ToJSON ItemSection where -- TODO: add a field like “people to ask on IRC about this library if you -- need help” +-- | Tab of Ecosystem field +data EcosystemTab = EcosystemTab { + _ecosystemTabUid :: Uid EcosystemTab, -- ^ Ecosystem tab ID + _ecosystemTabName :: Text, -- ^ Ecosystem tab title + _ecosystemTabBlock :: MarkdownBlock -- ^ Ecosystem tab content + } + deriving (Show, Generic, Data) +makeFields ''EcosystemTab + +deriveSafeCopySorted 0 'base ''EcosystemTab + +createEcosystemFromMDBlock :: MarkdownBlock -> [EcosystemTab] +createEcosystemFromMDBlock blck = map toEcosystem + $ listFromMarkdownList + $ blck^.mdMarkdown + where + toEcosystem :: [MD.Node] -> EcosystemTab + toEcosystem nodes = + EcosystemTab (unsafePerformIO randomShortUid) + "Tab" + (MarkdownBlock (stringify nodes) (renderMD nodes) nodes) + +instance A.ToJSON EcosystemTab where + toJSON = A.genericToJSON A.defaultOptions { + A.fieldLabelModifier = over _head toLower . drop (T.length "_ecosystem") } + + -- | An item (usually a library). Items are stored in categories. 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) - _itemDescription :: MarkdownBlock, -- ^ Item summary - _itemPros :: [Trait], -- ^ Pros (positive traits) - _itemProsDeleted :: [Trait], -- ^ Deleted pros go here (so that - -- it'd be easy to restore them) - _itemCons :: [Trait], -- ^ Cons (negative traits) - _itemConsDeleted :: [Trait], -- ^ Deleted cons go here - _itemEcosystem :: MarkdownBlock, -- ^ The ecosystem section - _itemNotes :: MarkdownTree, -- ^ The notes section - _itemLink :: Maybe Url, -- ^ Link to homepage or something - _itemKind :: ItemKind -- ^ Is it a library, tool, etc + _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) + _itemDescription :: MarkdownBlock, -- ^ Item summary + _itemPros :: [Trait], -- ^ Pros (positive traits) + _itemProsDeleted :: [Trait], -- ^ Deleted pros go here (so that + -- it'd be easy to restore them) + _itemCons :: [Trait], -- ^ Cons (negative traits) + _itemConsDeleted :: [Trait], -- ^ Deleted cons go here + _itemEcosystemTabs :: [EcosystemTab], -- ^ The ecosystem section + _itemNotes :: MarkdownTree, -- ^ The notes section + _itemLink :: Maybe Url, -- ^ Link to homepage or something + _itemKind :: ItemKind -- ^ Is it a library, tool, etc } deriving (Show, Generic, Data) -deriveSafeCopySorted 11 'extension ''Item +deriveSafeCopySorted 12 'extension ''Item makeFields ''Item -changelog ''Item (Current 11, Past 10) [] -deriveSafeCopySorted 10 'base ''Item_v10 +changelog ''Item (Current 12, Past 11) + [Removed "_itemEcosystem" [t|MarkdownBlock|], + Added "_itemEcosystemTabs" [hs| createEcosystemFromMDBlock _itemEcosystem|] + ] +deriveSafeCopySorted 11 'base ''Item_v11 + +-- changelog ''Item (Current 11, Past 10) [] +-- deriveSafeCopySorted 10 'base ''Item_v10 instance A.ToJSON Item where toJSON = A.genericToJSON A.defaultOptions { diff --git a/src/Guide/Types/Edit.hs b/src/Guide/Types/Edit.hs index 000da98..6a0d69a 100644 --- a/src/Guide/Types/Edit.hs +++ b/src/Guide/Types/Edit.hs @@ -29,6 +29,7 @@ import Data.SafeCopy.Migrate import Guide.Utils import Guide.Types.Core +import Guide.Markdown (MarkdownBlock (..)) -- | Edits made by users. It should always be possible to undo an edit. @@ -102,7 +103,16 @@ data Edit editItemUid :: Uid Item, editItemEcosystem :: Text, editItemNewEcosystem :: Text } - + | Edit'SetItemEcosystemTabName { + editItemUid :: Uid Item, + editItemEcosystemTabUid :: Uid EcosystemTab, + editItemEcosystemTabName :: Text, + editItemNewEcosystemTabName :: Text } + | Edit'SetItemEcosystemTabBlock { + editItemUid :: Uid Item, + editItemEcosystemTabUid :: Uid EcosystemTab, + editItemEcosystemTabBlock :: Text, + editItemNewEcosystemTabBlock :: Text } -- Change trait properties | Edit'SetTraitContent { editItemUid :: Uid Item, @@ -133,7 +143,7 @@ data Edit deriving (Eq, Show) -deriveSafeCopySimple 7 'extension ''Edit +deriveSafeCopySimple 8 'extension ''Edit genVer ''Edit 6 [ -- Add diff --git a/src/Guide/Views.hs b/src/Guide/Views.hs index afbacab..3a854d3 100644 --- a/src/Guide/Views.hs +++ b/src/Guide/Views.hs @@ -208,6 +208,7 @@ renderAdmin globalState = do content_ "width=device-width, initial-scale=1.0, user-scalable=yes"] body_ $ do + -- liftIO $ putStrLn $ show $ markdownBlockMdMarkdown $ _itemEcosystem (head$ filter (\x -> _itemName x == "attoparsec") ( (head $ filter (\x -> (x ^. title == "Parsing")) $ globalState ^. categories) ^. items)) script_ $ fromJS $ JS.createAjaxIndicator () h1_ "Miscellaneous" buttonUid <- randomLongUid @@ -756,15 +757,16 @@ renderSearchResult r = do toHtml (item^.name) div_ [class_ "description notes-like"] $ toHtml (item^.description) - SRItemEcosystem cat item -> do + SRItemEcosystemTab cat item tab -> do a_ [class_ "category-link in-item-sr", href_ (categoryLink cat)] $ toHtml (cat^.title) span_ [class_ "breadcrumb"] "»" a_ [class_ "item-link", href_ (itemLink cat item)] $ toHtml (item^.name) span_ [class_ "item-link-addition"] "'s ecosystem" - div_ [class_ "ecosystem notes-like"] $ - toHtml (item^.ecosystem) + div_ [class_ "ecosystem notes-like"] $ do + strong_ $ toHtml $ tab^.name + toHtml (tab^.block.mdText) {- Note [enabled sections] ~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/src/Guide/Views/Item.hs b/src/Guide/Views/Item.hs index cb9e724..49aea03 100644 --- a/src/Guide/Views/Item.hs +++ b/src/Guide/Views/Item.hs @@ -17,6 +17,7 @@ module Guide.Views.Item renderItemInfo, renderItemDescription, renderItemEcosystem, + renderItemEcosystemTab, renderItemTraits, renderItemNotes, @@ -91,9 +92,10 @@ renderItemForFeed category item = do h2_ "Cons" ul_ $ mapM_ (p_ . li_ . toHtml . view content) (item^.cons) when (ItemEcosystemSection `elem` category^.enabledSections) $ do - unless (markdownNull (item^.ecosystem)) $ do - h2_ "Ecosystem" - toHtml (item^.ecosystem) + forM_ (item^.ecosystemTabs) $ \tab -> do + unless (markdownNull (tab^.block)) $ do + h2_ $ toHtml (tab^.name) + toHtml (tab^.block.mdText) -- TODO: include .notes-like style here? otherwise the headers are too big unless (markdownNull (item^.notes)) $ do h2_ "Notes" @@ -147,37 +149,74 @@ renderItemDescription item = cached (CacheItemDescription (item^.uid)) $ mustache "item-description" $ A.object [ "item" A..= item ] --- | Render the “ecosystem” secion.. +-- | Render the “ecosystem” section.. +-- renderItemEcosystem :: MonadIO m => Item -> HtmlT m () +-- renderItemEcosystem item = cached (CacheItemEcosystem (item^.uid)) $ do +-- let thisId = "item-ecosystem-" <> uidToText (item^.uid) +-- this = JS.selectId thisId +-- div_ [id_ thisId, class_ "item-ecosystem"] $ do +-- +-- section "normal" [shown, noScriptShown] $ do +-- strong_ "Ecosystem" +-- emptySpan "0.5em" +-- imgButton "edit ecosystem" "/pencil.svg" +-- [style_ "width:12px;opacity:0.5", class_ " edit-item-ecosystem "] $ +-- JS.switchSection (this, "editing" :: Text) <> +-- JS.focusOn [(this `JS.selectSection` "editing") +-- `JS.selectChildren` +-- JS.selectClass "editor"] +-- div_ [class_ "notes-like"] $ do +-- unless (markdownNull (item^.ecosystem)) $ +-- toHtml (item^.ecosystem) +-- +-- section "editing" [] $ do +-- strong_ "Ecosystem" +-- emptySpan "0.5em" +-- imgButton "quit editing ecosystem" "/pencil.svg" +-- [style_ "width:12px;opacity:0.5", class_ " edit-item-ecosystem "] $ +-- JS.switchSection (this, "normal" :: Text) +-- markdownEditor +-- [rows_ "3", class_ " editor "] +-- (item^.ecosystem) +-- (\val -> JS.submitItemEcosystem +-- (this, item^.uid, item^.ecosystem.mdText, val)) +-- (JS.switchSection (this, "normal" :: Text)) +-- "or press Ctrl+Enter to save" renderItemEcosystem :: MonadIO m => Item -> HtmlT m () -renderItemEcosystem item = cached (CacheItemEcosystem (item^.uid)) $ do - let thisId = "item-ecosystem-" <> uidToText (item^.uid) +renderItemEcosystem item = cached (CacheItemEcosystem $ item^.uid) $ do + forM_ (item^.ecosystemTabs) $ \tab -> renderItemEcosystemTab item tab + +-- | Render the “ecosystemTab” section.. +renderItemEcosystemTab :: MonadIO m => Item -> EcosystemTab -> HtmlT m () +renderItemEcosystemTab item tab = do + let thisId = "item-ecosystem-tab-" <> uidToText (tab^.uid) this = JS.selectId thisId - div_ [id_ thisId, class_ "item-ecosystem"] $ do + div_ [id_ thisId, class_ "item-ecosystem-tab"] $ do section "normal" [shown, noScriptShown] $ do - strong_ "Ecosystem" + strong_ $ toHtml (tab^.name) emptySpan "0.5em" - imgButton "edit ecosystem" "/pencil.svg" - [style_ "width:12px;opacity:0.5", class_ " edit-item-ecosystem "] $ + imgButton "edit ecosystem tab" "/pencil.svg" + [style_ "width:12px;opacity:0.5", class_ " edit-item-ecosystem-tab "] $ JS.switchSection (this, "editing" :: Text) <> JS.focusOn [(this `JS.selectSection` "editing") `JS.selectChildren` JS.selectClass "editor"] div_ [class_ "notes-like"] $ do - unless (markdownNull (item^.ecosystem)) $ - toHtml (item^.ecosystem) + unless (markdownNull (tab^.block)) $ + toHtml (tab^.block.mdText) section "editing" [] $ do - strong_ "Ecosystem" + strong_ $ toHtml $ tab^.name emptySpan "0.5em" - imgButton "quit editing ecosystem" "/pencil.svg" - [style_ "width:12px;opacity:0.5", class_ " edit-item-ecosystem "] $ + imgButton "quit editing ecosystem tab" "/pencil.svg" + [style_ "width:12px;opacity:0.5", class_ " edit-item-ecosystem-tab "] $ JS.switchSection (this, "normal" :: Text) markdownEditor [rows_ "3", class_ " editor "] - (item^.ecosystem) - (\val -> JS.submitItemEcosystem - (this, item^.uid, item^.ecosystem.mdText, val)) + (tab^.block) + (\val -> JS.submitItemEcosystemTab + (this, item^.uid, tab^.uid, tab^.block.mdText, val)) (JS.switchSection (this, "normal" :: Text)) "or press Ctrl+Enter to save"