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

417 lines
15 KiB
Elm

module MarkdownCodec exposing (noteTitle, titleAndDescription, withFrontmatter, withoutFrontmatter)
import DataSource exposing (DataSource)
import DataSource.File as StaticFile
import List.Extra
import Markdown.Block as Block exposing (Block)
import Markdown.Parser
import Markdown.Renderer
import OptimizedDecoder exposing (Decoder)
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
)
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
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 :
(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
)
)
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