Editor.elm

module Sticky.Editor exposing
    ( Model, Msg, init, update, view
    , Style(..), BlockStyle(..)
    , toggleStyle, toggleBlockStyle
    , ControlContext, getControlContext
    , Selection(..)
    , setSelection
    )

{-|


# TEA model.

@docs Model, Msg, init, update, view


# Available inline or block styles .

@docs Style, BlockStyle


# Control actions.

@docs toggleStyle, toggleBlockStyle


# Context to assist with correctly rendering and applying control actions.

@docs ControlContext, getControlContext


# Cursor control and reporting.

@docs Selection

-}

import Array exposing (Array)
import Html exposing (Html)
import Html.Attributes
import Markdown.Block as Block
import Markdown.Config
import Markdown.Inline as Inline
import Maybe.Extra
import Regex
import RichText.Commands as Commands
import RichText.Config.Command as Command exposing (CommandMap)
import RichText.Config.Decorations as Decorations exposing (Decorations)
import RichText.Config.Keys as Keys
import RichText.Config.Spec exposing (Spec)
import RichText.Definitions as Definitions
import RichText.Editor as Editor exposing (Config, Editor, Message)
import RichText.List as RTList exposing (ListType)
import RichText.Model.Attribute as Attribute
import RichText.Model.Element as Element exposing (Element)
import RichText.Model.History as History
import RichText.Model.InlineElement as InlineElement
import RichText.Model.Mark as Mark exposing (Mark, MarkOrder)
import RichText.Model.Node as ModelNode exposing (Block, Children, Inline, InlineTree, Path)
import RichText.Model.Selection as Selection
import RichText.Model.State as State exposing (State)
import RichText.Model.Text as Text
import RichText.Node as Node exposing (Node)
import Set exposing (Set)
import Update2


type alias Model =
    { editor : Editor
    , styles : List Style
    , textMarkdown : String
    , markdownError : Maybe String
    , id : String
    , spec : Spec
    }


type Msg
    = InternalMsg Message


type Style
    = Bold
    | Italic
    | Code


type BlockStyle
    = CodeBlock
    | Heading Int


type alias ControlContext =
    { hasInline : Bool
    , selection : Selection
    , hasUndo : Bool
    , hasRedo : Bool
    , nodes : Set String
    , marks : Set String
    , canLift : Bool
    }


type Selection
    = NoSelection
    | Collapsed
        { offset : Int
        , node : List Int
        }
    | Range
        { anchorOffset : Int
        , anchorNode : List Int
        , focusOffset : Int
        , focusNode : List Int
        }


config : String -> Config Msg
config id =
    Editor.config
        { decorations = decorations id
        , commandMap = commandBindings Definitions.markdown
        , spec = Definitions.markdown
        , toMsg = InternalMsg
        }



-- spec : Spec
-- spec =
--     Editor.spec config


defaultInitialState : Selection -> State
defaultInitialState sel =
    let
        docInitNode : Block
        docInitNode =
            ModelNode.block
                (Element.element Definitions.doc [])
                (ModelNode.blockChildren (Array.fromList [ initialEditorNode ]))

        initialEditorNode : Block
        initialEditorNode =
            ModelNode.block
                (Element.element Definitions.paragraph [])
                (ModelNode.inlineChildren (Array.fromList [ ModelNode.plainText "Sticky Note" ]))
    in
    State.state docInitNode
        (localSelectionToRteSelection sel)


initialStateFromMarkdown : String -> Selection -> Result String State
initialStateFromMarkdown textMarkdown sel =
    let
        parseMarkdown val =
            Block.parse
                (Just
                    { softAsHardLineBreak = False
                    , rawHtml = Markdown.Config.DontParse
                    }
                )
                val
    in
    textMarkdown
        -- |> Debug.log "textMarkdown"
        |> parseMarkdown
        -- |> Debug.log "parsed markdown"
        |> filterBlankLines
        --|> Debug.log "with blank lines filtered out"
        |> markdownToBlock
        --|> Debug.log "converted to editor blocks"
        |> Result.map (\doc -> State.state doc (localSelectionToRteSelection sel))


listCommandBindings : CommandMap
listCommandBindings =
    RTList.defaultCommandMap RTList.defaultListDefinition


emptyParagraph : Block
emptyParagraph =
    ModelNode.block
        (Element.element Definitions.paragraph [])
        (Array.fromList [ ModelNode.plainText "" ] |> ModelNode.inlineChildren)


