Chapter 6 - HTML content

Author: soupi

src/HsBlog/Convert.hs

@@ -12,16 +12,16 @@ convertStructure :: Markup.Structure -> Html.Structure
 convertStructure structure =
   case structure of
     Markup.Heading n txt ->
-      Html.h_ n txt
+      Html.h_ n $ Html.txt_ txt
 
     Markup.Paragraph p ->
-      Html.p_ p
+      Html.p_ $ Html.txt_ p
 
     Markup.UnorderedList list ->
-      Html.ul_ $ map Html.p_ list
+      Html.ul_ $ map (Html.p_ . Html.txt_) list
 
     Markup.OrderedList list ->
-      Html.ol_ $ map Html.p_ list
+      Html.ol_ $ map (Html.p_ . Html.txt_) list
 
     Markup.CodeBlock list ->
       Html.code_ (unlines list)

src/HsBlog/Html.hs

@@ -10,6 +10,12 @@ module HsBlog.Html
   , ul_
   , ol_
   , code_
+  , Content
+  , txt_
+  , img_
+  , link_
+  , b_
+  , i_
   , render
   )
   where

src/HsBlog/Html/Internal.hs

@@ -12,6 +12,9 @@ newtype Html
 newtype Structure
   = Structure String
 
+newtype Content
+  = Content String
+
 type Title
   = String
 
@@ -26,11 +29,13 @@ html_ title content =
       )
     )
 
-p_ :: String -> Structure
-p_ = Structure . el "p" . escape
+-- * Structure
+
+p_ :: Content -> Structure
+p_ = Structure . el "p" . getContentString
 
-h_ :: Natural -> String -> Structure
-h_ n = Structure . el ("h" <> show n) . escape
+h_ :: Natural -> Content -> Structure
+h_ n = Structure . el ("h" <> show n) . getContentString
 
 ul_ :: [Structure] -> Structure
 ul_ =
@@ -50,6 +55,38 @@ instance Semigroup Structure where
 instance Monoid Structure where
   mempty = Structure ""
 
+-- * Content
+
+txt_ :: String -> Content
+txt_ = Content . escape
+
+link_ :: FilePath -> Content -> Content
+link_ path content =
+  Content $
+    elAttr
+      "a"
+      ("href=\"" <> escape path <> "\"")
+      (getContentString content)
+
+img_ :: FilePath -> Content
+img_ path =
+  Content $ "<img src=\"" <> escape path <> "\">"
+
+b_ :: Content -> Content
+b_ content =
+  Content $ el "b" (getContentString content)
+
+i_ :: Content -> Content
+i_ content =
+  Content $ el "i" (getContentString content)
+
+instance Semigroup Content where
+  (<>) c1 c2 =
+    Content (getContentString c1 <> getContentString c2)
+
+instance Monoid Content where
+  mempty = Content ""
+
 -- * Render
 
 render :: Html -> String
@@ -63,11 +100,20 @@ el :: String -> String -> String
 el tag content =
   "<" <> tag <> ">" <> content <> "</" <> tag <> ">"
 
+elAttr :: String -> String -> String -> String
+elAttr tag attrs content =
+  "<" <> tag <> " " <> attrs <> ">" <> content <> "</" <> tag <> ">"
+
 getStructureString :: Structure -> String
-getStructureString content =
-  case content of
+getStructureString structure =
+  case structure of
     Structure str -> str
 
+getContentString :: Content -> String
+getContentString content =
+  case content of
+    Content str -> str
+
 escape :: String -> String
 escape =
   let