Add target _blank (#398)

* Add target _blank

* Fix add blanker. Improve tests

back/src/Guide/Markdown.hs

@@ -24,6 +24,7 @@ module Guide.Markdown
   -- * Misc
   renderMD,
   extractPreface,
+  addTargetBlank,
 )
 where
 
@@ -93,16 +94,25 @@ parseMD s =
 renderMD :: [MD.Node] -> ByteString
 renderMD ns
   -- See https://github.com/jgm/cmark/issues/147
-  | any isInlineNode ns =
-      toUtf8ByteString . sanitize . T.concat . map (nodeToHtml []) $ ns
-  | otherwise =
-      toUtf8ByteString . sanitize . nodeToHtml [] $ MD.Node Nothing DOCUMENT ns
+  | any isInlineNode ns
+      = toUtf8ByteString
+      . sanitize
+      . T.concat
+      . map (nodeToHtml [] . addTargetBlank)
+      $ ns
+  | otherwise
+      = toUtf8ByteString
+      . sanitize
+      . nodeToHtml []
+      . addTargetBlank
+      $ MD.Node Nothing DOCUMENT ns
 
 isInlineNode :: MD.Node -> Bool
 isInlineNode (MD.Node _ tp _) = case tp of
   EMPH              -> True
   STRONG            -> True
   LINK _ _          -> True
+  IMAGE _ _         -> True
   CUSTOM_INLINE _ _ -> True
   SOFTBREAK         -> True
   LINEBREAK         -> True
@@ -181,6 +191,18 @@ extractInlines = concatMap go
       HTML_INLINE xs    -> [MD.Node Nothing (CODE xs) []]
       CODE_BLOCK _ xs   -> [MD.Node Nothing (CODE xs) []]
 
+-- | Convert LINK to HTML_INLINE with 'target="_blank"' attribute added.
+--
+-- It is necessary that the rendered html page be opened in a new tab.
+addTargetBlank :: MD.Node -> MD.Node
+addTargetBlank (MD.Node pos (LINK url title) ns) =
+    MD.Node pos (HTML_INLINE blankLink) []
+  where
+    blankLink = toText $ renderText
+      $ a_ ([href_ url, target_ "_blank"] ++ [title_ title | title /= ""])
+      $ toHtmlRaw $ renderMD ns
+addTargetBlank (MD.Node pos tp ns) = MD.Node pos tp (map addTargetBlank ns)
+
 shortcutLinks :: MD.Node -> MD.Node
 shortcutLinks node@(MD.Node pos (LINK url title) ns) | "@" <- T.take 1 url =
   -- %20s are possibly introduced by cmark (Pandoc definitely adds them,

back/tests/MarkdownSpec.hs

@@ -40,8 +40,29 @@ tests = describe "Markdown" $ do
     it "Hackage links" $ do
       let s = "[text](@hk)"
       let html = snd (convert s)
-      let l = "<a href=\"https://hackage.haskell.org/package/text\">text</a>"
+      let l = "<a href=\"https://hackage.haskell.org/package/text\" target=\"_blank\">text</a>"
       html `shouldSatisfy` (`elem` [l, "<p>"<>l<>"</p>\n"])
+    it "Common links" $ do
+      let s = "[Just link](http://guide.aelve.com)"
+      let html = snd (convert s)
+      let l = "<a href=\"http://guide.aelve.com\" target=\"_blank\">Just link</a>"
+      html `shouldSatisfy` (`elem` [l, "<p>"<>l<>"</p>\n"])
+    it "Links with image" $ do
+      let s = "[![BSD3 license](https://img.shields.io/badge/license-BSD3-blue.svg)](https://github.com/aelve/guide/blob/master/LICENSE)"
+      let html = snd (convert s)
+      let l = "<a href=\"https://github.com/aelve/guide/blob/master/LICENSE\" target=\"_blank\"><img src=\"https://img.shields.io/badge/license-BSD3-blue.svg\" alt=\"BSD3 license\" /></a>"
+      html `shouldSatisfy` (`elem` [l, "<p>"<>l<>"</p>\n"])
+    it "Test addTargetBlank" $ do
+      let node = MD.Node
+            Nothing
+            ( LINK "https://github.com/aelve/guide/blob/master/LICENSE" "" )
+            [ MD.Node Nothing ( IMAGE "https://img.shields.io/badge/license-BSD3-blue.svg" "" )
+              [ MD.Node Nothing ( TEXT "BSD3 license" ) [] ]]
+      let nodeBlanked = MD.Node
+            Nothing
+            ( HTML_INLINE "<a href=\"https://github.com/aelve/guide/blob/master/LICENSE\" target=\"_blank\"><img src=\"https://img.shields.io/badge/license-BSD3-blue.svg\" alt=\"BSD3 license\" /></a>" )
+            []
+      nodeBlanked `shouldBe` addTargetBlank node
 
   describe "inline Markdown" $ do
     it "works" $ do