elm-drag-drop-sorting/Main.elm at master · toburger/elm-drag-drop-sorting · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
module Main exposing (..)

import Html exposing (..)
import Html.Attributes exposing (style, src, width)
import Html5.DragDrop as DragDrop
import Utils


type alias DragId =
    Int


type alias DropId =
    Int


type alias Item =
    { heading : String
    , body : String
    , image : String
    }


type alias Model =
    { items : List Item
    , dragDrop : DragDrop.Model DragId DropId
    }


type Msg
    = DragDropMsg (DragDrop.Msg DragId DropId)


model : Model
model =
    { items =
        List.range 1 10
            |> List.map
                (\x ->
                    Item ("Item #" ++ toString x)
                        "This is the body text"
                        (if x % 2 == 0 then
                            "http://seeklogo.com/images/E/elm-logo-9DEF2A830B-seeklogo.com.png"
                         else
                            "https://www.w3.org/html/logo/downloads/HTML5_Logo_256.png"
                        )
                )
    , dragDrop = DragDrop.init
    }


update : Msg -> Model -> Model
update msg model =
    case msg of
        DragDropMsg msg_ ->
            let
                ( model_, result ) =
                    DragDrop.update msg_ model.dragDrop
            in
                ({ model
                    | dragDrop = model_
                    , items =
                        case result of
                            Nothing ->
                                model.items

                            Just ( currPos, newPos ) ->
                                Utils.transplant (currPos // 2)
                                    (newPos
                                        // 2
                                        - (if currPos <= newPos then
                                            1
                                           else
                                            0
                                          )
                                    )
                                    model.items
                 }
                )


viewSourceItem : Item -> List (Attribute Msg) -> Html Msg
viewSourceItem item draggable =
    li
        ([ style
            [ ( "border", "solid 1px black" )
            , ( "padding", "5px" )
            ]
         ]
            ++ draggable
        )
        [ div
            [ style [ ( "pointer-events", "none" ) ] ]
            [ h4 [] [ text item.heading ]
            , p []
                [ text item.body ]
            , img [ src item.image, width 20 ] []
            ]
        ]


viewTargetItem : List (Attribute Msg) -> Html Msg
viewTargetItem droppable =
    li
        ([ style
            [ ( "padding", "10px 5px" )
            , ( "color", "gray" )
            , ( "text-align", "center" )
            , ( "font-style", "italic" )
            ]
         ]
            ++ droppable
        )
        [ text "drop here..." ]


viewNeutralItem : List (Attribute Msg) -> Html Msg
viewNeutralItem droppable =
    li ([ style [ ( "height", "10px" ) ] ] ++ droppable) [ text "" ]


viewContainer : List (Html Msg) -> Html Msg
viewContainer children =
    div []
        [ ul
            [ style
                [ ( "list-style", "none" )
                , ( "margin", "10px" )
                , ( "padding", "0" )
                ]
            ]
            children
        ]


viewDragSource : Maybe dropId -> dragId -> (DragDrop.Msg dragId dropId -> msg) -> (List (Attribute msg) -> Html msg) -> Html msg
viewDragSource dropId dragId msg sourceItem =
    let
        draggable =
            DragDrop.draggable msg dragId
    in
        sourceItem draggable


viewDropTarget : Maybe dropId -> dropId -> (DragDrop.Msg dragId dropId -> msg) -> (List (Attribute msg) -> Html msg) -> (List (Attribute msg) -> Html msg) -> Html msg
viewDropTarget dropId dropId_ msg neutralItem dropItem =
    let
        droppable =
            DragDrop.droppable msg dropId_
    in
        if dropId == Just dropId_ then
            dropItem droppable
        else
            neutralItem droppable


type DragDropElement a
    = Draggable a
    | Droppable


view : Model -> Html Msg
view model =
    let
        dropId =
            DragDrop.getDropId model.dragDrop

        dragId =
            DragDrop.getDragId model.dragDrop

        isDragging =
            dragId /= Nothing
    in
        viewContainer
            (model.items
                |> List.map Draggable
                |> Utils.exospersed Droppable
                |> List.indexedMap
                    (\dragId_ elem ->
                        case elem of
                            Draggable elem ->
                                viewDragSource dropId dragId_ DragDropMsg (viewSourceItem elem)

                            Droppable ->
                                if isDragging then
                                    viewDropTarget dropId dragId_ DragDropMsg viewNeutralItem viewTargetItem
                                else
                                    viewNeutralItem []
                    )
            )


main : Program Never Model Msg
main =
    beginnerProgram
        { model = model
        , update = update
        , view = view
        }