Skip to content

Instantly share code, notes, and snippets.

@jwosty
Forked from JordanMarr/DragDropPage.fs
Last active January 31, 2021 01:42
Show Gist options
  • Save jwosty/aeee4e63be69fa243b330cc3f5afc1d3 to your computer and use it in GitHub Desktop.
Save jwosty/aeee4e63be69fa243b330cc3f5afc1d3 to your computer and use it in GitHub Desktop.
Fable bindings for "react-dnd" using HTML5 provider
type Language = {
Name: string
}
let draggableLanguage = FunctionComponent.Of(fun (props: {| lang: Language |}) ->
let dragState, drag, preview = ReactDND.useDrag [
DragSpec.Item { ``type`` = "Language"; dragSrc = props.lang }
DragSpec.Collect (fun mon -> { isDragging = mon.isDragging() })
//DragSpec.End (fun dragItem mon -> printf "DragEnd: %A; Mon.DropTarget: %A" dragItem mon)
]
div [
Ref drag
Style[Border "1px solid gray"; Padding "4px"; BackgroundColor (if dragState.isDragging then "yellow" else "white")]
Key props.lang.Name
] [
str props.lang.Name
]
)
let dropTarget = FunctionComponent.Of(fun () ->
let selectedLang = Hooks.useState<Language option>(None)
let dropState, drop = ReactDND.useDrop [
DropSpec.Accept ["Language"]
DropSpec.Collect (fun mon -> { canDrop = mon.canDrop(); isOver = mon.isOver() })
DropSpec.Drop (fun (dragItem: DragItem<Language>) ->
selectedLang.update (Some dragItem.dragSrc)
)
]
div [
Ref drop
Style[BackgroundColor "whitesmoke"; Padding "20px"; BackgroundColor (if dropState.isOver then "lightgreen" else "white")]
] [
selectedLang.current
|> Option.map (fun l -> sprintf "You selected: %s" l.Name)
|> Option.defaultValue "Drag your .net language of choice here"
|> str
]
)
let page = FunctionComponent.Of(fun () ->
let languages =
Hooks.useState<Language list>(
[ "C#"; "F#"; "VC" ] |> List.map (fun l -> { Name = l })
)
div [Style[Width "300px"; MarginLeft "auto"; MarginRight "auto"]] [
//ReactDND.dndProviderHtml5 [] [
ReactDND.dndProvider [DndProviderProps.Backend html5Backend] [
dropTarget()
languages.current
|> List.map (fun lang ->
div [Key lang.Name] [
draggableLanguage {| lang = lang |}
])
|> ofList
]
]
)
/// taken from https://gist.github.com/JordanMarr/2d478dfecf9e91bba953c649fe2ff458
/// Custom bindings for "react-dnd"; authored by jmarr on Feb 2020 and updated by jwosty on Dec 2020.
/// This expects that "react-dnd" and "react-dnd-html5-backend" are both installed.
module ReactDND
open Fable.Core
open Fable.Core.JsInterop
open Fable.React
open Fable.React.Props
open System.Text.RegularExpressions
let private kvl xs = JsInterop.keyValueList CaseRules.LowerFirst xs
type CollectedDragProps = {
isDragging: bool
}
type CollectedDropProps = {
isOver: bool
canDrop: bool
}
type [<AllowNullLiteral>] IDragMonitor =
abstract member isDragging: unit -> bool
type [<AllowNullLiteral>] IDropMonitor =
abstract member isOver: unit -> bool
abstract member canDrop: unit -> bool
abstract member getDropResult: unit -> obj
//
// Provider / Context
//
[<Import("HTML5Backend", from="react-dnd-html5-backend")>]
let html5Backend: obj = jsNative
type DndProviderProps =
| Backend of obj
let dndProvider (props: DndProviderProps list) = ofImport "DndProvider" "react-dnd" (kvl props)
/// Provides a Drag and Drop context using the "react-dnd-html-backend" provider.
let dndProviderHtml5 (props: DndProviderProps list) = dndProvider [DndProviderProps.Backend html5Backend]
type DragItem<'DragSrc> = {
``type``: string
dragSrc: 'DragSrc
}
//
// UseDrag
//
[<RequireQualifiedAccess>]
type DragSpec<'DragSrc> =
/// Specifies info about the drag source object and type (required).
| Item of DragItem<'DragSrc>
/// An optional handler to gather state.
| Collect of (IDragMonitor -> CollectedDragProps)
/// Provides an optional handler if actions are necessary at the end of a drag operation.
| End of (DragItem<'DragSrc> -> IDragMonitor -> unit)
module DragSpec =
let CollectDefault = DragSpec.Collect(fun mon -> { isDragging = mon.isDragging() })
let private useDragImpl: spec: obj -> collectedProps: CollectedDragProps * drag: (Browser.Types.Element -> unit) * preview: obj = import "useDrag" "react-dnd"
let useDrag<'TItem>(spec: DragSpec<'TItem> list) = useDragImpl (kvl spec)
//
// UseDrop
//
[<RequireQualifiedAccess>]
type DropSpec<'DragSrc, 'DropTgt> =
/// Specifies which kinds of drag item types are accepted (required).
| Accept of string []
//| Accept of string
/// An optional handler to gather state.
| Collect of (IDropMonitor -> CollectedDropProps)
/// Provides an optional handler for the drop event.
| Drop of (DragItem<'DragSrc> -> 'DropTgt)
/// Specifies whether the drop target is able to accept the item.
| CanDrop of (DragItem<'DragSrc> -> IDropMonitor -> bool)
module DropSpec =
let inline Accept types = DropSpec<_,_>.Accept (Array.ofSeq types)
let CollectDefault = DropSpec.Collect (fun mon -> { canDrop = mon.canDrop(); isOver = mon.isOver() })
let private useDropImpl: spec: obj -> collectedProps: CollectedDropProps * drop: (Browser.Types.Element -> unit) = import "useDrop" "react-dnd"
let useDrop<'DragSrc,'DragTgt> (spec: DropSpec<'DragSrc, 'DragTgt> list) = useDropImpl (kvl spec)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment