aboutsummaryrefslogtreecommitdiff
path: root/src/Internal/LayoutZipper.hs
diff options
context:
space:
mode:
authorJosh Rahm <rahm@google.com>2022-04-08 14:41:34 -0600
committerJosh Rahm <rahm@google.com>2022-04-08 14:41:34 -0600
commitc264ad435597ea6bf68c386195919209c8f2a3e3 (patch)
tree6c459c551fea6b2d3c813a2d66126b0478717736 /src/Internal/LayoutZipper.hs
parent1c5e867dd7183ffef0611d3bbbd50f06c1022328 (diff)
downloadrde-c264ad435597ea6bf68c386195919209c8f2a3e3.tar.gz
rde-c264ad435597ea6bf68c386195919209c8f2a3e3.tar.bz2
rde-c264ad435597ea6bf68c386195919209c8f2a3e3.zip
Cleanup and more documentation.
Diffstat (limited to 'src/Internal/LayoutZipper.hs')
-rw-r--r--src/Internal/LayoutZipper.hs9
1 files changed, 8 insertions, 1 deletions
diff --git a/src/Internal/LayoutZipper.hs b/src/Internal/LayoutZipper.hs
index d31360b..787fe4f 100644
--- a/src/Internal/LayoutZipper.hs
+++ b/src/Internal/LayoutZipper.hs
@@ -29,7 +29,11 @@ layoutZipper = LayoutZipper 0
nil :: LNil a
nil = LNil
-data NavigateLayout = ToNextLayout | ToPreviousLayout deriving (Typeable, Show)
+data NavigateLayout =
+ ToNextLayout |
+ ToPreviousLayout |
+ SetLayout Int
+ deriving (Typeable, Show)
instance Message NavigateLayout where
class LayoutSelect l a where
@@ -85,6 +89,9 @@ instance (Show (l a), Typeable l, LayoutSelect l a) => LayoutClass (LayoutZipper
if idx > 0
then return $ Just (LayoutZipper (idx - 1) l)
else return $ Just (LayoutZipper (nLayouts l - 1) l)
+ handleMessage (LayoutZipper _ l) (fromMessage -> Just (SetLayout i)) =
+ return $ Just $ LayoutZipper (max 0 $ min (nLayouts l - 1) $ i) l
+
handleMessage (LayoutZipper idx l) m = do
r <- update idx l $ \layout -> ((),) <$> handleMessage layout m
return $ LayoutZipper idx . snd <$> r