6 files changed, 40 insertions(+), 19 deletions(-)

M src/Document.hs
M src/Gemini/Compile.hs
M src/Html/Compile.hs
M src/Html/Internal.hs
M src/Markup/Parse.hs
M test/Markup/ParseSpec.hs

@@ 49,11 49,12 @@ condense xs = xs
 
 -- wrapper type around strings for formatted text
 data Text
-  = Plain String
-  | Italic [Text]
-  | Bold [Text]
+  = Bold [Text]
   | CodeInline String
+  | Italic [Text]
   | Link [Text] URL
+  | Plain String
+  | Strikeout [Text]
   deriving (Eq, Show)
 
 type URL = String

@@ 59,9 59,10 @@ compileAST =
 compileText :: Text -> String
 compileText =
   \case
-    Plain s -> s
-    Italic ts -> (concatMap compileText ts)
-    Bold ts -> (concatMap compileText ts)
+    Bold ts -> concatMap compileText ts
     CodeInline s -> "`" ++ s ++ "`"
+    Italic ts -> concatMap compileText ts
     -- FIXME: move inline URLS to end of 'block'
     Link ts url -> "\n=> " ++ url ++ "\t" ++ (concatMap compileText ts) ++ "\n"
+    Plain s -> s
+    Strikeout ts -> (concatMap compileText ts) ++ "^W"

@@ 53,6 53,7 @@ convertText =
   \case
     Plain s -> textProcess s
     Italic s -> Html.i_ $ convertTexts s
+    Strikeout s -> Html.s_ $ convertTexts s
     Bold s -> Html.b_ $ convertTexts s
     CodeInline s -> Html.codeInline_ $ escape s
     Link n u -> Html.link_ u $ convertTexts n

@@ 19,6 19,7 @@ module Html.Internal
   , ol_
   , p_
   , p_indent_
+  , s_
   , ul_
   , quote_
   ) where


@@ 113,6 114,9 @@ i_ = tagWrap "i"
 b_ :: String -> Structure
 b_ = tagWrap "b"
 
+s_ :: String -> Structure
+s_ = tagWrap "s"
+
 codeInline_ :: String -> Structure
 codeInline_ = tagWrap "code"
 

@@ 17,6 17,7 @@ module Markup.Parse
   , parseWithEof
   , parseWithLeftover
   , plain
+  , strikeout
   , text
   , url
   ) where


@@ 75,25 76,30 @@ delimit1 l r = between (string l) (string r) (many1 $ noneOf r)
 -- inline text formatting
 --
 codeInline :: Parser Text
-codeInline = fmap CodeInline $ delimit1 "`" "`"
+codeInline = CodeInline <$> delimit1 "`" "`"
 
 italic :: Parser Text
-italic = fmap (Italic . format) $ delimit1 "_" "_"
+italic = Italic . format <$> delimit1 "_" "_"
 
 bold :: Parser Text
-bold = fmap (Bold . format) $ delimit1 "*" "*"
+bold = Bold . format <$> delimit1 "*" "*"
+
+strikeout :: Parser Text
+strikeout = Strikeout . format <$> delimit1 "~" "~"
 
 url :: Parser Text
 url = Link <$> (fmap format $ delimit1 "[" "]") <*> delimit1 "(" ")"
 
 delims :: [Char]
-delims = "*_`[]" -- characters that define inline formatting
+delims = "*_`[]~" -- characters that define inline formatting
 
 plain :: Parser Text
 plain = fmap Plain $ many1 $ noneOf delims
 
 text :: Parser Text
-text = choice [try italic, try bold, try codeInline, try url, try plain]
+text =
+  choice
+    [try italic, try bold, try codeInline, try strikeout, try url, try plain]
 
 format :: String -> [Text]
 format s =


@@ 131,17 137,17 @@ img = do
 
 header :: Parser AST
 header = do
-  delims <- many1 $ char '#'
+  hdelims <- many1 $ char '#'
   optional whitespace
-  body <- line
-  return $ Header (length delims) (format body)
+  hbody <- line
+  return $ Header (length hdelims) (format hbody)
 
 centerText :: Parser AST
 centerText = fmap (CenterText . format) $ delimit1 "{{{" "}}}"
 
 paragraph :: Parser AST
 paragraph =
-  (Paragraph . format) <$> (manyTill anyToken . try . lookAhead $ string "\n")
+  Paragraph . format <$> (manyTill anyToken . try . lookAhead $ string "\n")
 
 ast :: Parser AST
 ast =

@@ 13,7 13,8 @@ spec = do
         it "configElem" $ do
             parseWithEof (configElem line "title") "title: title config\n" `shouldBe`
                 Right "title config"
-            parseWithEof (configElem line "style") "style:s\n" `shouldBe` Right "s"
+            parseWithEof (configElem line "style") "style:s\n" `shouldBe`
+                Right "s"
         it "config" $ do
             parseWithEof config "---\ntitle: TITLE\ntoc: False\n---\n" `shouldBe`
                 Right


@@ 55,6 56,9 @@ spec = do
                 Right (Italic [Plain "italic"])
         it "bold" $ do
             parseWithEof bold "*bold*" `shouldBe` Right (Bold [Plain "bold"])
+        it "strikeout" $ do
+            parseWithEof strikeout "~strikeout~" `shouldBe`
+                Right (Strikeout [Plain "strikeout"])
         it "url" $ do
             parseWithEof url "[url text](https://hate.net)" `shouldBe`
                 Right (Link [Plain "url text"] "https://hate.net")


@@ 62,10 66,12 @@ spec = do
             parseWithEof plain "just some text" `shouldBe`
                 Right (Plain "just some text")
         it "text" $ do
-            parseWithEof text "[*_url + bold + italic_*](*_no formatting_*)" `shouldBe`
+            parseWithEof text "[~*_url + bold + italic_*~](*_no formatting_*)" `shouldBe`
                 Right
                     (Link
-                         [Bold [Italic [Plain "url + bold + italic"]]]
+                         [ Strikeout
+                               [Bold [Italic [Plain "url + bold + italic"]]]
+                         ]
                          "*_no formatting_*")
     describe "ast" $ do
         it "codeBlock" $ do


@@ 74,13 80,15 @@ spec = do
         it "paragraph" $ do
             parseWithLeftover paragraph "some text\n" `shouldBe`
                 Right (Paragraph [Plain "some text"], "\n")
-            parseWithLeftover paragraph "some *formatted* _text_\n" `shouldBe`
+            parseWithLeftover paragraph "some *formatted* _text_ ~here~\n" `shouldBe`
                 Right
                     ( Paragraph
                           [ Plain "some "
                           , Bold [Plain "formatted"]
                           , Plain " "
                           , Italic [Plain "text"]
+                          , Plain " "
+                          , Strikeout [Plain "here"]
                           ]
                     , "\n")
     describe "asts" $ do