Document, and make better LayoutZipper.

Now LayoutZipper can be circular, which means layout switching operates
semantically identically to how it did before making the typesafe
selector.

The selector was very much an acedemic exercise, but since it is working
as expect, I will keep it. I like the type-safety and it can be used as
an example for similar exercises.

1 files changed, 175 insertions, 71 deletions

diff --git a/src/Internal/LayoutZipper.hs b/src/Internal/LayoutZipper.hs
index 7af7d7b..7fd4a5f 100644
--- a/src/Internal/LayoutZipper.hs
+++ b/src/Internal/LayoutZipper.hs
@@ -2,10 +2,26 @@
  FlexibleContexts, UndecidableInstances, ViewPatterns, StandaloneDeriving,
  RankNTypes, TupleSections, TypeFamilies #-}
 
-{- This module provides a more powerful version of the choose layout, using a
- - list to store the layouts, and thus the list is navigatable. -}
-module Internal.LayoutZipper where
-
+{-
+ - This module provides a more powerful version of the "Choose" layout that can
+ - be bidirectionally navigated.
+ -
+ - The indexing uses a type-safe zipper to keep track of the currently-selected
+ - layout.
+ -}
+module Internal.LayoutZipper (
+  LayoutZipper,
+  layoutZipper,
+  LCons,
+  LNil,
+  toNextLayout,
+  toPreviousLayout,
+  toFirstLayout,
+  (|:),
+  nil
+  )where
+
+import Control.Applicative ((<|>))
 import Data.Void
 import Control.Monad.Identity (runIdentity)
 import Data.Maybe (fromMaybe)
@@ -14,43 +30,108 @@ import XMonad
 import qualified XMonad.StackSet as W
 import Data.Proxy
 
+-- Type-level lists. LNil is the final of the list. LCons contains a layout and a
+-- tail.
 data LNil a = LNil deriving (Read, Show)
 data LCons l t a = LCons (l a) (t a) deriving (Read, Show)
 
-data IsSelected l = Selected | NotSelected l
-  deriving (Read, Show)
-
--- Combinator for combining layouts together into a LayoutList. This amy then be
--- used with the layoutZipper to create a layout zipper.
-class SelectionClass c where
-  nextSelection :: c -> c
-  prevSelection :: c -> c
-  firstSelection :: Maybe c
-  isSelected :: c -> Bool
-
-instance (SelectionClass t) => SelectionClass (IsSelected t) where
-  nextSelection (NotSelected l) = NotSelected (nextSelection l)
-  nextSelection Selected = maybe Selected NotSelected firstSelection 
-
-  firstSelection = Just Selected
-
-  prevSelection (NotSelected t) =
-    if isSelected t
-      then Selected
-      else NotSelected (prevSelection t)
-  prevSelection Selected = Selected
-
-  isSelected Selected = True
-  isSelected _ = False
-
-instance SelectionClass Void where
-  nextSelection = absurd
-  prevSelection = absurd
-  firstSelection = Nothing
-  isSelected = const False
-
+-- Sel - This defines a structure where either this selected, or some
+-- other element is selected.
+--
+-- These types can be composed to create what is effectively a bounded integer.
+-- I.e. there can be a type like
+--
+-- Sel (Sel (Sel (Sel Zero)))
+--
+-- Such a type is equivalent to an integer bounded at 4, because this type can
+-- exist in no more than 4 states:
+--
+-- Sel
+-- Skip Sel
+-- Skip (Skip Sel)
+-- Skip (Skip (Skip Sel))
+--
+-- Note that a type (Sel Zero) can only be in the Sel as Zero may not be
+-- construted (without using undefined).
+data Sel l =
+    Sel |
+    (Selector l) => Skip l
+deriving instance (Read l, Selector l) => Read (Sel l)
+deriving instance (Show l, Selector l) => Show (Sel l)
+
+-- Reimplement Void as Zero, just to keep the two separate, but Zero is for all
+-- intents and purposes Void.
+data Zero
+deriving instance Read Zero
+deriving instance Show Zero
+
+
+-- Types that constitute a selection. Selections can be moved to the next
+-- selection, moved to the previous selection, optionally there could be a
+-- previous selection and they may be currently selected.
+class Selector c where
+  -- Increments the selection to the next state
+  --
+  -- Returns Nothing if the selection class is in the final state and cannot be
+  -- incremented any farther. (This is helpful to facilitate modular
+  -- arithmatic)
+  increment :: c -> Maybe c
+
+  -- Decrements the selection to the previous state. Returns Nothing if the
+  -- state is already in its initial setting.
+  decrement :: c -> Maybe c
+
+  -- The initial state.
+  initial :: Maybe c
+
+  -- The final state.
+  final :: Maybe c
+
+--
+-- Is selelected can be in two states:
+--
+--   1. The current element is selected
+--   2. The current element is not selected and another element deeper in the
+--      structure is selected.
+instance (Selector t) => Selector (Sel t) where
+  -- If the current element is not selected, increment the tail.
+  increment (Skip l) = Skip <$> increment l
+  -- If the current element is selected, the increment is just the initial of
+  -- the tail.
+  increment Sel = Skip <$> initial 
+
+  -- For a selection, the initial is just this in the Sel state.
+  initial = Just Sel
+
+  -- Looks ahead at the tail, sees if it is selected, if so, select this one
+  -- instead, if the one ahead isn't selected, then decrement that one.
+  decrement (Skip t) = Just $ maybe Sel Skip (decrement t)
+  decrement Sel = Nothing
+
+  -- Navigates to the end of the structure to find the final form.
+  final = Just $ maybe Sel Skip final
+
+-- The Zero structure (which is equivalent to Void) is the "null" selector; the
+-- basecase that the Sel selector terminates at.
+instance Selector Zero where
+
+  -- Incrementing the Zero Selector doesn't do anything.
+  increment = const Nothing
+
+  -- Decrementing the Zero Selector doesn't do anythig
+  decrement = const Nothing
+
+  -- There is no initial value for the Zero selector.
+  initial = Nothing
+
+  -- There is not final state for the Zero selector.
+  final = Nothing
+
+-- A LayoutZipper consists of a LayoutSelect type and a corresponding Selector.
 data LayoutZipper l a where
