elm-pages-v3-beta/plugins/MarkdownCodec.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