commandBindings : Spec -> CommandMap
commandBindings commandSpec =
    let
        markOrder =
            Mark.markOrderFromSpec commandSpec
    in
    Command.combine
        listCommandBindings
        (Commands.defaultCommandMap
            |> Command.set [ Command.inputEvent "insertParagraph", Command.key [ Keys.enter ], Command.key [ Keys.return ] ]
                [ ( "insertNewline"
                  , Commands.insertNewline [ "code_block" ]
                        |> Command.transform
                  )
                , ( "liftEmpty"
                  , Commands.liftEmpty
                        |> Command.transform
                  )
                , ( "splitBlockHeaderToNewParagraph"
                  , Commands.splitBlockHeaderToNewParagraph [ "heading" ] (Element.element Definitions.paragraph [])
                        |> Command.transform
                  )
                , ( "insertEmptyParagraph"
                  , Commands.insertAfterBlockLeaf emptyParagraph
                        |> Command.transform
                  )
                ]
            |> Command.set [ Command.inputEvent "insertSpace", Command.key [ " " ] ]
                [ ( "insertSpace"
                  , Commands.insertText "\u{205F}"
                        |> Command.transform
                  )
                ]
            |> Command.set [ Command.inputEvent "formatBold", Command.key [ Keys.short, "b" ] ]
                [ ( "toggleStyle"
                  , Commands.toggleMark markOrder (Mark.mark Definitions.bold []) Mark.Flip
                        |> Command.transform
                  )
                ]
            |> Command.set [ Command.inputEvent "formatItalic", Command.key [ Keys.short, "i" ] ]
                [ ( "toggleStyle"
                  , Commands.toggleMark markOrder (Mark.mark Definitions.italic []) Mark.Flip
                        |> Command.transform
                  )
                ]
        )


decorations : String -> Decorations Msg
decorations id =
    Decorations.emptyDecorations
        |> Decorations.addElementDecoration Definitions.image (Decorations.selectableDecoration InternalMsg)
        |> Decorations.addElementDecoration Definitions.horizontalRule (Decorations.selectableDecoration InternalMsg)
        |> Decorations.withTopLevelAttributes
            [ -- Disable the grammarly plugin as it breaks the virtual dom.
              Html.Attributes.attribute "data-gramm_editor" "false"

            -- Prevent Firefox from spellchecking and underlining words mispelled.
            , Html.Attributes.attribute "spellcheck" "false"
            , Html.Attributes.id id
            ]


init : String -> String -> Selection -> Model
init id textMarkdown sel =
    let
        ( initialState, error ) =
            case initialStateFromMarkdown textMarkdown sel of
                Ok state ->
                    ( state, Nothing )

                Err err ->
                    ( defaultInitialState sel, Just err )
    in
    { editor = initialState |> Editor.init
    , styles = [ Bold, Italic ]
    , textMarkdown = textMarkdown
    , markdownError = error
    , id = id
    , spec = config id |> Editor.spec
    }


editorUpdate : Config msg -> Editor.Message -> Editor -> ( Editor, Cmd Editor.Message )
editorUpdate cfg msg ed =
    ( Editor.update cfg msg ed, Cmd.none )


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        InternalMsg internalEditorMsg ->
            model
                |> Update2.lift .editor (\x m -> { m | editor = x }) InternalMsg (editorUpdate (config model.id)) internalEditorMsg
                |> Update2.andThen extractMarkdown


extractMarkdown : Model -> ( Model, Cmd Msg )
extractMarkdown model =
    let
        markdownNodes =
            rootToMarkdown (State.root (Editor.state model.editor))

        ( result, error ) =
            case Result.andThen markdownToString markdownNodes of
                Err e ->
                    ( model.textMarkdown, Just e )

                Ok m ->
                    ( m, Nothing )
    in
    case error of
        Just e ->
            ( { model | markdownError = Just e }, Cmd.none )

        Nothing ->
            ( { model
                | textMarkdown = result
                , markdownError = Nothing
              }
            , Cmd.none
            )


unwrapBlock : Model -> Model
unwrapBlock model =
    { model
        | editor =
            Result.withDefault model.editor
                (Editor.applyList
                    [ ( "liftList"
                      , RTList.lift RTList.defaultListDefinition
                            |> Command.transform
                      )
                    , ( "lift"
                      , Command.transform Commands.lift
                      )
                    ]
                    model.spec
                    model.editor
                )
    }


wrapAsUnorderedListBlock : Model -> Model
wrapAsUnorderedListBlock model =
    wrapAsListBlock RTList.Unordered model


wrapAsOrderedListBlock : Model -> Model
wrapAsOrderedListBlock model =
    wrapAsListBlock RTList.Ordered model


