Add type-static way to get the length of a LayoutList

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