1 files changed, 25 insertions, 80 deletions
diff --git a/src/Internal/LayoutZipper.hs b/src/Internal/LayoutZipper.hs
index 787fe4f..136b913 100644
--- a/src/Internal/LayoutZipper.hs
+++ b/src/Internal/LayoutZipper.hs
@@ -3,7 +3,7 @@
  RankNTypes, TupleSections #-}
 
 {- This module provides a more powerful version of the choose layout, using a
- - list to store the layouts. -}
+ - list to store the layouts, and thus the list is navigatable. -}
 module Internal.LayoutZipper where
 
 import Control.Monad.Identity (runIdentity)
@@ -19,21 +19,38 @@ data LCons l t a = LCons (l a) (t a) deriving (Read, Show)
 data LayoutZipper l a = LayoutZipper Int (l a)
   deriving (Read, Show)
 
+-- Combinator for combining layouts together into a LayoutList. This amy then be
+-- used with the layoutZipper to create a layout zipper.
 (|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
 (|:) = LCons
 infixr 5 |:
 
+-- Create a layoutZipper that defaults to the first layout in the list.
 layoutZipper :: (LayoutSelect l a) => l a -> LayoutZipper l a
 layoutZipper = LayoutZipper 0
 
+-- The termination of a layout zipper.
 nil :: LNil a
 nil = LNil
 
+-- Message to navigate to a layout.
 data NavigateLayout =
-        ToNextLayout |
-        ToPreviousLayout |
-        SetLayout Int
-          deriving (Typeable, Show)
+          -- Sets the layout based on the given function.
+          SetLayout {
+            changeLayoutFn :: Int -> Int -- Function to use to change the layout.
+          , circularBool :: Bool -- True if the layouts should be treated as circular.
+          }
+          deriving (Typeable)
+
+toNextLayout :: NavigateLayout
+toNextLayout = SetLayout (+1) True
+
+toPreviousLayout :: NavigateLayout
+toPreviousLayout = SetLayout (\x -> x - 1) True
+
+toFirstLayout :: NavigateLayout
+toFirstLayout = SetLayout (const 0) True
+
 instance Message NavigateLayout where
 
 class LayoutSelect l a where
@@ -81,16 +98,9 @@ instance (Show (l a), Typeable l, LayoutSelect l a) => LayoutClass (LayoutZipper
       Nothing -> return ([], Nothing)
       Just (r, la) -> return (r, Just (LayoutZipper idx la))
 
-  handleMessage (LayoutZipper idx l) (fromMessage -> Just ToNextLayout) =
-    if idx < nLayouts l - 1
-      then return $ Just (LayoutZipper (idx + 1) l)
-      else return $ Just (LayoutZipper 0 l)
-  handleMessage (LayoutZipper idx l) (fromMessage -> Just ToPreviousLayout) =
-    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) (fromMessage -> Just (SetLayout fn circ)) =
+    let clip = if circ then mod else \i n -> max 0 $ min (n - 1) i in
+          return $ Just $ LayoutZipper (clip (fn idx) (nLayouts l)) l
 
   handleMessage (LayoutZipper idx l) m = do
     r <- update idx l $ \layout -> ((),) <$> handleMessage layout m
@@ -106,68 +116,3 @@ instance (Show (l a), Typeable l, LayoutSelect l a) => LayoutClass (LayoutZipper
       case r of
         Nothing -> "No Layout"
         Just (descr, _) -> descr
-
--- data LayoutZipper l a = LayoutZipper [Layout a] [Layout a]
---   deriving (Read, Show)
-
-
--- instance LayoutClass Layout a where
---   runLayout (W.Workspace i (Layout l) ms) r = do
---     (rects, new) <- runLayout (W.Workspace i l ms) r
---     return (rects, fmap Layout new)
---   doLayout (Layout l) r s = do
---     (rs, l') <- doLayout l r s
---     return (rs, fmap Layout l')
---   pureLayout (Layout l) r s = pureLayout l r s
---   emptyLayout (Layout l) = (fmap . second . fmap) Layout . emptyLayout l
---   handleMessage (Layout l) = (fmap . fmap) Layout . handleMessage l
---   pureMessage (Layout l) = fmap Layout . pureMessage l
---   description (Layout l) = description l
-
--- replaceHead :: LayoutZipper a -> Layout a ->  LayoutZipper a
--- replaceHead (LayoutZipper (_:hs) ts) h = LayoutZipper (h:hs) ts
--- replaceHead z _ = z
--- 
--- nil :: LayoutZipper a
--- nil = LayoutZipper [] []
--- 
--- (|:) :: (Read (l a), LayoutClass l a) => l a -> LayoutZipper a -> LayoutZipper a
--- (|:) l (LayoutZipper h t) = LayoutZipper (Layout l : h) t
--- 
--- infixr 5 |:
--- 
--- 
--- 
--- instance (LayoutClass Layout a) => LayoutClass LayoutZipper a where
---   runLayout (W.Workspace i z@(LayoutZipper (a:_) _) ms) = do
---     fmap (second . fmap $ replaceHead z) .
---       runLayout (W.Workspace i a ms)
---   runLayout (W.Workspace _ z _) = emptyLayout z
--- 
---   doLayout z@(LayoutZipper (h:_) _) r s = do
---     (rects, mh) <- doLayout h r s
---     return (rects, fmap (replaceHead z) mh)
---   doLayout z r s = emptyLayout z r
--- 
---   pureLayout (LayoutZipper (h:_) _) = pureLayout h
---   pureLayout l = \_ _ -> []
--- 
---   emptyLayout z@(LayoutZipper (h:_) _) r = do
---     (rects, mh) <- emptyLayout h r
---     return (rects, replaceHead z <$> mh)
---   emptyLayout _ _ = return ([], Nothing)
--- 
---   handleMessage (LayoutZipper (hs) (t:ts)) (fromMessage -> Just ToNextLayout) =
---     return $ return $ LayoutZipper (t:hs) ts
---   handleMessage (LayoutZipper (h:hs) (ts)) (fromMessage -> Just ToPreviousLayout) =
---     return $
---      case hs of
---        [] -> Nothing
---        _ -> Just (LayoutZipper hs (h:ts))
---   handleMessage z@(LayoutZipper (h:_) _) m =
---     (fmap $ fmap $ replaceHead z) (handleMessage h m)
---   handleMessage _ _ = return Nothing
--- 
---   pureMessage z@(LayoutZipper (h:_) _) = fmap (replaceHead z) . pureMessage h
--- 
---   description (LayoutZipper (h:_) _) = description h