Move plumage into this

packages.dhall

@@ -553,11 +553,9 @@ in  upstream
     }
   with react-virtuoso =
     { dependencies =
-        ( https://raw.githubusercontent.com/rowtype-yoga/purescript-react-virtuoso/main/spago.dhall
-            sha256:9c7c1ced896538360ba325dcefe912fed8c0207bc828f68ebadf5f3b83ee5012
-        ).dependencies
+      [ "effect", "functions", "prelude", "react-basic", "react-basic-dom" ]
     , repo = "https://github.com/rowtype-yoga/purescript-react-virtuoso.git"
-    , version = "ad50a215c024f4ee3393916c8a3307a9a7c9b4a5"
+    , version = "5be142c5a651509e9e9a68582ed1807c029ba1b5"
     }
   with yoga-tree =
     { dependencies =

spago.dhall

@@ -29,6 +29,7 @@ You can edit this file as you like.
   , "literals"
   , "maybe"
   , "newtype"
+  , "now"
   , "nullable"
   , "numbers"
   , "ordered-collections"
@@ -45,8 +46,10 @@ You can edit this file as you like.
   , "record"
   , "record-extra"
   , "refs"
+  , "remotedata"
   , "spec"
   , "spec-discovery"
+  , "st"
   , "strings"
   , "tailrec"
   , "transformers"

src/Plumage/Atom/Button.purs

@@ -0,0 +1,148 @@
+module Plumage.Atom.Button where
+
+import Prelude
+
+import Data.Array (fold)
+import Data.Monoid (guard)
+import Data.Nullable as Nullable
+import Data.Traversable (for_)
+import Data.Tuple.Nested ((/\))
+import Foreign.Object as Object
+import Framer.Motion as M
+import Fahrtwind.Layer as Layer
+import Fahrtwind.Style (background, black, border, borderCol, borderNone, borderSolid, boxSizingBorderBox, cursorPointer, gray, inlineBlock, mXY, opacity, pX, pXY, pY, positionAbsolute, positionRelative, rounded, roundedXl, shadowDefaultCol, shadowSm, textCol, violet, white)
+import Prim.Row (class Union)
+import React.Aria.Button (ButtonPropsImpl, useButton)
+import React.Aria.Focus (useFocusRing)
+import React.Aria.Utils (mergeProps)
+import React.Basic (JSX)
+import React.Basic.DOM (css, unsafeCreateDOMComponent)
+import React.Basic.DOM as R
+import React.Basic.Emotion (Style)
+import React.Basic.Emotion as E
+import React.Basic.Hooks (Component, component, useEffectAlways)
+import React.Basic.Hooks as React
+import Yoga.Prelude.View (getBoundingBoxFromRef)
+
+mkButton ∷
+  ∀ attrsIn69 attrsIn_70.
+  Union attrsIn69 attrsIn_70 ButtonPropsImpl ⇒
+  Component
+    { buttonProps ∷ Record attrsIn69
+    , children ∷ Array JSX
+    , containerCss ∷ Style
+    , css ∷ Style
+    }
+mkButton = do
+  rawButton ← unsafeCreateDOMComponent "button"
+  component "Button" \props → React.do
+    ref ← React.useRef Nullable.null
+    containerRef ← React.useRef Nullable.null
+    boundingBox /\ setBoundingBox ← React.useState' zero
+    useEffectAlways do
+      maybeBB ← getBoundingBoxFromRef containerRef
+      for_ maybeBB \bb →
+        when (bb /= boundingBox) (setBoundingBox bb)
+      mempty
+    { buttonProps } ← useButton props.buttonProps ref
+    { isFocused, isFocusVisible, focusProps } ←
+      useFocusRing { within: false, isTextInput: false, autoFocus: false }
+    pure
+      $ E.element R.div'
+          { className: "plm-button-container"
+          , css:
+              positionRelative
+                <> inlineBlock
+                <> pXY 0
+                <> mXY 0
+                <> props.containerCss
+          , ref: containerRef
+          , children:
+              [ E.element rawButton
+                  ( mergeProps
+                      focusProps
+                      ( mergeProps
+                          buttonProps
+                          { className: "plm-button"
+                          , css: props.css
+                          , ref
+                          , children: props.children
+                          }
+                      )
+                  )
+              , guard (isFocused && isFocusVisible)
+                  ( E.element M.div
+                      { className: "focus-outline"
+                      , css: focusStyle
+                      , initial:
+                          M.initial
+                            $ css
+                                { width: boundingBox.width
+                                , height: boundingBox.height
+                                , left: 0
+                                , top: 0
+                                }
+                      , animate:
+                          M.animate
+                            $ css
+                                { width: boundingBox.width + 12.0
+                                , height: boundingBox.height + 12.0
+                                , left: -6.0
+                                , top: -6.0
+                                }
+                      , layout: M.layout true
+                      , layoutId: M.layoutId "focus-indicator"
+                      , _aria: Object.singleton "hidden" "true"
+                      }
+                  )
+              ]
+          }
+
+focusStyle ∷ Style
+focusStyle =
+  fold
+    [ border 4
+    , borderCol violet._400
+    , borderSolid
+    , boxSizingBorderBox
+    , rounded (E.px 17)
+    , positionAbsolute
+    , opacity 80
+    , Layer.topmost
+    ]
+
+baseButtonStyle ∷ Style
+baseButtonStyle =
+  fold
+    [ background white
+    , textCol black
+    , roundedXl
+    , borderSolid
+    , borderCol gray._300
+    , border 1
+    , pY 11
+    , pX 27
+    , boxSizingBorderBox
+    , shadowSm
+    , cursorPointer
+    , E.css
+        { fontFamily: E.str "InterVariable, sans-serif"
+        , fontSize: E.str "0.95em"
+        , fontWeight: E.str "500"
+        , letterSpacing: E.str "0.025em"
+        , textAlign: E.str "center"
+        , outline: E.none
+        }
+    ]
+
+primaryButtonStyle ∷ Style
+primaryButtonStyle =
+  baseButtonStyle
+    <> fold
+      [ background violet._600
+      , textCol white
+      , borderNone
+      , pY 12
+      , pX 28
+      , shadowDefaultCol violet._600
+      ]

src/Plumage/Atom/DatePicker.purs

@@ -0,0 +1,70 @@
+module Plumage.Atom.DatePicker where
+
+import Yoga.Prelude.View
+
+import Data.Date (Date, Month, Year)
+import Effect.Now (nowDate)
+import Plumage.Atom.DatePicker.View (mkDatePickerView)
+import Plumage.Atom.DatePicker.View as DateView
+import React.Basic.Hooks (mkReducer)
+import React.Basic.Hooks as React
+
+type Props =
+  { dateʔ :: Maybe Date
+  , show :: Boolean
+  , showingMonthʔ :: Maybe (Month /\ Year)
+  , onChange :: Maybe Date -> Effect Unit
+  }
+
+data Action = DateViewAction DateView.Action
+
+type State =
+  { datePickerState ∷ DateView.State
+  }
+
+defaultState ∷ State
+defaultState = { datePickerState: DateView.defaultState }
+
+reduce ∷ State → Action → State
+reduce = case _, _ of
+  s, DateViewAction a → s { datePickerState = DateView.reduce (s.datePickerState) a }
+
+mkDatePicker ∷ React.Component Props
+mkDatePicker = do
+  dateView <- mkDatePickerView
+  reducer <- mkReducer reduce
+  React.component "DatePicker" \(props :: Props) → React.do
+    state /\ dispatch <- React.useReducer defaultState reducer
+    useEffect props.show do
+      if props.show then do
+        currentDate <- nowDate
+        dispatch (DateViewAction $ DateView.Open { selectedDateʔ: props.dateʔ, currentDate })
+      else
+        dispatch (DateViewAction DateView.Dismiss)
+      mempty
+
+    useEffect props.dateʔ do
+      case props.dateʔ of
+        Nothing -> mempty
+        Just date -> dispatch $ DateViewAction $ DateView.DateSelected date
+      mempty
+
+    useEffect (state.datePickerState <#> _.selectedDateʔ) do
+      case state.datePickerState of
+        Nothing -> mempty
+        Just { selectedDateʔ } -> unless (selectedDateʔ == props.dateʔ) do
+          props.onChange selectedDateʔ
+      mempty
+
+    useEffect props.showingMonthʔ do
+      case props.showingMonthʔ of
+        Nothing -> mempty
+        Just monthAndYear -> dispatch $ DateViewAction $ DateView.ShowMonthAndYear monthAndYear
+      mempty
+
+    pure
+      ( dateView
+          { state: state.datePickerState
+          , dispatch: dispatch <<< DateViewAction
+          }
+      )

src/Plumage/Atom/DatePicker/View.purs

@@ -0,0 +1,467 @@
+module Plumage.Atom.DatePicker.View where
+
+import Plumage.Prelude.Style
+
+import Data.Date (Date, Day, Month(..), Weekday(..), Year)
+import Data.Date as Date
+import Data.Enum (enumFromTo, fromEnum)
+import Data.Enum as Enum
+import Data.String as String
+import Data.Time.Duration (Days(..), negateDuration)
+import Data.Tuple.Nested (type (/\), (/\))
+import Framer.Motion as M
+import Literals.Undefined (undefined)
+import Fahrtwind.Icon.Heroicons as Heroicons
+import Plumage.Util.HTML as H
+import Prelude as Bounded
+import React.Basic (JSX)
+import React.Basic.DOM as R
+import React.Basic.Emotion (Style)
+import React.Basic.Emotion as E
+import React.Basic.Events (handler_)
+import React.Basic.Hooks as React
+import Record (disjointUnion)
+
+type Props = { state ∷ State, dispatch ∷ Action → Effect Unit }
+
+data Action
+  = DateSelected Date
+  | ShowPreviousMonth
+  | ShowNextMonth
+  | ShowMonthAndYear (Month /\ Year)
+  | Open { currentDate ∷ Date, selectedDateʔ ∷ Maybe Date }
+  | StartTransition TransitionDirection
+  | Dismiss
+
+data TransitionDirection = Opening | ToNextMonth | ToPreviousMonth | Closing
+
+derive instance Eq TransitionDirection
+
+type State = Maybe
+  { selectedDateʔ ∷ Maybe Date
+  , currentDate ∷ Date
+  , showingMonth ∷ (Month /\ Year)
+  , transitioningʔ ∷ Maybe TransitionDirection
+  }
+
+defaultState ∷ State
+defaultState = Nothing
+
+reduce ∷ State → Action → State
+reduce = case _, _ of
+  Just s, DateSelected d → Just (s { selectedDateʔ = Just d })
+  Just s, ShowMonthAndYear my → Just
+    (s { showingMonth = my, transitioningʔ = Nothing })
+  Just s, ShowNextMonth → Just
+    (s { showingMonth = nextMonth s.showingMonth, transitioningʔ = Nothing })
+  Just s, ShowPreviousMonth → Just
+    ( s
+        { showingMonth = previousMonth s.showingMonth
+        , transitioningʔ = Nothing
+        }
+    )
+
+  -- User clicking very fast. Without this they have to wait for the transition
+  -- to finish on every click
+  Just s@{ transitioningʔ: Just running }, StartTransition transition
+    | running == transition → case running of
+        ToNextMonth → Just s { showingMonth = nextMonth s.showingMonth }
+        ToPreviousMonth → Just s { showingMonth = previousMonth s.showingMonth }
+        _ → Just s
+  Just s, StartTransition transition → Just
+    (s { transitioningʔ = Just transition })
+  Just _, Dismiss → Nothing
+  Nothing, Open { currentDate, selectedDateʔ } → do
+    let date = fromMaybe currentDate selectedDateʔ
+    Just
+      { selectedDateʔ
+      , currentDate
+      , showingMonth: (Date.month date /\ Date.year date)
+      , transitioningʔ: Nothing
+      }
+  s, _ → s
+
+mkDatePickerView ∷ React.Component Props
+mkDatePickerView = do
+  React.component "DatePickerView" \props → React.do
+    let { state, dispatch } = props
+    pure case state of
+      Just s → renderDate ({ dispatch } `disjointUnion` s)
+      Nothing → mempty
+
+renderDate ∷
+  { dispatch ∷ Action → Effect Unit
+  , currentDate ∷ Date
+  , selectedDateʔ ∷ Maybe Date
+  , showingMonth ∷ Month /\ Year
+  , transitioningʔ ∷ Maybe TransitionDirection
+  } →
+  JSX
+renderDate
+  { dispatch
+  , currentDate
+  , selectedDateʔ
+  , transitioningʔ
+  , showingMonth: showingMonth /\ showingYear
+  } = do
+  let date = Date.canonicalDate showingYear showingMonth Bounded.bottom
+  let nextMonth /\ nextYear = nextMonth (showingMonth /\ showingYear)
+  let nextDate = Date.canonicalDate nextYear nextMonth Bounded.bottom
+  let
+    previousMonth /\ previousYear = previousMonth (showingMonth /\ showingYear)
+  let
+    previousDate = Date.canonicalDate previousYear previousMonth Bounded.bottom
+  H.div_ dateContainerStyle
+    [ H.div_ titleAndControlsStyle
+        [ E.element R.button'
+            { className: "plm-cal-btn"
+            , css: monthChangeButtonStyle
+            , onClick: handler_ (dispatch (StartTransition ToPreviousMonth))
+            , children: [ Heroicons.chevronLeft ]
+            }
+        -- , E.element R.button'
+        --     { className: "monthAndYear"
+        --     , css: monthAndYearStyle
+        --     , children:
+        --         [ R.div_
+        --             [ R.text $ monthName showingMonth <>
+        --                 if showingYear == Date.year currentDate then ""
+        --                 else " " <> yearString showingYear
+        --             ]
+        --         , H.div_
+        --             ( width 20
+        --                 <> height' (E.str "calc(100% - 6px)")
+        --                 <> flexRow
+        --                 <> itemsCenter
+        --                 <> justifyEnd
+        --                 <> border 0
+        --                 <> borderLeft 1
+        --                 <> borderSolid
+        --                 <> borderCol gray._200
+        --             )
+        --             [ H.div_ (widthAndHeight 16)
+        --                 [ Heroicons.chevronDown ]
+        --             ]
+        --         ]
+        --     }
+        , R.text $ monthName showingMonth <>
+            if showingYear == Date.year currentDate then ""
+            else " " <> yearString showingYear
+
+        , E.element R.button'
+            { className: "plm-cal-btn"
+            , css: monthChangeButtonStyle
+            , onClick: handler_ (dispatch (StartTransition ToNextMonth))
+            , children: [ Heroicons.chevronRight ]
+            }
+        ]
+    , E.element R.div'
+        { className: "days-container"
+        , css: daysContainerStyle
+        , children:
+            [ H.div_ daysHeadingsStyle
+                ( enumFromTo Monday Sunday <#>
+                    (weekdayName >>> String.take 3 >>> \n → R.div_ [ R.text n ])
+                )
+            , E.element M.div
+                { className: "the-days"
+                , key: monthName showingMonth
+                , css: flexRow <> width (7 * size) <> height 260
+                , initial: M.initial $ R.css { x: "-100%" }
+                , animate: M.animate case transitioningʔ of
+                    Just ToNextMonth → R.css
+                      { x: "-200%", transition: { duration: 0.2 } }
+                    Just ToPreviousMonth → R.css
+                      { x: "0%", transition: { duration: 0.2 } }
+                    _ → R.css { x: "-100%" }
+                , onAnimationComplete: M.onAnimationComplete
+                    case transitioningʔ of
+                      Just ToNextMonth → const $ dispatch ShowNextMonth
+                      Just ToPreviousMonth → const $ dispatch ShowPreviousMonth
+                      _ → mempty
+                , children:
+                    [ H.div "days" daysStyle
+                        $ renderMonthNumbers
+                            { date: previousDate
+                            , selectedDateʔ: Nothing
+                            , currentDateʔ: Nothing
+                            , showingMonth: previousMonth
+                            , dispatch: mempty
+                            }
+                    , H.div "days" daysStyle
+                        $ renderMonthNumbers
+                            { date
+                            , selectedDateʔ
+                            , currentDateʔ: Just currentDate
+                            , showingMonth
+                            , dispatch
+                            }
+                    , H.div "days" daysStyle
+                        $ renderMonthNumbers
+                            { date: nextDate
+                            , selectedDateʔ: Nothing
+                            , currentDateʔ: Nothing
+                            , showingMonth: nextMonth
+                            , dispatch: mempty
+                            }
+                    ]
+                }
+            ]
+        }
+    ]
+
+renderMonthNumbers ∷
+  { currentDateʔ ∷ Maybe Date
+  , date ∷ Date
+  , dispatch ∷ Action → Effect Unit
+  , selectedDateʔ ∷ Maybe Date
+  , showingMonth ∷ Month
+  } →
+  Array JSX
+renderMonthNumbers { date, selectedDateʔ, currentDateʔ, showingMonth, dispatch } =
+  do
+    let firstDay = firstMondayBefore $ setDay Bounded.bottom date
+    let lastDay = Date.adjust (41.0 # Days) firstDay # fromMaybe Bounded.top
+    ( ( enumFromTo firstDay lastDay
+      -- ( firstSundayAfter
+      --     $ setDay (lastDayOfMonth (Date.year date) (Date.month date)) date
+      -- )
+      )
+        <#> \(d ∷ Date) →
+          E.element R.button'
+            { className: "day"
+            , css: dayStyle <>
+                if Date.month d /= showingMonth then
+                  otherMonthDayStyle
+                else mempty
+            , children:
+                [ E.element M.div
+                    { css:
+                        dayRoundStyle
+                          <>
+                            ( if selectedDateʔ == Just d then
+                                selectedDayStyle
+                              else mempty
+                            )
+                          <>
+                            ( if Just d == currentDateʔ then currentDayStyle
+                              else mempty
+                            )
+                          <>
+                            if (fromEnum $ Date.day d) == 1 then oneDayStyle
+                            else mempty
+                    , initial:
+                        if selectedDateʔ == Just d then
+                          M.initial $ R.css { scale: 1.2 }
+                        else M.initial $ undefined
+                    , animate:
+                        M.animate $ R.css
+                          { scale: 1
+                          , transition:
+                              { type: "spring"
+                              , delay: 0.1
+                              , stiffness: 100
+                              , mass: 0.5
+                              , damping: 5
+                              }
+                          }
+                    , className: "cn"
+                    , children: [ R.text $ show $ fromEnum $ Date.day d ]
+                    }
+                ]
+            , onClick: handler_
+                if Date.month d < showingMonth then do
+                  dispatch (StartTransition ToPreviousMonth)
+                  dispatch (DateSelected d)
+                else if Date.month d > showingMonth then do
+                  dispatch (StartTransition ToNextMonth)
+                  dispatch (DateSelected d)
+                else do
+                  dispatch $ DateSelected d
+            }
+    )
+
+nextMonth ∷ Month /\ Year → Month /\ Year
+nextMonth (currentMonth /\ currentYear) = do
+  let monthSuccʔ = Enum.succ currentMonth
+  case monthSuccʔ of
+    Nothing → Bounded.bottom /\ (Enum.succ currentYear # fromMaybe Bounded.top)
+    Just monthSucc → monthSucc /\ currentYear
+
+previousMonth ∷ Month /\ Year → Month /\ Year
+previousMonth (currentMonth /\ currentYear) = do
+  let monthPredʔ = Enum.pred currentMonth
+  case monthPredʔ of
+    Nothing → Bounded.top /\ (Enum.pred currentYear # fromMaybe Bounded.bottom)
+    Just monthPred → monthPred /\ currentYear
+
+setDay ∷ Day → Date → Date
+setDay day date = Date.canonicalDate (Date.year date) (Date.month date) day
+
+firstMondayBefore ∷ Date → Date
+firstMondayBefore date = go date
+  where
+  go d =
+    if Date.weekday d == Monday then d
+    else do
+      Date.adjust (negateDuration (Days 1.0)) d # maybe d go
+
+firstSundayAfter ∷ Date → Date
+firstSundayAfter date = go date
+  where
+  go d =
+    if Date.weekday d == Sunday then d
+    else Date.adjust (Days 1.0) d # maybe d go
+
+commonDaysStyle ∷ Style
+commonDaysStyle = displayGrid <> templateCols "repeat(7, 1fr)" <> textCenter
+
+daysHeadingsStyle ∷ Style
+daysHeadingsStyle = commonDaysStyle
+  <> textCol gray._500
+  <> fontMedium
+  <> textXs
+  <> pT 10
+  <> pB 8
+
+daysStyle ∷ Style
+daysStyle = commonDaysStyle <> templateRows ("repeat(7," <> show size <> "px)")
+
+size ∷ Int
+size = 42
+
+padding ∷ Int
+padding = 2
+
+dayStyle ∷ Style
+dayStyle = width size <> height size <> borderNone
+  <> E.css { background: E.none }
+  <> mXY 0
+  <> pXY padding
+  <> textCol (gray._500 # darken 0.07)
+  <> fontMedium
+  <> textSm
+
+dayRoundStyle ∷ Style
+dayRoundStyle = roundedXl <> widthFull <> heightFull <> boxSizingBorderBox
+  <> pT 6
+  <> transition "all 160ms ease-out"
+  <> hover
+    ( background coolGray._100
+        <> borderCol coolGray._100
+        <> cursorPointer
+        <> textCol black
+    )
+  <> border 3
+  <> borderCol white
+  <> borderSolid
+
+selectedDayStyle ∷ Style
+selectedDayStyle = s <> hover s
+  where
+  s = background violet._100
+    <> borderCol violet._500
+    <> textCol violet._800
+
+oneDayStyle ∷ Style
+oneDayStyle = pR' (E.str "1px")
+
+currentDayStyle ∷ Style
+currentDayStyle = positionRelative
+  <> E.css { fontVariantNumeric: E.str "tabular-nums" }
+  <> afterElement
+    ( positionAbsolute <> bottom' (6 # E.px) <> right' (50.0 # E.percent)
+        <> width 18
+        <> height 3
+        <> background (gray._500 # withAlpha 0.5)
+        <> translate "50%" "50%"
+        <> roundedFull
+    )
+
+otherMonthDayStyle ∷ Style
+otherMonthDayStyle = textCol gray._400
+
+dateContainerStyle ∷ Style
+dateContainerStyle = roundedLg <> shadowMd <> flexCol <> justifyCenter
+  <> itemsCenter
+  <> pX 12
+  <> pT 16
+  <> pB 12
+  <> background (white)
+  <> textSm
+  <> overflowXHidden
+  <> border 1
+  <> borderSolid
+  <> borderCol gray._200
+  <> E.css { width: E.str "fit-content" }
+
+titleAndControlsStyle ∷ Style
+titleAndControlsStyle = flexRow
+  <> justifyBetween
+  <> itemsCenter
+  <> widthFull
+
+monthChangeButtonStyle ∷ Style
+monthChangeButtonStyle =
+  border 1
+    <> roundedMd
+    <> borderSolid
+    <> textCol gray._600
+    <> background white
+    <> borderCol gray._200
+    <> widthAndHeight 30
+    <> shadowSm
+    <> pXY 6
+    <> boxSizingBorderBox
+    <> mXY 0
+    <> hover (background gray._100)
+
+monthAndYearStyle ∷ Style
+monthAndYearStyle =
+  textDefault <> fontMedium <> textCol gray._600
+    <> background white
+    <> border 1
+    <> borderSolid
+    <> roundedMd
+    <> borderCol gray._200
+    <> pXY 0
+    <> width 180
+    <> height 30
+    <> itemsCenter
+    <> mXY 0
+    <> pX 5
+    <> flexRow
+    <> textSm
+    <> justifyBetween
+    <> shadowSm
+
+daysContainerStyle ∷ Style
+daysContainerStyle = pT 8
+
+yearString ∷ Year → String
+yearString = fromEnum >>> show
+
+monthName ∷ Month → String
+monthName = case _ of
+  January → "January"
+  February → "February"
+  March → "March"
+  April → "April"
+  May → "May"
+  June → "June"
+  July → "July"
+  August → "August"
+  September → "September"
+  October → "October"
+  November → "November"
+  December → "December"
+
+weekdayName ∷ Weekday → String
+weekdayName = case _ of
+  Monday → "Monday"
+  Tuesday → "Tuesday"
+  Wednesday → "Wednesday"
+  Thursday → "Thursday"
+  Friday → "Friday"
+  Saturday → "Saturday"
+  Sunday → "Sunday"

src/Plumage/Atom/InfiniteLoadingBar.purs

@@ -0,0 +1,93 @@
+module Plumage.Atom.InfiniteLoadingBar where
+
+import Plumage.Prelude.Style
+
+import Data.Array ((..))
+import Network.RemoteData (RemoteData)
+import Network.RemoteData as RemoteData
+import Fahrtwind.Style as TW
+import Plumage.Util.HTML as H
+import React.Basic.DOM as R
+import React.Basic.Emotion as E
+import React.Basic.Hooks as React
+import Yoga ((/>), (</*))
+
+mkKittLoadingBar ∷
+  ∀ e a. React.Component { numberOfLights ∷ Int, remoteData ∷ RemoteData e a }
+mkKittLoadingBar =
+  React.component "KittLoadingBar" \props → React.do
+    let { numberOfLights: number, remoteData: rd } = props
+    pure $
+      H.div_
+        ( flexRow
+            <> gap 4
+            <> E.css { alignSelf: E.center }
+            <> boxSizingContentBox
+        )
+        ( (1 .. number)
+            <#> \i →
+              R.div'
+                </*
+                  { key: show i
+                  , style: R.css
+                      { animationDelay: show (number * (-50) + i * 50) <>
+                          "ms"
+                      }
+                  , css: baseStyle number <> dynamicStyle number rd i
+                  }
+                /> []
+        )
+  where
+  dynamicStyle number rd i = case rd of
+    RemoteData.NotAsked → notAskedStyle
+    RemoteData.Loading → loadingStyle case i of
+      x | x < (number - 3) → TW.violet
+      _ → TW.violet
+    RemoteData.Failure _ → errorStyle
+    RemoteData.Success _ → successStyle
+
+  loadingStyle col = E.css { animationName: glowAnimation col }
+
+  baseStyle number =
+    ( width 12
+        <> height 4
+        <> boxSizingContentBox
+        <> background (violet._400 # desaturate 0.8)
+        <> E.css
+          { borderRadius: E.str "14%"
+          , animation: E.str "x 1s infinite ease-in-out"
+          , animationFillMode: E.str "alternate"
+          , animationDuration: E.str $ show (number * 50 * 2) <> "ms"
+          }
+    )
+
+  notAskedStyle = background TW.warmGray._300
+  errorStyle = background TW.red._400
+  successStyle =
+    E.css
+      { boxShadow:
+          E.str
+            ("0 0 2px " <> cssStringRGBA (TW.gray._300 # withAlpha 0.6))
+      }
+
+  glowAnimation col =
+    E.keyframes
+      { from:
+          background (col._400 # desaturate 0.8)
+            <> E.css
+              { boxShadow:
+                  E.str
+                    ( "0 0 1px " <> cssStringRGBA
+                        (col._200 # withAlpha 0.0)
+                    )
+              }
+      , to:
+          background col._500
+            <> E.css
+              { boxShadow:
+                  E.str
+                    ( "0 0 5px " <> cssStringRGBA
+                        (col._400 # withAlpha 0.33)
+                    )
+              }
+      }

src/Plumage/Atom/Input/Input/Style.purs

@@ -0,0 +1,125 @@
+module Plumage.Atom.Input.Input.Style where
+
+import Plumage.Prelude.Style
+
+import React.Basic.Emotion (auto, px)
+import Yoga.Block.Internal.CSS (transparent)
+
+blockContainerStyle ∷ Style
+blockContainerStyle =
+  flexCol
+    <> textCol gray._700
+    <> focusWithin blockContainerFocusWithinStyle
+
+blockContainerFocusWithinStyle ∷ Style
+blockContainerFocusWithinStyle = css
+  { "&>label": nested
+      $ translate "0px" "4px"
+      <> textCol violet._50
+      <> background violet._500
+  }
+
+defaultLabelStyle ∷ Style
+defaultLabelStyle =
+  (textSized 0.8 1.2)
+    <> trackingTight
+    <> textTransformUppercase
+    <> css { borderRadius: str "4px 4px 0 0" }
+    <> pL 6
+    <> pY 3
+    <> transition "all 0.2s ease-in-out"
+    <> fontMedium
+
+smallLabelStyle ∷ Style
+smallLabelStyle = defaultLabelStyle <> textSized 0.67 0.7
+
+inputBackground ∷ Color
+inputBackground = (coolGray._700 # rotateHue 30.0 # desaturate 0.1)
+
+defaultInputStyle ∷ Style
+defaultInputStyle =
+  border 3
+    <> textCol gray._800
+    <> borderCol (gray._300 # withAlpha 0.5)
+    <> transition "all 0.2s ease-in-out"
+    <> roundedDefault
+    <> textLg
+    <> pY 6
+    <> pX 8
+    <> hover
+      ( borderCol (gray._500 # withAlpha 0.5)
+      )
+    <> shadow "inset 0 1px 4px rgba(0,0,0,0.3)"
+    <> focus
+      defaultInputFocusStyle
+    <> outlineNone
+    <> placeholder (textCol (gray._500))
+
+defaultInputFocusStyle ∷ Style
+defaultInputFocusStyle =
+  borderCol violet._500
+    -- <> E.css { backgroundImage: E.none }
+    -- <> background (violet._900 # darken 0.1)
+    <> textCol violet._100
+    <> placeholder (textCol violet._400)
+
+type InputProps =
+  { id ∷ String
+  , value ∷ String
+  , setValue ∷ String → Effect Unit
+  , placeholder ∷ String
+  , placeholders ∷ Array String
+  }
+
+plumageInputContainerStyle ∷ Style
+plumageInputContainerStyle =
+  width' auto
+    <> flexRow
+    <> itemsCenter
+    <> positionRelative
+    <> borderSolid
+    <> roundedMd
+    <> textSm
+    <> border 2
+    <> borderCol' (var "--plm-inputBorder-colour")
+    <> background' (var "--plm-inputBackground-colour")
+    <> textCol' (var "--plm-inputIcon--colour")
+    <> focusWithin plumageInputContainerFocusWithinStyle
+    <>
+      ( attributeValueStyle "data-input-size" "small"
+          ( rounded (5 # px)
+              <> border 1
+              <> fontSize 12
+          )
+      )
+
+plumageInputContainerFocusWithinStyle ∷ Style
+plumageInputContainerFocusWithinStyle = borderCol'
+  (var "--plm-inputBorderActive-colour")
+
+plumageInputStyle ∷ Style
+plumageInputStyle =
+  userSelectText
+    <> height 32
+    <> background transparent
+    <> border 0
+    <> mXY 0
+    <> width 1
+    <> flexGrow 1
+    <> outlineNone
+    <> textCol' (var "--plm-inputText-colour")
+    <> pB 1
+    <> pL 8
+    <> css
+      { autocomplete: str "off"
+      , autocorrect: str "off"
+      , spellcheck: str "false"
+      }
+    <> css
+      { "&[data-input-size='small']": nested
+          $ pT 0
+          <> pB 1
+          <> pL 8
+          <> height 26
+
+      }

src/Plumage/Atom/Input/Select.purs

@@ -0,0 +1,43 @@
+module Plumage.Atom.Input.Select where
+
+import Prelude
+
+import Effect (Effect)
+import Plumage.Atom.Input.Input.Style (plumageInputContainerStyle)
+import Plumage.Atom.Input.Select.Style (plumageSelectStyle)
+import Plumage.Util.HTML as Styled
+import React.Basic.DOM as R
+import React.Basic.Hooks as React
+import Yoga ((/>), (</), (</*))
+
+mkSelect ∷
+  ∀ a.
+  React.Component
+    ( { choice ∷ a
+      , choices ∷ Array a
+      , onChange ∷ Array a → Effect Unit
+      , toString ∷ a → String
+      , toValue ∷ a → String
+      }
+    )
+mkSelect = do
+  React.component "Select" \{ toString, toValue, choices } → React.do
+    pure $
+      Styled.div "input-container" plumageInputContainerStyle
+        [ R.select'
+            </*
+              { className: "select"
+              , role: "listbox"
+              , css: plumageSelectStyle
+              }
+            />
+              ( choices <#> \c → R.option' </ { value: toValue c } />
+                  [ R.text $ toString c ]
+              )
+        ]
+
+-- [ R.div_ [ R.text (toString choice) ]
+-- , H.div_ (widthAndHeight 16)
+--     [ Heroicons.chevronDown ]
+
+-- ]

src/Plumage/Atom/Input/Select/Style.purs

@@ -0,0 +1,31 @@
+module Plumage.Atom.Input.Select.Style where
+
+import Plumage.Prelude.Style
+
+import Plumage.Atom.Input.Input.Style (plumageInputStyle)
+import React.Basic.DOM.SVG as SVG
+
+plumageSelectStyle ∷ Style
+plumageSelectStyle =
+  plumageInputStyle
+    <> css { appearance: none }
+    <> pR 8
+    <> svgBackgroundImage
+      ( SVG.svg
+          { viewBox: "0 0 24 24"
+          , xmlns: "http://www.w3.org/2000/svg"
+          , stroke: cssStringRGBA gray._400
+          , fill: "none"
+          , children:
+              [ SVG.path
+                  { strokeLinecap: "round"
+                  , strokeLinejoin: "round"
+                  , strokeWidth: "4"
+                  , d: "M19 9l-7 7-7-7"
+                  }
+              ]
+          }
+      )
+    <> backgroundPosition "right 4px center"
+    <> backgroundNoRepeat
+    <> backgroundSize "10px"

src/Plumage/Atom/Input/View.purs

@@ -0,0 +1,39 @@
+module Plumage.Atom.Input.View where
+
+import Plumage.Prelude.Style
+
+import Plumage.Atom.Input.Input.Style (plumageInputContainerStyle, plumageInputStyle)
+import Plumage.Util.HTML as Styled
+import React.Basic.DOM as R
+import React.Basic.Hooks (Component)
+import React.Basic.Hooks as React
+import Yoga ((</*>))
+import Yoga.Block.Atom.Input.Hook.UseTypingPlaceholders (useTypingPlaceholders)
+import Yoga.Prelude.View (handler, targetValue)
+
+type InputProps =
+  { id ∷ String
+  , value ∷ String
+  , setValue ∷ String → Effect Unit
+  , placeholder ∷ String
+  , placeholders ∷ Array String
+  }
+
+mkInput ∷ Component InputProps
+mkInput = React.component "Input" render
+  where
+  render ∷ InputProps → _
+  render (props@{ id, value, setValue } ∷ InputProps) = React.do
+    inputRef ← useTypingPlaceholders props.placeholder props.placeholders
+    pure $
+      Styled.div "input-container" plumageInputContainerStyle
+        [ R.input'
+            </*>
+              { id
+              , className: "plm-input"
+              , css: plumageInputStyle
+              , value
+              , onChange: handler targetValue (traverse_ setValue)
+              , ref: inputRef
+              }
+        ]

src/Plumage/Atom/Modal/View.purs

@@ -0,0 +1,91 @@
+module Plumage.Atom.Modal.View where
+
+import Yoga.Prelude.View
+
+import Fahrtwind (acceptClicks)
+import Fahrtwind.Style.Color.Background (background)
+import Fahrtwind.Style.Color.Tailwind as TW
+import Fahrtwind.Style.Color.Util (withAlpha)
+import Fahrtwind.Style.Inset (left, left', top) as P
+import Fahrtwind.Style.Position (positionFixed)
+import Fahrtwind.Style.Size (heightScreen, widthScreen) as P
+import Fahrtwind.Style.Transform (translate)
+import Plumage.Hooks.UseRenderInPortal (useRenderInPortal)
+import Plumage.Util.HTML as H
+import React.Basic.DOM as R
+import React.Basic.Emotion (Style)
+import React.Basic.Emotion as E
+import React.Basic.Hooks as React
+
+clickAwayStyle ∷ Style
+clickAwayStyle =
+  P.widthScreen
+    <> P.heightScreen
+    <> positionFixed
+    <> P.left 0
+    <> P.top 0
+    <> acceptClicks
+
+-- [TODO] Move out
+mkClickAway ∷
+  React.Component
+    { css ∷ Style
+    , hide ∷ Effect Unit
+    , isVisible ∷ Boolean
+    , clickAwayId ∷ String
+    }
+mkClickAway = do
+  React.component "Clickaway"
+    \{ css, isVisible, hide, clickAwayId } →
+      React.do
+        renderInPortal ← useRenderInPortal clickAwayId
+        pure
+          $ guard isVisible
+          $ renderInPortal
+          $ R.div'
+          </*>
+            { className: "click-away"
+            , css: clickAwayStyle <> css
+            , onMouseUp: handler_ hide
+            , onTouchEnd: handler_ hide
+            }
+
+modalStyle ∷ Style
+modalStyle = positionFixed <> P.left' (50.0 # E.percent)
+  <> P.top 0
+  <> translate "-50%" "0"
+  <> acceptClicks
+
+type ModalIds = { clickAwayId ∷ String, modalContainerId ∷ String }
+
+type Props =
+  { hide ∷ Effect Unit
+  , isVisible ∷ Boolean
+  , content ∷ JSX
+  , allowClickAway ∷ Boolean
+  , clickAwayId ∷ String
+  , modalContainerId ∷ String
+  }
+
+mkModal ∷ React.Component Props
+mkModal = do
+  clickAway ← mkClickAway
+  React.component "Modal" \props → React.do
+    let
+      { hide
+      , isVisible
+      , content
+      , allowClickAway
+      , clickAwayId
+      , modalContainerId
+      } = props
+    renderInPortal ← useRenderInPortal modalContainerId
+    pure $ fragment
+      [ clickAway
+          { css: background (TW.gray._900 # withAlpha 0.5)
+          , hide: if allowClickAway then hide else mempty
+          , isVisible
+          , clickAwayId
+          }
+      , renderInPortal (H.div "modal" modalStyle [ content ])
+      ]

src/Plumage/Atom/PopOver/Types.purs

@@ -0,0 +1,63 @@
+module Plumage.Atom.PopOver.Types where
+
+import Yoga.Prelude.View
+
+import Data.Array.NonEmpty (NonEmptyArray)
+import Data.Array.NonEmpty as NEA
+import Plumage.Prelude.Style (Style)
+
+data HookDismissBehaviour
+  = DismissPopOverOnClickAway { id ∷ String, css ∷ Style }
+  | DismissPopOverOnClickOutsideTargetAnd (Array NodeRef)
+  | DismissPopOverOnClickOutsideElements NodeRef (Array NodeRef)
+
+toDismissBehaviour ∷ NodeRef → HookDismissBehaviour → DismissBehaviour
+toDismissBehaviour targetRef = case _ of
+  DismissPopOverOnClickAway x → DismissOnClickAway x
+  DismissPopOverOnClickOutsideTargetAnd refs →
+    DismissOnClickOutsideElements (NEA.cons' targetRef refs)
+  DismissPopOverOnClickOutsideElements ref refs →
+    DismissOnClickOutsideElements (NEA.cons' ref refs)
+
+data DismissBehaviour
+  = DismissOnClickAway { id ∷ String, css ∷ Style }
+  | DismissOnClickOutsideElements (NonEmptyArray NodeRef)
+
+data Placement = Placement PrimaryPlacement SecondaryPlacement
+data PrimaryPlacement = Above | LeftOf | RightOf | Below
+data SecondaryPlacement = Centre | Start | End
+
+derive instance Eq PrimaryPlacement
+derive instance Ord PrimaryPlacement
+derive instance Eq SecondaryPlacement
+derive instance Ord SecondaryPlacement
+derive instance Eq Placement
+derive instance Ord Placement
+
+cyclePlacement ∷ Placement → Placement
+cyclePlacement = case _ of
+  Placement Above Start → Placement Above Centre
+  Placement Above Centre → Placement Above End
+  Placement Above End → Placement RightOf Start
+  Placement RightOf Start → Placement RightOf Centre
+  Placement RightOf Centre → Placement RightOf End
+  Placement RightOf End → Placement Below End
+  Placement Below End → Placement Below Centre
+  Placement Below Centre → Placement Below Start
+  Placement Below Start → Placement LeftOf End
+  Placement LeftOf End → Placement LeftOf Centre
+  Placement LeftOf Centre → Placement LeftOf Start
+  Placement LeftOf Start → Placement Above Start
+
+printPlacement ∷ Placement → String
+printPlacement (Placement primary secondary) = p <> " " <> s
+  where
+  p = case primary of
+    Above → "above"
+    LeftOf → "left of"
+    RightOf → "right of"
+    Below → "below"
+  s = case secondary of
+    Centre → "centre"
+    Start → "start"
+    End → "end"

src/Plumage/Atom/PopOver/View.purs

@@ -0,0 +1,363 @@
+module Plumage.Atom.PopOver.View where
+
+import Yoga.Prelude.View
+
+import Control.Monad.ST.Internal as ST
+import Data.Array.NonEmpty as NEA
+import Data.Int as Int
+import Data.Maybe (isNothing)
+import Data.Time.Duration (Milliseconds(..))
+import Data.Traversable (for)
+import Fahrtwind (acceptClicks, positionAbsolute)
+import Fahrtwind.Style.BoxShadow (shadow)
+import Framer.Motion as M
+import Plumage.Atom.Modal.View (mkClickAway)
+import Plumage.Atom.PopOver.Types (DismissBehaviour(..), Placement(..), PrimaryPlacement(..), SecondaryPlacement(..))
+import Plumage.Hooks.UseRenderInPortal (useRenderInPortal)
+import Plumage.Hooks.UseResize2 (useOnResize)
+import Plumage.Prelude.Style (Style)
+import React.Basic.DOM as R
+import React.Basic.Hooks as React
+import Unsafe.Reference (reallyUnsafeRefEq)
+import Web.Event.Event (EventType(..))
+import Web.Event.EventTarget (addEventListener, eventListener, removeEventListener)
+import Web.HTML (window)
+import Web.HTML.HTMLDocument as HTMLDocument
+import Web.HTML.Window (document, innerHeight, innerWidth, requestAnimationFrame, scrollX, scrollY)
+import Web.UIEvent.MouseEvent as MouseEvent
+
+popOverShadow ∷ Style
+popOverShadow =
+  shadow
+    "0 30px 12px 2px rgba(50,57,70,0.2), 0 24px 48px 0 rgba(0,0,0,0.4)"
+
+type PopOverViewProps =
+  { dismissBehaviourʔ ∷ Maybe DismissBehaviour
+  , containerId ∷ String
+  , placement ∷ Placement
+  , placementRef ∷ NodeRef
+  , childʔ ∷ Maybe JSX
+  , hide ∷ Effect Unit
+  , onAnimationStateChange ∷ Boolean → Effect Unit
+  }
+
+mkPopOverView ∷ React.Component PopOverViewProps
+mkPopOverView = do
+  popOver ← mkPopOver
+  React.component "PopOverView" \props → React.do
+    visiblePlacementʔ /\ setVisiblePlacement ← React.useState' Nothing
+    -- Triggers a recomputation of the bounding box for more correct
+    -- click outside handling
+    _ /\ setAnimationDone ← React.useState' false
+    visibleChildʔ /\ setVisibleChild ← React.useState' Nothing
+    contentRef ← React.useRef null
+    motionRef ← React.useRef null
+    useEffectAlways do
+      when (props.childʔ # isNothing) do
+        setVisibleChild Nothing
+      mempty
+    useEffectAlways do
+      case props.dismissBehaviourʔ of
+        Nothing → mempty
+        Just (DismissOnClickAway _) → mempty
+        Just (DismissOnClickOutsideElements elements) → do
+          -- No need to register and deregister an event listener if
+          -- there are no bounding boxes to measure
+          maybeBbsʔ ← for elements getBoundingBoxFromRef
+          let bbsʔ = maybeBbsʔ # NEA.catMaybes # NEA.fromArray
+          case bbsʔ of
+            Nothing → mempty
+            Just bbs → do
+              let eventType = EventType "mousedown"
+              eventTarget ← window >>= document <#> HTMLDocument.toEventTarget
+              listener ← eventListener \e → do
+                for_ (MouseEvent.fromEvent e) \mouseEvent → do
+                  let x = MouseEvent.clientX mouseEvent # Int.toNumber
+                  let y = MouseEvent.clientY mouseEvent # Int.toNumber
+                  let
+                    clickedOutside = bbs # NEA.all
+                      \{ left, right, bottom, top } →
+                        x < left || x > right || y < top || y > bottom
+                  props.hide # when clickedOutside
+
+              addEventListener eventType listener true eventTarget
+              pure $ removeEventListener eventType listener true
+                eventTarget
+
+    let
+      -- measureStyle = R.css { visibility: "hidden" }
+      measureStyle = R.css
+        { visibility: "hidden"
+        , outline: "pink"
+        , border: "solid 10px red"
+        }
+      style = visiblePlacementʔ # foldMap \placement → R.css
+        { transformOrigin: toTransformOrigin placement
+        }
+      initial = M.initial $ R.css
+        { scale: 0.7
+        , opacity: 0
+        }
+      animate = M.animate $ R.css
+        { scale: 1
+        , opacity: 1
+        , y: 0
+        , transition: { type: "spring", bounce: 0.3, duration: 0.3 }
+        }
+      exit =
+        M.exit $ R.css
+          { scale: 0.8
+          , opacity: 0.0
+          , transition:
+              { type: "spring", bounce: 0.2, duration: 0.2 }
+          }
+      onAnimationComplete = M.onAnimationComplete \fgn → do
+        props.onAnimationStateChange false
+        if (reallyUnsafeRefEq fgn exit) then
+          setVisiblePlacement Nothing
+        else if (reallyUnsafeRefEq fgn animate) then do
+          setAnimationDone true
+        else mempty
+
+      onAnimationStart = M.onAnimationStart do
+        props.onAnimationStateChange true
+        setAnimationDone false
+
+      getBBWidthAndHeight = ado
+        bbʔ ← getBoundingBoxFromRef contentRef
+        w ← window >>= innerWidth <#> Int.toNumber
+        h ← window >>= innerHeight <#> Int.toNumber
+        in { bbʔ, w, h }
+
+      calculatePlacement { bbʔ, w, h } oldPlacement = do
+
+        -- [FIXME] I need to take the placement ref into account, it'll be the
+        -- longest if else in the world
+        let (Placement _ secondary) = oldPlacement
+        bbʔ <#> \bb → do
+          if (bb.height > h) || (bb.width > w) then
+            oldPlacement
+          else if bb.right > w then
+            (Placement LeftOf secondary)
+          else if bb.left < zero then
+            (Placement RightOf secondary)
+          else if bb.top < zero then
+            (Placement Below secondary)
+          else if bb.bottom > h then
+            (Placement Above secondary)
+          else do
+            oldPlacement
+
+      getBestPlacement ∷
+        { bbʔ ∷ Maybe DOMRect, w ∷ Number, h ∷ Number } → Placement → Placement
+      getBestPlacement bbWidthAndHeight oldPlacement = ST.run do
+        pRef ← ST.new oldPlacement
+        let
+          getNewPlacement = do
+            currentPlacement ← ST.read pRef
+            let
+              newPlacement = calculatePlacement bbWidthAndHeight
+                currentPlacement
+            for_ newPlacement (_ `ST.write` pRef)
+        getNewPlacement
+        placementBefore ← ST.read pRef
+        ST.while (ST.read pRef <#> (_ /= placementBefore)) do
+          getNewPlacement
+        result ← ST.read pRef
+        pure result
+
+    let
+      recalculatePlacement =
+        case props.childʔ of
+          Just child →
+            -- I don't know why we need three frames, sorry
+            void $ window >>= requestAnimationFrame do
+              void $ window >>= requestAnimationFrame do
+                void $ window >>= requestAnimationFrame do
+                  bbWidthAndHeight ← getBBWidthAndHeight
+                  for_ bbWidthAndHeight.bbʔ $ \_ → do
+                    let
+                      newPlacement = getBestPlacement bbWidthAndHeight
+                        props.placement
+                    setVisiblePlacement (Just newPlacement)
+                  -- Do this always
+                  setVisibleChild (Just child)
+          Nothing →
+            setVisibleChild Nothing
+
+    useLayoutEffectAlways do
+      recalculatePlacement
+      mempty
+
+    useOnResize (200.0 # Milliseconds) \_ → do
+      setVisibleChild Nothing
+
+    pure $ popOver
+      { isVisible: props.childʔ # isJust
+      , dismissBehaviourʔ: props.dismissBehaviourʔ
+      , containerId: props.containerId
+      , hide: props.hide
+      , placement: visiblePlacementʔ # fromMaybe props.placement
+      , placementRef: props.placementRef
+      , content:
+          fragment
+            [ guard (visibleChildʔ # isNothing) $ props.childʔ # foldMap
+                \child → R.div'
+                  </
+                    { ref: contentRef
+                    , style: measureStyle
+                    }
+                  /> [ child ]
+            , M.animatePresence </ {} />
+                [ visibleChildʔ # foldMap \child →
+                    M.div
+                      </
+                        { key: "popOver"
+                        , style
+                        , initial
+                        , animate
+                        , exit
+                        , onAnimationComplete
+                        , onAnimationStart
+                        , ref: motionRef
+                        }
+                      />
+                        [ child ]
+                ]
+            ]
+      }
+
+popOverStyle ∷ Style
+popOverStyle = positionAbsolute <> acceptClicks
+
+type Props =
+  { hide ∷ Effect Unit
+  , isVisible ∷ Boolean
+  , content ∷ JSX
+  , placement ∷ Placement
+  , placementRef ∷ NodeRef
+  , dismissBehaviourʔ ∷ Maybe DismissBehaviour
+  , containerId ∷ String
+  }
+
+toTransformOrigin ∷ Placement → String
+toTransformOrigin (Placement primary secondary) = primaryOrigin <> " " <>
+  secondaryOrigin
+  where
+  primaryOrigin = case primary of
+    Above → "bottom"
+    LeftOf → "right"
+    RightOf → "left"
+    Below → "top"
+  secondaryOrigin = case secondary of
+    Centre → "center"
+    Start | primary == Above || primary == Below → "left"
+    Start → "top"
+    End | primary == Above || primary == Below → "right"
+    End → "bottom"
+
+mkPopOver ∷ React.Component Props
+mkPopOver = do
+  clickAway ← mkClickAway
+  React.component "popOver" \props → React.do
+    let { hide, isVisible, content, dismissBehaviourʔ, containerId } = props
+    refBB /\ setRefBB ← React.useState' (zero ∷ DOMRect)
+    let
+      recalc = when isVisible do
+        bbʔ ← getBoundingBoxFromRef props.placementRef
+        fromTop ← window >>= scrollY
+        fromLeft ← window >>= scrollX
+        let
+          adjustedBbʔ = bbʔ <#> \bb → bb
+            { top = bb.top + fromTop
+            , left = bb.left + fromLeft
+            , right = bb.right + fromLeft
+            , bottom = bb.bottom + fromTop
+            }
+        for_ adjustedBbʔ \newBb →
+          unless (refBB == newBb) do
+            setRefBB newBb
+
+    useEffectAlways do
+      recalc
+      mempty
+
+    renderInPortal ← useRenderInPortal containerId
+    pure $ fragment
+      [ case dismissBehaviourʔ of
+          Just (DismissOnClickAway { id, css }) →
+            clickAway { css, hide, isVisible, clickAwayId: id }
+          _ → mempty
+      , renderInPortal
+          ( R.div'
+              </*
+                { className: "popOver"
+                , css: popOverStyle
+                , style: toAbsoluteCSS refBB props.placement
+                }
+              />
+                [ content ]
+          )
+      ]
+
+toAbsoluteCSS ∷ DOMRect → Placement → R.CSS
+toAbsoluteCSS bb (Placement primary secondary) =
+  case primary, secondary of
+    Above, Centre → R.css
+      { top: bb.top
+      , left: bb.left + bb.width / 2.0
+      , transform: "translate(-50%, -100%)"
+      }
+    Above, Start → R.css
+      { top: bb.top
+      , left: bb.left
+      , transform: "translate(0, -100%)"
+      }
+    Above, End → R.css
+      { top: bb.top
+      , left: bb.right
+      , transform: "translate(-100%, -100%)"
+      }
+    RightOf, Centre → R.css
+      { top: bb.top + bb.height / 2.0
+      , left: bb.right
+      , transform: "translate(0, -50%)"
+      }
+    RightOf, Start → R.css
+      { top: bb.top
+      , left: bb.right
+      }
+    RightOf, End → R.css
+      { top: bb.bottom
+      , left: bb.right
+      , transform: "translate(0, -100%)"
+      }
+    LeftOf, Centre → R.css
+      { top: bb.top + bb.height / 2.0
+      , left: bb.left
+      , transform: "translate(-100%, -50%)"
+      }
+    LeftOf, Start → R.css
+      { top: bb.top
+      , left: bb.left
+      , transform: "translate(-100%, 0)"
+      }
+    LeftOf, End → R.css
+      { top: bb.bottom
+      , left: bb.left
+      , transform: "translate(-100%, -100%)"
+      }
+    Below, Centre → R.css
+      { top: bb.bottom
+      , left: bb.left + bb.width / 2.0
+      , transform: "translate(-50%, 0)"
+      }
+    Below, Start → R.css
+      { top: bb.bottom
+      , left: bb.left
+      }
+    Below, End → R.css
+      { top: bb.bottom
+      , left: bb.right
+      , transform: "translate(-100%, 0)"
+      }

src/Plumage/Atom/Tooltip/View.purs

@@ -0,0 +1,50 @@
+module Plumage.Atom.Tooltip.View where
+
+import Yoga.Prelude.View
+
+import Effect.Unsafe (unsafePerformEffect)
+import Plumage.Atom.PopOver.Types (Placement)
+import Plumage.Hooks.UsePopOver (usePopOver)
+import React.Basic.DOM as R
+import React.Basic.Hooks as React
+
+tooltip ∷
+  { containerId ∷ String, placement ∷ Placement, tooltip ∷ JSX } → JSX → JSX
+tooltip props@{ containerId, placement } child = rawComponent
+  </>
+    { placement
+    , containerId
+    , child
+    , tooltipContent: props.tooltip
+    }
+
+type Props =
+  { placement ∷ Placement
+  , containerId ∷ String
+  , child ∷ JSX
+  , tooltipContent ∷ JSX
+  }
+
+rawComponent ∷ ReactComponent Props
+rawComponent = unsafePerformEffect $ React.reactComponent "Tooltip" $
+  \({ placement, containerId, child, tooltipContent } ∷ Props) → React.do
+    { hidePopOver
+    , renderInPopOver
+    , targetRef
+    , showPopOver
+    , isVisible
+    } ← usePopOver
+      { dismissBehaviourʔ: Nothing
+      , containerId
+      , placement
+      }
+
+    pure $ fragment
+      [ R.div
+          { children: [ child ]
+          , ref: targetRef
+          , onMouseLeave: handler_ $ guard isVisible hidePopOver
+          , onMouseEnter: handler_ $ guard (not isVisible) showPopOver
+          }
+      , renderInPopOver tooltipContent
+      ]

src/Plumage/Hooks/UsePopOver.purs

@@ -0,0 +1,55 @@
+module Plumage.Hooks.UsePopOver where
+
+import Yoga.Prelude.View
+
+import Data.Newtype (class Newtype)
+import Effect.Unsafe (unsafePerformEffect)
+import Plumage.Atom.PopOver.Types (HookDismissBehaviour, Placement, toDismissBehaviour)
+import Plumage.Atom.PopOver.View (mkPopOverView)
+import Plumage.Atom.PopOver.View as PopOver
+import React.Basic.Hooks as React
+
+type Options =
+  { dismissBehaviourʔ ∷ Maybe HookDismissBehaviour
+  , containerId ∷ String
+  , placement ∷ Placement
+  }
+
+type Result =
+  { hidePopOver ∷ Effect Unit
+  , renderInPopOver ∷ JSX → JSX
+  , targetRef ∷ NodeRef
+  , showPopOver ∷ Effect Unit
+  , isVisible ∷ Boolean
+  }
+
+newtype UsePopOver hooks = UsePopOver
+  (UseRef (Nullable Node) (UseState Boolean hooks))
+
+derive instance Newtype (UsePopOver hooks) _
+
+usePopOver ∷ Options → Hook UsePopOver Result
+usePopOver options = coerceHook React.do
+  isVisible /\ setIsVisible ← React.useState' false
+  targetRef ← React.useRef null
+  let
+    renderInPopOver content = popOverComponent
+      { hide: when isVisible $ setIsVisible false
+      , childʔ: if isVisible then Just content else Nothing
+      , placementRef: targetRef
+      , placement: options.placement
+      , dismissBehaviourʔ: options.dismissBehaviourʔ <#> toDismissBehaviour
+          targetRef
+      , containerId: options.containerId
+      , onAnimationStateChange: mempty
+      }
+  pure
+    { targetRef
+    , renderInPopOver
+    , hidePopOver: when isVisible $ setIsVisible false
+    , showPopOver: unless isVisible $ setIsVisible true
+    , isVisible
+    }
+
+popOverComponent ∷ PopOver.PopOverViewProps → JSX
+popOverComponent = unsafePerformEffect mkPopOverView

src/Plumage/Hooks/UseRenderInPortal.purs

@@ -0,0 +1,28 @@
+module Plumage.Hooks.UseRenderInPortal
+  ( UseRenderInPortal(..)
+  , useRenderInPortal
+  ) where
+
+import Yoga.Prelude.View
+
+import Data.Maybe (isNothing)
+import Data.Newtype (class Newtype)
+import React.Basic.DOM (createPortal)
+import React.Basic.Hooks as React
+import Web.DOM (Element)
+import Yoga.Block.Internal (findElementByIdInDocument)
+
+newtype UseRenderInPortal hooks = UseRenderInPortal
+  (UseEffect Unit (UseState (Maybe Element) hooks))
+
+derive instance Newtype (UseRenderInPortal hooks) _
+
+useRenderInPortal ∷ String → Hook UseRenderInPortal (JSX → JSX)
+useRenderInPortal portalId = coerceHook React.do
+  portalʔ /\ setPortal ← React.useState' Nothing
+  let renderInPortal jsx = portalʔ # foldMap (createPortal jsx)
+  useEffectOnce do
+    when (portalʔ # isNothing) do
+      findElementByIdInDocument portalId >>= setPortal
+    mempty
+  pure renderInPortal

src/Plumage/Hooks/UseResize2.purs

@@ -0,0 +1,113 @@
+module Plumage.Hooks.UseResize2 where
+
+import Prelude
+
+import Data.Foldable (for_)
+import Data.Int (toNumber)
+import Data.Maybe (Maybe(..))
+import Data.Newtype (class Newtype)
+import Data.Ord (abs)
+import Data.Time.Duration (class Duration)
+import Data.Time.Duration as Milliseconds
+import Effect (Effect)
+import Effect.Aff (Aff, Fiber, delay, error, killFiber, launchAff, launchAff_)
+import Effect.Class (liftEffect)
+import React.Basic.Hooks (Hook, UseEffect, UseLayoutEffect, UseRef, UseState, coerceHook, useEffectOnce, useLayoutEffect, (/\))
+import React.Basic.Hooks as React
+import Web.Event.Event (EventType(..))
+import Web.Event.EventTarget (EventListener, EventTarget, addEventListener, eventListener, removeEventListener)
+import Web.HTML as HTML
+import Web.HTML.Window as Window
+
+eventType ∷ EventType
+eventType = EventType "resize"
+
+registerListener ∷ EventListener → Effect (Effect Unit)
+registerListener listener = do
+  target ← HTML.window <#> Window.toEventTarget
+  addEventListener eventType listener false target
+  pure $ removeEventListener eventType listener false target
+
+type Sizes =
+  { innerWidth ∷ Number, innerHeight ∷ Number }
+
+newtype UseResize hooks = UseResize
+  (UseLayoutEffect Unit (UseState Sizes hooks))
+
+derive instance ntUseResize ∷ Newtype (UseResize hooks) _
+
+useResize ∷ Hook UseResize Sizes
+useResize =
+  coerceHook React.do
+    size /\ setSize ← React.useState' zero
+    useLayoutEffect unit do
+      setSizeFromWindow setSize
+      listener ← makeListener setSize
+      registerListener listener
+    pure size
+
+setSizeFromWindow ∷ (Sizes → Effect Unit) → Effect Unit
+setSizeFromWindow setSize = do
+  window ← HTML.window
+  innerWidth ← Window.innerWidth window <#> toNumber
+  innerHeight ← Window.innerHeight window <#> toNumber
+  setSize { innerWidth, innerHeight }
+
+makeListener ∷ (Sizes → Effect Unit) → Effect EventListener
+makeListener setSize = do
+  eventListener
+    $ const (setSizeFromWindow setSize)
+
+newtype UseOnResize hooks = UseOnResize
+  ( UseEffect Unit
+      ( UseRef Sizes
+          (UseRef (Maybe (Fiber Unit)) hooks)
+      )
+  )
+
+derive instance ntUseOnResize ∷ Newtype (UseOnResize hooks) _
+
+useOnResize ∷
+  ∀ d.
+  Duration d ⇒
+  d →
+  ( { innerWidth ∷ Number
+    , innerHeight ∷ Number
+    , deltaWidth ∷ Number
+    , deltaHeight ∷ Number
+    } →
+    Effect Unit
+  ) →
+  Hook UseOnResize Unit
+useOnResize debounceBy callback =
+  coerceHook React.do
+    fiberRef ← React.useRef Nothing
+    sizeRef ← React.useRef (zero ∷ Sizes)
+    let
+      layoutEffect ∷ Effect (Effect Unit)
+      layoutEffect = do
+        setSizeFromWindow (React.writeRef sizeRef ∷ Sizes → Effect Unit)
+        listener ∷ EventListener ←
+          makeListener \(dimensions ∷ Sizes) → do
+            let
+              aff ∷ Aff Unit
+              aff = do
+                fiberʔ ← React.readRef fiberRef # liftEffect
+                for_ fiberʔ (killFiber (error "Fiber cancelled"))
+                delay (Milliseconds.fromDuration debounceBy)
+                let { innerWidth, innerHeight } = dimensions
+                size ← React.readRef sizeRef # liftEffect
+                let deltaWidth = abs (size.innerWidth - innerWidth)
+                let deltaHeight = abs (size.innerHeight - innerWidth)
+                React.writeRef sizeRef dimensions # liftEffect
+                callback { innerWidth, innerHeight, deltaWidth, deltaHeight } #
+                  liftEffect
+                pure unit
+            fiber ∷ Fiber _ ← launchAff aff
+            React.writeRef fiberRef (Just fiber)
+        target ∷ EventTarget ← HTML.window <#> Window.toEventTarget
+        addEventListener eventType listener false target
+        pure $ launchAff_ do
+          fiberʔ ← React.readRef fiberRef # liftEffect
+          for_ fiberʔ (killFiber (error "Fiber cancelled"))
+    useEffectOnce layoutEffect

src/Plumage/Hooks/UseTypeAhead.purs

@@ -0,0 +1,21 @@
+module Plumage.Hooks.UseTypeAhead where
+
+import Yoga.Prelude.View
+
+import Effect.Aff (attempt, delay)
+import Network.RemoteData as RemoteData
+import React.Basic.Hooks as React
+import React.Basic.Hooks.Aff (useAff)
+
+useTypeahead args = React.do
+  input /\ setInput ← React.useState' ""
+  suggestions /\ setSuggestions ← React.useState' RemoteData.NotAsked
+  { activeIndex, updatedByKeyboard } /\ updateActiveIndex ← React.useState
+    { activeIndex: Nothing, updatedByKeyboard: false }
+
+  useAff input do
+    setSuggestions RemoteData.Loading # liftEffect
+    delay args.debounce
+    result ← attempt (args.loadSuggestions input)
+    let rd = RemoteData.fromEither (join result)
+    setSuggestions rd # liftEffect

src/Plumage/Molecule/Typeahead.purs

@@ -0,0 +1,537 @@
+module Plumage.Molecule.Typeahead where
+
+import Yoga.Prelude.View
+
+import Data.Array ((!!))
+import Data.Array as Array
+import Data.Function.Uncurried (mkFn3)
+import Data.Time.Duration (Milliseconds(..))
+import Effect.Aff (Aff, attempt, delay)
+import Effect.Exception (Error)
+import Effect.Uncurried (mkEffectFn1, runEffectFn1)
+import Fahrtwind (mX, minWidth, overflowHidden, textCol', widthAndHeight)
+import Fahrtwind.Style.ScrollBar (scrollBar')
+
+import Framer.Motion as M
+import Network.RemoteData (RemoteData)
+import Network.RemoteData as RemoteData
+import Plumage.Atom.PopOver.Types (Placement(..), PrimaryPlacement(..), SecondaryPlacement(..))
+import Plumage.Atom.PopOver.View (mkPopOverView)
+import Plumage.Molecule.Typeahead.Style as Style
+import Plumage.Util.HTML as H
+import Prim.Row (class Lacks, class Nub)
+import React.Aria.Interactions2 (useFocus, useFocusWithin)
+import React.Aria.Utils (mergeProps)
+import React.Basic.DOM as R
+import React.Basic.DOM.Events (capture_)
+import React.Basic.DOM.Events as SE
+import React.Basic.Emotion as E
+import React.Basic.Hooks as React
+import React.Basic.Hooks.Aff (useAff)
+import React.Virtuoso (virtuosoImpl)
+import Record as Record
+import Type.Proxy (Proxy(..))
+import Unsafe.Coerce (unsafeCoerce)
+import Untagged.Union (maybeToUor, uorToMaybe)
+import Web.DOM.Document (toNonElementParentNode)
+import Web.DOM.NonElementParentNode (getElementById)
+
+import Web.HTML (window)
+import Web.HTML.HTMLDocument (activeElement)
+import Web.HTML.HTMLDocument as HTMLDocument
+import Web.HTML.HTMLElement as HTMLElement
+import Web.HTML.Window (document)
+import Yoga.Block.Atom.Input as Input
+import Yoga.Block.Container.Style (col)
+import Yoga.Block.Hook.Key (KeyCode)
+import Yoga.Block.Hook.Key as Key
+import Yoga.Block.Icon.SVG.Spinner (spinner)
+
+type Overscan = { main ∷ Int, reverse ∷ Int }
+type ScrollSeekPlaceholder = ReactComponent { height ∷ Number, index ∷ Int }
+type ScrollSeekConfiguration =
+  { enter ∷ Number → Boolean, exit ∷ Number → Boolean }
+
+type Args a =
+  { debounce ∷ Milliseconds
+  , suggestionToText ∷ a → String
+  , contextMenuLayerId ∷ String
+  , scrollSeekPlaceholderʔ ∷ Maybe ScrollSeekPlaceholder
+  , scrollSeekConfigurationʔ ∷ Maybe ScrollSeekConfiguration
+  , overscan ∷ Overscan
+  , containerStyle ∷ E.Style
+  , itemStyle ∷ E.Style
+  }
+
+newtype InputProps = InputProps (∀ x. { | x })
+
+inputProps ∷ ∀ p p_. Union p p_ Input.Props ⇒ { | p } → InputProps
+inputProps = unsafeCoerce
+
+type Props a =
+  { onSelected ∷
+      a → Effect { overrideInputValue ∷ Maybe String, dismiss ∷ Boolean }
+  , onRemoved ∷ a → Effect Unit
+  , renderSuggestion ∷ a → JSX
+  , loadSuggestions ∷ String → Aff (Either Error (Array a))
+  , onDismiss ∷ Effect Unit
+  , placeholder ∷ String
+  , inputProps ∷ InputProps
+  }
+
+mkDefaultArgs ∷
+  ∀ a.
+  { suggestionToText ∷ a → String
+  , contextMenuLayerId ∷ String
+  } →
+  Args a
+mkDefaultArgs
+  { suggestionToText
+  , contextMenuLayerId
+  } =
+  { debounce: Milliseconds 200.0
+  , suggestionToText
+  , contextMenuLayerId
+  , scrollSeekPlaceholderʔ: Nothing
+  , scrollSeekConfigurationʔ: Nothing
+  , overscan: { main: 100, reverse: 100 }
+  , containerStyle: Style.resultsContainer
+  , itemStyle: Style.item
+  }
+
+mkTypeahead ∷ ∀ a. Eq a ⇒ Args a → Effect (ReactComponent (Props a))
+mkTypeahead args = do
+  typeaheadView ← mkTypeaheadView
+    { contextMenuLayerId: args.contextMenuLayerId
+    , overscan: args.overscan
+    , scrollSeekPlaceholderʔ: args.scrollSeekPlaceholderʔ
+    , scrollSeekConfigurationʔ: args.scrollSeekConfigurationʔ
+    , containerStyle: args.containerStyle
+    , itemStyle: args.itemStyle
+    }
+  React.reactComponent "Typeahead" \(props ∷ Props a) → React.do
+    input /\ setInput ← React.useState' ""
+    suggestions /\ setSuggestions ← React.useState' RemoteData.NotAsked
+    { activeIndex, updatedByKeyboard } /\ updateActiveIndex ← React.useState
+      { activeIndex: Nothing, updatedByKeyboard: false }
+
+    useAff input do
+      setSuggestions RemoteData.Loading # liftEffect
+      delay args.debounce
+      result ← attempt (props.loadSuggestions input)
+      let rd = RemoteData.fromEither (join result)
+      setSuggestions rd # liftEffect
+
+    pure
+      $ typeaheadView
+      </>
+        { input
+        , setInput
+        , suggestions
+        , activeIndex
+        , updatedByKeyboard
+        , updateActiveIndex
+        , onSelected: props.onSelected
+        , onRemoved: props.onRemoved
+        , onDismiss: setSuggestions RemoteData.NotAsked *> props.onDismiss
+        , placeholder: props.placeholder
+        , renderSuggestion: props.renderSuggestion
+        , inputProps: props.inputProps
+        , isLoading: suggestions # RemoteData.isLoading
+        }
+
+type ViewProps a =
+  { activeIndex ∷ Maybe Int
+  , updatedByKeyboard ∷ Boolean
+  , input ∷ String
+  , isLoading ∷ Boolean
+  , setInput ∷ String → Effect Unit
+  , suggestions ∷ RemoteData Error (Array a)
+  , renderSuggestion ∷ a → JSX
+  , updateActiveIndex ∷
+      ( { activeIndex ∷ Maybe Int
+        , updatedByKeyboard ∷ Boolean
+        } →
+        { activeIndex ∷ Maybe Int
+        , updatedByKeyboard ∷ Boolean
+        }
+      ) →
+      Effect Unit
+  , onSelected ∷
+      a → Effect { overrideInputValue ∷ Maybe String, dismiss ∷ Boolean }
+  , onRemoved ∷ a → Effect Unit
+  , onDismiss ∷ Effect Unit
+  , placeholder ∷ String
+  , inputProps ∷ InputProps
+  }
+
+mkTypeaheadView ∷
+  ∀ a.
+  Eq a ⇒
+  { contextMenuLayerId ∷ String
+  , scrollSeekPlaceholderʔ ∷ Maybe ScrollSeekPlaceholder
+  , scrollSeekConfigurationʔ ∷ Maybe ScrollSeekConfiguration
+  , overscan ∷ Overscan
+  , containerStyle ∷ E.Style
+  , itemStyle ∷ E.Style
+  } →
+  Effect (ReactComponent (ViewProps a))
+mkTypeaheadView
+  args@{ contextMenuLayerId } = do
+  -- loader ← mkLoader
+  popOver ← mkPopOverView
+  itemCompo ∷ ReactComponent {} ← mkForwardRefComponentWithStyle "TypeaheadItem"
+    Style.resultContainer
+    M.li
+  listCompo ∷ ReactComponent {} ← mkForwardRefComponentWithStyle "TypeaheadList"
+    (overflowHidden)
+    R.ul'
+
+  React.reactComponent "TypeaheadView" \(props ∷ ViewProps a) →
+    React.do
+      let
+        { renderSuggestion
+        , input
+        , setInput
+        , suggestions
+        , onDismiss
+        , activeIndex
+        , updatedByKeyboard
+        , updateActiveIndex
+        , placeholder
+        , isLoading
+        } = props
+      let (InputProps inputProps) = props.inputProps
+      id ← React.useId
+      -- The previous suggestions so we have something to display while loading
+      prevSuggs /\ setPrevSuggs ← React.useState' []
+      inputHasFocus /\ setInputHasFocus ← React.useState' false
+      popupHasFocus /\ setPopupHasFocus ← React.useState' false
+      isScrolling /\ setIsScrolling ← React.useState' false
+      isAnimating /\ setIsAnimating ← React.useState' false
+      inputContainerRef ← React.useRef null
+      inputRef ← React.useRef null
+      virtuosoRef ← React.useRef null
+
+      let focusIsWithin = inputHasFocus || popupHasFocus
+
+      { focusWithinProps } ←
+        useFocusWithin
+          { onFocusWithin: handler_ (setPopupHasFocus true)
+          , onBlurWithin: handler_ (setPopupHasFocus false)
+          }
+
+      { focusProps } ←
+        useFocus
+          { onFocus: handler_ (setInputHasFocus true)
+          , onBlur: handler_ (setInputHasFocus false)
+          }
+
+      -- We store the result whenever we have successful suggestions
+      React.useEffect (RemoteData.isSuccess suggestions) do
+        case suggestions of
+          RemoteData.Success suggs | suggs /= prevSuggs → setPrevSuggs suggs
+          _ → mempty
+        mempty
+
+      let
+        visibleData = case suggestions of
+          RemoteData.NotAsked → prevSuggs
+          RemoteData.Loading → prevSuggs
+          RemoteData.Failure _ → prevSuggs
+          RemoteData.Success suggs → suggs
+
+        focusInput ∷ Effect Unit
+        focusInput = do
+          maybeElem ← React.readRefMaybe inputRef
+          for_ (maybeElem >>= HTMLElement.fromNode) focus
+
+        blurCurrentItem ∷ Effect Unit
+        blurCurrentItem = do
+          maybeActive ← window >>= document >>= activeElement
+          for_ maybeActive \active → blur active
+
+      focusActiveElement id { isAnimating, isScrolling, updatedByKeyboard }
+        blurCurrentItem
+        activeIndex
+      let
+        onSelected i = do
+          { overrideInputValue, dismiss } ← props.onSelected i
+          when (Just props.input /= overrideInputValue) do
+            for_ overrideInputValue props.setInput
+          when dismiss do
+            updateActiveIndex $ const
+              { activeIndex: Nothing
+              , updatedByKeyboard: false
+              }
+            blurCurrentItem
+
+      -- Keyboard events
+      let
+        handleKeyUp =
+          mkHandleKeyUp
+            { activeIndex
+            , updateActiveIndex: \update → updateActiveIndex \old →
+                { activeIndex: update old.activeIndex, updatedByKeyboard: true }
+            , focusInput
+            , suggestions: suggestions # RemoteData.toMaybe # fromMaybe
+                prevSuggs
+            , onSelected
+            , onDismiss
+            }
+      let
+        inputBox = fragment
+          [ inputElement
+          , popOver
+              { hide: blurCurrentItem
+              , placement: Placement Below Start
+              , placementRef: inputContainerRef
+              , dismissBehaviourʔ: Nothing
+              , onAnimationStateChange: setIsAnimating
+              , containerId: contextMenuLayerId
+              , childʔ:
+                  if focusIsWithin then Just $ R.div'
+                    </
+                      { onFocus: focusWithinProps.onFocus
+                      , onBlur: focusWithinProps.onBlur
+                      }
+                    /> [ resultsContainer ]
+                  else Nothing
+              }
+          ]
+
+        inputElement = React.element Input.component
+          ( ( inputProps `mergeProps`
+                { id
+                , ref: inputContainerRef
+                , inputRef: inputRef
+                , spellCheck: false
+                , autoComplete: "off"
+                , placeholder
+                , value: input
+                , onChange: handler targetValue (traverse_ setInput)
+                , onMouseEnter: handler_
+                    (when focusIsWithin focusInput)
+                , onKeyUp:
+                    handler
+                      SE.key
+                      \e → e >>= parseKey # traverse_ handleKeyUp
+
+                , onFocus: focusProps.onFocus
+                , onBlur: focusProps.onBlur
+                , trailing:
+                    if isLoading then H.div_
+                      (widthAndHeight 18 <> textCol' col.textPaler2)
+                      [ spinner ]
+                    else (unsafeCoerce inputProps.trailing)
+                }
+            ) ∷ { | Input.Props }
+          )
+
+        wrapSuggestion i suggestion _ =
+          R.div'
+            </*
+              { tabIndex: -1
+              , id: id <> "-suggestion-" <> show i
+              , css: args.itemStyle
+              , onMouseMove:
+                  handler syntheticEvent \det → unless (activeIndex == Just i)
+                    do
+                      let
+                        movementX = (unsafeCoerce det).movementX # uorToMaybe #
+                          fromMaybe 0.0
+                      let
+                        movementY = (unsafeCoerce det).movementY # uorToMaybe #
+                          fromMaybe 0.0
+                      unless ((movementX == zero && movementY == zero)) do
+                        updateActiveIndex
+                          ( const
+                              { activeIndex: Just i
+                              , updatedByKeyboard: false
+                              }
+                          )
+              , onKeyDown: handler preventDefault mempty
+              -- ^ disables scrolling with arrow keys
+              , onKeyUp:
+                  handler SE.key
+                    (traverse_ handleKeyUp <<< (parseKey =<< _))
+              , onClick: capture_ do
+                  onSelected suggestion
+              }
+            /> [ renderSuggestion suggestion ]
+
+        resultsContainer =
+          M.div
+            </*
+              { css: minWidth 210 <> mX 0 <> args.containerStyle
+              , initial: M.initial $ false
+              , animate: M.animate $ R.css
+                  { height:
+                      if Array.length visibleData > 5 then 230
+                      else 120
+                  }
+              }
+            />
+              [ suggestionElements
+              ]
+
+        suggestionElements = virtuosoImpl </*>
+          ( { overscan: args.overscan
+            , ref: virtuosoRef
+            , className: "virtuoso"
+            , css:
+                scrollBar'
+                  { background: col.inputBackground
+                  , col: col.textPaler2
+                  , width: E.var "--s0"
+                  , borderRadius: E.px 8
+                  , borderWidth: E.px 4
+                  }
+            , scrollSeekConfiguration: args.scrollSeekConfigurationʔ #
+                maybeToUor
+            , components: case args.scrollSeekPlaceholderʔ of
+                Nothing → { "Item": itemCompo, "List": listCompo }
+                Just scrollSeekPlaceholder → unsafeCoerce
+                  { "Item": itemCompo
+                  , "List": listCompo
+                  , "ScrollSeekPlaceholder": scrollSeekPlaceholder
+                  }
+            , isScrolling: mkEffectFn1 setIsScrolling
+            , style: R.css
+                { height: "100%", width: "100%" }
+            , data: visibleData
+            , itemContent: mkFn3 wrapSuggestion
+            }
+          )
+
+      useEffect focusIsWithin do
+        unless focusIsWithin do
+          updateActiveIndex
+            (const { activeIndex: Nothing, updatedByKeyboard: false })
+        mempty
+
+      pure inputBox
+
+  where
+  focusActiveElement
+    id
+    { isAnimating, isScrolling, updatedByKeyboard }
+    blurCurrentItem
+    activeIndex =
+    useEffect activeIndex do
+      unless (isAnimating || isScrolling) do
+        case activeIndex of
+          Nothing → blurCurrentItem
+          Just i → do
+            suggʔ ← window >>= document >>=
+              ( HTMLDocument.toDocument >>> toNonElementParentNode >>>
+                  getElementById (id <> "-suggestion-" <> show i)
+              )
+            for_ (suggʔ >>= HTMLElement.fromElement)
+              (if updatedByKeyboard then focus else focusPreventScroll)
+      mempty
+
+-- https://caniuse.com/mdn-api_svgelement_focus_options_preventscroll_parameter
+focusPreventScroll ∷ HTMLElement → Effect Unit
+focusPreventScroll (htmlElement ∷ HTMLElement) = do
+  runEffectFn1 (unsafeCoerce htmlElement).focus { preventScroll: true }
+
+parseKey ∷ String → Maybe KeyCode
+parseKey = case _ of
+  "ArrowUp" → Just Key.Up
+  "ArrowDown" → Just Key.Down
+  "Backspace" → Just Key.Backspace
+  "Enter" → Just Key.Return
+  _ → Nothing
+
+mkHandleKeyUp ∷
+  ∀ a.
+  { activeIndex ∷ Maybe Int
+  , focusInput ∷ Effect Unit
+  , suggestions ∷ (Array a)
+  , updateActiveIndex ∷
+      (Maybe Int → Maybe Int) →
+      Effect Unit
+  , onSelected ∷ a → Effect Unit
+  , onDismiss ∷ Effect Unit
+  } →
+  KeyCode →
+  Effect Unit
+mkHandleKeyUp
+  { activeIndex
+  , suggestions
+  , updateActiveIndex
+  , focusInput
+  , onSelected
+  , onDismiss
+  }
+  key = do
+  let maxIndex = Array.length suggestions - 1
+  case key of
+    Key.Up → do
+      when (activeIndex == Just 0) focusInput
+      updateActiveIndex case _ of
+        Just 0 → Nothing
+        Nothing → Just maxIndex
+        Just i → Just (i - 1)
+    Key.Down → do
+      when (activeIndex == Just maxIndex) focusInput
+      updateActiveIndex case _ of
+        Just i | i == maxIndex → Nothing
+        Nothing → Just 0
+        Just i → Just (i + 1)
+    -- [TODO] End and Home keys
+    Key.Return → do
+      for_ activeIndex \i → do
+        for_ (suggestions !! i) onSelected
+    Key.Backspace → do
+      focusInput
+    Key.Escape → do
+      onDismiss
+    _ → mempty
+
+mkForwardRefComponent ∷
+  ∀ ref props.
+  Lacks "ref" props ⇒
+  String →
+  ReactComponent { ref ∷ React.Ref ref | props } →
+  Effect (ReactComponent { | props })
+mkForwardRefComponent name component = mkForwardRefComponentEffect name
+  \(props ∷ { | props }) ref → React.do
+    pure $ React.element component (Record.insert (Proxy ∷ _ "ref") ref props)
+
+mkForwardRefEmotionComponent ∷
+  ∀ ref props.
+  Lacks "ref" props ⇒
+  String →
+  ReactComponent { className ∷ String, ref ∷ React.Ref ref | props } →
+  Effect (ReactComponent { className ∷ String, css ∷ E.Style | props })
+mkForwardRefEmotionComponent name component =
+  mkForwardRefComponentEffect name
+    \(props ∷ { className ∷ String, css ∷ E.Style | props }) ref → React.do
+      pure $ E.element component
+        ( Record.insert (Proxy ∷ _ "ref") ref props
+        )
+
+mkForwardRefComponentWithStyle ∷
+  ∀ ref props.
+  Lacks "ref" props ⇒
+  Lacks "className" props ⇒
+  Union props
+    (className ∷ String, css ∷ E.Style)
+    (className ∷ String, css ∷ E.Style | props) ⇒
+  Nub (className ∷ String, css ∷ E.Style | props)
+    (className ∷ String, css ∷ E.Style | props) ⇒
+  String →
+  E.Style →
+  ReactComponent { className ∷ String, ref ∷ React.Ref ref | props } →
+  Effect (ReactComponent { | props })
+mkForwardRefComponentWithStyle name css component = mkForwardRefComponentEffect
+  name
+  \(props ∷ { | props }) ref → React.do
+    pure $ E.element component
+      ( Record.insert (Proxy ∷ _ "ref") ref
+          ( (props `Record.disjointUnion` { className: name, css }) ∷
+              { className ∷ String, css ∷ E.Style | props }
+          )
+      )

src/Plumage/Molecule/Typeahead/Style.purs

@@ -0,0 +1,31 @@
+module Plumage.Molecule.Typeahead.Style where
+
+import Yoga.Prelude.Style
+
+import Yoga.Block.Container.Style (col)
+
+resultsContainer ∷ Style
+resultsContainer =
+  background' col.inputBackground
+    <> pT 0
+    <> pX 0
+    <> flexCol
+    <> justifyEnd
+    <> itemsStart
+    <> gap 3
+    <> roundedLg
+    <> textXs
+    <> shadowLg
+    <> borderCol gray._200
+    <> overflowHidden
+
+resultContainer ∷ Style
+resultContainer = pY 2 <> cursorPointer <> overflowHidden
+
+item ∷ Style
+item =
+  focus
+    ( background' col.highlight
+        <> textCol' col.highlightText
+        <> outlineNone
+    )

src/Plumage/Prelude/Style.purs

@@ -0,0 +1,12 @@
+module Plumage.Prelude.Style
+  ( module Yoga.Prelude.Default
+  , module Fahrtwind.Style
+  , module Color
+  , module React.Basic.Emotion
+  ) where
+
+import Color (Color, ColorSpace(..), Interpolator, brightness, complementary, contrast, cssStringHSLA, cssStringRGBA, darken, desaturate, distance, fromHexString, fromInt, graytone, hsl, hsla, hsv, hsva, isLight, isReadable, lab, lch, lighten, luminance, mix, mixCubehelix, rgb, rgb', rgba, rgba', rotateHue, saturate, textColor, toGray, toHSLA, toHSVA, toHexString, toLCh, toLab, toRGBA, toRGBA', toXYZ, xyz)
+import Yoga.Prelude.Default (class Applicative, class Apply, class Bind, class BooleanAlgebra, class Bounded, class Category, class CommutativeRing, class Discard, class DivisionRing, class Eq, class EuclideanRing, class Field, class Functor, class HeytingAlgebra, class Monad, class Monoid, class Ord, class Ring, class Semigroup, class Semigroupoid, class Semiring, class Show, type (~>), Effect, Either(..), Maybe(..), MaybeT(..), Ordering(..), Unit, Void, absurd, add, ap, append, apply, between, bind, clamp, compare, comparing, compose, conj, const, degree, discard, disj, div, eq, flap, flip, fold, foldMap, foldMapWithIndex, for_, fromMaybe, fromMaybe', gcd, guard, hush, identity, ifM, intercalate, isJust, join, lcm, lift, liftA1, liftEffect, liftM1, map, mapWithIndex, max, maybe, mempty, min, mod, mul, negate, not, notEq, note, one, otherwise, pure, recip, runMaybeT, runMaybeT_, show, sub, traverse_, unit, unless, unlessM, void, when, whenM, zero, (#), ($), ($>), (&&), (*), (*>), (+), (-), (/), (/=), (<), (<#>), (<$), (<$>), (<*), (<*>), (<<<), (<=), (<=<), (<>), (<@>), (<|>), (=<<), (==), (>), (>=), (>=>), (>>=), (>>>), (||))
+import React.Basic.Emotion (StyleProperty, Style, nested, css, str, var, none)
+
+import Fahrtwind.Style

src/Plumage/Util/HTML.purs

@@ -0,0 +1,88 @@
+module Plumage.Util.HTML where
+
+import React.Basic (JSX, ReactComponent)
+import React.Basic.DOM as R
+import React.Basic.Emotion (Style)
+import React.Basic.Emotion as E
+
+jsx ∷
+  ReactComponent
+    { children ∷ Array JSX
+    , className ∷ String
+    } →
+  String →
+  Style →
+  Array JSX →
+  JSX
+jsx component className css children = E.element component
+  { className, css, children }
+
+jsx_ ∷
+  ReactComponent
+    { children ∷ Array JSX
+    , className ∷ String
+    } →
+  Style →
+  Array JSX →
+  JSX
+jsx_ component = jsx component ""
+
+div ∷ String → Style → Array JSX → JSX
+div = jsx R.div'
+
+div_ ∷ Style → Array JSX → JSX
+div_ = jsx_ R.div'
+
+span ∷ String → Style → Array JSX → JSX
+span = jsx R.span'
+
+span_ ∷ Style → Array JSX → JSX
+span_ = jsx_ R.span'
+
+li ∷ String → Style → Array JSX → JSX
+li = jsx R.li'
+
+li_ ∷ Style → Array JSX → JSX
+li_ = jsx_ R.li'
+
+ul ∷ String → Style → Array JSX → JSX
+ul = jsx R.ul'
+
+ul_ ∷ Style → Array JSX → JSX
+ul_ = jsx_ R.ul'
+
+nav ∷ String → Style → Array JSX → JSX
+nav = jsx R.nav'
+
+nav_ ∷ Style → Array JSX → JSX
+nav_ = jsx_ R.nav'
+
+p ∷ String → Style → Array JSX → JSX
+p = jsx R.p'
+
+p_ ∷ Style → Array JSX → JSX
+p_ = jsx_ R.p'
+
+section ∷ String → Style → Array JSX → JSX
+section = jsx R.section'
+
+section_ ∷ Style → Array JSX → JSX
+section_ = jsx_ R.section'
+
+h1_ ∷ Style → String → JSX
+h1_ style txt = jsx_ R.h1' style [ R.text txt ]
+
+h2_ ∷ Style → String → JSX
+h2_ style txt = jsx_ R.h2' style [ R.text txt ]
+
+h3_ ∷ Style → String → JSX
+h3_ style txt = jsx_ R.h3' style [ R.text txt ]
+
+h4_ ∷ Style → String → JSX
+h4_ style txt = jsx_ R.h4' style [ R.text txt ]
+
+h5_ ∷ Style → String → JSX
+h5_ style txt = jsx_ R.h5' style [ R.text txt ]
+
+h6_ ∷ Style → String → JSX
+h6_ style txt = jsx_ R.h6' style [ R.text txt ]

src/React/Aria/Button.js

@@ -0,0 +1,50 @@
+import { useButton } from "@react-aria/button"
+
+export const useButtonImpl = useButton
+
+export function toDashedProps(psProps) {
+  const arias = psProps.hasOwnProperty("_aria")
+    ? Object.fromEntries(
+        Object.entries(psProps._aria).map(([key, value]) => [
+          "aria-" + key,
+          value
+        ])
+      )
+    : {}
+  const datas = psProps.hasOwnProperty("_data")
+    ? Object.fromEntries(
+        Object.entries(psProps._data).map(([key, value]) => [
+          "data-" + key,
+          value
+        ])
+      )
+    : {}
+  const reactProps = Object.assign({}, psProps, arias, datas)
+  delete reactProps._aria
+  delete reactProps._data
+  return reactProps
+}
+
+export function fromDashedProps(reactProps) {
+  const psProps = {}
+  let _aria = {}
+  let _data = {}
+  Object.entries(reactProps.buttonProps).forEach(([key, value]) => {
+    if (key.startsWith("aria-")) {
+      _aria[key.slice(5)] = value
+    } else if (key.startsWith("data-")) {
+      _data[key.slice(5)] = value
+    } else {
+      psProps[key] = value
+    }
+    // console.log(psProps)
+  })
+  if (Object.keys(_aria).length !== 0) {
+    psProps._aria = _aria
+  }
+  if (Object.keys(_data).length !== 0) {
+    psProps._data = _data
+  }
+  reactProps.buttonProps = psProps
+  return reactProps
+}

src/React/Aria/Button.purs

@@ -0,0 +1,98 @@
+module React.Aria.Button
+  ( useButton
+  , UseButton
+  , ButtonPropsImpl
+  , pressEvent
+  , PressEventImpl
+  ) where
+
+import Prelude
+import Data.Nullable (Nullable)
+import Effect.Uncurried (EffectFn1, EffectFn2, runEffectFn2)
+import Foreign (Foreign, unsafeFromForeign, unsafeToForeign)
+import Foreign.Object (Object)
+import Prim.Row (class Union)
+import React.Basic.Events (EventFn, SyntheticEvent, EventHandler, unsafeEventFn)
+import React.Basic.Hooks (Hook, Ref, unsafeHook)
+import Unsafe.Coerce (unsafeCoerce)
+import Untagged.Union (OneOf)
+import Web.DOM (Node)
+import Web.HTML (HTMLElement)
+
+foreign import data UseButton ∷ Type → Type
+
+type PressEventImpl =
+  { type ∷ String
+  , pointerType ∷ String
+  , target ∷ HTMLElement
+  , shiftKey ∷ Boolean
+  , ctrlKey ∷ Boolean
+  , metaKey ∷ Boolean
+  }
+
+pressEvent ∷ EventFn SyntheticEvent PressEventImpl
+pressEvent = unsafeEventFn unsafeCoerce
+
+type ButtonPropsImpl =
+  ( elementType ∷ String -- button/a/div...
+  , isDisabled ∷ Boolean
+  , onPress ∷ EventHandler
+  , onPressStart ∷ EventHandler
+  , onPressEnd ∷ EventHandler
+  , onPressUp ∷ EventHandler
+  , onPressChange ∷ EffectFn1 Boolean Unit
+  , preventFocusOnPress ∷ Boolean
+  , href ∷ String -- for `a`
+  , target ∷ String -- for `a`
+  , rel ∷ String -- for `a`
+  , "aria-expanded" ∷ Boolean
+  , "aria-haspopup" ∷ OneOf Boolean String
+  , "aria-controls" ∷ String
+  , "aria-pressed" ∷ Boolean
+  , type ∷ String -- button/submit/reset
+  , excludeFromTabOrder ∷ Boolean
+  , "aria-label" ∷ String
+  , "aria-labelledby" ∷ String
+  , "aria-describedby" ∷ String
+  , "aria-details" ∷ String
+  )
+
+type ButtonPropsResult =
+  { _aria ∷ Object String
+  , disabled ∷ Boolean
+  , onBlur ∷ EventHandler
+  , onClick ∷ EventHandler
+  , onDragStart ∷ EventHandler
+  , onFocus ∷ EventHandler
+  , onKeyDown ∷ EventHandler
+  , onKeyUp ∷ EventHandler
+  , onMouseDown ∷ EventHandler
+  , onPointerDown ∷ EventHandler
+  , onPointerUp ∷ EventHandler
+  , tabIndex ∷ Int
+  , type ∷ String
+  }
+
+useButton ∷
+  ∀ attrsIn attrsIn_.
+  Union attrsIn attrsIn_ ButtonPropsImpl ⇒
+  { | attrsIn } →
+  Ref (Nullable Node) →
+  Hook UseButton { isPressed ∷ Boolean, buttonProps ∷ ButtonPropsResult }
+useButton props ref =
+  unsafeHook
+    $
+      runEffectFn2 useButtonImpl
+        (unsafeToForeign $ props)
+        ref
+        <#> (fromDashedProps >>> unsafeFromForeign)
+
+foreign import useButtonImpl ∷
+  EffectFn2
+    (Foreign)
+    (Ref (Nullable Node))
+    (Foreign)
+
+foreign import toDashedProps ∷ Foreign → Foreign
+
+foreign import fromDashedProps ∷ Foreign → Foreign

src/React/Aria/Combobox.js

@@ -0,0 +1,3 @@
+import { useComboBox } from "@react-aria/combobox"
+
+export const useComboBoxImpl = useComboBox

src/React/Aria/Combobox.purs

@@ -0,0 +1,127 @@
+module React.Aria.Combobox where
+
+import Prelude
+
+import Data.Nullable (Nullable)
+import Effect (Effect)
+import Effect.Uncurried (EffectFn1, EffectFn2, runEffectFn2)
+import Prim.Row (class Union)
+import React.Aria.JSSet (JSSet)
+import React.Aria.Types (FocusStrategy, MenuTriggerAction, Selection, SelectionBehaviour, SelectionMode, ValidationState)
+import React.Basic (JSX)
+import React.Basic.Events (EventHandler, SyntheticEvent)
+import React.Basic.Hooks (Hook, Ref, unsafeHook)
+import Web.DOM (Node)
+
+-- UseComboBox
+newtype UseComboBox hooks = UseComboBox hooks
+
+type AriaComboBoxPropsRequired a r =
+  ( inputRef ∷ Ref (Nullable Node)
+  , popoverRef ∷ Ref (Nullable Node)
+  , listBoxRef ∷ Ref (Nullable Node)
+  , children ∷ a → JSX -- Must map to either an item or a section
+  | r
+  )
+
+type AriaComboBoxPropsOptional a =
+  ( buttonRef ∷ Ref (Nullable Node)
+  , defaultItems ∷ Array a
+  , items ∷ Array a
+  -- , keyboardDelegate :: KeyboardDelegate
+  , onOpenChange ∷
+      EffectFn2 Boolean {- isOpen -} 
+        String {- menuTriggerAction: 'focus' | 'input' | 'manual' -}
+        Unit
+  , inputValue ∷ String
+  , defaultInputValue ∷ String
+  , onInputChange ∷ EffectFn1 String Unit
+  , allowsCustomValue ∷ Boolean
+  , menuTrigger ∷ MenuTriggerAction
+  , shouldFocusWrap ∷ Boolean -- | Whether keyboard navigation is circular.
+  , disabledKeys ∷
+      Array String -- | The item keys that are disabled. These items cannot be selected, focused, or otherwise interacted with.
+  , disallowEmptySelection ∷ Boolean -- | Whether the collection allows empty selection.
+  , selectedKey ∷ String -- | The currently selected key in the collection (controlled).
+  , defaultSelectedKey ∷ String -- | The initial selected key in the collection (uncontrolled).
+  , onSelectionChange ∷ EffectFn1 String Unit
+  , isDisabled ∷ Boolean
+  , isReadOnly ∷ Boolean
+  , placeholder ∷ String
+  , id ∷ String
+  , validationState ∷ ValidationState
+  , isRequired ∷ Boolean
+  , autoFocus ∷ Boolean
+  , onFocus ∷ EventHandler
+  , onBlur ∷ EventHandler
+  , onFocusChange ∷ EffectFn1 Boolean Unit
+  , onKeyDown ∷ EventHandler
+  , onKeyUp ∷ EventHandler
+  , label ∷ JSX
+  , description ∷ JSX
+  , errorMessage ∷ JSX
+  )
+
+type UseComboBoxState =
+  { inputValue ∷ String
+  , isFocused ∷ Boolean
+  , selectedKey ∷ String
+  , selectedItem ∷ Node
+  , collection ∷ Array Node
+  , disabledKeys :: JSSet String
+  , selectionManager :: SelectionManager
+  , focusStrategy ∷ FocusStrategy
+  , isOpen ∷ Boolean
+  , setInputValue ∷ EffectFn1 String Unit
+  , commit ∷ Effect Unit
+  , open ∷ EffectFn2 (Nullable FocusStrategy) MenuTriggerAction Unit
+  , toggle ∷ EffectFn2 (Nullable FocusStrategy) MenuTriggerAction Unit
+  , revert ∷ Effect Unit
+  , setFocused ∷ EffectFn1 Boolean Unit
+  , setSelectedKey ∷ EffectFn1 String Unit
+  , close ∷ Effect Unit
+  }
+
+type SelectionManager =
+  { selectionMode ∷ SelectionMode
+  , disallowEmptySelection ∷ Boolean
+  , selectionBehavior ∷ SelectionBehaviour
+  , isFocused ∷ Boolean
+  , focusedKey ∷ String
+  , childFocusStrategy ∷ FocusStrategy
+  , selectedKeys :: JSSet String
+  , rawSelection :: Selection
+  , isEmpty ∷ Boolean
+  , isSelectAll ∷ Boolean
+  , firstSelectedKey ∷ Nullable String
+  , lastSelectedKey ∷ Nullable String
+  , setSelectionBehavior ∷ EffectFn1 SelectionBehaviour Unit
+  , setFocused ∷ EffectFn1 Boolean Unit
+  , setFocusedKey ∷ EffectFn2 String FocusStrategy Unit
+  , isSelected ∷ EffectFn1 String Boolean
+  , extendSelection ∷ EffectFn1 String Unit
+  , toggleSelection ∷ EffectFn1 String Unit
+  , replaceSelection ∷ EffectFn1 String Unit
+  , setSelectedKeys ∷ EffectFn1 (Array String) Unit
+  , selectAll ∷ Effect Unit
+  , clearSelection ∷ Effect Unit
+  , toggleSelectAll ∷ Effect Unit
+  , select ∷ EffectFn2 String SyntheticEvent Unit
+  , isSelectionEqual :: EffectFn1 (JSSet String) Unit
+  , canSelectItem ∷ EffectFn1 String Unit
+  }
+
+type ComboBoxAria = { comboBoxProps ∷ { "data-isComboBox" ∷ Boolean } }
+
+foreign import useComboBoxImpl
+  ∷ ∀ props state
+  . EffectFn2 props state ComboBoxAria
+
+useComboBox
+  ∷ ∀ a props props_
+  . Union props props_ (AriaComboBoxPropsOptional a)
+  ⇒ { | AriaComboBoxPropsRequired a props }
+  → UseComboBoxState
+  → Hook UseComboBox ComboBoxAria
+useComboBox p s = unsafeHook do
+  runEffectFn2 useComboBoxImpl p s

src/React/Aria/Focus.js

@@ -0,0 +1,5 @@
+import { FocusRing, FocusScope, useFocusRing } from "@react-aria/focus"
+
+export const focusRingImpl = FocusRing
+export const focusScopeImpl = FocusScope
+export const useFocusRingImpl = useFocusRing

src/React/Aria/Focus.purs

@@ -0,0 +1,27 @@
+module React.Aria.Focus where
+
+import Prelude
+import Effect.Uncurried (EffectFn1, runEffectFn1)
+import React.Basic (ReactComponent)
+import React.Basic.Events (EventHandler)
+import React.Basic.Hooks (Hook, unsafeHook)
+
+foreign import focusRingImpl ∷ ∀ props. ReactComponent { | props }
+
+foreign import focusScopeImpl ∷ ∀ props. ReactComponent { | props }
+
+foreign import useFocusRingImpl ∷ EffectFn1 UseFocusRingInput UseFocusRingResult
+
+foreign import data UseFocusRing ∷ Type -> Type
+
+type UseFocusRingResult =
+  { isFocused ∷ Boolean
+  , isFocusVisible ∷ Boolean
+  , focusProps ∷ { onBlur ∷ EventHandler, onFocus ∷ EventHandler }
+  }
+
+type UseFocusRingInput =
+  { within ∷ Boolean, isTextInput ∷ Boolean, autoFocus ∷ Boolean }
+
+useFocusRing ∷ UseFocusRingInput -> Hook UseFocusRing UseFocusRingResult
+useFocusRing = unsafeHook <<< runEffectFn1 useFocusRingImpl

src/React/Aria/Interactions.js

@@ -0,0 +1,4 @@
+import { useFocusWithin, useFocus } from "@react-aria/interactions"
+
+export const useFocusWithinImpl = useFocusWithin
+export const useFocusImpl = useFocus

src/React/Aria/Interactions.purs

@@ -0,0 +1,56 @@
+module React.Aria.Interactions2 where
+
+import Prelude
+
+import Effect.Uncurried (EffectFn1, runEffectFn1)
+import Prim.Row (class Union)
+import React.Basic.Events (EventHandler)
+import React.Basic.Hooks (Hook, unsafeHook)
+
+-- UseFocusWithin
+
+type FocusWithinProps =
+  ( isDisabled ∷ Boolean
+  , onFocusWithin ∷ EventHandler
+  , onBlurWithin ∷ EventHandler
+  , onFocusWithinChange ∷ EffectFn1 Boolean Unit
+  )
+
+type FocusWithinResult =
+  { focusWithinProps ∷
+      { onBlur ∷ EventHandler, onFocus ∷ EventHandler }
+  }
+
+foreign import useFocusWithinImpl ∷ ∀ props. EffectFn1 props FocusWithinResult
+
+newtype UseFocusWithin a = UseFocusWithin a
+
+useFocusWithin ∷
+  ∀ props props_.
+  Union props props_ FocusWithinProps ⇒
+  { | props } →
+  Hook UseFocusWithin FocusWithinResult
+useFocusWithin = unsafeHook <<< runEffectFn1 useFocusWithinImpl
+
+-- UseFocus
+
+type FocusProps =
+  ( isDisabled ∷ Boolean
+  , onFocus ∷ EventHandler
+  , onBlur ∷ EventHandler
+  , onFocusChange ∷ EffectFn1 Boolean Unit
+  )
+
+type FocusResult =
+  { focusProps ∷ { onBlur ∷ EventHandler, onFocus ∷ EventHandler } }
+
+foreign import useFocusImpl ∷ ∀ props. EffectFn1 props FocusResult
+
+newtype UseFocus a = UseFocus a
+
+useFocus ∷
+  ∀ props props_.
+  Union props props_ FocusProps ⇒
+  { | props } →
+  Hook UseFocus FocusResult
+useFocus = unsafeHook <<< runEffectFn1 useFocusImpl

src/React/Aria/JSSet.js

@@ -0,0 +1,4 @@
+export const toArray = Array.from
+export function fromArray(arr) {
+  return new Set(arr)
+}

src/React/Aria/JSSet.purs

@@ -0,0 +1,17 @@
+module React.Aria.JSSet where
+
+import Prelude
+
+import Data.Set (Set)
+import Data.Set as Set
+
+foreign import data JSSet ∷ Type → Type
+
+foreign import toArray ∷ JSSet ~> Array
+foreign import fromArray ∷ Array ~> JSSet
+
+fromJSSet ∷ ∀ a. Ord a ⇒ JSSet a → Set a
+fromJSSet = toArray >>> Set.fromFoldable
+
+toJSSet ∷ Set ~> JSSet
+toJSSet = Set.toUnfoldable >>> fromArray 

src/React/Aria/Listbox.js

@@ -0,0 +1,6 @@
+import { useListBox, useListBoxSection, useOption } from "@react-aria/listbox"
+
+export const useListBoxImpl = useListBox
+export const useListBoxSectionImpl = useListBoxSection
+export const useOptionImpl = useOption
+// exports.getItemIdImpl = listbox.getItemId;

src/React/Aria/Listbox.purs

@@ -0,0 +1,112 @@
+module React.Aria.Listbox where
+
+import Prelude
+
+import Data.Nullable (Nullable)
+import Effect.Uncurried (EffectFn1, EffectFn3, runEffectFn3)
+import Prim.Row (class Union)
+import React.Aria.Combobox (SelectionManager)
+import React.Aria.JSSet (JSSet)
+import React.Aria.Types (FocusStrategy, Selection, SelectionMode)
+import React.Basic (JSX, Ref)
+import React.Basic.Events (EventHandler)
+import React.Basic.Hooks (Hook, unsafeHook)
+import Web.DOM (Node)
+
+type ListState =
+  { collection ∷ Array Node
+  , disabledKeys ∷ JSSet String
+  , selectionManager ∷ SelectionManager
+  }
+
+--##########################################################################  
+
+type AriaListBoxOptions a =
+  ( isVirtualized ∷ Boolean
+  --  , keyboardDelegate :: KeyboardDelegate
+  , shouldUseVirtualFocus ∷ Boolean
+  , shouldSelectOnPressUp ∷ Boolean
+  , shouldFocusOnHover ∷ Boolean
+  , label ∷ JSX
+  , autoFocus ∷ FocusStrategy
+  , shouldFocusWrap ∷ Boolean
+  , items ∷ Array a
+  , disabledKeys ∷ Array String
+  , selectionMode ∷ SelectionMode
+  , disallowEmptySelection ∷ Boolean
+  , selectedKeys ∷ Array String
+  , defaultSelectedKeys ∷ Array String
+  , onSelectionChange ∷ EffectFn1 Selection Unit
+  , onFocus ∷ EventHandler
+  , onBlur ∷ EventHandler
+  , onFocusChange ∷ EffectFn1 Boolean Unit
+  , id ∷ String
+  , "aria-label" ∷ String
+  , "aria-labelledby" ∷ String
+  , "aria-describedby" ∷ String
+  , "aria-details" ∷ String
+  )
+
+type ListBoxAria =
+  { listBoxProps ∷ {}
+  , labelProps ∷ {}
+  }
+
+foreign import useListBoxImpl
+  ∷ ∀ props. EffectFn3 props ListState (Ref (Nullable Node)) ListBoxAria
+
+newtype UseListBox hooks = UseListBox hooks
+
+useListBox
+  ∷ ∀ a props props_
+  . Union props props_ (AriaListBoxOptions a)
+  ⇒ { | props }
+  → ListState
+  → Ref (Nullable Node)
+  → Hook UseListBox ListBoxAria
+useListBox p s r = unsafeHook do
+  runEffectFn3 useListBoxImpl p s r
+
+--##########################################################################  
+
+type AriaOptionPropsOptional = ("aria-label" ∷ String)
+type AriaOptionPropsRequired r = (key ∷ String | r)
+type OptionAria =
+  { optionProps ∷ {}
+  , labelProps ∷ {}
+  , descriptionProps ∷ {}
+  , isFocused ∷ Boolean
+  , isSelected ∷ Boolean
+  , isPressed ∷ Boolean
+  , isDisabled ∷ Boolean
+  }
+
+foreign import useOptionImpl
+  ∷ ∀ props. EffectFn3 props ListState (Ref (Nullable Node)) OptionAria
+
+newtype UseOption hooks = UseOption hooks
+
+useOption
+  ∷ ∀ props props_
+  . Union props props_ AriaOptionPropsOptional
+  ⇒ { | AriaOptionPropsRequired props }
+  → ListState
+  → (Ref (Nullable Node))
+  → Hook UseOption OptionAria
+useOption p s r = unsafeHook do
+  runEffectFn3 useOptionImpl p s r
+
+--##########################################################################  
+
+type AriaListBoxSectionProps = (heading :: JSX, "aria-label" :: String)
+type ListBoxSectionAria =
+  { itemProps ∷ {} -- [FIXME]
+  , headingProps ∷ {} -- [FIXME]
+  , groupProps ∷ {} -- [FIXME]
+  }
+
+foreign import useListBoxSectionImpl
+  ∷ forall props
+   . EffectFn1 props ListBoxSectionAria
+
+newtype UseListBoxSection hooks = UseListBoxSection hooks

src/React/Aria/Overlays.js

@@ -0,0 +1,37 @@
+import {
+  useModal,
+  useOverlay,
+  useOverlayPosition,
+  useOverlayTrigger,
+  usePreventScroll,
+  OverlayProvider,
+  OverlayContainer,
+  DismissButton,
+  ModalProvider
+} from "@react-aria/overlays"
+
+export const useModalImpl = useModal
+export const useOverlayImpl = useOverlay
+export const useOverlayPositionImpl = useOverlayPosition
+export const useOverlayTriggerImpl = useOverlayTrigger
+export const usePreventScrollImpl = usePreventScroll
+export const overlayProvider = OverlayProvider
+export const overlayContainer = OverlayContainer
+export const dismissButton = DismissButton
+export const modalProvider = ModalProvider
+
+export function toPSAria(obj) {
+  let result = {}
+  Object.keys(obj).forEach((k) => {
+    if (k.startsWith("aria-")) {
+      const v = obj[k]
+      if (v !== undefined && v !== null) {
+        const newKey = k.substring(5)
+        result[newKey] = v
+      }
+    } else {
+      console.error(`${k} is not an aria attribute`)
+    }
+  })
+  return result
+}

src/React/Aria/Overlays.purs

@@ -0,0 +1,159 @@
+module React.Aria.Overlays where
+
+import Prelude
+
+import Data.Nullable (Nullable)
+import Effect (Effect)
+import Effect.Aff.Compat (runEffectFn1)
+import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, runEffectFn2, runEffectFn3)
+import Foreign (Foreign)
+import Foreign.Object (Object)
+import Prim.Row (class Union)
+import React.Basic (JSX)
+import React.Basic.DOM (CSS)
+import React.Basic.Events (EventHandler)
+import React.Basic.Hooks (Hook, ReactComponent, Ref, unsafeHook)
+import Web.DOM (Node)
+import Web.HTML (HTMLElement)
+
+-- UseModal
+newtype UseModal hooks = UseModal hooks
+
+type UseModalOptions = { isDisabled :: Boolean }
+
+type ModalAria = { modalProps :: { "data-ismodal" :: Boolean } }
+
+foreign import useModalImpl ∷ EffectFn1 UseModalOptions ModalAria
+
+useModal :: UseModalOptions -> Hook UseModal ModalAria
+useModal = unsafeHook <<< runEffectFn1 useModalImpl
+
+-- UseOverlay
+newtype UseOverlay hooks = UseOverlay hooks
+
+type UseOverlayProps =
+  ( isOpen ∷ Boolean
+  , onClose ∷ Effect Unit
+  , isDismissable ∷ Boolean
+  , shouldCloseOnBlur ∷ Boolean
+  , isKeyboardDismissaDisabled ∷ Boolean
+  , shouldCloseOnInteractOutside ∷ HTMLElement → Boolean
+  )
+
+type OverlayAria =
+  { overlayProps ∷ { onKeyDown ∷ EventHandler }
+  , underlayProps ∷ { onPointerDown ∷ EventHandler }
+  }
+
+foreign import useOverlayImpl
+  ∷ ∀ useOverlayProps. EffectFn2 useOverlayProps (Ref (Nullable Node)) OverlayAria
+
+useOverlay
+  ∷ ∀ props props_
+  . Union props props_ UseOverlayProps
+  ⇒ Record props
+  → Ref (Nullable Node)
+  → Hook UseOverlay OverlayAria
+useOverlay x y = unsafeHook $ runEffectFn2 useOverlayImpl x y
+
+-- UseOverlayPosition
+newtype UseOverlayPosition hooks = UseOverlayPosition hooks
+
+type UseAriaPositionPropsRequired r =
+  ( targetRef ∷ Ref (Nullable Node)
+  , overlayRef ∷ Ref (Nullable Node)
+  | r
+  )
+
+type UseAriaPositionPropsOptional =
+  ( boundaryElement ∷ HTMLElement
+  , scrollRef ∷ Ref (Nullable Node)
+  , shouldUpdatePosition ∷ Boolean
+  , onClose ∷ Effect Unit
+  , placement ∷ String
+  , containerPadding ∷ Number
+  , offset ∷ Number
+  , crossOffset ∷ Number
+  , shouldFlip ∷ Boolean
+  , isOpen ∷ Boolean
+  )
+
+type PositionAria =
+  { overlayProps :: { style :: CSS }
+  , arrowProps :: { style :: CSS }
+  , placement :: String
+  , updatePosition :: Effect Unit
+  }
+
+foreign import useOverlayPositionImpl
+  ∷ ∀ props
+  . EffectFn1 props PositionAria
+
+usePosition
+  ∷ ∀ props props_
+  . Union props props_ UseAriaPositionPropsOptional
+  ⇒ Record (UseAriaPositionPropsRequired props)
+  → Hook UseOverlayPosition PositionAria
+usePosition = unsafeHook <<< runEffectFn1 useOverlayPositionImpl
+
+-- UseOverlayTrigger
+newtype UseOverlayTrigger hooks = UseOverlayTrigger hooks
+
+-- | Type must be one of the following
+-- | 'dialog'
+-- | 'menu'
+-- | 'listbox'
+-- | 'tree'
+-- | 'grid'
+type UseOverlayTriggerProps = { type ∷ String }
+
+type UseOverlayTriggerState =
+  { isOpen ∷ Boolean
+  , open ∷ Effect Unit
+  , close ∷ Effect Unit
+  , toggle ∷ Effect Unit
+  }
+
+type OverlayTriggerAriaImpl =
+  { triggerProps ∷ Object Foreign
+  , overlayProps ∷ { id ∷ String }
+  }
+
+type OverlayTriggerAria =
+  { triggerProps ∷ { _aria ∷ Object String }
+  , overlayProps ∷ { id ∷ String }
+  }
+
+foreign import useOverlayTriggerImpl ∷
+  EffectFn3
+    UseOverlayTriggerProps
+    UseOverlayTriggerState
+    (Ref (Nullable Node))
+    OverlayTriggerAriaImpl
+
+useOverlayTrigger
+  ∷ UseOverlayTriggerProps
+  → UseOverlayTriggerState
+  → Ref (Nullable Node)
+  → Hook UseOverlayTrigger OverlayTriggerAria
+useOverlayTrigger x y z = unsafeHook do
+  implProps ← runEffectFn3 useOverlayTriggerImpl x y z
+  pure (implProps { triggerProps = { _aria: toPSAria implProps.triggerProps } })
+
+-- Prevent Scroll
+newtype UsePreventScroll hooks = UsePreventScroll hooks
+type UsePreventScrollOptions = { isDisabled :: Boolean }
+
+foreign import usePreventScrollImpl ∷ EffectFn1 UsePreventScrollOptions Unit
+
+usePreventScroll :: UsePreventScrollOptions -> Hook UsePreventScroll Unit
+usePreventScroll = unsafeHook <<< runEffectFn1 usePreventScrollImpl
+
+-- foreign import ariaHideOutsideImpl ∷ Fn2 Foreign Foreign (Effect Unit)
+
+foreign import overlayProvider :: ReactComponent { children :: Array JSX }
+foreign import overlayContainer :: ReactComponent { children :: Array JSX }
+foreign import dismissButton :: ReactComponent { onDismiss :: Effect Unit }
+foreign import modalProvider :: ReactComponent { children :: Array JSX }
+
+foreign import toPSAria ∷ Object Foreign → Object String

src/React/Aria/Types.purs

@@ -0,0 +1,81 @@
+module React.Aria.Types where
+
+import Prelude
+
+import React.Aria.JSSet (JSSet)
+import Unsafe.Coerce (unsafeCoerce)
+
+-- MenuTriggerAction
+foreign import data MenuTriggerAction ∷ Type
+
+menuTriggerActionFocus ∷ MenuTriggerAction
+menuTriggerActionFocus = unsafeCoerce "focus"
+
+menuTriggerActionInput ∷ MenuTriggerAction
+menuTriggerActionInput = unsafeCoerce "input"
+
+menuTriggerActionManual ∷ MenuTriggerAction
+menuTriggerActionManual = unsafeCoerce "manual"
+
+instance Eq MenuTriggerAction where
+  eq a b = ((unsafeCoerce a) ∷ String) == unsafeCoerce b
+
+-- ValidationState
+foreign import data ValidationState ∷ Type
+
+validationStateValid ∷ ValidationState
+validationStateValid = unsafeCoerce "valid"
+
+validationStateInvalid ∷ ValidationState
+validationStateInvalid = unsafeCoerce "invalid"
+
+instance Eq ValidationState where
+  eq a b = ((unsafeCoerce a) ∷ String) == unsafeCoerce b
+
+-- FocusStrategy
+foreign import data FocusStrategy ∷ Type
+
+focusStrategyFirst ∷ FocusStrategy
+focusStrategyFirst = unsafeCoerce "first"
+
+focusStrategyLast ∷ FocusStrategy
+focusStrategyLast = unsafeCoerce "last"
+
+instance Eq FocusStrategy where
+  eq a b = ((unsafeCoerce a) ∷ String) == unsafeCoerce b
+
+-- SelectionMode
+foreign import data SelectionMode ∷ Type
+
+selectionModeNone ∷ SelectionMode
+selectionModeNone = unsafeCoerce "none"
+
+selectionModeSingle ∷ SelectionMode
+selectionModeSingle = unsafeCoerce "single"
+
+selectionModeMultiple ∷ SelectionMode
+selectionModeMultiple = unsafeCoerce "multiple"
+
+instance Eq SelectionMode where
+  eq a b = ((unsafeCoerce a) ∷ String) == unsafeCoerce b
+
+-- SelectionBehaviour
+foreign import data SelectionBehaviour ∷ Type
+
+selectionBehaviourToggle ∷ SelectionBehaviour
+selectionBehaviourToggle = unsafeCoerce "toggle"
+
+selectionBehaviourReplace ∷ SelectionBehaviour
+selectionBehaviourReplace = unsafeCoerce "replace"
+
+instance Eq SelectionBehaviour where
+  eq a b = ((unsafeCoerce a) ∷ String) == unsafeCoerce b
+
+-- Selection
+foreign import data Selection ∷ Type
+
+selectionAll ∷ Selection
+selectionAll = unsafeCoerce "all"
+
+selectionFromSet ∷ JSSet String -> SelectionBehaviour
+selectionFromSet = unsafeCoerce

src/React/Aria/Utils.js

@@ -0,0 +1,7 @@
+import { mergeProps, useId } from "@react-aria/utils"
+
+export function mergePropsImpl(args) {
+  return mergeProps(...args)
+}
+
+export const useIdImpl = useId

src/React/Aria/Utils.purs

@@ -0,0 +1,19 @@
+module React.Aria.Utils where
+
+import Foreign (Foreign, unsafeFromForeign, unsafeToForeign)
+import Prim.Row (class Union)
+import React.Basic.Hooks (Hook, unsafeHook)
+import Effect (Effect)
+
+foreign import useIdImpl ∷ Effect String
+
+newtype UseId a = UseId a
+
+useId ∷ Hook UseId String
+useId = unsafeHook useIdImpl
+
+foreign import mergePropsImpl ∷ Array Foreign → Foreign
+
+mergeProps ∷ ∀ r1 r2 r3. Union r1 r2 r3 ⇒ { | r1 } → { | r2 } → { | r3 }
+mergeProps r1 r2 = unsafeFromForeign
+  (mergePropsImpl [ unsafeToForeign r1, unsafeToForeign r2 ])

src/Yoga/Block/Hook/UseOverflows.purs

@@ -38,13 +38,11 @@ useOverflows = coerceHook React.do
           Array.head entries # traverse_ \{ target } -> do
             -- get old style
             styleʔ <- elʔ # traverse getElementStyle
-            let _ = spy "setting style visible" styleʔ
             oldOverflowʔ <- styleʔ # traverse (getStyleProperty "overflow")
             for_ styleʔ \style -> do
               setStyleProperty "overflow" "scroll" style
               -- force reflow: https://gist.github.com/paulirish/5d52fb081b3570c81e3a
               -- (elʔ >>= HTMLElement.fromElement) # traverse_ (offsetTop)
-              let _ = spy "setting style visible" style
               pure unit
             -- get sizes
             sw <- scrollWidth target