diff options
| author | Josh Rahm <rahm@google.com> | 2022-11-21 12:05:03 -0700 |
|---|---|---|
| committer | Josh Rahm <rahm@google.com> | 2022-11-21 12:05:03 -0700 |
| commit | ee9be16599f20aef6d1d3fd15666c00452f85aba (patch) | |
| tree | 1aed66c1de2ce201463e3becc2d452d4a8aa2992 /src/Rahm/Desktop/Layout/List.hs | |
| parent | a1636c65e05d02f7d4fc408137e1d37b412ce890 (diff) | |
| download | rde-ee9be16599f20aef6d1d3fd15666c00452f85aba.tar.gz rde-ee9be16599f20aef6d1d3fd15666c00452f85aba.tar.bz2 rde-ee9be16599f20aef6d1d3fd15666c00452f85aba.zip | |
Format with ormolu.
Diffstat (limited to 'src/Rahm/Desktop/Layout/List.hs')
| -rw-r--r-- | src/Rahm/Desktop/Layout/List.hs | 125 |
1 files changed, 72 insertions, 53 deletions
diff --git a/src/Rahm/Desktop/Layout/List.hs b/src/Rahm/Desktop/Layout/List.hs index d6ab6ba..787697e 100644 --- a/src/Rahm/Desktop/Layout/List.hs +++ b/src/Rahm/Desktop/Layout/List.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE UndecidableInstances, TypeOperators #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} {- - This module provides a more powerful version of the "Choose" layout that can @@ -7,34 +8,36 @@ - 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, - toIndexedLayout, - (|:), - nil, - layoutListLength, - layoutListLengthProxy - )where +module Rahm.Desktop.Layout.List + ( LayoutList, + layoutList, + LCons, + LNil, + toNextLayout, + toPreviousLayout, + toFirstLayout, + toIndexedLayout, + (|:), + nil, + layoutListLength, + layoutListLengthProxy, + ) +where import Control.Applicative ((<|>)) import Control.Arrow (second, (>>>)) import Control.Monad.Identity (runIdentity) -import Data.Maybe (fromMaybe, fromJust) +import Data.Maybe (fromJust, fromMaybe) import Data.Proxy import Data.Void import GHC.TypeLits -import XMonad import qualified Rahm.Desktop.StackSet as W +import XMonad -- 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 @@ -55,20 +58,25 @@ data LCons l t a = LCons (l a) (t a) deriving (Read, Show) -- -- 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 +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 +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 @@ -118,7 +126,6 @@ instance (Selector t) => Selector (Sel t) where -- 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 @@ -155,9 +162,12 @@ intToSelector n = incrementCycle $ intToSelector (n - 1) data LayoutList l a where LayoutList :: (LayoutSelect l a, Selector (SelectorFor l)) => - SelectorFor l -> l a -> LayoutList l a + 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) -- Type family to get the LengthOf a ConsList. @@ -183,8 +193,10 @@ 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 :: + (LayoutSelect l a, SelectorFor l ~ Sel n) => + l a -> + LayoutList l a layoutList = LayoutList Sel -- The termination of a layout zipper. @@ -193,11 +205,11 @@ 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) + -- 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 @@ -213,28 +225,34 @@ toFirstLayout = NavigateLayout (`fromMaybe` initial) -- NavigateLayout instance to go to an indexed layout. toIndexedLayout :: Int -> NavigateLayout -toIndexedLayout i = NavigateLayout $ - (`fromMaybe` initial) >>> addSelector (intToSelector i) +toIndexedLayout i = + NavigateLayout $ + (`fromMaybe` initial) >>> addSelector (intToSelector i) -instance Message NavigateLayout where +instance Message NavigateLayout -- 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 - +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) => + update :: + forall r m. + (Monad m) => -- The selector for this type. Determines which layout the function is -- applied to. SelectorFor l -> @@ -243,18 +261,19 @@ class (Show (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 - +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. @@ -278,19 +297,19 @@ instance LayoutSelect LNil a where -- 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 - +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 + 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 |