Source
module ImagePreviews exposing (main)
-- Image upload with a drag and drop zone. See image previews!
--
-- Dependencies:
-- elm install elm/file
-- elm install elm/json
--
import Browser
import File exposing (File)
import File.Select as Select
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Json.Decode as D
import Task
-- MAIN
main =
Browser.element
{ init = init
, view = view
, update = update
, subscriptions = subscriptions
}
-- MODEL
type alias Model =
{ hover : Bool
, previews : List String
}
init : () -> (Model, Cmd Msg)
init _ =
(Model False [], Cmd.none)
-- UPDATE
type Msg
= Pick
| DragEnter
| DragLeave
| GotFiles File (List File)
| GotPreviews (List String)
update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
case msg of
Pick ->
( model
, Select.files ["image/*"] GotFiles
)
DragEnter ->
( { model | hover = True }
, Cmd.none
)
DragLeave ->
( { model | hover = False }
, Cmd.none
)
GotFiles file files ->
( { model | hover = False }
, Task.perform GotPreviews <| Task.sequence <|
List.map File.toUrl (file :: files)
)
GotPreviews urls ->
( { model | previews = urls }
, Cmd.none
)
-- SUBSCRIPTIONS
subscriptions : Model -> Sub Msg
subscriptions model =
Sub.none
-- VIEW
view : Model -> Html Msg
view model =
div
[ style "border" (if model.hover then "6px dashed purple" else "6px dashed #ccc")
, style "border-radius" "20px"
, style "width" "480px"
, style "margin" "100px auto"
, style "padding" "40px"
, style "display" "flex"
, style "flex-direction" "column"
, style "justify-content" "center"
, style "align-items" "center"
, hijackOn "dragenter" (D.succeed DragEnter)
, hijackOn "dragover" (D.succeed DragEnter)
, hijackOn "dragleave" (D.succeed DragLeave)
, hijackOn "drop" dropDecoder
]
[ button [ onClick Pick ] [ text "Upload Images" ]
, div
[ style "display" "flex"
, style "align-items" "center"
, style "height" "60px"
, style "padding" "20px"
]
(List.map viewPreview model.previews)
]
viewPreview : String -> Html msg
viewPreview url =
div
[ style "width" "60px"
, style "height" "60px"
, style "background-image" ("url('" ++ url ++ "')")
, style "background-position" "center"
, style "background-repeat" "no-repeat"
, style "background-size" "contain"
]
[]
dropDecoder : D.Decoder Msg
dropDecoder =
D.at ["dataTransfer","files"] (D.oneOrMore GotFiles File.decoder)
hijackOn : String -> D.Decoder msg -> Attribute msg
hijackOn event decoder =
preventDefaultOn event (D.map hijack decoder)
hijack : msg -> (msg, Bool)
hijack msg =
(msg, True)