From baf56fd0bd78fcbd60086858ab65d2688e0d2709 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 12 Apr 2022 12:19:02 -0600
Subject: Clean up LayoutList and move to Layout.List

---
 src/Rahm/Desktop/Keys.hs              |   2 +-
 src/Rahm/Desktop/Layout.hs            |   4 +-
 src/Rahm/Desktop/Layout/LayoutList.hs | 295 ----------------------------------
 src/Rahm/Desktop/Layout/List.hs       | 280 ++++++++++++++++++++++++++++++++
 4 files changed, 283 insertions(+), 298 deletions(-)
 delete mode 100644 src/Rahm/Desktop/Layout/LayoutList.hs
 create mode 100644 src/Rahm/Desktop/Layout/List.hs

(limited to 'src/Rahm')

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 27de459..87f88cf 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -45,7 +45,6 @@ import XMonad.Actions.SpawnOn as SpawnOn
 import qualified Data.Map as Map
 import qualified XMonad.StackSet as W
 
-import Rahm.Desktop.Layout.LayoutList
 import Rahm.Desktop.MouseMotion
 import Rahm.Desktop.Windows
 import Rahm.Desktop.Lib
@@ -54,6 +53,7 @@ import Rahm.Desktop.PassMenu
 import Rahm.Desktop.Logger
 import Rahm.Desktop.RebindKeys
 import Rahm.Desktop.Swallow
+import Rahm.Desktop.Layout.List (toNextLayout, toPreviousLayout, toFirstLayout)
 import Rahm.Desktop.Layout.Hole (toggleHole)
 import Rahm.Desktop.Layout.Pop (togglePop)
 import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index aeceff9..b416111 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -25,7 +25,7 @@ import XMonad.Core
 import XMonad.Layout.NoBorders (smartBorders, noBorders)
 
 import Rahm.Desktop.Layout.CornerLayout (Corner(..))
-import Rahm.Desktop.Layout.LayoutList
+import Rahm.Desktop.Layout.List
 import Rahm.Desktop.Windows
 import Rahm.Desktop.Layout.ReinterpretMessage
 import Rahm.Desktop.Layout.Pop
@@ -44,7 +44,7 @@ mods =
 myLayout =
   fullscreenFull $
     avoidStruts $
-        layoutZipper $
+        layoutList $
           mods (reinterpretIncMaster $ spiral (6/7)) |:
           mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
           mods (reinterpretIncMaster $ Corner (3/4) (3/100)) |:
