module HtmlTree exposing
  ( HtmlTree(..), assembleHtml, leaf, textWrapper, container, opaque, empty
  , withText, appendText, prependText, textAsMarkdown, withAttributes
  , addAttribute, withActions, addAction, withObserver, withId, withClasses
  , addClass, removeClass, withStyles, addStyle, withTag, withChildren
  , appendChild, prependChild
  )

{-|

## An alternative syntax for generating HTML in Elm

`HtmlTree` is an alternative syntax for generating HTML, built on top of the
standard `Html` and `VirtualDom` packages. This syntax enables a
["pipeline"](https://en.wikipedia.org/wiki/Pipeline_%28software%29)
approach to HTML specification, and its implementation allows for downstream
modification of view components — something that is not possible when working
with the standard API. Once constructed, view components may be passed to modify
functions as data, encouraging a design pattern for updating a program's view
that may result in more intuitive and readable code.


# HTML DOM Representation
@docs HtmlTree

# Rendering an `HtmlTree` to standard `Html`
@docs assembleHtml

# Constructing `HtmlTree` nodes
@docs leaf, textWrapper, container, opaque, empty

# Adding Text to a Node
@docs withText, appendText, prependText, textAsMarkdown

# Adding Attributes and Event Handlers to a Node
@docs withAttributes, addAttribute, withActions, addAction, withObserver

# Adding an Id Attribute, Class Names, and Style Declarations to a Node
@docs withId, withClasses, addClass, removeClass, withStyles, addStyle

# Modifying a Node's HTML tag
@docs withTag

# Replacing, Appending, or Prepending Child Nodes
@docs withChildren, appendChild, prependChild

-}

import CssBasics as Css exposing (CssValue)

import Internal.HtmlElement exposing (HtmlElement)
import Internal.AttributeLookup as Lookup
import Internal.Util as Util

import Html exposing (Html, Attribute)
import Html.Attributes as Attributes
import Html.Events as Events
import Json.Decode as Json
import Dict exposing (Dict)
import Markdown


--TYPE DECLARATIONS

{-| Represents a node in the DOM tree that may have some children or
no children
-}
type HtmlTree msg
  = Empty
  | Opaque (Html msg)
  | Leaf (HtmlElement msg)
  | Stem (HtmlElement msg) (List (HtmlTree msg))


-- RENDERING AN `HtmlTree` TO STANDARD `Html`

{-| Convert an `HtmlTree` containing one or more nodes to standard `Html`
(an alias for `VirtualDom.Node`). This function must be called on the
root node of your `HtmlTree` in order for the tree to be rendered in your Elm
program's view.
-}
assembleHtml : HtmlTree msg -> Html msg
assembleHtml htmlTree =
  let
    renderText isMarkdown maybeText =
      case maybeText of
        Just someText ->
          someText
            |> (if isMarkdown then Markdown.toHtml [] else Html.text)
            |> List.singleton

        Nothing ->
          []

    assembleHtml_internal treeList =
      case treeList |> List.head |> Maybe.withDefault Empty of
        Empty ->
          []

        Opaque node ->
          node
            |> List.singleton

        Leaf htmlElement ->
          htmlElement.text
            |> renderText htmlElement.markdown
            |> renderNode htmlElement
            |> List.singleton

        Stem htmlElement childList ->
          childList
            |> List.map (List.singleton >> assembleHtml_internal)
            |> List.concat
            |> (++) (htmlElement.text |> renderText htmlElement.markdown)
            |> renderNode htmlElement
            |> List.singleton

  in
    case htmlTree of
      Empty ->
        Html.div [] []

      _ ->
        htmlTree
          |> List.singleton
          |> assembleHtml_internal
          |> List.head
          |> Maybe.withDefault (Html.div [] [])



{-| Constructs a `VirtualDom.Node` from an `HtmlElement` and a list of child
nodes. Called recursively by `assembleHtml` on each node of the tree.
-}
renderNode : HtmlElement msg -> List (Html msg) -> Html msg
renderNode htmlElement childList =
  let
    attributes =
      [ case htmlElement.classes of
          [] ->
            []

          _ ->
            htmlElement.classes
              |> String.join " "
              |> Attributes.class
              |> List.singleton

      , case htmlElement.styles of
          [] ->
            []

          _ ->
            htmlElement.styles
              |> Attributes.style
              |> List.singleton

      , htmlElement.attributes
        |> List.map Lookup.toAttribute

      , htmlElement.actions
        |> List.map (\(event, msg) -> msg |> Json.succeed |> Events.on event)

      , case htmlElement.observer of
          Just observer ->
            [ observer ]

          Nothing ->
            []

      ]
        |> List.concat

  in
    childList
      |> Html.node htmlElement.htmlTag attributes


--CONSTRUCTING `HtmlTree` NODES

{-| Initialize an `HtmlTree` node with no attributes, no text, and no children.

    leaf "br"

    --> <br>
-}
leaf : String -> HtmlTree msg
leaf htmlTag =
  Leaf
    { htmlTag = htmlTag
    , attributes = []
    , actions = []
    , classes = []
    , styles = []
    , text = Nothing
    , markdown = False
    , observer = Nothing
    }


{-| Initialize an `HtmlTree` node that contains text, but has no attributes and
no children.

    "Hello, World!"
      |> textWrapper "p"

    --> <p>Hello, World!</p>
-}
textWrapper : String -> String -> HtmlTree msg
textWrapper htmlTag textString =
  Leaf
    { htmlTag = htmlTag
    , attributes = []
    , actions = []
    , classes = []
    , styles = []
    , text = Just textString
    , markdown = False
    , observer = Nothing
    }


{-| Initialize an `HtmlTree` node that has children, but has no attributes and
no text.

    "Hello, World!"
      |> textWrapper "p"
      |> List.singleton
      |> container "div"

    --> <div><p>Hello, World!</p></div>
-}
container : String -> List (HtmlTree msg) -> HtmlTree msg
container htmlTag childList =
  childList
    |> Stem
      { htmlTag = htmlTag
      , attributes = []
      , actions = []
      , classes = []
      , styles = []
      , text = Nothing
      , markdown = False
      , observer = Nothing
      }


{-| Convert a standard `Html` node to an opaque `HtmlTree` ("opaque" because its
internal attributes and children will not be accessible to modify functions).

This feature is included so that `HtmlTree` can be used flexibly with other
packages that generate standard `Html`, but it should be used with caution
because the presence of opaque nodes limits the functionality of the `HtmlTree`
package. Constructor and modify functions called on opaque nodes will return
the node without modification.
-}
opaque : Html msg -> HtmlTree msg
opaque node =
  Opaque node


{-| Construct an empty `HtmlTree` node. The `assembleHtml` function passes over
internal `Empty` nodes when rendering to `Html`. If `assembleHtml` is called on
an `Empty` root node, the rendering function returns a `<div>` with no
attributes and no children. This is useful for component abstraction where
subcomponents are optional.

-}
empty : HtmlTree msg
empty =
  Empty


--ADDING TEXT TO A NODE

{-| Add text to the element at the root node of an `HtmlTree`, *replacing*
any existing text

    welcomeMessage =
      leaf "p"
        |> withText "Hello, World!"

    --> <p>Hello, World!</p>

    welcomeMessage
      |> withText "Hello, Universe!"

    --> <p>Hello, Universe!</p>
-}
withText : String -> HtmlTree msg -> HtmlTree msg
withText newText htmlTree =
  let
    updateFunction htmlElement =
      { htmlElement
      | text =
          Just newText
      }

  in
    htmlTree
      |> modifyRoot updateFunction


{-| Add new text to the element at the root node of an `HtmlTree`, *appended
after* any existing text.

    welcomeMessage
        |> appendText "!!"

    --> <p>Hello, World!!!</p>
-}
appendText : String -> HtmlTree msg -> HtmlTree msg
appendText newText htmlTree =
  let
    updateFunction htmlElement =
      { htmlElement
      | text =
          case htmlElement.text of
            Nothing ->
              Just newText

            Just someText ->
              Just (someText ++ newText)
      }

  in
    htmlTree
      |> modifyRoot updateFunction


{-| Add new text to the element at the root node of an `HtmlTree`, *prepended
before* any existing text.

    welcomeMessage
        |> prependText "#"

    --> <p>#Hello, World!</p>
-}
prependText : String -> HtmlTree msg -> HtmlTree msg
prependText newText htmlTree =
  let
    updateFunction htmlElement =
      { htmlElement
      | text =
          case htmlElement.text of
            Nothing ->
              Just newText

            Just someText ->
              Just (newText ++ someText)
      }

  in
    htmlTree
      |> modifyRoot updateFunction


{-| Flag the text at the root node of an `HtmlTree` as
[markdown](https://en.wikipedia.org/wiki/Markdown); when
`assembleHtml` is called, the text will be rendered using
[`Markdown.toHtml`](package.elm-lang.org/packages/evancz/elm-markdown/latest/Markdown#toHtml)
-}
textAsMarkdown : HtmlTree msg -> HtmlTree msg
textAsMarkdown htmlTree =
  let
    updateFunction htmlElement =
      { htmlElement
      | markdown =
          True
      }

  in
    htmlTree
      |> modifyRoot updateFunction


-- ADDING ATTRIBUTES AND EVENT HANDLERS TO A NODE

{-| Add a list of attributes (*name-value* pairs) to the element at the root
node of an `HtmlTree`, *replacing* any existing attributes

    welcomeMessage
      |> withAttributes
        [ ("id", "welcomeMessage")
        , ("title", "Hello again!")
        ]
-}
withAttributes : List (String, String) -> HtmlTree msg -> HtmlTree msg
withAttributes attributeList htmlTree =
  let
    updateFunction htmlElement =
      { htmlElement
      | attributes =
          attributeList
      }

  in
    htmlTree
      |> modifyRoot updateFunction


{-| Add a new attribute (*name-value* pair) to the element at the root
node of an `HtmlTree`. If the new attribute has the same *name* as an existing
attribute, the new *value* replaces the old one; otherwise, existing attributes
are retained.

    welcomeMessage
      |> addAttribute ("id", "welcomeMessage")
-}
addAttribute : (String, String) -> HtmlTree msg -> HtmlTree msg
addAttribute newAttribute htmlTree =
  let
    updateFunction htmlElement =
      { htmlElement
      | attributes =
          newAttribute
            |> List.singleton
            |> List.append
              ( htmlElement.attributes
                |> Util.removeMatchingKeys [ Tuple.first newAttribute ]
              )
      }

  in
    htmlTree
      |> modifyRoot updateFunction


{-| Add a list of actions to the element at the root node of an `HtmlTree`,
*replacing* any existing actions. Actions must be encoded as *action-message*
pairs. As defined here, "actions" include all events that __do not__ capture
form input. Following the typical pattern of an Elm program, a "message" is a
user-defined type that tells the program what updates to perform on the model
via pattern matching. Note that the action name should be given as a string
without the "on" prefix.

    "Click here and see what happens!"
      |> textWrapper "p"
      |> withAttributes
        [ ("hidden", toString model) ]
      |> withActions
        [ ("click", HideMessage) ]

See [examples/Buttons.elm](https://github.com/danielnarey/elm-html-tree/tree/master/examples)
for a full working example.
-}
withActions : List (String, msg) -> HtmlTree msg -> HtmlTree msg
withActions actionList htmlTree =
  let
    updateFunction htmlElement =
      { htmlElement
      | actions =
          actionList
      }

  in
    htmlTree
      |> modifyRoot updateFunction


{-| Add a new action to the element at the root node of an `HtmlTree`. If a new
*action-message* pair has the same *action* as an existing one, the new
*message* replaces the old one; otherwise, existing *action-message* pairs are
retained.

    myTextElement
      |> addAction ("click", HideMessage)

-}
addAction : (String, msg) -> HtmlTree msg -> HtmlTree msg
addAction newAction htmlTree =
  let
    updateFunction htmlElement =
      { htmlElement
      | actions =
          newAction
            |> List.singleton
            |> List.append
              ( htmlElement.actions
                |> Util.removeMatchingKeys [ Tuple.first newAction ]
              )
      }

  in
    htmlTree
      |> modifyRoot updateFunction


{-| Add an observer to the element at the root node of an `HtmlTree`, encoded as
an [`Html.Attribute`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html#Attribute).
An "observer" differs from an "action" in that it captures one or more input
values, and so requires a `Json`
[`Decoder`](http://package.elm-lang.org/packages/elm-lang/core/latest/Json-Decode#Decoder)
to read that input. The built-in observers in the `Html.Events` package
are
[`onInput`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html-Events#onInput)
and
[`onCheck`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html-Events#onCheck).
Custom observers may be created using the
[`Html.Events.on`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html-Events#on)
function, which takes an
[event name](http://www.w3schools.com/jsref/dom_obj_event.asp) (as a string,
without the "on" prefix) and a
[`Decoder`](http://package.elm-lang.org/packages/elm-lang/core/latest/Json-Decode#Decoder)
as arguments.

    leaf "input"
      |> withAttributes
        [ ("type", "checkbox")
        , ("checked", toString model)
        ]
      |> withObserver (Events.onCheck Checked)

See
[examples/Checkboxes.elm](https://github.com/danielnarey/elm-html-tree/tree/master/examples)
and
[examples/RadioButtons.elm](https://github.com/danielnarey/elm-html-tree/tree/master/examples)
for full working examples.
-}
withObserver : Attribute msg -> HtmlTree msg -> HtmlTree msg
withObserver newObserver htmlTree =
  let
    updateFunction htmlElement =
      { htmlElement
      | observer =
          Just newObserver
      }

  in
    htmlTree
      |> modifyRoot updateFunction


-- ADDING AN ID ATTRIBUTE, CLASS NAMES, AND STYLE DECLARATIONS TO A NODE

{-| Convenience function to add an `id` attribute to the root element of an
`HtmlTree`. Calls `addAttribute`.

    welcomeMessage
      |> withId "welcomeMessage"
-}
withId : String -> HtmlTree msg -> HtmlTree msg
withId idString htmlTree =
  htmlTree
    |> addAttribute ("id", idString)


{-| Add a list of class names to the element at the root node of an `HtmlTree`,
*replacing* any existing class assignments

    welcomeMessage =
      "Hello, world!"
        |> textWrapper "p"
        |> withClasses
          [ "large-text"
          , "align-center"
          ]
-}
withClasses : List String -> HtmlTree msg -> HtmlTree msg
withClasses classList htmlTree =
  let
    updateFunction htmlElement =
      { htmlElement
      | classes =
          classList
      }

  in
    htmlTree
      |> modifyRoot updateFunction



{-| Add a new class assignment to the element at the root node of an `HtmlTree`,
*retaining* any existing class assignments

    welcomeMessage
        |> addClass "align-center"
-}
addClass : String -> HtmlTree msg -> HtmlTree msg
addClass newClass htmlTree =
  let
    updateFunction htmlElement =
      { htmlElement
      | classes =
          newClass
            |> List.singleton
            |> List.append htmlElement.classes
      }

  in
    htmlTree
      |> modifyRoot updateFunction


{-| Remove a class name from the element at the root node of an `HtmlTree`

    welcomeMessage
      |> removeClass "large-text"
-}
removeClass : String -> HtmlTree msg -> HtmlTree msg
removeClass classToRemove htmlTree =
  let
    updateFunction htmlElement =
      { htmlElement
      | classes =
          htmlElement.classes
            |> Util.removeMatchingEntries
              [ classToRemove ]
      }

  in
    htmlTree
      |> modifyRoot updateFunction


{-| Add a list of style declarations (*property-value* pairs) to the element at
the root node of an `HtmlTree`, *replacing* any existing styles.

The *value* part of each declaration must be given as a
[`CssValue`](http://package.elm-lang.org/packages/danielnarey/elm-css-basics/latest/CssBasics#CssValue),
defined in the
[`CssBasics`](http://package.elm-lang.org/packages/danielnarey/elm-css-basics/latest)
package. These values are automatically converted to strings, so if you don't
want to concern yourself with the `CssValue` types, just enter each value as a
string prefaced by `Str`. For instance, in the example below, the expression
`Unit 2 Em` is equivalent to `Str "2em"`.

    welcomeMessage =
      "Hello, world!"
        |> textWrapper "p"
        |> withStyles
          [ ("font-size", Unit 2 Em)
          , ("text-align", Str "center")
          ]

Style declarations added in this way are defined via the element's `style`
attribute, which means they override style declarations assigned to tag, class,
and id selectors in global stylesheets. See my
[Stylesheet](http://package.elm-lang.org/packages/danielnarey/elm-stylesheet/latest/Stylesheet)
package for a more general approach to defining CSS rules and generating a
global stylesheet in Elm.
-}
withStyles : List (String, CssValue) -> HtmlTree msg -> HtmlTree msg
withStyles styleList htmlTree =
  let
    updateFunction htmlElement =
      { htmlElement
      | styles =
          styleList
            |> List.map (Tuple.mapSecond Css.encodeCssValue)
      }

  in
    htmlTree
      |> modifyRoot updateFunction


{-| Add a new style declaration (*proprty-value* pair) to the element at the root
node of an `HtmlTree`. If a new declaration has the same *property* as an
existing declaration, the new *value* replaces the old one; otherwise, existing
style declarations are retained.

The *value* part of the declaration must be given as a
[`CssValue`](http://package.elm-lang.org/packages/danielnarey/elm-css-basics/latest/CssBasics#CssValue),
defined in the
[`CssBasics`](http://package.elm-lang.org/packages/danielnarey/elm-css-basics/latest)
package.

    welcomeMessage
        |> addStyle ("text-align", Str "center")
-}
addStyle : (String, CssValue) -> HtmlTree msg -> HtmlTree msg
addStyle newStyle htmlTree =
  let
    updateFunction htmlElement =
      { htmlElement
      | styles =
          newStyle
            |> Tuple.mapSecond Css.encodeCssValue
            |> List.singleton
            |> List.append
              ( htmlElement.styles
                |> Util.removeMatchingKeys [ Tuple.first newStyle ]
              )
      }

  in
    htmlTree
      |> modifyRoot updateFunction


-- MODIFYING A NODE'S HTML TAG

{-| Modify the HTML tag of the element at the root node of an `HtmlTree`.
Replaces the existing tag.

    welcomeMessage
      |> withTag "span"
-}
withTag : String -> HtmlTree msg -> HtmlTree msg
withTag newTag htmlTree =
  let
    updateFunction htmlElement =
      { htmlElement
      | htmlTag =
          newTag
      }

  in
    htmlTree
      |> modifyRoot updateFunction


-- REPLACING, APPENDING, OR PREPENDING CHILD NODES

{-| Add child nodes to the root node of an `HtmlTree`, *replacing* any existing
children, and return the result. One use of this function is to convert a
`Leaf` to a `Stem`, which is helpful when nesting text elements.

    "Hello, world!"
      |> textWrapper "p"
      |> withChildren
        [ leaf "br"
        , "Awesome!" |> textWrapper "strong"
        ]
      |> List.singleton
      |> container "div"

    --> <div><p>Hello, world!<br><strong>Awesome!</strong></p></div>
-}
withChildren : List (HtmlTree msg) -> HtmlTree msg -> HtmlTree msg
withChildren newChildList htmlTree =
  case htmlTree of
    Leaf htmlElement ->
      newChildList
        |> Stem htmlElement

    Stem htmlElement childList ->
      newChildList
        |> Stem htmlElement

    _ ->
      htmlTree


{-| Add a child node to the root node of an `HtmlTree`, *appended
after* any existing children.

    fruit =
      [ "apple"
      , "banana"
      , "orange"
      ]
        |> List.map textWrapper "li"
        |> container "ul"

    fruit
      |> appendChild ("watermelon" |> textWrapper "li")

    --> <ul>
    --    <li>apple</li>
    --    <li>banana</li>
    --    <li>orange</li>
    --    <li>watermelon</li>
    --  </ul>
-}
appendChild : HtmlTree msg -> HtmlTree msg -> HtmlTree msg
appendChild newChild htmlTree =
  case htmlTree of
    Leaf htmlElement ->
      newChild
        |> List.singleton
        |> Stem htmlElement

    Stem htmlElement childList ->
      newChild
        |> List.singleton
        |> List.append childList
        |> Stem htmlElement

    _ ->
      htmlTree


{-| Add a child node to the root node of an `HtmlTree`, *prepended
before* any existing children.

    fruit
      |> prependChild ("watermelon" |> textWrapper "li")

    --> <ul>
    --    <li>watermelon</li>
    --    <li>apple</li>
    --    <li>banana</li>
    --    <li>orange</li>
    --  </ul>

-}
prependChild : HtmlTree msg -> HtmlTree msg -> HtmlTree msg
prependChild newChild htmlTree =
  case htmlTree of
    Leaf htmlElement ->
      newChild
        |> List.singleton
        |> Stem htmlElement

    Stem htmlElement childList ->
      childList
        |> (::) newChild
        |> Stem htmlElement

    _ ->
      htmlTree


-- INTERNAL MODIFY FUNCTION

{-| Apply an update function to the element at the root node of an `HtmlTree`
-}
modifyRoot : (HtmlElement msg -> HtmlElement msg) -> HtmlTree msg -> HtmlTree msg
modifyRoot updateFunction htmlTree =
  case htmlTree of
    Leaf htmlElement ->
      htmlElement
        |> updateFunction
        |> Leaf

    Stem htmlElement childList ->
      htmlElement
        |> updateFunction
        |> (\elem -> Stem elem childList)

    _ ->
      htmlTree