Prevent selection of unselectable items when scrolling

src/Dodge/SelectionSections.hs

@@ -3,9 +3,10 @@ module Dodge.SelectionSections (
     ssLookupDown,
     ssLookupGT,
     ssSetCursor,
-    firstPosSelectionSections,
+    setFirstPosSelectionSections,
 ) where
 
+import Control.Applicative
 import Control.Lens
 import qualified Data.IntMap.Strict as IM
 import Data.Maybe
@@ -17,33 +18,41 @@ scrollSelectionSections yi sss
     | yi > 0 = foldr ($) sss $ replicate yi scrollUpSelectionSections
     | otherwise = foldr ($) sss $ replicate (negate yi) scrollDownSelectionSections
 
--- when is this used? it needs to correctly set the cursor
-firstPosSelectionSections :: SelectionSections a -> SelectionSections a
-firstPosSelectionSections sss = fromMaybe sss $ do
+setFirstPosSelectionSections :: SelectionSections a -> SelectionSections a
+setFirstPosSelectionSections sss = fromMaybe sss $ do
     (i, j, _) <- ssLookupMin sss
-    return $
-        sss
-            & sssSelPos ?~ (i, j)
-
---        & sssSetCursor
---        & sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si)
-
---sssSetCursor :: SelectionSections a -> SelectionSections a
---sssSetCursor sss = sss
+    return $ sss & sssSelPos ?~ (i, j)
 
+--scrollUpSelectionSections :: SelectionSections a -> SelectionSections a
+--scrollUpSelectionSections sss = fromMaybe (setFirstPosSelectionSections sss) $ do
+--    (i, j) <- sss ^? sssSelPos . _Just
+--    (i', j', _) <- ssLookupUp i j sss
+--    return $ sss & sssSelPos ?~ (i', j')
 scrollUpSelectionSections :: SelectionSections a -> SelectionSections a
-scrollUpSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do
-    (i, j) <- sss ^? sssSelPos . _Just
-    (i', j', _) <- ssLookupUp i j sss
-    return $ sss & sssSelPos ?~ (i', j')
+scrollUpSelectionSections sss = sss & sssSelPos .~
+    fmap f (ssScrollUp (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable)))
+  where
+    f (i,j,_) = (i,j)
 
---        & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)
+ssScrollUp :: SelectionSections a -> Maybe (Int,Int,SelectionItem a)
+ssScrollUp sss = l <|> ssLookupMin sss
+  where
+    l = do
+        (i,j) <- sss ^? sssSelPos . _Just
+        ssLookupUp i j sss
+
+ssScrollDown :: SelectionSections a -> Maybe (Int,Int,SelectionItem a)
+ssScrollDown sss = l <|> ssLookupMin sss
+  where
+    l = do
+        (i,j) <- sss ^? sssSelPos . _Just
+        ssLookupDown i j sss
 
 scrollDownSelectionSections :: SelectionSections a -> SelectionSections a
-scrollDownSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do
-    (i, j) <- sss ^? sssSelPos . _Just
-    (i', j', _) <- ssLookupDown i j sss
-    return $ sss & sssSelPos ?~ (i', j')
+scrollDownSelectionSections sss = sss & sssSelPos .~
+    fmap f (ssScrollDown (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable)))
+  where
+    f (i,j,_) = (i,j)
 
 --        & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)