-  LayoutZipper :: (LayoutSelect l a) => Selection l -> l a -> LayoutZipper l a
+  LayoutZipper ::
+    (LayoutSelect l a, Selector (SelectorFor l)) =>
+      SelectorFor l -> l a -> LayoutZipper l a
 
 deriving instance (LayoutSelect l a) => Show (LayoutZipper l a)
 deriving instance (LayoutSelect l a) => Read (LayoutZipper l a)
@@ -60,8 +141,12 @@ deriving instance (LayoutSelect l a) => Read (LayoutZipper l a)
 
 infixr 5 |: 
 
-layoutZipper :: (LayoutSelect l a, Selection l ~ IsSelected n) => l a -> LayoutZipper l a
-layoutZipper = LayoutZipper Selected
+-- Constructs a LayoutZipper. This function enforces that the SelectorFor l
+-- is a 'Sel' type. Essentially this enforces that there must be at least one
+-- underlying layout, otherwise a LayoutZipper cannot be constructed.
+layoutZipper :: (LayoutSelect l a, SelectorFor l ~ Sel n) =>
+  l a -> LayoutZipper l a
+layoutZipper = LayoutZipper Sel
 
 -- The termination of a layout zipper.
 nil :: LNil a
@@ -71,68 +156,87 @@ nil = LNil
 newtype NavigateLayout =
           -- Sets the layout based on the given function.
           NavigateLayout {
-            changeLayoutFn :: forall c. (SelectionClass c) => c -> c
+            changeLayoutFn :: forall c. (Selector c) => c -> c
           }
           deriving (Typeable)
 
 -- NavigateLayout instance to move to the next layout, circularly.
 toNextLayout :: NavigateLayout
-toNextLayout = NavigateLayout nextSelection
+toNextLayout = NavigateLayout $ \c -> fromMaybe c (increment c <|> initial)
 
 -- NavigateLayout instance to move to the previous layout, circularly.
 toPreviousLayout :: NavigateLayout
