Prepare drag-drop for items into folders

This commit is contained in:
Eike Kettner 2020-08-08 13:20:29 +02:00
parent f0a5f84c8b
commit 9c50a85363
7 changed files with 357 additions and 169 deletions

View File

@ -3,13 +3,16 @@ module Comp.FolderSelect exposing
, Msg
, init
, update
, updateDrop
, view
, viewDrop
)
import Api.Model.FolderItem exposing (FolderItem)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Html5.DragDrop as DD
import Util.ExpandCollapse
import Util.List
@ -36,10 +39,24 @@ init all =
type Msg
= Toggle FolderItem
| ToggleExpand
| FolderDDMsg (DD.Msg String String)
update : Msg -> Model -> ( Model, Maybe FolderItem )
update msg model =
let
( m, f, _ ) =
updateDrop DD.init msg model
in
( m, f )
updateDrop :
DD.Model String String
-> Msg
-> Model
-> ( Model, Maybe FolderItem, DD.Model String String )
updateDrop dropModel msg model =
case msg of
Toggle item ->
let
@ -53,13 +70,36 @@ update msg model =
model_ =
{ model | selected = selection }
in
( model_, selectedFolder model_ )
( model_, selectedFolder model_, dropModel )
ToggleExpand ->
( { model | expanded = not model.expanded }
, selectedFolder model
, dropModel
)
FolderDDMsg lm ->
let
( dm_, result ) =
DD.update lm dropModel
_ =
case result of
Just ( item, folder, _ ) ->
let
_ =
Debug.log "item menu" item
_ =
Debug.log "folder menu" folder
in
Cmd.none
Nothing ->
Cmd.none
in
( model, selectedFolder model, dm_ )
selectedFolder : Model -> Maybe FolderItem
selectedFolder model =
@ -75,7 +115,12 @@ selectedFolder model =
view : Int -> Model -> Html Msg
view constr model =
view =
viewDrop DD.init
viewDrop : DD.Model String String -> Int -> Model -> Html Msg
viewDrop dropModel constr model =
div [ class "ui list" ]
[ div [ class "item" ]
[ i [ class "folder open icon" ] []
@ -84,22 +129,22 @@ view constr model =
[ text "Folders"
]
, div [ class "ui relaxed list" ]
(renderItems constr model)
(renderItems dropModel constr model)
]
]
]
renderItems : Int -> Model -> List (Html Msg)
renderItems constr model =
renderItems : DD.Model String String -> Int -> Model -> List (Html Msg)
renderItems dropModel constr model =
if constr <= 0 then
List.map (viewItem model) model.all
List.map (viewItem dropModel model) model.all
else if model.expanded then
List.map (viewItem model) model.all ++ collapseToggle constr model
List.map (viewItem dropModel model) model.all ++ collapseToggle constr model
else
List.map (viewItem model) (List.take constr model.all) ++ expandToggle constr model
List.map (viewItem dropModel model) (List.take constr model.all) ++ expandToggle constr model
expandToggle : Int -> Model -> List (Html Msg)
@ -118,8 +163,8 @@ collapseToggle max model =
ToggleExpand
viewItem : Model -> FolderItem -> Html Msg
viewItem model item =
viewItem : DD.Model String String -> Model -> FolderItem -> Html Msg
viewItem dropModel model item =
let
selected =
Just item.id == model.selected
@ -130,15 +175,21 @@ viewItem model item =
else
"folder outline icon"
highlightDrop =
DD.getDropId dropModel == Just item.id
in
a
[ classList
([ classList
[ ( "item", True )
, ( "active", selected )
, ( "current-drop-target", highlightDrop )
]
, href "#"
, onClick (Toggle item)
]
, href "#"
, onClick (Toggle item)
]
++ DD.droppable FolderDDMsg item.id
)
[ i [ class icon ] []
, div [ class "content" ]
[ div [ class "header" ]

View File

@ -5,6 +5,7 @@ module Comp.ItemCardList exposing
, nextItem
, prevItem
, update
, updateDrag
, view
)
@ -20,6 +21,7 @@ import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Html5.DragDrop as DD
import Markdown
import Util.List
import Util.String
@ -35,6 +37,7 @@ type Msg
= SetResults ItemLightList
| AddResults ItemLightList
| SelectItem ItemLight
| ItemDDMsg (DD.Msg String String)
init : Model
@ -60,28 +63,72 @@ prevItem model id =
update : Flags -> Msg -> Model -> ( Model, Cmd Msg, Maybe ItemLight )
update _ msg model =
update flags msg model =
let
res =
updateDrag DD.init flags msg model
in
( res.model, res.cmd, res.selected )
type alias UpdateResult =
{ model : Model
, cmd : Cmd Msg
, selected : Maybe ItemLight
, dragModel : DD.Model String String
}
updateDrag :
DD.Model String String
-> Flags
-> Msg
-> Model
-> UpdateResult
updateDrag dm _ msg model =
case msg of
SetResults list ->
let
newModel =
{ model | results = list }
in
( newModel, Cmd.none, Nothing )
UpdateResult newModel Cmd.none Nothing dm
AddResults list ->
if list.groups == [] then
( model, Cmd.none, Nothing )
UpdateResult model Cmd.none Nothing dm
else
let
newModel =
{ model | results = Data.Items.concat model.results list }
in
( newModel, Cmd.none, Nothing )
UpdateResult newModel Cmd.none Nothing dm
SelectItem item ->
( model, Cmd.none, Just item )
UpdateResult model Cmd.none (Just item) dm
ItemDDMsg lm ->
let
( dm_, result ) =
DD.update lm dm
_ =
case result of
Just ( item, folder, _ ) ->
let
_ =
Debug.log "item card" item
_ =
Debug.log "folder card" folder
in
Cmd.none
Nothing ->
Cmd.none
in
UpdateResult model Cmd.none Nothing dm_
@ -139,14 +186,16 @@ viewItem settings item =
"blue"
in
a
[ classList
([ classList
[ ( "ui fluid card", True )
, ( newColor, not isConfirmed )
]
, id item.id
, href "#"
, onClick (SelectItem item)
]
, id item.id
, href "#"
, onClick (SelectItem item)
]
++ DD.draggable ItemDDMsg item.id
)
[ div [ class "content" ]
[ div
[ class "header"

View File

@ -1,11 +1,14 @@
module Comp.SearchMenu exposing
( Model
( DragDropData
, Model
, Msg(..)
, NextState
, getItemSearch
, init
, update
, updateDrop
, view
, viewDrop
)
import Api
@ -29,6 +32,7 @@ import DatePicker exposing (DatePicker)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onCheck, onClick, onInput)
import Html5.DragDrop as DD
import Http
import Util.Html exposing (KeyCode(..))
import Util.Maybe
@ -127,33 +131,6 @@ init =
}
type Msg
= Init
| TagSelectMsg Comp.TagSelect.Msg
| DirectionMsg (Comp.Dropdown.Msg Direction)
| OrgMsg (Comp.Dropdown.Msg IdName)
| CorrPersonMsg (Comp.Dropdown.Msg IdName)
| ConcPersonMsg (Comp.Dropdown.Msg IdName)
| ConcEquipmentMsg (Comp.Dropdown.Msg Equipment)
| FromDateMsg Comp.DatePicker.Msg
| UntilDateMsg Comp.DatePicker.Msg
| FromDueDateMsg Comp.DatePicker.Msg
| UntilDueDateMsg Comp.DatePicker.Msg
| ToggleInbox
| GetTagsResp (Result Http.Error TagCloud)
| GetOrgResp (Result Http.Error ReferenceList)
| GetEquipResp (Result Http.Error EquipmentList)
| GetPersonResp (Result Http.Error ReferenceList)
| SetName String
| SetAllName String
| SetFulltext String
| ResetForm
| KeyUpMsg (Maybe KeyCode)
| ToggleNameHelp
| FolderSelectMsg Comp.FolderSelect.Msg
| GetFolderResp (Result Http.Error FolderList)
getDirection : Model -> Maybe Direction
getDirection model =
let
@ -218,19 +195,53 @@ getItemSearch model =
-- Update
type alias NextState =
{ modelCmd : ( Model, Cmd Msg )
, stateChange : Bool
type Msg
= Init
| TagSelectMsg Comp.TagSelect.Msg
| DirectionMsg (Comp.Dropdown.Msg Direction)
| OrgMsg (Comp.Dropdown.Msg IdName)
| CorrPersonMsg (Comp.Dropdown.Msg IdName)
| ConcPersonMsg (Comp.Dropdown.Msg IdName)
| ConcEquipmentMsg (Comp.Dropdown.Msg Equipment)
| FromDateMsg Comp.DatePicker.Msg
| UntilDateMsg Comp.DatePicker.Msg
| FromDueDateMsg Comp.DatePicker.Msg
| UntilDueDateMsg Comp.DatePicker.Msg
| ToggleInbox
| GetTagsResp (Result Http.Error TagCloud)
| GetOrgResp (Result Http.Error ReferenceList)
| GetEquipResp (Result Http.Error EquipmentList)
| GetPersonResp (Result Http.Error ReferenceList)
| SetName String
| SetAllName String
| SetFulltext String
| ResetForm
| KeyUpMsg (Maybe KeyCode)
| ToggleNameHelp
| FolderSelectMsg Comp.FolderSelect.Msg
| GetFolderResp (Result Http.Error FolderList)
type alias DragDropData =
{ folderDrop : DD.Model String String
}
noChange : ( Model, Cmd Msg ) -> NextState
noChange p =
NextState p False
type alias NextState =
{ model : Model
, cmd : Cmd Msg
, stateChange : Bool
, dragDrop : DragDropData
}
update : Flags -> UiSettings -> Msg -> Model -> NextState
update flags settings msg model =
update =
updateDrop (DragDropData DD.init)
updateDrop : DragDropData -> Flags -> UiSettings -> Msg -> Model -> NextState
updateDrop dd flags settings msg model =
case msg of
Init ->
let
@ -257,9 +268,9 @@ update flags settings msg model =
]
)
in
noChange
( mdp
, Cmd.batch
{ model = mdp
, cmd =
Cmd.batch
[ Api.getTagCloud flags GetTagsResp
, Api.getOrgLight flags GetOrgResp
, Api.getEquipments flags "" GetEquipResp
@ -267,7 +278,9 @@ update flags settings msg model =
, Api.getFolders flags "" False GetFolderResp
, cdp
]
)
, stateChange = False
, dragDrop = dd
}
ResetForm ->
let
@ -286,10 +299,18 @@ update flags settings msg model =
model_ =
{ model | tagSelectModel = selectModel }
in
noChange ( model_, Cmd.none )
{ model = model_
, cmd = Cmd.none
, stateChange = False
, dragDrop = dd
}
GetTagsResp (Err _) ->
noChange ( model, Cmd.none )
{ model = model
, cmd = Cmd.none
, stateChange = False
, dragDrop = dd
}
GetEquipResp (Ok equips) ->
let
@ -299,7 +320,11 @@ update flags settings msg model =
update flags settings (ConcEquipmentMsg opts) model
GetEquipResp (Err _) ->
noChange ( model, Cmd.none )
{ model = model
, cmd = Cmd.none
, stateChange = False
, dragDrop = dd
}
GetOrgResp (Ok orgs) ->
let
@ -309,98 +334,112 @@ update flags settings msg model =
update flags settings (OrgMsg opts) model
GetOrgResp (Err _) ->
noChange ( model, Cmd.none )
{ model = model
, cmd = Cmd.none
, stateChange = False
, dragDrop = dd
}
GetPersonResp (Ok ps) ->
let
opts =
Comp.Dropdown.SetOptions ps.items
next1 =
updateDrop dd flags settings (CorrPersonMsg opts) model
next2 =
updateDrop next1.dragDrop flags settings (ConcPersonMsg opts) next1.model
in
noChange <|
Util.Update.andThen1
[ update flags settings (CorrPersonMsg opts) >> .modelCmd
, update flags settings (ConcPersonMsg opts) >> .modelCmd
]
model
next2
GetPersonResp (Err _) ->
noChange ( model, Cmd.none )
{ model = model
, cmd = Cmd.none
, stateChange = False
, dragDrop = dd
}
TagSelectMsg m ->
let
( m_, sel ) =
Comp.TagSelect.update m model.tagSelectModel
in
NextState
( { model
{ model =
{ model
| tagSelectModel = m_
, tagSelection = sel
}
, Cmd.none
)
(sel /= model.tagSelection)
}
, cmd = Cmd.none
, stateChange = sel /= model.tagSelection
, dragDrop = dd
}
DirectionMsg m ->
let
( m2, c2 ) =
Comp.Dropdown.update m model.directionModel
in
NextState
( { model | directionModel = m2 }
, Cmd.map DirectionMsg c2
)
(isDropdownChangeMsg m)
{ model = { model | directionModel = m2 }
, cmd = Cmd.map DirectionMsg c2
, stateChange = isDropdownChangeMsg m
, dragDrop = dd
}
OrgMsg m ->
let
( m2, c2 ) =
Comp.Dropdown.update m model.orgModel
in
NextState
( { model | orgModel = m2 }
, Cmd.map OrgMsg c2
)
(isDropdownChangeMsg m)
{ model = { model | orgModel = m2 }
, cmd = Cmd.map OrgMsg c2
, stateChange = isDropdownChangeMsg m
, dragDrop = dd
}
CorrPersonMsg m ->
let
( m2, c2 ) =
Comp.Dropdown.update m model.corrPersonModel
in
NextState
( { model | corrPersonModel = m2 }
, Cmd.map CorrPersonMsg c2
)
(isDropdownChangeMsg m)
{ model = { model | corrPersonModel = m2 }
, cmd = Cmd.map CorrPersonMsg c2
, stateChange = isDropdownChangeMsg m
, dragDrop = dd
}
ConcPersonMsg m ->
let
( m2, c2 ) =
Comp.Dropdown.update m model.concPersonModel
in
NextState
( { model | concPersonModel = m2 }
, Cmd.map ConcPersonMsg c2
)
(isDropdownChangeMsg m)
{ model = { model | concPersonModel = m2 }
, cmd = Cmd.map ConcPersonMsg c2
, stateChange = isDropdownChangeMsg m
, dragDrop = dd
}
ConcEquipmentMsg m ->
let
( m2, c2 ) =
Comp.Dropdown.update m model.concEquipmentModel
in
NextState
( { model | concEquipmentModel = m2 }
, Cmd.map ConcEquipmentMsg c2
)
(isDropdownChangeMsg m)
{ model = { model | concEquipmentModel = m2 }
, cmd = Cmd.map ConcEquipmentMsg c2
, stateChange = isDropdownChangeMsg m
, dragDrop = dd
}
ToggleInbox ->
let
current =
model.inboxCheckbox
in
NextState ( { model | inboxCheckbox = not current }, Cmd.none ) True
{ model = { model | inboxCheckbox = not current }
, cmd = Cmd.none
, stateChange = True
, dragDrop = dd
}
FromDateMsg m ->
let
@ -415,11 +454,11 @@ update flags settings msg model =
_ ->
Nothing
in
NextState
( { model | fromDateModel = dp, fromDate = nextDate }
, Cmd.none
)
(model.fromDate /= nextDate)
{ model = { model | fromDateModel = dp, fromDate = nextDate }
, cmd = Cmd.none
, stateChange = model.fromDate /= nextDate
, dragDrop = dd
}
UntilDateMsg m ->
let
@ -434,11 +473,11 @@ update flags settings msg model =
_ ->
Nothing
in
NextState
( { model | untilDateModel = dp, untilDate = nextDate }
, Cmd.none
)
(model.untilDate /= nextDate)
{ model = { model | untilDateModel = dp, untilDate = nextDate }
, cmd = Cmd.none
, stateChange = model.untilDate /= nextDate
, dragDrop = dd
}
FromDueDateMsg m ->
let
@ -453,11 +492,11 @@ update flags settings msg model =
_ ->
Nothing
in
NextState
( { model | fromDueDateModel = dp, fromDueDate = nextDate }
, Cmd.none
)
(model.fromDueDate /= nextDate)
{ model = { model | fromDueDateModel = dp, fromDueDate = nextDate }
, cmd = Cmd.none
, stateChange = model.fromDueDate /= nextDate
, dragDrop = dd
}
UntilDueDateMsg m ->
let
@ -472,79 +511,98 @@ update flags settings msg model =
_ ->
Nothing
in
NextState
( { model | untilDueDateModel = dp, untilDueDate = nextDate }
, Cmd.none
)
(model.untilDueDate /= nextDate)
{ model = { model | untilDueDateModel = dp, untilDueDate = nextDate }
, cmd = Cmd.none
, stateChange = model.untilDueDate /= nextDate
, dragDrop = dd
}
SetName str ->
let
next =
Util.Maybe.fromString str
in
NextState
( { model | nameModel = next }
, Cmd.none
)
False
{ model = { model | nameModel = next }
, cmd = Cmd.none
, stateChange = False
, dragDrop = dd
}
SetAllName str ->
let
next =
Util.Maybe.fromString str
in
NextState
( { model | allNameModel = next }
, Cmd.none
)
False
{ model = { model | allNameModel = next }
, cmd = Cmd.none
, stateChange = False
, dragDrop = dd
}
SetFulltext str ->
let
next =
Util.Maybe.fromString str
in
NextState
( { model | fulltextModel = next }
, Cmd.none
)
False
{ model = { model | fulltextModel = next }
, cmd = Cmd.none
, stateChange = False
, dragDrop = dd
}
KeyUpMsg (Just Enter) ->
NextState ( model, Cmd.none ) True
{ model = model
, cmd = Cmd.none
, stateChange = True
, dragDrop = dd
}
KeyUpMsg _ ->
NextState ( model, Cmd.none ) False
{ model = model
, cmd = Cmd.none
, stateChange = False
, dragDrop = dd
}
ToggleNameHelp ->
NextState ( { model | showNameHelp = not model.showNameHelp }, Cmd.none ) False
{ model = { model | showNameHelp = not model.showNameHelp }
, cmd = Cmd.none
, stateChange = False
, dragDrop = dd
}
GetFolderResp (Ok fs) ->
let
model_ =
{ model | folderList = Comp.FolderSelect.init fs.items }
in
NextState
( model_, Cmd.none )
False
{ model = model_
, cmd = Cmd.none
, stateChange = False
, dragDrop = dd
}
GetFolderResp (Err _) ->
noChange ( model, Cmd.none )
{ model = model
, cmd = Cmd.none
, stateChange = False
, dragDrop = dd
}
FolderSelectMsg lm ->
let
( fsm, sel ) =
Comp.FolderSelect.update lm model.folderList
( fsm, sel, dd_ ) =
Comp.FolderSelect.updateDrop dd.folderDrop lm model.folderList
in
NextState
( { model
{ model =
{ model
| folderList = fsm
, selectedFolder = sel
}
, Cmd.none
)
(model.selectedFolder /= sel)
}
, cmd = Cmd.none
, stateChange = model.selectedFolder /= sel
, dragDrop = { dd | folderDrop = dd_ }
}
@ -552,7 +610,12 @@ update flags settings msg model =
view : Flags -> UiSettings -> Model -> Html Msg
view flags settings model =
view =
viewDrop (DragDropData DD.init)
viewDrop : DragDropData -> Flags -> UiSettings -> Model -> Html Msg
viewDrop ddd flags settings model =
let
formHeader icon headline =
div [ class "ui tiny header" ]
@ -585,7 +648,7 @@ view flags settings model =
[ Html.map TagSelectMsg (Comp.TagSelect.viewTags settings model.tagSelectModel)
, Html.map TagSelectMsg (Comp.TagSelect.viewCats settings model.tagSelectModel)
, Html.map FolderSelectMsg
(Comp.FolderSelect.view settings.searchMenuFolderCount model.folderList)
(Comp.FolderSelect.viewDrop ddd.folderDrop settings.searchMenuFolderCount model.folderList)
]
, div [ class segmentClass ]
[ formHeader (Icons.correspondentIcon "")

View File

@ -16,10 +16,11 @@ import Api.Model.ItemLightList exposing (ItemLightList)
import Api.Model.ItemSearch
import Comp.FixedDropdown
import Comp.ItemCardList
import Comp.SearchMenu
import Comp.SearchMenu exposing (DragDropData)
import Data.Flags exposing (Flags)
import Data.Items
import Data.UiSettings exposing (UiSettings)
import Html5.DragDrop as DD
import Http
import Throttle exposing (Throttle)
import Util.Html exposing (KeyCode(..))
@ -39,6 +40,7 @@ type alias Model =
, searchType : SearchType
, searchTypeForm : SearchType
, contentOnlySearch : Maybe String
, dragDropData : DragDropData
}
@ -67,6 +69,9 @@ init flags =
, searchType = BasicSearch
, searchTypeForm = defaultSearchType flags
, contentOnlySearch = Nothing
, dragDropData =
{ folderDrop = DD.init
}
}

View File

@ -6,6 +6,7 @@ import Comp.ItemCardList
import Comp.SearchMenu
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Html5.DragDrop as DD
import Page exposing (Page(..))
import Page.Home.Data exposing (..)
import Throttle
@ -39,10 +40,18 @@ update key flags settings msg model =
SearchMenuMsg m ->
let
nextState =
Comp.SearchMenu.update flags settings m model.searchMenuModel
Comp.SearchMenu.updateDrop
model.dragDropData
flags
settings
m
model.searchMenuModel
newModel =
{ model | searchMenuModel = Tuple.first nextState.modelCmd }
{ model
| searchMenuModel = nextState.model
, dragDropData = nextState.dragDrop
}
( m2, c2, s2 ) =
if nextState.stateChange && not model.searchInProgress then
@ -54,18 +63,21 @@ update key flags settings msg model =
( m2
, Cmd.batch
[ c2
, Cmd.map SearchMenuMsg (Tuple.second nextState.modelCmd)
, Cmd.map SearchMenuMsg nextState.cmd
]
, s2
)
ItemCardListMsg m ->
let
( m2, c2, mitem ) =
Comp.ItemCardList.update flags m model.itemListModel
result =
Comp.ItemCardList.updateDrag model.dragDropData.folderDrop
flags
m
model.itemListModel
cmd =
case mitem of
case result.selected of
Just item ->
Page.set key (ItemDetailPage item.id)
@ -73,8 +85,11 @@ update key flags settings msg model =
Cmd.none
in
withSub
( { model | itemListModel = m2 }
, Cmd.batch [ Cmd.map ItemCardListMsg c2, cmd ]
( { model
| itemListModel = result.model
, dragDropData = { folderDrop = result.dragModel }
}
, Cmd.batch [ Cmd.map ItemCardListMsg result.cmd, cmd ]
)
ItemSearchResp (Ok list) ->

View File

@ -63,7 +63,12 @@ view flags settings model =
]
]
, div [ class "ui attached fluid segment" ]
[ Html.map SearchMenuMsg (Comp.SearchMenu.view flags settings model.searchMenuModel)
[ Html.map SearchMenuMsg
(Comp.SearchMenu.viewDrop model.dragDropData
flags
settings
model.searchMenuModel
)
]
]
, div

View File

@ -166,7 +166,7 @@ textarea.markdown-editor {
background: rgba(240,248,255,0.4);
}
.default-layout .ui.menu .item.current-drop-target {
.default-layout .ui.menu .item.current-drop-target, a.item.current-drop-target {
background: rgba(0,0,0,0.2);
}