wrapAsListBlock : ListType -> Model -> Model
wrapAsListBlock listType model =
    { model
        | editor =
            Result.withDefault model.editor
                (Editor.apply
                    ( "wrapList"
                    , RTList.wrap RTList.defaultListDefinition listType |> Command.transform
                    )
                    model.spec
                    model.editor
                )
    }


redo : Model -> Model
redo model =
    { model
        | editor =
            Result.withDefault model.editor
                (Editor.apply ( "redo", Command.internal Command.Redo ) model.spec model.editor)
    }


undo : Model -> Model
undo model =
    { model
        | editor =
            Result.withDefault model.editor
                (Editor.apply ( "undo", Command.internal Command.Undo ) model.spec model.editor)
    }


setSelection : Selection -> Model -> Model
setSelection sel model =
    { model
        | editor =
            Editor.state model.editor
                |> State.withSelection (localSelectionToRteSelection sel)
                |> Editor.init
    }


toggleStyle : Style -> Model -> Model
toggleStyle style model =
    let
        markDef =
            case style of
                Bold ->
                    Definitions.bold

                Italic ->
                    Definitions.italic

                Code ->
                    Definitions.code

        markOrder =
            Mark.markOrderFromSpec model.spec
    in
    { model
        | editor =
            Result.withDefault model.editor
                (Editor.apply
                    ( "toggleStyle"
                    , Commands.toggleMark markOrder (Mark.mark markDef []) Mark.Flip
                        |> Command.transform
                    )
                    model.spec
                    model.editor
                )
    }


toggleBlockStyle : BlockStyle -> Model -> Model
toggleBlockStyle blockStyle model =
    let
        onParams =
            case blockStyle of
                CodeBlock ->
                    Element.element
                        Definitions.codeBlock
                        []

                Heading level ->
                    Element.element
                        Definitions.heading
                        [ Attribute.IntegerAttribute
                            "level"
                            level
                        ]

        offParams =
            Element.element Definitions.paragraph []

        convertToPlainText =
            blockStyle == CodeBlock
    in
    { model
        | editor =
            Result.withDefault model.editor
                (Editor.apply
                    ( "toggleBlock"
                    , Commands.toggleTextBlock onParams offParams convertToPlainText |> Command.transform
                    )
                    model.spec
                    model.editor
                )
    }


wrapAsBlockQuote : Model -> Model
wrapAsBlockQuote model =
    { model
        | editor =
            Result.withDefault model.editor
                (Editor.apply
                    ( "wrapBlockquote"
                    , Commands.wrap
                        (\n -> n)
                        (Element.element Definitions.blockquote [])
                        |> Command.transform
                    )
                    model.spec
                    model.editor
                )
    }


insertHorizontalRule : Model -> Model
insertHorizontalRule model =
    { model
        | editor =
            Result.withDefault model.editor
                (Editor.apply
                    ( "insertHR"
                    , Commands.insertBlock
                        (ModelNode.block
                            (Element.element
                                Definitions.horizontalRule
                                []
                            )
                            ModelNode.Leaf
                        )
                        |> Command.transform
                    )
                    model.spec
                    model.editor
                )
    }


view : Model -> Html Msg
view model =
    Html.div
        [ Html.Attributes.class "editor-container"
        , Html.Attributes.attribute "data-gramm_editor" "false"
        ]
        [ Editor.view (config model.id) model.editor ]



--- Controls


emptyControlState : ControlContext
emptyControlState =
    { hasUndo = False
    , hasRedo = False
    , hasInline = False
    , selection = NoSelection
    , nodes = Set.empty
    , marks = Set.empty
    , canLift = False
    }


accumulateControlState : Node -> ControlContext -> ControlContext
accumulateControlState node controlState =
    case node of
        Node.Block n ->
            { controlState
                | nodes =
                    Set.insert (Element.name (ModelNode.element n)) controlState.nodes
            }

        Node.Inline inline ->
            let
                names =
                    List.map Mark.name (ModelNode.marks inline)
            in
            { controlState
                | hasInline = True
                , marks = Set.union (Set.fromList names) controlState.marks
            }


accumulateControlStateWithRanges : List ( Path, Path ) -> Block -> ControlContext -> ControlContext
accumulateControlStateWithRanges ranges root controlState =
    List.foldl
        (\( start, end ) cs ->
            Node.foldlRange start
                end
                accumulateControlState
                cs
                root
        )
        controlState
        ranges


