From c264ad435597ea6bf68c386195919209c8f2a3e3 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 8 Apr 2022 14:41:34 -0600
Subject: Cleanup and more documentation.

---
 src/Internal/LayoutZipper.hs | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

(limited to 'src/Internal/LayoutZipper.hs')

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
-- 
cgit