~jleightcap/hhtml

f6e115bbfa6e40e311acfe2b8aa9445d8f99d2c5 — jleightcap 4 months ago e12212a
strickout formatting
M src/Document.hs => src/Document.hs +4 -3
@@ 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

M src/Gemini/Compile.hs => src/Gemini/Compile.hs +4 -3
@@ 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"

M src/Html/Compile.hs => src/Html/Compile.hs +1 -0
@@ 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

M src/Html/Internal.hs => src/Html/Internal.hs +4 -0
@@ 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"


M src/Markup/Parse.hs => src/Markup/Parse.hs +15 -9
@@ 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 =

M test/Markup/ParseSpec.hs => test/Markup/ParseSpec.hs +12 -4
@@ 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