getControlContext : Model -> ControlContext
getControlContext model =
    let
        state_ =
            Editor.state model.editor

        history_ =
            Editor.history model.editor
    in
    case State.selection state_ of
        Nothing ->
            emptyControlState

        Just selection ->
            let
                hasUndo =
                    History.peek history_ /= Nothing

                hasRedo =
                    List.isEmpty (History.redoList history_) |> not

                normalizedSelection =
                    selection |> Selection.normalize

                parentFocus =
                    ModelNode.parent (Selection.focusNode normalizedSelection)

                parentAnchor =
                    ModelNode.parent (Selection.anchorNode normalizedSelection)

                controlState =
                    accumulateControlStateWithRanges
                        [ ( Selection.anchorNode normalizedSelection
                          , Selection.focusNode normalizedSelection
                          )
                        , ( parentFocus, parentFocus )
                        , ( parentAnchor, parentAnchor )
                        ]
                        (State.root state_)
                        { emptyControlState
                            | selection = normalizedSelection |> rteSelectionToLocalSelection
                        }
            in
            { controlState
                | canLift =
                    -- This is hacky, but we'll assume we can lift anything that's nested
                    -- three or more nodes deep.
                    (List.length (Selection.anchorNode normalizedSelection) > 2)
                        || (List.length (Selection.focusNode normalizedSelection) > 2)
                        || Set.member "blockquote" controlState.nodes
                        || Set.member "li" controlState.nodes
                , hasUndo = hasUndo
                , hasRedo = hasRedo
            }


rteSelectionToLocalSelection : Selection.Selection -> Selection
rteSelectionToLocalSelection sel =
    let
        anchorNode =
            Selection.anchorNode sel

        anchorOffset =
            Selection.anchorOffset sel

        focusNode =
            Selection.focusNode sel

        focusOffset =
            Selection.focusOffset sel
    in
    if anchorNode == focusNode && anchorOffset == focusOffset then
        Collapsed
            { node = anchorNode
            , offset = anchorOffset
            }

    else
        Range
            { anchorNode = anchorNode
            , anchorOffset = anchorOffset
            , focusNode = focusNode
            , focusOffset = focusOffset
            }


localSelectionToRteSelection : Selection -> Maybe Selection.Selection
localSelectionToRteSelection sel =
    case sel of
        NoSelection ->
            Nothing

        Collapsed args ->
            Selection.caret
                args.node
                args.offset
                |> Just

        Range args ->
            Selection.range
                args.anchorNode
                args.anchorOffset
                args.focusNode
                args.focusOffset
                |> Just



-- Markdown AST


type alias CustomInline =
    {}


type alias CustomBlock =
    {}


type alias MBlock =
    Block.Block CustomBlock CustomInline


type alias MInline =
    Inline.Inline CustomInline


markdownMarkOrder : MarkOrder
markdownMarkOrder =
    Mark.markOrderFromSpec Definitions.markdown



-- Convert markdown AST to RTE Toolkit blocks.


unwrapAndFilterChildNodes : List (Result String a) -> Result String (List a)
unwrapAndFilterChildNodes results =
    let
        unwrappedResults =
            List.filterMap
                (\x ->
                    case x of
                        Ok v ->
                            Just v

                        _ ->
                            Nothing
                )
                results
    in
    if List.length unwrappedResults == List.length results then
        Ok unwrappedResults

    else
        Err <|
            String.join "\n" <|
                List.filterMap
                    (\x ->
                        case x of
                            Err s ->
                                Just s

                            _ ->
                                Nothing
                    )
                    results


blockChildrenToMarkdown : Children -> Result String (List MBlock)
blockChildrenToMarkdown cn =
    case cn of
        ModelNode.BlockChildren a ->
            let
                results =
                    List.map blockToMarkdown (Array.toList (ModelNode.toBlockArray a))
            in
            unwrapAndFilterChildNodes results

        ModelNode.InlineChildren _ ->
            Err "Invalid child nodes, received inline, expected block"

        ModelNode.Leaf ->
            Err "Invalid child nodes, received leaf, expected block"


inlineChildrenToMarkdown : Children -> Result String (List MInline)
inlineChildrenToMarkdown cn =
    case cn of
        ModelNode.InlineChildren a ->
            let
                results =
                    List.map (inlineToMarkdown (ModelNode.toInlineArray a)) (Array.toList (ModelNode.toInlineTree a))
            in
            Result.map (List.concatMap identity) (unwrapAndFilterChildNodes results)

        ModelNode.BlockChildren _ ->
            Err "Invalid child nodes, was expected inline, received block"

        ModelNode.Leaf ->
            Err "Invalid child nodes, was expected inline, received leaf"