diff --git a/src/Rahm/Desktop/Layout/LayoutList.hs b/src/Rahm/Desktop/Layout/LayoutList.hs
deleted file mode 100644
index 3e72e99..0000000
--- a/src/Rahm/Desktop/Layout/LayoutList.hs
+++ /dev/null
@@ -1,295 +0,0 @@
-{-# LANGUAGE UndecidableInstances #-}
-
-{-
- - 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 Rahm.Desktop.Layout.LayoutList (
-  LayoutList,
-  layoutZipper,
-  LCons,
-  LNil,
-  toNextLayout,
-  toPreviousLayout,
-  toFirstLayout,
-  (|:),
-  nil
-  )where
-
-import Control.Applicative ((<|>))
-import Data.Void
-import Control.Monad.Identity (runIdentity)
-import Data.Maybe (fromMaybe, fromJust)
-import Control.Arrow (second)
-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)
-
--- 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 End)))
---
--- 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 End) can only be in the Sel as End 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)
-deriving instance (Eq l, Selector l) => Eq (Sel l)
-
--- Reimplement Void as End, just to keep the two separate, but End is for all
--- intents and purposes Void.
-data End
-deriving instance Read End
-deriving instance Show End
-deriving instance Eq End
-
-
--- 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 (Eq c) => 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 End structure (which is equivalent to Void) is the "null" selector; the
--- basecase that the Sel selector terminates at.
-instance Selector End where
-
-  -- Incrementing the End Selector doesn't do anything.
-  increment = const Nothing
-
-  -- Decrementing the End Selector doesn't do anythig
-  decrement = const Nothing
-
-  -- There is no initial value for the End selector.
-  initial = Nothing
-
-  -- There is not final state for the End selector.
-  final = Nothing
-
--- Increment a selector, but cyclicly
-incrementCycle :: (Selector c) => c -> c
-incrementCycle c =
-  case increment c of
-    Nothing -> fromMaybe c initial
-    Just x -> x
-
--- Add two selectors together, incrementing the first until the second cannot be
--- incremented anymore.
-addSelector :: (Selector c) => c -> c -> c
-addSelector c1 c2 = addSel c1 (decrement c2)
-  where
-    addSel c1 Nothing = c1
-    addSel c1 (Just c2) = addSel (incrementCycle c1) (decrement c2)
-
--- Turn an int into a selector by repeatably incrementing.
-intToSelector :: (Selector c) => Int -> c
-intToSelector 0 = fromJust initial
-intToSelector n = incrementCycle $ intToSelector (n - 1)
-
--- A LayoutList consists of a LayoutSelect type and a corresponding Selector.
-data LayoutList l a where
-  LayoutList ::
-    (LayoutSelect l a, Selector (SelectorFor l)) =>
-      SelectorFor l -> l a -> LayoutList l a
-
-deriving instance (LayoutSelect l a) => Show (LayoutList l a)
-deriving instance (LayoutSelect l a) => Read (LayoutList l a)
-
-(|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
-(|:) = LCons
-
-infixr 5 |: 
-
--- Constructs a LayoutList. 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 LayoutList cannot be constructed.
-layoutZipper :: (LayoutSelect l a, SelectorFor l ~ Sel n) =>
-  l a -> LayoutList l a
-layoutZipper = LayoutList Sel
-
--- The termination of a layout zipper.
-nil :: LNil a
-nil = LNil
-
--- Message to navigate to a layout.
-newtype NavigateLayout =
-          -- Sets the layout based on the given function.
-          NavigateLayout {
-            changeLayoutFn :: forall c. (Selector c) => c -> c
-          }
-          deriving (Typeable)
-
--- NavigateLayout instance to move to the next layout, circularly.
-toNextLayout :: NavigateLayout
-toNextLayout = NavigateLayout $ addSelector (intToSelector 1)
-
--- NavigateLayout instance to move to the previous layout, circularly.
-toPreviousLayout :: NavigateLayout
-toPreviousLayout = NavigateLayout $ \c -> fromMaybe c (decrement c <|> final)
-
--- NavigateLayotu instance to move to the first layout.
-toFirstLayout :: NavigateLayout
-toFirstLayout = NavigateLayout (`fromMaybe` initial)
-
-instance Message NavigateLayout where
-
--- 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) =>
-    -- 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))) ->
-
-    -- Returns a result r, and an updated LayoutSelect.
-    m (Maybe (r, l a))
-
--- 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
-
-  -- The SelectorFor Cons is Sel (SelectorFor t). This creates the structure
-  -- Sel (Sel (Sel ( ... (Sel End) .. ))) 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)
-
-  -- 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)
-
-  -- 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
-
--- 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 End type.
-instance LayoutSelect LNil a where
-  type SelectorFor LNil = End -- LNil cannot be selected.
-  update _ _ _ = return Nothing
-
--- Instance of layout class for LayoutList. 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 (LayoutList l) a where
-
-  runLayout (W.Workspace i (LayoutList idx l) ms) r = do
-    r <- update idx l $ \layout ->
-            runLayout (W.Workspace i layout ms) r
-    case r of
-      Nothing -> return ([], Nothing)
-      Just (r, la) -> return (r, Just (LayoutList idx la))
-
-  pureLayout (LayoutList idx l) r s = runIdentity $ do
-    r <- update idx l $ \layout -> return (pureLayout layout r s, Nothing)
-    case r of
-      Nothing -> return []
-      Just (r, a) -> return r
-
-  emptyLayout (LayoutList idx l) r = do
-    r <- update idx l $ \layout -> emptyLayout layout r
-    case r of
-      Nothing -> return ([], Nothing)
-      Just (r, la) -> return (r, Just (LayoutList idx la))
-
-  handleMessage (LayoutList idx l) (fromMessage -> Just (NavigateLayout fn)) =
-    return $ Just (LayoutList (fn idx) l)
-
-  handleMessage (LayoutList idx l) m = do
-    r <- update idx l $ \layout -> ((),) <$> handleMessage layout m
-    return $ LayoutList idx . snd <$> r
-
-  pureMessage (LayoutList idx l) m = runIdentity $ do
-    r <- update idx l $ \layout -> return ((), pureMessage layout m)
-    return $ LayoutList idx . snd <$> r
-
-  description (LayoutList idx l) = runIdentity $ do
-    r <- update idx l $ \l -> return (description l, Nothing)
-    return $
-      case r of
-        Nothing -> "No Layout"
-        Just (descr, _) -> descr
diff --git a/src/Rahm/Desktop/Layout/List.hs b/src/Rahm/Desktop/Layout/List.hs
new file mode 100644
index 0000000..96f9be5
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/List.hs
@@ -0,0 +1,280 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+{-
+ - 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 Rahm.Desktop.Layout.List (
+  LayoutList,
+  layoutList,
+  LCons,
+  LNil,
+  toNextLayout,
+  toPreviousLayout,
+  toFirstLayout,
+  (|:),
+  nil
+  )where
+
+import Control.Applicative ((<|>))
+import Data.Void
+import Control.Monad.Identity (runIdentity)
+import Data.Maybe (fromMaybe, fromJust)
+import Control.Arrow (second)
+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)
+
+-- 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 End)))
+--
+-- 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 End) can only be in the Sel as End 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)
+deriving instance (Eq l, Selector l) => Eq (Sel l)
+
+-- Reimplement Void as End, just to keep the two separate, but End is for all
+-- intents and purposes Void.
+data End
+deriving instance Read End
+deriving instance Show End
+deriving instance Eq End
+
+
+-- 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 (Eq c) => 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 End structure (which is equivalent to Void) is the "null" selector; the
+-- basecase that the Sel selector terminates at.
+instance Selector End where
+
+  -- Incrementing the End Selector doesn't do anything.
+  increment = const Nothing
+
+  -- Decrementing the End Selector doesn't do anythig
+  decrement = const Nothing
+
+  -- There is no initial value for the End selector.
+  initial = Nothing
+
+  -- There is not final state for the End selector.
+  final = Nothing
+
+-- Increment a selector, but cyclicly
+incrementCycle :: (Selector c) => c -> c
+incrementCycle c =
+  case increment c of
+    Nothing -> fromMaybe c initial
+    Just x -> x
+
+-- Add two selectors together, incrementing the first until the second cannot be
+-- incremented anymore.
+addSelector :: (Selector c) => c -> c -> c
+addSelector c1 c2 = addSel c1 (decrement c2)
+  where
+    addSel c1 Nothing = c1
+    addSel c1 (Just c2) = addSel (incrementCycle c1) (decrement c2)
+
+-- Turn an int into a selector by repeatably incrementing.
+intToSelector :: (Selector c) => Int -> c
+intToSelector 0 = fromJust initial
+intToSelector n = incrementCycle $ intToSelector (n - 1)
+
+-- A LayoutList consists of a LayoutSelect type and a corresponding Selector.
+data LayoutList l a where
+  LayoutList ::
+    (LayoutSelect l a, Selector (SelectorFor l)) =>
+      SelectorFor l -> l a -> LayoutList l a
+
+deriving instance (LayoutSelect l a) => Show (LayoutList l a)
+deriving instance (LayoutSelect l a) => Read (LayoutList l a)
+
+-- Cons two LayoutSelect types together.
+(|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
+(|:) = LCons
+
+infixr 5 |: 
+
+-- Constructs a LayoutList. 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 LayoutList cannot be constructed.
+layoutList :: (LayoutSelect l a, SelectorFor l ~ Sel n) =>
+  l a -> LayoutList l a
+layoutList = LayoutList Sel
+
+-- The termination of a layout zipper.
+nil :: LNil a
+nil = LNil
+
+-- Message to navigate to a layout.
+newtype NavigateLayout =
+          -- Sets the layout based on the given function.
+          NavigateLayout {
+            changeLayoutFn :: forall c. (Selector c) => c -> c
+          }
+          deriving (Typeable)
+
+-- NavigateLayout instance to move to the next layout, circularly.
+toNextLayout :: NavigateLayout
+toNextLayout = NavigateLayout $ addSelector (intToSelector 1)
+
+-- NavigateLayout instance to move to the previous layout, circularly.
+toPreviousLayout :: NavigateLayout
+toPreviousLayout = NavigateLayout $ \c -> fromMaybe c (decrement c <|> final)
+
+-- NavigateLayotu instance to move to the first layout.
+toFirstLayout :: NavigateLayout
+toFirstLayout = NavigateLayout (`fromMaybe` initial)
+
+instance Message NavigateLayout where
+
+-- 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) =>
+    -- 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))) ->
+
+    -- Returns a result r, and an updated LayoutSelect.
+    m (Maybe (r, l a))
+
+-- 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
+
+  -- The SelectorFor Cons is Sel (SelectorFor t). This creates the structure
+  -- Sel (Sel (Sel ( ... (Sel End) .. ))) 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)
+
+  -- 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)
+
+  -- 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
+
+-- 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 End type.
+instance LayoutSelect LNil a where
+  type SelectorFor LNil = End -- LNil cannot be selected.
+  update _ _ _ = return Nothing
+
+-- Instance of layout class for LayoutList. 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 (LayoutList l) a where
+
+  runLayout (W.Workspace i (LayoutList idx l) ms) r = do
+    r <- update idx l $ \layout ->
+            runLayout (W.Workspace i layout ms) r
+    case r of
+      Nothing -> return ([], Nothing)
+      Just (r, la) -> return (r, Just (LayoutList idx la))
+
+  handleMessage (LayoutList idx l) (fromMessage -> Just (NavigateLayout fn)) =
+    return $ Just (LayoutList (fn idx) l)
+
+  handleMessage (LayoutList idx l) m = do
+    r <- update idx l $ \layout -> ((),) <$> handleMessage layout m
+    return $ LayoutList idx . snd <$> r
+
+  description (LayoutList idx l) = runIdentity $ do
+    r <- update idx l $ \l -> return (description l, Nothing)
+    return $
+      case r of
+        Nothing -> "No Layout"
+        Just (descr, _) -> descr
-- 
cgit