elm-pages-v3-beta/plugins/MarkdownCodec.elm

417 lines
15 KiB
Elm
Raw Normal View History

module MarkdownCodec exposing (noteTitle, titleAndDescription, withFrontmatter, withoutFrontmatter)
2021-06-18 19:01:03 +03:00
import DataSource exposing (DataSource)
import DataSource.File as StaticFile
import List.Extra
2021-06-18 19:01:03 +03:00
import Markdown.Block as Block exposing (Block)
import Markdown.Parser
import Markdown.Renderer
import OptimizedDecoder exposing (Decoder)
2021-06-18 19:01:03 +03:00
import Serialize as S
noteTitle : String -> DataSource String
noteTitle filePath =
titleFromFrontmatter filePath
|> DataSource.andThen
(\maybeTitle ->
maybeTitle
|> Maybe.map DataSource.succeed
|> Maybe.withDefault
(StaticFile.bodyWithoutFrontmatter filePath
|> DataSource.andThen
(\rawContent ->
Markdown.Parser.parse rawContent
|> Result.mapError (\_ -> "Markdown error")
|> Result.map
(\blocks ->
List.Extra.findMap
(\block ->
case block of
Block.Heading Block.H1 inlines ->
Just (Block.extractInlineText inlines)
_ ->
Nothing
)
blocks
)
|> Result.andThen (Result.fromMaybe <| "Expected to find an H1 heading for page " ++ filePath)
|> DataSource.fromResult
)
)
)
|> DataSource.distillSerializeCodec ("note-title-" ++ filePath) S.string
titleAndDescription : String -> DataSource { title : String, description : String }
titleAndDescription filePath =
filePath
|> StaticFile.onlyFrontmatter
(OptimizedDecoder.map2 (\title description -> { title = title, description = description })
(OptimizedDecoder.optionalField "title" OptimizedDecoder.string)
(OptimizedDecoder.optionalField "description" OptimizedDecoder.string)
)
|> DataSource.andThen
(\metadata ->
Maybe.map2 (\title description -> { title = title, description = description })
metadata.title
metadata.description
|> Maybe.map DataSource.succeed
|> Maybe.withDefault
(StaticFile.bodyWithoutFrontmatter filePath
|> DataSource.andThen
(\rawContent ->
Markdown.Parser.parse rawContent
|> Result.mapError (\_ -> "Markdown error")
|> Result.map
(\blocks ->
Maybe.map
(\title ->
{ title = title
, description =
case metadata.description of
Just description ->
description
Nothing ->
findDescription blocks
}
)
(case metadata.title of
Just title ->
Just title
Nothing ->
findH1 blocks
)
)
|> Result.andThen (Result.fromMaybe <| "Expected to find an H1 heading for page " ++ filePath)
|> DataSource.fromResult
)
)
)
findH1 : List Block -> Maybe String
findH1 blocks =
List.Extra.findMap
(\block ->
case block of
Block.Heading Block.H1 inlines ->
Just (Block.extractInlineText inlines)
_ ->
Nothing
2021-06-23 08:14:48 +03:00
)
blocks
findDescription : List Block -> String
findDescription blocks =
blocks
|> List.Extra.findMap
(\block ->
case block of
Block.Paragraph inlines ->
Just (Block.extractInlineText inlines)
_ ->
Nothing
)
|> Maybe.withDefault ""
titleFromFrontmatter : String -> DataSource (Maybe String)
titleFromFrontmatter filePath =
StaticFile.onlyFrontmatter
(OptimizedDecoder.optionalField "title" OptimizedDecoder.string)
filePath
2021-06-23 08:14:48 +03:00
withoutFrontmatter :
Markdown.Renderer.Renderer view
-> String
-> DataSource (List view)
withoutFrontmatter renderer filePath =
(StaticFile.bodyWithoutFrontmatter
filePath
|> DataSource.andThen
(\rawBody ->
rawBody
|> Markdown.Parser.parse
|> Result.mapError (\_ -> "Couldn't parse markdown.")
|> DataSource.fromResult
)
)
|> DataSource.distillSerializeCodec ("markdown-blocks-" ++ filePath)
(S.list codec)
|> DataSource.andThen
(\blocks ->
blocks
|> Markdown.Renderer.render renderer
|> DataSource.fromResult
)
withFrontmatter :
2021-06-23 08:14:48 +03:00
(frontmatter -> List view -> value)
-> Decoder frontmatter
-> Markdown.Renderer.Renderer view
-> String
-> DataSource value
withFrontmatter constructor frontmatterDecoder renderer filePath =
DataSource.map2 constructor
(StaticFile.onlyFrontmatter
frontmatterDecoder
filePath
)
((StaticFile.bodyWithoutFrontmatter
filePath
|> DataSource.andThen
(\rawBody ->
rawBody
|> Markdown.Parser.parse
|> Result.mapError (\_ -> "Couldn't parse markdown.")
|> DataSource.fromResult
)
)
|> DataSource.distillSerializeCodec ("markdown-blocks-" ++ filePath)
(S.list codec)
|> DataSource.andThen
(\blocks ->
blocks
|> Markdown.Renderer.render renderer
|> DataSource.fromResult
)
)
2021-06-18 19:01:03 +03:00
codec : S.Codec Never Block
codec =
S.customType
(\encodeThematicBreak encodeHtmlBlock encodeUnorderedList encodeOrderedList encodeBlockQuote encodeHeading encodeParagraph encodeTable encodeCodeBlock value ->
case value of
Block.ThematicBreak ->
encodeThematicBreak
Block.HtmlBlock html ->
encodeHtmlBlock html
Block.UnorderedList listItems ->
encodeUnorderedList listItems
Block.OrderedList int lists ->
encodeOrderedList int lists
Block.BlockQuote blocks ->
encodeBlockQuote blocks
Block.Heading headingLevel inlines ->
encodeHeading headingLevel inlines
Block.Paragraph inlines ->
encodeParagraph inlines
Block.Table header rows ->
encodeTable header rows
Block.CodeBlock record ->
encodeCodeBlock record
)
|> S.variant0 Block.ThematicBreak
|> S.variant1 Block.HtmlBlock htmlCodec
|> S.variant1 Block.UnorderedList (S.list listItemCodec)
|> S.variant2 Block.OrderedList S.int (S.list (S.list inlineCodec))
|> S.variant1 Block.BlockQuote (S.list (S.lazy (\() -> codec)))
|> S.variant2 Block.Heading headingCodec (S.list inlineCodec)
|> S.variant1 Block.Paragraph (S.list inlineCodec)
|> S.variant2 Block.Table tableHeaderCodec (S.list (S.list (S.list inlineCodec)))
|> S.variant1 Block.CodeBlock
(S.record (\body language -> { body = body, language = language })
|> S.field .body S.string
|> S.field .language (S.maybe S.string)
|> S.finishRecord
)
|> S.finishCustomType
tableHeaderCodec :
S.Codec
Never
(List
{ label : List Block.Inline
, alignment : Maybe Block.Alignment
}
)
tableHeaderCodec =
S.record (\label alignment -> { label = label, alignment = alignment })
|> S.field .label (S.list inlineCodec)
|> S.field .alignment (S.maybe alignmentCodec)
|> S.finishRecord
|> S.list
alignmentCodec : S.Codec Never Block.Alignment
alignmentCodec =
S.customType
(\encodeAlignLeft encodeAlignRight encodeAlignCenter value ->
case value of
Block.AlignLeft ->
encodeAlignLeft
Block.AlignRight ->
encodeAlignRight
Block.AlignCenter ->
encodeAlignCenter
)
|> S.variant0 Block.AlignLeft
|> S.variant0 Block.AlignRight
|> S.variant0 Block.AlignCenter
|> S.finishCustomType
headingCodec : S.Codec Never Block.HeadingLevel
headingCodec =
S.customType
(\encodeH1 encodeH2 encodeH3 encodeH4 encodeH5 encodeH6 value ->
case value of
Block.H1 ->
encodeH1
Block.H2 ->
encodeH2
Block.H3 ->
encodeH3
Block.H4 ->
encodeH4
Block.H5 ->
encodeH5
Block.H6 ->
encodeH6
)
|> S.variant0 Block.H1
|> S.variant0 Block.H2
|> S.variant0 Block.H3
|> S.variant0 Block.H4
|> S.variant0 Block.H5
|> S.variant0 Block.H6
|> S.finishCustomType
inlineCodec : S.Codec Never Block.Inline
inlineCodec =
S.customType
(\encodeHardLineBreak encodeHtmlInline encodeLink encodeImage encodeEmphasis encodeStrong encodeStrikethrough encodeCodeSpan encodeText value ->
case value of
Block.HardLineBreak ->
encodeHardLineBreak
Block.HtmlInline html ->
encodeHtmlInline html
Block.Link string maybeString inlines ->
encodeLink string maybeString inlines
Block.Image string maybeString inlines ->
encodeImage string maybeString inlines
Block.Emphasis inlines ->
encodeEmphasis inlines
Block.Strong inlines ->
encodeStrong inlines
Block.Strikethrough inlines ->
encodeStrikethrough inlines
Block.CodeSpan string ->
encodeCodeSpan string
Block.Text string ->
encodeText string
)
|> S.variant0 Block.HardLineBreak
|> S.variant1 Block.HtmlInline htmlCodec
|> S.variant3 Block.Link S.string (S.maybe S.string) (S.list (S.lazy (\() -> inlineCodec)))
|> S.variant3 Block.Image S.string (S.maybe S.string) (S.list (S.lazy (\() -> inlineCodec)))
|> S.variant1 Block.Emphasis (S.list (S.lazy (\() -> inlineCodec)))
|> S.variant1 Block.Strong (S.list (S.lazy (\() -> inlineCodec)))
|> S.variant1 Block.Strikethrough (S.list (S.lazy (\() -> inlineCodec)))
|> S.variant1 Block.CodeSpan S.string
|> S.variant1 Block.Text S.string
|> S.finishCustomType
htmlCodec : S.Codec Never (Block.Html Block)
htmlCodec =
S.customType
(\encodeHtmlElement encodeHtmlComment encodeProcessingInstruction encodeHtmlDeclaration encodeCdata value ->
case value of
Block.HtmlElement tag attributes children ->
encodeHtmlElement tag attributes children
Block.HtmlComment comment ->
encodeHtmlComment comment
Block.ProcessingInstruction string ->
encodeProcessingInstruction string
Block.HtmlDeclaration string1 string2 ->
encodeHtmlDeclaration string1 string2
Block.Cdata string ->
encodeCdata string
)
|> S.variant3 Block.HtmlElement S.string (S.list htmlAttributeCodec) (S.list (S.lazy (\() -> codec)))
|> S.variant1 Block.HtmlComment S.string
|> S.variant1 Block.ProcessingInstruction S.string
|> S.variant2 Block.HtmlDeclaration S.string S.string
|> S.variant1 Block.Cdata S.string
|> S.finishCustomType
htmlAttributeCodec : S.Codec Never { name : String, value : String }
htmlAttributeCodec =
S.record (\name value -> { name = name, value = value })
|> S.field .name S.string
|> S.field .value S.string
|> S.finishRecord
listItemCodec : S.Codec Never (Block.ListItem Block.Inline)
listItemCodec =
S.customType
(\encodeListItem value ->
case value of
Block.ListItem task children ->
encodeListItem task children
)
|> S.variant2 Block.ListItem taskCodec (S.list inlineCodec)
|> S.finishCustomType
taskCodec : S.Codec Never Block.Task
taskCodec =
S.customType
(\encodeNoTask encodeIncompleteTask encodeCompletedTask value ->
case value of
Block.NoTask ->
encodeNoTask
Block.IncompleteTask ->
encodeIncompleteTask
Block.CompletedTask ->
encodeCompletedTask
)
|> S.variant0 Block.NoTask
|> S.variant0 Block.IncompleteTask
|> S.variant0 Block.CompletedTask
|> S.finishCustomType