rootToMarkdown : Block -> Result String (List MBlock)
rootToMarkdown node =
    let
        children =
            ModelNode.childNodes node
    in
    blockChildrenToMarkdown children


imageToMarkdown : Element -> Result String MInline
imageToMarkdown parameters =
    let
        attributes =
            Element.attributes parameters

        alt =
            Attribute.findStringAttribute "alt" attributes
    in
    case Attribute.findStringAttribute "src" attributes of
        Nothing ->
            Err "No src attribute found"

        Just src ->
            Ok <| Inline.Image src alt []


inlineToMarkdown : Array Inline -> InlineTree -> Result String (List MInline)
inlineToMarkdown leaves tree =
    case tree of
        ModelNode.LeafNode i ->
            case Array.get i leaves of
                Nothing ->
                    Err "Invalid leaf tree"

                Just inlineLeaf ->
                    case inlineLeaf of
                        ModelNode.Text p ->
                            Ok <| [ Inline.Text (Text.text p) ]

                        ModelNode.InlineElement il ->
                            let
                                parameters =
                                    InlineElement.element il
                            in
                            case Element.name parameters of
                                "image" ->
                                    Result.map List.singleton (imageToMarkdown parameters)

                                "hard_break" ->
                                    Ok <| [ Inline.HardLineBreak ]

                                name ->
                                    Err <| "Unsupported inline leaf :" ++ name

        ModelNode.MarkNode m ->
            case unwrapAndFilterChildNodes <| List.map (inlineToMarkdown leaves) (Array.toList m.children) of
                Err s ->
                    Err s

                Ok children ->
                    let
                        flattenedChildren =
                            List.concatMap identity children
                    in
                    case Mark.name m.mark of
                        "bold" ->
                            Ok <| [ Inline.Emphasis 2 flattenedChildren ]

                        "italic" ->
                            Ok <| [ Inline.Emphasis 1 flattenedChildren ]

                        "code" ->
                            Ok <|
                                List.map
                                    (\x ->
                                        case x of
                                            Inline.Text s ->
                                                Inline.CodeInline s

                                            _ ->
                                                x
                                    )
                                    flattenedChildren

                        "link" ->
                            let
                                attributes =
                                    Mark.attributes m.mark

                                title =
                                    Attribute.findStringAttribute "title" attributes
                            in
                            case Attribute.findStringAttribute "href" attributes of
                                Nothing ->
                                    Err "Invalid link mark"

                                Just href ->
                                    Ok <| [ Inline.Link href title flattenedChildren ]

                        name ->
                            Err <| "Unsupported mark: " ++ name


textFromChildNodes : Children -> String
textFromChildNodes cn =
    case cn of
        ModelNode.InlineChildren il ->
            String.join "" <|
                Array.toList <|
                    Array.map
                        (\l ->
                            case l of
                                ModelNode.Text tl ->
                                    Text.text tl

                                ModelNode.InlineElement p ->
                                    if
                                        Element.name
                                            (InlineElement.element p)
                                            == "hard_break"
                                    then
                                        "\n"

                                    else
                                        ""
                        )
                        (ModelNode.toInlineArray il)

        _ ->
            ""


headingToMarkdown : Element -> Children -> Result String MBlock
headingToMarkdown p cn =
    let
        attributes =
            Element.attributes p

        level =
            Maybe.withDefault 1 (Attribute.findIntegerAttribute "level" attributes)
    in
    Result.map (Block.Heading "" level) (inlineChildrenToMarkdown cn)


codeBlockToMarkdown : Children -> Result String MBlock
codeBlockToMarkdown cn =
    let
        t =
            textFromChildNodes cn
    in
    Ok <| Block.CodeBlock Block.Indented t


listToMarkdown : Block.ListType -> Element -> Children -> Result String MBlock
listToMarkdown type_ parameters cn =
    let
        defaultDelimiter =
            case type_ of
                Block.Unordered ->
                    "*"

                Block.Ordered _ ->
                    "."

        delimiter =
            Maybe.withDefault defaultDelimiter <|
                Attribute.findStringAttribute
                    "delimiter"
                    (Element.attributes parameters)

        listItems =
            case cn of
                ModelNode.BlockChildren a ->
                    let
                        children =
                            Array.toList <| ModelNode.toBlockArray a
                    in
                    unwrapAndFilterChildNodes <|
                        List.map
                            (\x ->
                                blockChildrenToMarkdown (ModelNode.childNodes x)
                            )
                            children

                _ ->
                    Err <| "Invalid list items"
    in
    case listItems of
        Err s ->
            Err s

        Ok lis ->
            Ok <|
                Block.List
                    { type_ = type_
                    , indentLength = 3
                    , delimiter = delimiter
                    , isLoose = False
                    }
                    lis


