Rename LayoutZipper to LayoutList. Add more utils for handling a selector

1 files changed, 0 insertions, 275 deletions

diff --git a/src/Internal/LayoutZipper.hs b/src/Internal/LayoutZipper.hs
deleted file mode 100644
index 7fd4a5f..0000000
--- a/src/Internal/LayoutZipper.hs
+++ /dev/null
@@ -1,275 +0,0 @@
-{-# LANGUAGE GADTs, RankNTypes, FlexibleInstances, MultiParamTypeClasses,
- FlexibleContexts, UndecidableInstances, ViewPatterns, StandaloneDeriving,
- RankNTypes, TupleSections, TypeFamilies #-}
-
-{-
- - 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)
-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 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, 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)
-
-(|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
-(|:) = LCons
-
-infixr 5 |: 
-
--- 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
-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 $ \c -> fromMaybe c (increment c <|> initial)
-
--- 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 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)
-
-  -- 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 Zero type.
-instance LayoutSelect LNil a where
-  type SelectorFor LNil = Zero -- LNil cannot be selected.
-  update _ _ _ = return Nothing
-
--- 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
-    case r of
-      Nothing -> return ([], Nothing)
-      Just (r, la) -> return (r, Just (LayoutZipper idx la))
-
-  pureLayout (LayoutZipper 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 (LayoutZipper idx l) r = do
-    r <- update idx l $ \layout -> emptyLayout layout r
-    case r of
-      Nothing -> return ([], Nothing)
-      Just (r, la) -> return (r, Just (LayoutZipper idx la))
-
-  handleMessage (LayoutZipper idx l) (fromMessage -> Just (NavigateLayout fn)) =
-    return $ Just (LayoutZipper (fn idx) l)
-
-  handleMessage (LayoutZipper idx l) m = do
-    r <- update idx l $ \layout -> ((),) <$> handleMessage layout m
-    return $ LayoutZipper idx . snd <$> r
-
-  pureMessage (LayoutZipper idx l) m = runIdentity $ do
-    r <- update idx l $ \layout -> return ((), pureMessage layout m)
-    return $ LayoutZipper idx . snd <$> r
-
-  description (LayoutZipper idx l) = runIdentity $ do
-    r <- update idx l $ \l -> return (description l, Nothing)
-    return $
-      case r of
-        Nothing -> "No Layout"
-        Just (descr, _) -> descr