Mark Eibes
2023-02-03T10:17:51Z

SelectionManager.purs

| module SelectionManager where
|
| import Yoga.Prelude.View
|
| import Data.Set (Set)
| import Data.Set as Set
| import Hooks.UseSelectable (UseSelectable, UseSelectableResult, useSelectable)
|
| type State a =
| { selection ∷ Set a
| , selectables ∷ Set a
| , enabled ∷ Boolean
| }
|
| defaultState ∷ ∀ a. State a
| defaultState = { selection: Set.empty, selectables: Set.empty, enabled: true }
|
| data Action a = UpdateSelection ((Set a → Set a))
|
| type Props a =
| { state ∷ State a
| , dispatch ∷ Action a → Effect Unit
| }
|
| reduce ∷ ∀ a. Eq a ⇒ Ord a ⇒ State a → Action a → State a
| reduce = case _, _ of
| s@{ selection, enabled: true }, UpdateSelection update → s
| { selection = update selection }
| state, _ → state
|
| useSelectableDispatch ∷
| ∀ a.
| Eq a ⇒
| Ord a ⇒
| State a →
| (Action a → Effect Unit) →
| Set a →
| Hook (UseSelectable a) (UseSelectableResult a)
| useSelectableDispatch state dispatch selectables =
| useSelectable
| { selection: state.selection
| , updateSelection: (dispatch <<< UpdateSelection)
| , selectables
| }

UseSelectable.purs

| module Hooks.UseSelectable where
|
| import Yoga.Prelude.View
|
| import Data.FoldableWithIndex (traverseWithIndex_)
| import Data.Map (Map)
| import Data.Map as Map
| import Data.Maybe (isNothing)
| import Data.Newtype (class Newtype)
| import Data.Nullable as Nullable
| import Data.Set (Set)
| import Data.Set as Set
| import Data.Traversable (for)
| import Data.TraversableWithIndex (traverseWithIndex)
| import Debug (spy)
| import Effect.Class.Console as Console
| import Effect.Ref as Ref
| import Effect.Uncurried (mkEffectFn1)
| import Foreign.Internal.Stringify (unsafeStringify)
| import Foreign.Object (Object)
| import Foreign.Object as Object
| import React.Basic.Hooks as React
| import Unsafe.Coerce (unsafeCoerce)
| import Web.DOM.Element as Element
| import Web.HTML.HTMLElement as HTMLElement
|
| type UseSelectableResult a =
| { getOverlappingItems ∷ DOMRect → Effect (Set a)
| , getSelectedBoundingBoxes ∷ Effect (Map a DOMRect)
| , recalculateBoundingBoxes ∷ Effect Unit
| , getItemProps ∷ GetItemProps a
| , getCachedBoundingBox ∷ a → Effect (Maybe DOMRect)
| , deleteStaleRefs ∷ Effect Unit
| , getCurrentBoundingBox ∷ a → Effect (Maybe DOMRect)
| }
|
| type GetItemProps a =
| a → { _aria ∷ Object String, onClick ∷ EventHandler, ref ∷ NodeRef }
|
| newtype UseSelectable a hooks = UseSelectable
| ( UseEffect (Set a)
| ( UseRef (Map a DOMRect)
| (UseRef (Map a Node) hooks)
| )
| )
|
| derive instance Newtype (UseSelectable a hooks) _
|
| useSelectable ∷
| ∀ a.
| Eq a ⇒
| Ord a ⇒
| { selectables ∷ Set a
| , selection ∷ Set a
| , updateSelection ∷ (Set a → Set a) → Effect Unit
| } →
| Hook (UseSelectable a) (UseSelectableResult a)
| useSelectable { selection, selectables, updateSelection } = coerceHook
| React.do
| refsRef ∷ Ref (Map a Node) ← React.useRef Map.empty
| bbsRef ∷ Ref (Map a DOMRect) ← React.useRef Map.empty
|
| React.useEffect selectables do
| refs ← readRef refsRef
| refs # traverseWithIndex_ \item _ →
| when (not Set.member item selectables) do
| modifyRef refsRef (Map.delete item)
| modifyRef bbsRef (Map.delete item)
| mempty
|
| let
| isChecked item = Set.member item selection
| onClick item = handler_ (updateSelection (Set.toggle item))
|
| itemRef ∷ a → NodeRef
| itemRef item = unsafeCoerce $ mkEffectFn1
| \(nullableNode ∷ Nullable Node) → do
| for_ (Nullable.toMaybe nullableNode) \node → do
| when (not Set.member item selectables) do
| Console.error
| ( "Got a ref for item " <> unsafeStringify item <>
| " but it is not in the selectable set"
| )
| modifyRef refsRef (Map.insert item node)
| bbʔ ← getBBʔ node
| for_ bbʔ \bb → do
| modifyRef bbsRef (Map.insert item bb)
|
| getCachedBoundingBox item = do
| readRef bbsRef <#> Map.lookup item
|
| deleteStaleRefs = do
| refs ∷ Map a Node ← readRef refsRef
| bbs ∷ Map a DOMRect ← readRef bbsRef
| bbs # traverseWithIndex_ \(item ∷ a) _ → do
| let nodeʔ = Map.lookup item refs
| case nodeʔ of
| Just _ → mempty
| Nothing → do
| modifyRef refsRef (Map.delete item)
|
| getSelectedBoundingBoxes = ado
| bbs ← readRef bbsRef
| in
| selection
| # Set.mapMaybe (\item → Map.lookup item bbs <#> (item /\ _))
| # Map.fromFoldable
|
| recalculateBoundingBoxes = do
| writeRef bbsRef Map.empty
| readRef refsRef >>=
| traverseWithIndex_ \item nodeRef → do
| bbʔ ← getBBʔ nodeRef
| for_ bbʔ \bb → do
| modifyRef bbsRef (Map.insert item bb)
|
| getCurrentBoundingBox item = do
| refs ← readRef refsRef
| for (Map.lookup item refs) getBBʔ <#> join
|
| getOverlappingItems ∷ DOMRect → Effect (Set a)
| getOverlappingItems { top, left, right, bottom } = do
| resultRef ← Ref.new Set.empty
| bbs ← readRef bbsRef
| for_ (bbs # Map.toUnfoldable ∷ Array _)
| \(item /\ domRect) → do
| when
| ( (domRect.left <= right) && (domRect.right >= left)
| && (domRect.top <= bottom)
| && (domRect.bottom >= top)
| )
| do Ref.modify_ (Set.insert item) resultRef
| Ref.read resultRef
|
| pure
| ( { getOverlappingItems
| , getSelectedBoundingBoxes
| , recalculateBoundingBoxes
| , getCachedBoundingBox
| , getCurrentBoundingBox
| , deleteStaleRefs
| , getItemProps: \i →
| { _aria: Object.fromHomogeneous { checked: show (isChecked i) }
| , onClick: onClick i
| , ref: itemRef i
| }
| } ∷ UseSelectableResult _
| )
|
| getBBʔ ∷ Node → Effect (Maybe DOMRect)
| getBBʔ node = runMaybeT do
| element ← (node # Element.fromNode) # pure # MaybeT
| getBoundingClientRect element # lift
|
| modifyRef ∷ ∀ a. Ref a → (a → a) → Effect Unit
| modifyRef ref f = do
| val ← readRef ref
| writeRef ref (f val)