Chapter 5.1 - Convert markup to HTML

Convert.hs

@@ -0,0 +1,27 @@
+-- Convert.hs
+
+module Convert where
+
+import qualified Markup
+import qualified Html
+
+convert :: Html.Title -> Markup.Document -> Html.Html
+convert title = Html.html_ title . foldMap convertStructure
+
+convertStructure :: Markup.Structure -> Html.Structure
+convertStructure structure =
+  case structure of
+    Markup.Heading n txt ->
+      Html.h_ n txt
+
+    Markup.Paragraph p ->
+      Html.p_ p
+
+    Markup.UnorderedList list ->
+      Html.ul_ $ map Html.p_ list
+
+    Markup.OrderedList list ->
+      Html.ol_ $ map Html.p_ list
+
+    Markup.CodeBlock list ->
+      Html.code_ (unlines list)

Html.hs

@@ -5,12 +5,11 @@ module Html
   , Title
   , Structure
   , html_
-  , h1_
+  , h_
   , p_
   , ul_
   , ol_
   , code_
-  , append_
   , render
   )
   where

Html/Internal.hs

@@ -2,6 +2,8 @@
 
 module Html.Internal where
 
+import Numeric.Natural
+
 -- * Types
 
 newtype Html
@@ -27,8 +29,8 @@ html_ title content =
 p_ :: String -> Structure
 p_ = Structure . el "p" . escape
 
-h1_ :: String -> Structure
-h1_ = Structure . el "h1" . escape
+h_ :: Natural -> String -> Structure
+h_ n = Structure . el ("h" <> show n) . escape
 
 ul_ :: [Structure] -> Structure
 ul_ =
@@ -41,9 +43,12 @@ ol_ =
 code_ :: String -> Structure
 code_ = Structure . el "pre" . escape
 
-append_ :: Structure -> Structure -> Structure
-append_ c1 c2 =
-  Structure (getStructureString c1 <> getStructureString c2)
+instance Semigroup Structure where
+  (<>) c1 c2 =
+    Structure (getStructureString c1 <> getStructureString c2)
+
+instance Monoid Structure where
+  mempty = Structure ""
 
 -- * Render
 

hello.hs

@@ -9,10 +9,7 @@ myhtml :: Html
 myhtml =
   html_
     "My title"
-    ( append_
-      (h1_ "Heading")
-      ( append_
-        (p_ "Paragraph #1")
-        (p_ "Paragraph #2")
-      )
+    ( h_ 1 "Heading"
+      <> p_ "Paragraph #1"
+      <> p_ "Paragraph #2"
     )