blockToMarkdown : Block -> Result String MBlock
blockToMarkdown node =
    let
        parameters =
            ModelNode.element node

        children =
            ModelNode.childNodes node
    in
    case Element.name parameters of
        "paragraph" ->
            Result.map (Block.Paragraph "") (inlineChildrenToMarkdown children)

        "blockquote" ->
            Result.map Block.BlockQuote (blockChildrenToMarkdown children)

        "horizontal_rule" ->
            Ok Block.ThematicBreak

        "heading" ->
            headingToMarkdown parameters children

        "code_block" ->
            codeBlockToMarkdown children

        "unordered_list" ->
            listToMarkdown Block.Unordered parameters children

        "ordered_list" ->
            listToMarkdown (Block.Ordered 1) parameters children

        name ->
            Err ("Unexpected element: " ++ name)



-- Convert RTE Toolkit blocks to string formatted markdown.


markdownToString : List MBlock -> Result String String
markdownToString blocks =
    blockMarkdownChildrenToString blocks


escapeForMarkdown : String -> String
escapeForMarkdown s =
    s


inlineMarkdownToString : MInline -> Result String String
inlineMarkdownToString inline =
    case inline of
        Inline.Text s ->
            Ok <| escapeForMarkdown s

        Inline.HardLineBreak ->
            Ok "  \n"

        Inline.CodeInline s ->
            Ok <| "`" ++ s ++ "`"

        Inline.Link href title children ->
            Result.map
                (\c ->
                    let
                        t =
                            Maybe.withDefault "" <| Maybe.map (\m -> " \"" ++ m ++ "\"") title
                    in
                    "[" ++ c ++ "](" ++ href ++ t ++ ")"
                )
                (inlineMarkdownChildrenToString children)

        Inline.Image url alt children ->
            Result.map
                (\c ->
                    let
                        a =
                            Maybe.withDefault "" <| Maybe.map (\m -> " \"" ++ m ++ "\"") alt
                    in
                    "![" ++ c ++ "](" ++ url ++ a ++ ")"
                )
                (inlineMarkdownChildrenToString children)

        Inline.Emphasis length children ->
            let
                e =
                    String.repeat length "*"

                noEmphasisIfEmpty c =
                    case c of
                        "" ->
                            c

                        _ ->
                            e ++ c ++ e
            in
            Result.map noEmphasisIfEmpty (inlineMarkdownChildrenToString children)

        Inline.HtmlInline _ _ _ ->
            Err "Html inline is not implemented."

        Inline.Custom _ _ ->
            Err "Custom elements are not implemented"


inlineMarkdownChildrenToString : List MInline -> Result String String
inlineMarkdownChildrenToString inlines =
    Result.map (String.join "") <|
        unwrapAndFilterChildNodes <|
            List.map inlineMarkdownToString inlines


blockMarkdownChildrenToString : List MBlock -> Result String String
blockMarkdownChildrenToString blocks =
    Result.map (String.join "\n") <|
        unwrapAndFilterChildNodes (List.map markdownBlockToString blocks)


indentEverythingButFirstLine : Int -> String -> String
indentEverythingButFirstLine n s =
    String.join "\n" <|
        List.indexedMap
            (\i x ->
                if i == 0 then
                    x

                else
                    String.repeat n " " ++ x
            )
            (String.split "\n" s)


listMarkdownToString : Block.ListBlock -> List (List MBlock) -> Result String String
listMarkdownToString listBlock listItems =
    Result.map
        (\children ->
            String.join "\n"
                (List.indexedMap
                    (\i z ->
                        let
                            prefix =
                                case listBlock.type_ of
                                    Block.Unordered ->
                                        listBlock.delimiter ++ " "

                                    Block.Ordered startIndex ->
                                        String.fromInt (startIndex + i) ++ listBlock.delimiter ++ " "
                        in
                        prefix ++ indentEverythingButFirstLine (String.length prefix) z
                    )
                    children
                )
        )
        (unwrapAndFilterChildNodes <|
            List.map blockMarkdownChildrenToString listItems
        )