-toPreviousLayout = NavigateLayout prevSelection
+toPreviousLayout = NavigateLayout $ \c -> fromMaybe c (decrement c <|> final)
 
 -- NavigateLayotu instance to move to the first layout.
 toFirstLayout :: NavigateLayout
-toFirstLayout = NavigateLayout (`fromMaybe` firstSelection)
+toFirstLayout = NavigateLayout (`fromMaybe` initial)
 
 instance Message NavigateLayout where
 
-class (
-     Show (l a),
-     Read (l a),
-     Read (Selection l),
-     Show (Selection l),
-     SelectionClass (Selection l)) => LayoutSelect l a where
-  type Selection l :: *
-
+-- LayoutSelect class Describes a type that can be used to select a layout using
+-- the associated type SelectorFor.
+--
+-- Instances of this class are LCons and LNil.
+class (Show (l a),
+       Read (l a),
+       Read (SelectorFor l),
+       Show (SelectorFor l),
+       Selector (SelectorFor l)) => LayoutSelect l a where
+
+  -- The selector that is used to update the layout corresponding to the
+  -- selector. This selector must be an instance of the Selector class.
+  type SelectorFor l :: *
+
+  -- Update applies a functor to the selected layout and maybe returns a result
+  -- and an updated layout.
   update :: forall r m. (Monad m) =>
-    Selection l ->
+    -- The selector for this type. Determines which layout the function is
+    -- applied to.
+    SelectorFor l ->
+    -- The LayoutSelect being modified.
     l a ->
+    -- Higher-ordered function to generically apply to the Layout associated
+    -- with the Selector. Works on all LayoutClass's.
     (forall l'. (LayoutClass l' a) => l' a -> m (r, Maybe (l' a))) ->
-    m (Maybe (r, l a))
-
-  nLayouts :: l a -> Int
 
-instance (
-        Read (l a),
-        LayoutClass l a,
-        LayoutSelect t a,
+    -- Returns a result r, and an updated LayoutSelect.
+    m (Maybe (r, l a))
 
-        Show (Selection t),
-        Read (Selection t)) =>
+-- Instance for LayoutSelect for cons
+instance (Read (l a),
+          LayoutClass l a,
+          LayoutSelect t a,
+          Show (SelectorFor t),
+          Read (SelectorFor t)) =>
     LayoutSelect (LCons l t) a where
 
-  -- This is something
-  type Selection (LCons l t) = IsSelected (Selection t)
+  -- The SelectorFor Cons is Sel (SelectorFor t). This creates the structure
+  -- Sel (Sel (Sel ( ... (Sel Zero) .. ))) where the number of Sel's match the
+  -- number of Cons in this structure enforcing safe selection.
+  type SelectorFor (LCons l t) = Sel (SelectorFor t)
 
-  update Selected (LCons layout t) fn = do
+  -- The current layout in this Cons-list is selected.
+  update Sel (LCons layout t) fn = do
     (r, layout') <- fn layout
     return $ Just (r, LCons (fromMaybe layout layout') t)
 
-  update (NotSelected s) (LCons l t) fn =
+  -- The current layout is not selected. Move on to another layout.
+  update (Skip s) (LCons l t) fn =
     fmap (second $ \t' -> LCons l t') <$> update s t fn
-  
-  nLayouts (LCons _ t) = 1 + nLayouts t
 
+-- LNil is a layout select. It doesn't do anything. Indeed update really can't
+-- be called on on this because that would require instantiating a Zero type.
 instance LayoutSelect LNil a where
-  type Selection LNil = Void -- Cannot be selected
-
+  type SelectorFor LNil = Zero -- LNil cannot be selected.
   update _ _ _ = return Nothing
-  nLayouts _ = 0
 
-instance (Show (l a), Typeable l, LayoutSelect l a) => LayoutClass (LayoutZipper l) a where
+-- Instance of layout class for LayoutZipper. The implementation for this
+-- just delegates to the underlying LayoutSelect class using the generic
+-- update method.
+instance (Show (l a), Typeable l, LayoutSelect l a) =>
+    LayoutClass (LayoutZipper l) a where
+
   runLayout (W.Workspace i (LayoutZipper idx l) ms) r = do
     r <- update idx l $ \layout ->
             runLayout (W.Workspace i layout ms) r