From 219f18179a568b4fb10d4dccf77ca198664b042c Mon Sep 17 00:00:00 2001 From: David Roundy Date: Tue, 23 Oct 2007 15:56:38 +0200 Subject: add new LayoutCombinators module. darcs-hash:20071023135638-72aca-1b19cf35b57dcbf9ed6fa023b09977f3d457fa6b.gz --- LayoutCombinators.hs | 41 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) create mode 100644 LayoutCombinators.hs (limited to 'LayoutCombinators.hs') diff --git a/LayoutCombinators.hs b/LayoutCombinators.hs new file mode 100644 index 0000000..c7e065d --- /dev/null +++ b/LayoutCombinators.hs @@ -0,0 +1,41 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.LayoutCombinators +-- Copyright : (c) David Roundy +-- License : BSD +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : portable +-- +-- A module for combining Layouts +----------------------------------------------------------------------------- + +module XMonadContrib.LayoutCombinators ( + -- * Usage + -- $usage + (<|>), (), (<||>), () + ) where + +import XMonad +import Operations ( Tall(..), Mirror(..) ) +import XMonadContrib.Combo +import XMonadContrib.DragPane + +-- $usage +-- Use LayoutCombinators to easily combine Layouts. + +(<||>), () :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => + l1 a -> l2 a -> CombineTwo DragPane l1 l2 a +(<|>) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) + => l1 a -> l2 a -> CombineTwo Tall l1 l2 a +() :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) + => l1 a -> l2 a -> CombineTwo (Mirror Tall) l1 l2 a + +(<||>) = combineTwo (dragPane Vertical 0.1 0.5) +() = combineTwo (dragPane Horizontal 0.1 0.5) +(<|>) = combineTwo (Tall 1 0.1 0.5) +() = combineTwo (Mirror $ Tall 1 0.1 0.5) -- cgit v1.2.3