aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop/Layout
diff options
context:
space:
mode:
Diffstat (limited to 'src/Rahm/Desktop/Layout')
-rw-r--r--src/Rahm/Desktop/Layout/List.hs35
1 files changed, 29 insertions, 6 deletions
diff --git a/src/Rahm/Desktop/Layout/List.hs b/src/Rahm/Desktop/Layout/List.hs
index 96f9be5..f533ea2 100644
--- a/src/Rahm/Desktop/Layout/List.hs
+++ b/src/Rahm/Desktop/Layout/List.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableInstances, TypeOperators #-}
{-
- This module provides a more powerful version of the "Choose" layout that can
@@ -15,18 +15,22 @@ module Rahm.Desktop.Layout.List (
toNextLayout,
toPreviousLayout,
toFirstLayout,
+ toIndexedLayout,
(|:),
- nil
+ nil,
+ layoutListLength,
+ layoutListLengthProxy
)where
import Control.Applicative ((<|>))
-import Data.Void
+import Control.Arrow (second, (>>>))
import Control.Monad.Identity (runIdentity)
import Data.Maybe (fromMaybe, fromJust)
-import Control.Arrow (second)
+import Data.Proxy
+import Data.Void
+import GHC.TypeLits
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.
@@ -156,6 +160,20 @@ data LayoutList l a where
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.
+type family LengthOf (x :: * -> *) :: Nat where
+ LengthOf LNil = 0
+ LengthOf (LCons l t) = 1 + LengthOf t
+
+-- Length of a LayoutList. This is calculated at Compile-time using
+-- typefamilies and Nat TypeLits.
+layoutListLength :: forall l n a. (LengthOf l ~ n, KnownNat n) => LayoutList l a -> Int
+layoutListLength = fromIntegral . natVal . layoutListLengthProxy
+
+-- Proxy for the type-level Nat length of a LayoutList.
+layoutListLengthProxy :: (LengthOf l ~ n) => LayoutList l a -> Proxy n
+layoutListLengthProxy _ = Proxy
+
-- Cons two LayoutSelect types together.
(|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
(|:) = LCons
@@ -189,10 +207,15 @@ toNextLayout = NavigateLayout $ addSelector (intToSelector 1)
toPreviousLayout :: NavigateLayout
toPreviousLayout = NavigateLayout $ \c -> fromMaybe c (decrement c <|> final)
--- NavigateLayotu instance to move to the first layout.
+-- NavigateLayout instance to move to the first layout.
toFirstLayout :: NavigateLayout
toFirstLayout = NavigateLayout (`fromMaybe` initial)
+-- NavigateLayout instance to go to an indexed layout.
+toIndexedLayout :: Int -> NavigateLayout
+toIndexedLayout i = NavigateLayout $
+ (`fromMaybe` initial) >>> addSelector (intToSelector i)
+
instance Message NavigateLayout where
-- LayoutSelect class Describes a type that can be used to select a layout using