markdownCodeBlockToString : Block.CodeBlock -> String -> Result String String
markdownCodeBlockToString cb s =
    case cb of
        Block.Fenced _ fence ->
            let
                delimeter =
                    String.repeat fence.fenceLength fence.fenceChar
            in
            Ok <|
                (delimeter ++ "\n")
                    ++ String.join "\n" (List.map (\v -> String.repeat fence.indentLength " " ++ v) (String.split "\n" s))
                    ++ ("\n" ++ delimeter)

        Block.Indented ->
            Ok <| String.join "\n" <| List.map (\v -> "    " ++ v) (String.split "\n" s)


markdownBlockToString : MBlock -> Result String String
markdownBlockToString block =
    case block of
        Block.BlankLine s ->
            Ok <| s

        Block.ThematicBreak ->
            Ok <| "---"

        Block.Heading _ i children ->
            Result.map
                (\x -> String.repeat i "#" ++ " " ++ x)
                (inlineMarkdownChildrenToString children)

        Block.CodeBlock cb s ->
            markdownCodeBlockToString cb s

        Block.Paragraph _ children ->
            Result.map (\x -> x ++ "\n") <|
                inlineMarkdownChildrenToString children

        Block.BlockQuote children ->
            Result.map
                (\x ->
                    String.join "\n" (List.map (\m -> "> " ++ m) (String.split "\n" x))
                )
                (blockMarkdownChildrenToString children)

        Block.List lb listItems ->
            listMarkdownToString lb listItems

        Block.PlainInlines children ->
            inlineMarkdownChildrenToString children

        Block.Custom _ _ ->
            Err "Custom element are not implemented"


markdownToBlock : List MBlock -> Result String Block
markdownToBlock md =
    Result.map
        (\children ->
            ModelNode.block
                (Element.element Definitions.doc [])
                children
        )
        (markdownBlockListToBlockChildNodes md)


markdownBlockListToBlockChildNodes : List MBlock -> Result String Children
markdownBlockListToBlockChildNodes blocks =
    Result.map
        (\items -> ModelNode.blockChildren (Array.fromList items))
        (markdownBlockListToBlockLeaves blocks)


markdownBlockListToBlockLeaves : List MBlock -> Result String (List Block)
markdownBlockListToBlockLeaves blocks =
    unwrapAndFilterChildNodes (List.map markdownBlockToEditorBlock blocks)


markdownInlineListToInlineChildNodes : List MInline -> Result String Children
markdownInlineListToInlineChildNodes inlines =
    Result.map
        (\items -> ModelNode.inlineChildren (Array.fromList items))
        (markdownInlineListToInlineLeaves [] inlines)


markdownInlineListToInlineLeaves : List Mark -> List MInline -> Result String (List Inline)
markdownInlineListToInlineLeaves marks inlines =
    Result.map
        (\items -> List.concatMap identity items)
        (unwrapAndFilterChildNodes (List.map (markdownInlineToInlineLeaves marks) inlines))


markdownInlineToInlineLeaves : List Mark -> MInline -> Result String (List Inline)
markdownInlineToInlineLeaves marks inline =
    case inline of
        Inline.Text s ->
            Ok <|
                [ ModelNode.markedText s (Mark.sort markdownMarkOrder marks) ]

        Inline.HardLineBreak ->
            Ok <|
                [ ModelNode.inlineElement (Element.element Definitions.hardBreak []) [] ]

        Inline.CodeInline s ->
            let
                codeMark =
                    Mark.mark Definitions.code []
            in
            Ok <| [ ModelNode.markedText s (Mark.sort markdownMarkOrder (codeMark :: marks)) ]

        Inline.Link href title children ->
            let
                linkMark =
                    Mark.mark Definitions.link
                        (List.filterMap identity
                            [ Just <| Attribute.StringAttribute "href" href
                            , Maybe.map (\t -> Attribute.StringAttribute "title" t) title
                            ]
                        )
            in
            markdownInlineListToInlineLeaves (linkMark :: marks) children

        Inline.Image src alt _ ->
            let
                inlineImage =
                    ModelNode.inlineElement
                        (Element.element Definitions.image
                            (List.filterMap identity
                                [ Just <| Attribute.StringAttribute "src" src
                                , Maybe.map (\t -> Attribute.StringAttribute "alt" t) alt
                                ]
                            )
                        )
                        (Mark.sort markdownMarkOrder marks)
            in
            Ok <| [ inlineImage ]

        Inline.Emphasis i children ->
            let
                emphasis =
                    case i of
                        1 ->
                            [ Mark.mark Definitions.italic [] ]

                        2 ->
                            [ Mark.mark Definitions.bold [] ]

                        3 ->
                            [ Mark.mark Definitions.bold [], Mark.mark Definitions.italic [] ]

                        _ ->
                            []
            in
            markdownInlineListToInlineLeaves (emphasis ++ marks) children

        Inline.HtmlInline _ _ _ ->
            Err "Not implemented"

        Inline.Custom _ _ ->
            Err "Not implemented"


