CommonMark mode

#18
dahlia · Nov 16, 2021 · aa44d24 · aa44d24
1 parent b938a29
commit aa44d24
Show file tree

Hide file tree

Showing 7 changed files with 279 additions and 24 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -15,6 +15,7 @@ To be released.
      -  `text/html` (previously non-XHTML mode)
      -  `application/xhtml+xml` (previously XHTML mode)
      -  `text/plain` (added)
+     -  `text/markdown` (added)
 
     The below Haskell APIs changed:
 

diff --git a/app/seonbi-api.hs b/app/seonbi-api.hs
@@ -291,5 +291,6 @@ main = do
     let netloc = showHostPreference (getHost serverSettings') ++ ":" ++
             show (getPort serverSettings')
     let url = "http://" ++ netloc ++ "/"
+    hPutStrLn stderr $ "seonbi-api v" ++ showVersion Meta.version
     hPutStrLn stderr url
     runSettings serverSettings' $ app appOptions
diff --git a/demo/src/Demo.elm b/demo/src/Demo.elm
@@ -27,7 +27,9 @@ import Http
 import Json.Decode
 import Json.Encode
 import List
+import Markdown
 import Markdown.Block
+import Markdown.Config
 import Markdown.HtmlString
 import Maybe
 import Regex
@@ -128,11 +130,12 @@ type ContentType
     = Html
     | Xhtml
     | PlainText
+    | CommonMark
 
 
 parseContentType : String -> Maybe ContentType
 parseContentType contentType =
-    [ Html, Xhtml, PlainText ]
+    [ Html, Xhtml, PlainText, CommonMark ]
         |> List.filterMap
             (\t ->
                 if stringifyContentType t == contentType then
@@ -156,6 +159,9 @@ stringifyContentType contentType =
         PlainText ->
             "text/plain"
 
+        CommonMark ->
+            "text/markdown"
+
 
 contentTypeLabel : ContentType -> String
 contentTypeLabel contentType =
@@ -169,6 +175,9 @@ contentTypeLabel contentType =
         PlainText ->
             "Plain text"
 
+        CommonMark ->
+            "Markdown"
+
 
 isHtml : ContentType -> Bool
 isHtml t =
@@ -309,13 +318,13 @@ makeInput source =
     ( apiServerUrl
     , Json.Encode.object <|
         List.append
-            [ ( "sourceHtml"
+            [ ( "content"
               , Json.Encode.string <|
-                    if source.contentType == PlainText then
-                        Maybe.withDefault "" source.text
+                    if isHtml source.contentType then
+                        source.html
 
                     else
-                        source.html
+                        Maybe.withDefault "" source.text
               )
             , ( "contentType"
               , stringifyContentType source.contentType
@@ -891,16 +900,20 @@ viewRenderTab model =
             Tab.pane tabPaneAttrs <|
                 case model.result of
                     Just result ->
-                        if result.contentType == PlainText then
-                            nl2br result.content
+                        case result.contentType of
+                            PlainText ->
+                                nl2br result.content
 
-                        else
-                            case Html.Parser.run result.content of
-                                Ok nodes ->
-                                    Html.Parser.Util.toVirtualDom nodes
+                            CommonMark ->
+                                Markdown.toHtml markdownOptions result.content
+
+                            _ ->
+                                case Html.Parser.run result.content of
+                                    Ok nodes ->
+                                        Html.Parser.Util.toVirtualDom nodes
 
-                                Err _ ->
-                                    []
+                                    Err _ ->
+                                        []
 
                     _ ->
                         []
@@ -928,6 +941,9 @@ viewCodeTab model =
                                         PlainText ->
                                             noLang
 
+                                        CommonMark ->
+                                            noLang
+
                                         _ ->
                                             xml
                                    )
@@ -957,9 +973,18 @@ viewWarningsTab warnings =
         }
 
 
+markdownOptions : Maybe Markdown.Config.Options
+markdownOptions =
+    let
+        defaultOptions =
+            Markdown.Config.defaultOptions
+    in
+    Just { defaultOptions | rawHtml = Markdown.Config.ParseUnsafe }
+
+
 renderMarkdown : String -> String
 renderMarkdown =
-    Markdown.Block.parse Nothing
+    Markdown.Block.parse markdownOptions
         >> Markdown.HtmlString.render
 
 
@@ -1490,7 +1515,7 @@ viewOptions model =
                                 ]
                                 [ text <| contentTypeLabel t ]
                         )
-                        [ Html, Xhtml, PlainText ]
+                        [ Html, Xhtml, PlainText, CommonMark ]
                 ]
             ]
         ]
diff --git a/package.yaml b/package.yaml
@@ -35,6 +35,7 @@ dependencies:
 - base >= 4.12 && < 5
 - bytestring
 - containers
+- html-entities >= 1 && < 2
 - text
 flags:
   static:
@@ -70,10 +71,10 @@ library:
   - bytestring-trie >= 0.2.5 && < 0.3
   - cassava >= 0.5 && < 0.6
   - case-insensitive >= 1 && < 2
+  - cmark >= 0.6 && < 1
   - data-default >= 0.2 && < 1
   - filepath >= 1 && < 2
   - file-embed >= 0.0.10 && < 0.0.16
-  - html-entities >= 1 && < 2
   when:
   - condition: flag(static) || flag(embed-dictionary)
     then:

diff --git a/scripts/deno/mod.ts b/scripts/deno/mod.ts
@@ -38,7 +38,8 @@ export type Dictionary = "kr-stdict";
 export type ContentType =
   | "text/html"
   | "application/xhtml+xml"
-  | "plain/text";
+  | "text/plain"
+  | "text/markdown";
 
 /**
  * Options for transformation.