From dc9de413d7b40ff97d385596781dc47d3f38660a Mon Sep 17 00:00:00 2001 From: Artyom Date: Tue, 25 Apr 2017 14:30:30 +0300 Subject: [PATCH] Rename MarkdownBlockWithTOC to MarkdownTree --- src/Guide/Markdown.hs | 44 ++++++++++++++++++++++------------------- src/Guide/State.hs | 4 ++-- src/Guide/Types/Core.hs | 2 +- src/Guide/Views.hs | 3 +-- 4 files changed, 28 insertions(+), 25 deletions(-) diff --git a/src/Guide/Markdown.hs b/src/Guide/Markdown.hs index c64435b..b02041c 100644 --- a/src/Guide/Markdown.hs +++ b/src/Guide/Markdown.hs @@ -13,7 +13,7 @@ module Guide.Markdown -- * Types MarkdownInline(..), MarkdownBlock(..), - MarkdownBlockWithTOC(..), + MarkdownTree(..), -- * Lenses mdHtml, @@ -26,7 +26,7 @@ module Guide.Markdown -- * Converting text to Markdown toMarkdownInline, toMarkdownBlock, - toMarkdownBlockWithTOC, + toMarkdownTree, -- * Misc renderMD, @@ -77,15 +77,15 @@ data MarkdownBlock = MarkdownBlock { markdownBlockMdHtml :: ByteString, markdownBlockMdMarkdown :: ![MD.Node] } -data MarkdownBlockWithTOC = MarkdownBlockWithTOC { - markdownBlockWithTOCMdText :: Text, - markdownBlockWithTOCMdTree :: !(Document Text ByteString), - markdownBlockWithTOCMdIdPrefix :: Text, - markdownBlockWithTOCMdTOC :: Forest ([MD.Node], Text) } +data MarkdownTree = MarkdownTree { + markdownTreeMdText :: Text, + markdownTreeMdTree :: !(Document Text ByteString), + markdownTreeMdIdPrefix :: Text, + markdownTreeMdTOC :: Forest ([MD.Node], Text) } makeFields ''MarkdownInline makeFields ''MarkdownBlock -makeFields ''MarkdownBlockWithTOC +makeFields ''MarkdownTree parseMD :: Text -> [MD.Node] parseMD s = @@ -141,7 +141,11 @@ stringify = T.concat . map go HTML_INLINE _ -> "" -- | Extract everything before the first heading. -extractPreface :: MarkdownBlockWithTOC -> MarkdownBlock +-- +-- Note that if you render 'mdText' of the produced Markdown block, it won't +-- necessarily parse into 'mdHtml' from the same block. It's because rendered +-- Markdown might depend on links that are defined further in the tree. +extractPreface :: MarkdownTree -> MarkdownBlock extractPreface = mkBlock . preface . view mdTree where mkBlock x = MarkdownBlock { @@ -246,12 +250,12 @@ toMarkdownBlock s = MarkdownBlock { doc = parseMD s html = renderMD doc -toMarkdownBlockWithTOC :: Text -> Text -> MarkdownBlockWithTOC -toMarkdownBlockWithTOC idPrefix s = MarkdownBlockWithTOC { - markdownBlockWithTOCMdText = s, - markdownBlockWithTOCMdIdPrefix = idPrefix, - markdownBlockWithTOCMdTree = tree, - markdownBlockWithTOCMdTOC = toc } +toMarkdownTree :: Text -> Text -> MarkdownTree +toMarkdownTree idPrefix s = MarkdownTree { + markdownTreeMdText = s, + markdownTreeMdIdPrefix = idPrefix, + markdownTreeMdTree = tree, + markdownTreeMdTOC = toc } where blocks :: [MD.Node] blocks = parseMD s @@ -291,7 +295,7 @@ instance Show MarkdownInline where show = show . view mdText instance Show MarkdownBlock where show = show . view mdText -instance Show MarkdownBlockWithTOC where +instance Show MarkdownTree where show = show . view mdText instance A.ToJSON MarkdownInline where @@ -302,7 +306,7 @@ instance A.ToJSON MarkdownBlock where toJSON md = A.object [ "text" A..= (md^.mdText), "html" A..= T.decodeUtf8 (md^.mdHtml) ] -instance A.ToJSON MarkdownBlockWithTOC where +instance A.ToJSON MarkdownTree where toJSON md = A.object [ "text" A..= (md^.mdText) ] @@ -312,7 +316,7 @@ instance ToHtml MarkdownInline where instance ToHtml MarkdownBlock where toHtmlRaw = toHtml toHtml = toHtmlRaw . view mdHtml -instance ToHtml MarkdownBlockWithTOC where +instance ToHtml MarkdownTree where toHtmlRaw = toHtml toHtml = toHtmlRaw . renderDoc . view mdTree where @@ -340,14 +344,14 @@ instance SafeCopy MarkdownBlock where kind = base putCopy = contain . safePut . view mdText getCopy = contain $ toMarkdownBlock <$> safeGet -instance SafeCopy MarkdownBlockWithTOC where +instance SafeCopy MarkdownTree where version = 0 kind = base putCopy md = contain $ do safePut (md ^. mdIdPrefix) safePut (md ^. mdText) getCopy = contain $ - toMarkdownBlockWithTOC <$> safeGet <*> safeGet + toMarkdownTree <$> safeGet <*> safeGet -- | Is a piece of Markdown empty? markdownNull :: HasMdText a Text => a -> Bool diff --git a/src/Guide/State.hs b/src/Guide/State.hs index 4bc8bba..347ded8 100644 --- a/src/Guide/State.hs +++ b/src/Guide/State.hs @@ -288,7 +288,7 @@ addItem catId itemId name' created' kind' = do _itemConsDeleted = [], _itemEcosystem = toMarkdownBlock "", _itemNotes = let pref = "item-notes-" <> uidToText itemId <> "-" - in toMarkdownBlockWithTOC pref "", + in toMarkdownTree pref "", _itemLink = Nothing, _itemKind = kind' } categoryById catId . items %= (++ [newItem]) @@ -425,7 +425,7 @@ setItemNotes :: Uid Item -> Text -> Acid.Update GlobalState (Edit, Item) setItemNotes itemId notes' = do let pref = "item-notes-" <> uidToText itemId <> "-" oldNotes <- itemById itemId . notes <<.= - toMarkdownBlockWithTOC pref notes' + toMarkdownTree pref notes' let edit = Edit'SetItemNotes itemId (oldNotes ^. mdText) notes' (edit,) <$> use (itemById itemId) diff --git a/src/Guide/Types/Core.hs b/src/Guide/Types/Core.hs index 8074ca6..64f51cc 100644 --- a/src/Guide/Types/Core.hs +++ b/src/Guide/Types/Core.hs @@ -165,7 +165,7 @@ data Item = Item { _itemCons :: [Trait], _itemConsDeleted :: [Trait], _itemEcosystem :: MarkdownBlock, - _itemNotes :: MarkdownBlockWithTOC, + _itemNotes :: MarkdownTree, _itemLink :: Maybe Url, _itemKind :: ItemKind } deriving (Show, Generic) diff --git a/src/Guide/Views.hs b/src/Guide/Views.hs index cf6b84e..452d3d6 100644 --- a/src/Guide/Views.hs +++ b/src/Guide/Views.hs @@ -702,8 +702,7 @@ renderSearchResult r = do a_ [class_ "category-link", href_ (categoryLink cat)] $ toHtml (cat^.title) div_ [class_ "category-description notes-like"] $ - toHtml (extractPreface $ - toMarkdownBlockWithTOC "" $ cat^.notes.mdText) + toHtml (extractPreface $ toMarkdownTree "" $ cat^.notes.mdText) SRItem cat item -> do a_ [class_ "category-link in-item-sr", href_ (categoryLink cat)] $ toHtml (cat^.title)