{-# LANGUAGE OverloadedStrings #-}
module Gemoire.Converter.Markdown
(
defMarkdownConversion
, escapeContent
, defDocument
, defText
, defLink
, defH1
, defH2
, defH3
, defList
, defListItem
, defQuote
, defPre
) where
import Control.Arrow (second)
import Data.Char (isSpace)
import Data.HashMap.Strict (empty)
import Data.Text (Text)
import qualified Data.Text as T
import Gemoire.Converter.Types (Conversion (..))
import Gemoire.Template (Template, template)
defMarkdownConversion :: Conversion
defMarkdownConversion :: Conversion
defMarkdownConversion =
Conversion
{ targetExtension :: String
targetExtension = String
".md"
, escaper :: Text -> Text
escaper = Text -> Text
escapeContent
, preEscaper :: Text -> Text
preEscaper = Text -> Text
forall a. a -> a
id
, attrEscaper :: Text -> Text
attrEscaper = Text -> Text
escapeContent
, documentTemplate :: Template
documentTemplate = Template
defDocument
, textTemplate :: Template
textTemplate = Template
defText
, linkTemplate :: Template
linkTemplate = Template
defLink
, h1Template :: Template
h1Template = Template
defH1
, h2Template :: Template
h2Template = Template
defH2
, h3Template :: Template
h3Template = Template
defH3
, listTemplates :: (Template, Template)
listTemplates = (Template
defList, Template
defListItem)
, quoteTemplate :: Template
quoteTemplate = Template
defQuote
, preTemplate :: Template
preTemplate = Template
defPre
, rewriteRules :: [RewriteRule]
rewriteRules = []
, conversionOverrides :: Values
conversionOverrides = Values
forall k v. HashMap k v
empty
}
escapeContent :: Text -> Text
escapeContent :: Text -> Text
escapeContent =
Text -> Text -> Text -> Text
replaceOnStart Text
">" Text
"\\>"
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
replaceOnStart Text
"-" Text
"\\-"
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
replaceOnStart Text
"+" Text
"\\+"
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
replaceOnStart Text
"*" Text
"\\*"
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
replaceOnStart Text
"#" Text
"\\#"
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"(" Text
"\\("
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
")" Text
"\\)"
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"[" Text
"\\["
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"]" Text
"\\]"
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\\" Text
"\\\\"
replaceOnStart :: Text -> Text -> Text -> Text
replaceOnStart :: Text -> Text -> Text -> Text
replaceOnStart Text
a Text
b Text
text =
(Text -> Text -> Text) -> (Text, Text) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>)
((Text, Text) -> Text) -> (Text -> (Text, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> (Text, Text) -> (Text, Text)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
text (Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Maybe Text -> Text) -> (Text -> Maybe Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Maybe Text
T.stripPrefix Text
a)
((Text, Text) -> (Text, Text))
-> (Text -> (Text, Text)) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isSpace
(Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
text
defDocument :: Template
defDocument :: Template
defDocument = Text -> Template
template Text
"{$body$}\LF"
defText :: Template
defText :: Template
defText = Text -> Template
template Text
"{$text$} "
defLink :: Template
defLink :: Template
defLink = Text -> Template
template Text
"[{&description:link&}]({$link$}) "
defH1 :: Template
defH1 :: Template
defH1 = Text -> Template
template Text
"# {$text$}"
defH2 :: Template
defH2 :: Template
defH2 = Text -> Template
template Text
"## {$text$}"
defH3 :: Template
defH3 :: Template
defH3 = Text -> Template
template Text
"### {$text$}"
defList :: Template
defList :: Template
defList = Text -> Template
template Text
"{$items$}"
defListItem :: Template
defListItem :: Template
defListItem = Text -> Template
template Text
"- {$text$}"
defQuote :: Template
defQuote :: Template
defQuote = Text -> Template
template Text
"> {$text$}"
defPre :: Template
defPre :: Template
defPre =
Text -> Template
template (Text -> Template) -> ([Text] -> Text) -> [Text] -> Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\LF" ([Text] -> Template) -> [Text] -> Template
forall a b. (a -> b) -> a -> b
$
[ Text
"```{$alt$}"
, Text
"{$text$}"
, Text
"```"
]