EmulateExpandableTextarea.elm

module Writeable exposing (..)


import Html.App as App
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Json.Decode
import Json.Encode


main : Program Never
main =
    App.beginnerProgram
        { update = update
        , view = view
        , model = initialModel
        }


-- model


type alias Model =
    { value : String
    , tmpValue : String
    , showPlaceholder : Bool
    }


initialModel : Model
initialModel =
    { value = ""
    , tmpValue = ""
    , showPlaceholder = True
    }

-- update


type Msg
    = HandleBlur String
    | SetTmpValue String
    | HandleFocus ()


update : Msg -> Model -> Model
update msg model =
    case msg of
        HandleBlur newValue ->
            let
                updatedValue =
                    sanitizeValue newValue
            in
                { model
                    | value = updatedValue
                    , tmpValue = ""
                    , showPlaceholder = updatedValue == ""
                }

        HandleFocus _ ->
            { model | showPlaceholder = model.value == "" }

        SetTmpValue newTmpValue ->
            let
                tmpValue =
                    sanitizeValue newTmpValue
            in
                { model
                    | tmpValue = tmpValue
                    , showPlaceholder = tmpValue == ""
                }



sanitizeValue : String -> String
sanitizeValue val =
    if val == "\n" then
        ""
    else
        val


-- view

innerHtmlDecoder : Json.Decode.Decoder String
innerHtmlDecoder =
  Json.Decode.at ["target", "innerText"] Json.Decode.string


view : Model -> Html Msg
view model =
    div
        [ style [ ("position", "relative") ] ]
        [ viewPlaceholder "Enter text here ..." model
        , div
            [ contenteditable True
            , on "input" (Json.Decode.map SetTmpValue innerHtmlDecoder)
            , on "blur" (Json.Decode.map HandleBlur innerHtmlDecoder)
            , on "focus" (Json.Decode.map HandleFocus <| Json.Decode.succeed ())
            , property "innerText" <| Json.Encode.string model.value
            , property "aria-multiline" "true"
            , property "role" "textbox"
            , style
                [ ("border", "1px solid gray")
                , ("padding", "4px")
                , ("width", "200px")
                , ("min-height", "100px")
                , ("max-height", "400px")
                , ("overflow", "auto")
                , ("outline", "none")
                , ("display", "block")
                , ("text-decoration", "none")
                ]
            ]
            []
        ]


viewPlaceholder : String -> Model -> Html Msg
viewPlaceholder placeholderText model =
    if model.showPlaceholder then
        div
            [ style
                [ ("position", "absolute")
                , ("top", "5px")
                , ("left", "5px")
                , ("color", "#aaa")
                , ("z-index", "-1")
                ]
            ]
            [ text placeholderText ]
    else
        text ""