Improved cell scroll during navigation & resize

src/CSS/Table.purs

@@ -49,6 +49,7 @@ formulaCss = do
     marginTop := px 40
     marginBottom := px 10
     padding := px 20
+    borderStyle := solid
     borderColor := grey2
     borderWidth := px 3
     fontSize := px 20

src/Components/Table.purs

@@ -3,7 +3,7 @@ module App.Components.Table where
 import FatPrelude
 import Prim hiding (Row)
 
-import App.Components.Table.Cell (CellValue(..), Column(..), Row(..))
+import App.Components.Table.Cell (CellValue(..), mkColumn, mkRow)
 import App.Components.Table.Formula (FormulaState(..))
 import App.Components.Table.Handler (handleAction)
 import App.Components.Table.Models (Action(..), AppState)
@@ -24,21 +24,21 @@ component =
 
 initialState :: forall a. a -> AppState
 initialState = const
-  { selectedCell: { column: Column $ fromUpper 'A', row: Row 1 }
-  , formulaCell: { column: Column $ fromUpper 'A', row: Row 1 }
+  { selectedCell: { column: mkColumn 'A', row: mkRow 1 }
+  , formulaCell: { column: mkColumn 'A', row: mkRow 1 }
   , activeFormula: false
   , activeInput: false
   , formulaState: UnknownFormula
   , tableData: HashMap.fromArray
-      [ { column: Column $ fromUpper 'A', row: Row 1 } /\ IntVal 1
-      , { column: Column $ fromUpper 'B', row: Row 1 } /\ IntVal 2
-      , { column: Column $ fromUpper 'C', row: Row 1 } /\ IntVal 3
-      , { column: Column $ fromUpper 'D', row: Row 1 } /\ IntVal 4
+      [ { column: mkColumn 'A', row: mkRow 1 } /\ IntVal 1
+      , { column: mkColumn 'B', row: mkRow 1 } /\ IntVal 2
+      , { column: mkColumn 'C', row: mkRow 1 } /\ IntVal 3
+      , { column: mkColumn 'D', row: mkRow 1 } /\ IntVal 4
       ]
   , tableDependencies: HashMap.empty
   , tableFormulas: HashMap.empty
   , formulaCache: HashMap.empty
-  , rows: bottom .. Row 100
+  , rows: bottom .. mkRow 100
   , multiSelection: NoSelection
   , selectionState: NotStartedSelection
   , draggedHeader: Nothing

src/Components/Table/Cell.purs

@@ -17,10 +17,10 @@ parseCellValue input =
   fromRight (StringVal input) (runParser cellValueParser input)
 
 rowParser :: Parser Row
-rowParser = Row <$> unsignedInt
+rowParser = mkRow <$> unsignedInt
 
 columnParser :: Parser Column
-columnParser = Column <<< fromUpper <$> upper
+columnParser = mkColumn <$> upper
 
 cellParser :: Parser Cell
 cellParser = do
@@ -46,9 +46,10 @@ getCell
   :: (Int -> Int)
   -> Cell
   -> Maybe Cell
-getCell f cell =
-  getColumnCell (over Column f) cell
-    <|> getRowCell (over Row f) cell
+getCell f cell = getColumnCell (over Column f) cell
+  <|> (_ { column = column } <$> getRowCell (over Row f) cell)
+  where
+  column = if cell.column == top then bottom else top
 
 getColumnCell
   :: (Column -> Column)
@@ -67,12 +68,6 @@ getRowCell f { column, row } =
 prevColumnCell :: Cell -> Cell
 prevColumnCell { column, row } = { column: dec column, row }
 
-nextColumnCell :: Cell -> Cell
-nextColumnCell { column, row } = { column: inc column, row }
-
-prevRowCell :: Cell -> Cell
-prevRowCell { column, row } = { column, row: dec row }
-
 nextRowCell :: Cell -> Cell
 nextRowCell { column, row } = { column, row: inc row }
 
@@ -108,10 +103,16 @@ swapTableMapRow origin target tableDict =
           (HashMap.keys tableDict)
 
 allColumns :: NonEmptyArray Column
-allColumns = allValues
+allColumns = enumValues
 
 allRows :: NonEmptyArray Row
-allRows = allValues
+allRows = enumValues
+
+mkColumn :: Char -> Column
+mkColumn = Column <<< fromUpper
+
+mkRow :: Int -> Row
+mkRow = Row
 
 newtype Column = Column Int
 

src/Components/Table/Handler.purs

@@ -3,40 +3,41 @@ module App.Components.Table.Handler where
 import FatPrelude
 
 import App.CSS.Ids (formulaBoxId, formulaCellInputId, inputElement, selectedCellInputId)
-import App.Components.Table.Cell (CellMove(..), Header(..), getColumnHeader, getRowHeader, swapTableMapColumn, swapTableMapRow)
+import App.Components.Table.Cell (CellMove(..), Header(..), getColumnHeader, getRowHeader, mkColumn, mkRow, swapTableMapColumn, swapTableMapRow)
 import App.Components.Table.Formula (FormulaState(..))
-import App.Components.Table.HandlerHelpers (cellArrowMove, cellMove, copyCells, deleteCells, insertFormula, loadPrelude, pasteCells, refreshCells, selectAllCells, selectCell, setRows)
+import App.Components.Table.HandlerHelpers (cellArrowMove, cellMove, copyCells, deleteCells, insertFormula, loadPrelude, pasteCells, refreshCells, selectAllCells, selectCell, subscribeSelectionChange, subscribeWindowResize)
 import App.Components.Table.Models (Action(..), AppState, EventTransition(..))
 import App.Components.Table.Selection (MultiSelection(..), SelectionState(..))
 import App.Evaluator.Formula (mkLocalContext)
 import App.Utils.Dom (KeyCode(..), actOnElementById, ctrlKey, displayFunctionType, emptyFormulaBox, emptyFormulaSignature, focusById, focusCell, focusCellElem, performSyntaxHighlight, prevent, shiftKey, toMouseEvent, withPrevent)
 import App.Utils.HashMap (lookup2) as HashMap
 import Data.HashMap (insert, member) as HashMap
 import Data.Set as Set
-import Halogen as H
-import Halogen.Query.Event (eventListener)
-import Web.Event.Event (EventType(..))
+import Halogen (HalogenM)
 import Web.HTML (window)
-import Web.HTML.HTMLDocument as HTMLDocument
 import Web.HTML.HTMLElement (setContentEditable)
-import Web.HTML.Window (document)
+import Web.HTML.Window (scroll)
 import Web.UIEvent.WheelEvent (deltaX, deltaY)
 
 handleAction
   :: forall slots o m
    . MonadAff m
   => Action
-  -> H.HalogenM AppState Action slots o m Unit
+  -> HalogenM AppState Action slots o m Unit
 
 handleAction Initialize = do
   loadPrelude
-  setRows
   actOnElementById formulaBoxId $ setContentEditable "true"
-  document' <- liftEffect $ document =<< window
-  H.subscribe' \_ -> eventListener
-    (EventType "selectionchange")
-    (HTMLDocument.toEventTarget document')
-    (const $ Just SelectionChange)
+  handleAction ResizeWindow
+  subscribeSelectionChange
+  subscribeWindowResize
+
+handleAction ResizeWindow = do
+  { selectedCell } <- get
+  void $ selectCell $ OtherCell { column: mkColumn 'A', row: mkRow 1000 }
+  void $ selectCell $ OtherCell { column: mkColumn 'A', row: mkRow 1 }
+  void $ selectCell $ OtherCell selectedCell
+  liftEffect $ scroll 0 0 =<< window
 
 handleAction (WriteSelectedCellInput cell) =
   traverse_ (selectCell <<< OtherCell) cell
@@ -75,13 +76,8 @@ handleAction (FormulaKeyDown (CharKeyCode 'G') ev)
 handleAction (FormulaKeyDown _ _) =
   modify_ _ { formulaState = UnknownFormula }
 
-handleAction (FormulaKeyUp x ev)
-  | elem x [ Space, Tab, Delete, Comma ]
-      || elem x (OtherKeyCode <$> [ "BracketLeft", "BracketRight" ])
-      || shiftKey ev
-      && elem x (DigitKeyCode <$> [ 9, 0 ]) =
-      performSyntaxHighlight
-  | otherwise = pure unit
+handleAction (FormulaKeyUp _ _) =
+  performSyntaxHighlight
 
 handleAction (FocusInFormula _) =
   whenM (not <$> gets _.activeFormula)
@@ -142,7 +138,7 @@ handleAction (KeyDown Enter ev)
         { activeInput = not st.activeInput }
       focusCellElem selectedCell $ whenMaybe activeInput inputElement
 
-handleAction (KeyDown Tab ev) = selectCell move
+handleAction (KeyDown Tab ev) = withPrevent ev $ selectCell move
   where
   move
     | shiftKey ev = PrevCell

src/Components/Table/HandlerHelpers.purs

@@ -5,11 +5,11 @@ import Prim hiding (Row)
 
 import App.Components.Table.Cell (Cell, CellMove, Column, Row(..), columnParser, rowParser)
 import App.Components.Table.Formula (FormulaId, FormulaState(..), getDependencies, newFormulaId, toDependenciesMap)
-import App.Components.Table.Models (AppState)
+import App.Components.Table.Models (Action(..), AppState)
 import App.Components.Table.Selection (MultiSelection(..), SelectionState(..), computeNextSelection, deserializeSelectionValues, getCellFromMove, getTargetCells, serializeSelectionValues)
 import App.Interpreter.Formula (runFormula)
 import App.Interpreter.Module (reloadModule)
-import App.Utils.Dom (class IsEvent, emptyFormulaBox, focusCell, getClipboard, getFormulaBoxContents, getVisibleCols, getVisibleRows, parseElements, scrollByX, shiftKey, withPrevent)
+import App.Utils.Dom (class IsEvent, emptyFormulaBox, focusCell, getClipboard, getFormulaBoxContents, getVisibleCols, getVisibleRows, parseElements, scrollCellLeft, scrollCellRight, shiftKey, withPrevent)
 import App.Utils.HashMap (updateJust) as HashMap
 import Bookhound.Parser (runParser)
 import Data.HashMap (delete, insert, keys, lookup, union, unionWith) as HashMap
@@ -20,11 +20,15 @@ import Data.Tree (Forest)
 import Effect.Class.Console as Logger
 import Foreign (ForeignError, readString, unsafeToForeign)
 import Foreign.Index ((!))
+import Halogen (HalogenM, subscribe')
+import Halogen.Query.Event (eventListener)
 import Promise.Aff as Promise
 import Web.Clipboard (readText, writeText)
 import Web.DOM (Element)
-import Web.DOM.Element (scrollWidth)
+import Web.Event.Event (EventType(..))
 import Web.HTML (window)
+import Web.HTML.HTMLDocument as HTMLDocument
+import Web.HTML.Window as Window
 import Web.UIEvent.KeyboardEvent (KeyboardEvent)
 
 cellArrowMove
@@ -110,32 +114,30 @@ getPrelude = runExceptT
 selectCell
   :: forall m. MonadEffect m => MonadState AppState m => CellMove -> m Unit
 selectCell move = do
-  originCell <- gets _.selectedCell
-  { selectedCell, rows } <- modify \st -> st
+  target <- goToCell move
+  modify_ _
     { activeInput = false
     , multiSelection = NoSelection
-    , selectedCell = getCellFromMove move st.selectedCell
+    , selectedCell = target
     }
-  visibleCols <- getVisibleCols
-  visibleRows <- getVisibleRows
-  goToCell visibleCols visibleRows rows originCell selectedCell
 
 goToCell
   :: forall m
    . MonadEffect m
   => MonadState AppState m
-  => Array Element
-  -> Array Element
-  -> NonEmptyArray Row
-  -> Cell
-  -> Cell
-  -> m Unit
-goToCell visibleCols visibleRows rows origin target = do
+  => CellMove
+  -> m Cell
+goToCell move = do
+  { rows, selectedCell: origin } <- get
+  let target = getCellFromMove move origin
+  visibleCols <- getVisibleCols
+  visibleRows <- getVisibleRows
   cols <- parseElements parseColumns visibleCols
   adjustRows (length visibleRows - 1) target.row
     (maximum1 rows)
     (minimum1 rows)
   liftEffect $ goToCellHelper cols origin target visibleCols
+  pure target
   where
   parseColumns = hush <<< runParser columnParser
 
@@ -147,28 +149,29 @@ goToCellHelper
   -> Effect Unit
 goToCellHelper cols origin { column, row } visibleCols
 
-  | last' cols == Just column && top /= origin.column = do
-      width <- traverse scrollWidth $ head' visibleCols
-      scrollByX (coalesce width + 1.0) =<< window
+  | last' cols == Just column && origin.column /= top
+  , Just element <- head' visibleCols = do
+      scrollCellRight element
 
-  | head' cols == Just column && bottom /= origin.column = do
-      width <- traverse scrollWidth $ last' visibleCols
-      scrollByX (-(coalesce width + 1.0)) =<< window
+  | head' cols == Just column && origin.column /= bottom
+  , Just element <- head' visibleCols = do
+      scrollCellLeft element
 
   | otherwise = focusCell { column, row }
 
 adjustRows
   :: forall m. MonadState AppState m => Int -> Row -> Row -> Row -> m Unit
 adjustRows rowRange currentRow maxRow minRow
 
-  | inc currentRow > maxRow = modify_ _
-      { rows = clampBounded (currentRow - wrap (inc rowRange))
-          .. clampBounded (inc currentRow)
-      }
+  | inc currentRow > maxRow =
+      modify_ _
+        { rows = clampBounded (currentRow - wrap (rowRange))
+            .. clampBounded (inc currentRow)
+        }
 
   | currentRow < minRow = modify_ _
-      { rows = clampBounded currentRow
-          .. clampBounded (currentRow + wrap rowRange)
+      { rows = clampBounded (currentRow)
+          .. clampBounded (currentRow + wrap (rowRange))
       }
 
   | otherwise = pure unit
@@ -251,7 +254,29 @@ setRows = do
   let Row (firstRow) = head rows
   visibleRows <- parseElements parseRow =<< getVisibleRows
   modify_ _
-    { rows = Row <$> firstRow .. (firstRow + length visibleRows - 2) }
+    { rows = Row <$> firstRow .. (firstRow + length visibleRows + 2) }
   focusCell selectedCell
   where
   parseRow = hush <<< runParser rowParser
+
+subscribeSelectionChange
+  :: forall slots o m
+   . MonadEffect m
+  => HalogenM AppState Action slots o m Unit
+subscribeSelectionChange = do
+  doc <- liftEffect $ Window.document =<< window
+  subscribe' \_ -> eventListener
+    (EventType "selectionchange")
+    (HTMLDocument.toEventTarget doc)
+    (const $ Just SelectionChange)
+
+subscribeWindowResize
+  :: forall slots o m
+   . MonadEffect m
+  => HalogenM AppState Action slots o m Unit
+subscribeWindowResize = do
+  window' <- liftEffect window
+  subscribe' \_ -> eventListener
+    (EventType "resize")
+    (Window.toEventTarget window')
+    (const $ Just ResizeWindow)

src/Components/Table/Models.purs

@@ -56,6 +56,7 @@ data Action
   | HoverHeader EventTransition Header MouseEvent
   | DragHeader EventTransition Header DragEvent
   | SelectionChange
+  | ResizeWindow
 
 data EventTransition
   = Start

src/FatPrelude.purs

@@ -3,7 +3,7 @@ module FatPrelude
   ) where
 
 import App.Utils.Array (arr2, deleteAt', drop', dropEnd', findIndex', findLastIndex', head', index', init', insertAt', intersperse', last', slice', sliceNext', splitAt', tail', take', takeEnd', toArray', uncons', unsnoc', updateAt', zip', zipWith') as X
-import App.Utils.Bounded (allValues, clampBounded, getInBoundedRange, inBoundedRange, inRange, (..)) as X
+import App.Utils.Bounded (clampBounded, enumValues, getInBoundedRange, inBoundedRange, inRange, (..)) as X
 import App.Utils.Char (fromUpper, nextChar, prevChar, toUpper, upperEndCode, upperStartCode) as X
 import App.Utils.Common (partialMaybe) as X
 import App.Utils.Foldable (findMapEither, intercalate1, maximum1, maximumBy1, minimum1, minimumBy1) as X

src/Utils/Bounded.purs

@@ -5,15 +5,15 @@ import Prelude
 import App.Utils.Maybe (whenMaybe')
 import App.Utils.Number (inc)
 import Bookhound.FatPrelude (class Newtype)
-import Data.Enum (class Enum, Cardinality, enumFromTo)
+import Data.Enum (class BoundedEnum, Cardinality, enumFromTo)
 import Data.Maybe (Maybe)
 import Data.Newtype (unwrap, wrap)
 import Data.Unfoldable1 (class Unfoldable1)
 
 infixr 8 enumFromTo as ..
 
-allValues :: forall a f. Enum a => Unfoldable1 f => Bounded a => f a
-allValues = enumFromTo bottom top
+enumValues :: forall a f. BoundedEnum a => Unfoldable1 f => f a
+enumValues = enumFromTo bottom top
 
 getInBoundedRange :: forall a. Bounded a => a -> Maybe a
 getInBoundedRange = whenMaybe' inBoundedRange