markdownCodeBlockToEditorBlock : Block.CodeBlock -> String -> Result String Block
markdownCodeBlockToEditorBlock cb s =
    let
        attributes =
            case cb of
                Block.Indented ->
                    [ Attribute.StringAttribute "type" "indented" ]

                Block.Fenced b f ->
                    List.filterMap identity
                        [ Just <| Attribute.BoolAttribute "open" b
                        , Just <| Attribute.StringAttribute "type" "fenced"
                        , Just <| Attribute.IntegerAttribute "indentLength" f.indentLength
                        , Just <| Attribute.IntegerAttribute "fenceLength" f.fenceLength
                        , Maybe.map (\m -> Attribute.StringAttribute "language" m) f.language
                        ]
    in
    Ok <|
        ModelNode.block
            (Element.element Definitions.codeBlock attributes)
            (ModelNode.inlineChildren <| Array.fromList [ ModelNode.plainText s ])


markdownListToEditorBlock : Block.ListBlock -> List (List MBlock) -> Result String Block
markdownListToEditorBlock lb children =
    let
        ( node, typeAttributes ) =
            case lb.type_ of
                Block.Ordered i ->
                    ( Definitions.orderedList, [ Attribute.IntegerAttribute "startIndex" i ] )

                Block.Unordered ->
                    ( Definitions.unorderedList, [] )

        attributes =
            [ Attribute.IntegerAttribute "indentLength" lb.indentLength
            , Attribute.StringAttribute "delimiter" lb.delimiter
            ]
                ++ typeAttributes
    in
    Result.map
        (\listItems ->
            ModelNode.block
                (Element.element node attributes)
                (ModelNode.blockChildren
                    (Array.fromList
                        (List.map
                            (\cn ->
                                ModelNode.block
                                    (Element.element Definitions.listItem [])
                                    cn
                            )
                            listItems
                        )
                    )
                )
        )
        (unwrapAndFilterChildNodes
            (List.map
                (\x -> markdownBlockListToBlockChildNodes x)
                children
            )
        )


markdownInlineToParagraphBlock : List MInline -> Result String Block
markdownInlineToParagraphBlock children =
    Result.map
        (\c ->
            ModelNode.block
                (Element.element Definitions.paragraph [])
                c
        )
        (markdownInlineListToInlineChildNodes children)


markdownBlockToEditorBlock : MBlock -> Result String Block
markdownBlockToEditorBlock mblock =
    case mblock of
        Block.BlankLine s ->
            Ok <|
                ModelNode.block
                    (Element.element Definitions.paragraph [])
                    (ModelNode.inlineChildren <| Array.fromList [ ModelNode.plainText s ])

        Block.ThematicBreak ->
            Ok <|
                ModelNode.block
                    (Element.element Definitions.horizontalRule [])
                    ModelNode.Leaf

        Block.Heading _ i children ->
            Result.map
                (\c ->
                    ModelNode.block
                        (Element.element
                            Definitions.heading
                            [ Attribute.IntegerAttribute "level" i ]
                        )
                        c
                )
                (markdownInlineListToInlineChildNodes children)

        Block.CodeBlock cb s ->
            markdownCodeBlockToEditorBlock cb s

        Block.Paragraph _ children ->
            markdownInlineToParagraphBlock children

        Block.BlockQuote children ->
            Result.map
                (\c ->
                    ModelNode.block
                        (Element.element Definitions.blockquote [])
                        c
                )
                (markdownBlockListToBlockChildNodes children)

        Block.List lb listItems ->
            markdownListToEditorBlock lb listItems

        Block.PlainInlines children ->
            markdownInlineToParagraphBlock children

        Block.Custom _ _ ->
            Err "Custom elements are not implemented"


filterBlankLines : List MBlock -> List MBlock
filterBlankLines blocks =
    let
        newBlocks =
            List.filterMap
                (\block ->
                    case block of
                        Block.BlankLine _ ->
                            Nothing

                        Block.BlockQuote children ->
                            Just <| Block.BlockQuote (filterBlankLines children)

                        Block.List lb listItems ->
                            Just <| Block.List lb (List.map filterBlankLines listItems)

                        _ ->
                            Just block
                )
                blocks
    in
    if List.isEmpty newBlocks then
        [ Block.BlankLine "" ]

    else
        newBlocks