Clean up LayoutList and move to Layout.List

1 files changed, 0 insertions, 295 deletions

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