{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TupleSections #-}
module XMonad.Layout.LayoutModifier (
LayoutModifier(..), ModifiedLayout(..)
) where
import XMonad.Prelude
import XMonad
import XMonad.StackSet ( Stack, Workspace (..) )
class (Show (m a), Read (m a)) => LayoutModifier m a where
modifyLayout :: (LayoutClass l a) =>
m a
-> Workspace WorkspaceId (l a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (l a))
modifyLayout m a
_ = forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace WorkspaceId (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout
modifyLayoutWithUpdate :: (LayoutClass l a) =>
m a
-> Workspace WorkspaceId (l a) a
-> Rectangle
-> X (([(a,Rectangle)], Maybe (l a)), Maybe (m a))
modifyLayoutWithUpdate m a
m Workspace WorkspaceId (l a) a
w Rectangle
r = (, forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a (l :: * -> *).
(LayoutModifier m a, LayoutClass l a) =>
m a
-> Workspace WorkspaceId (l a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (l a))
modifyLayout m a
m Workspace WorkspaceId (l a) a
w Rectangle
r
handleMess :: m a -> SomeMessage -> X (Maybe (m a))
handleMess m a
m SomeMessage
mess | Just LayoutMessages
Hide <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
mess = forall {a}. X (Maybe a)
doUnhook
| Just LayoutMessages
ReleaseResources <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
mess = forall {a}. X (Maybe a)
doUnhook
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
LayoutModifier m a =>
m a -> SomeMessage -> Maybe (m a)
pureMess m a
m SomeMessage
mess
where doUnhook :: X (Maybe a)
doUnhook = do forall (m :: * -> *) a. LayoutModifier m a => m a -> X ()
unhook m a
m; forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))
handleMessOrMaybeModifyIt m a
m SomeMessage
mess = do Maybe (m a)
mm' <- forall (m :: * -> *) a.
LayoutModifier m a =>
m a -> SomeMessage -> X (Maybe (m a))
handleMess m a
m SomeMessage
mess
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (m a)
mm')
pureMess :: m a -> SomeMessage -> Maybe (m a)
pureMess m a
_ SomeMessage
_ = forall a. Maybe a
Nothing
redoLayout :: m a
-> Rectangle
-> Maybe (Stack a)
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (m a))
redoLayout m a
m Rectangle
r Maybe (Stack a)
ms [(a, Rectangle)]
wrs = do forall (m :: * -> *) a. LayoutModifier m a => m a -> X ()
hook m a
m; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
LayoutModifier m a =>
m a
-> Rectangle
-> Maybe (Stack a)
-> [(a, Rectangle)]
-> ([(a, Rectangle)], Maybe (m a))
pureModifier m a
m Rectangle
r Maybe (Stack a)
ms [(a, Rectangle)]
wrs
pureModifier :: m a
-> Rectangle
-> Maybe (Stack a)
-> [(a, Rectangle)]
-> ([(a, Rectangle)], Maybe (m a))
pureModifier m a
_ Rectangle
_ Maybe (Stack a)
_ [(a, Rectangle)]
wrs = ([(a, Rectangle)]
wrs, forall a. Maybe a
Nothing)
hook :: m a -> X ()
hook m a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
unhook :: m a -> X ()
unhook m a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
modifierDescription :: m a -> String
modifierDescription = forall a b. a -> b -> a
const WorkspaceId
""
modifyDescription :: (LayoutClass l a) => m a -> l a -> String
modifyDescription m a
m l a
l = forall (m :: * -> *) a. LayoutModifier m a => m a -> WorkspaceId
modifierDescription m a
m WorkspaceId -> WorkspaceId -> WorkspaceId
`add` forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> WorkspaceId
description l a
l
where WorkspaceId
"" add :: WorkspaceId -> WorkspaceId -> WorkspaceId
`add` WorkspaceId
x = WorkspaceId
x
WorkspaceId
x `add` WorkspaceId
y = WorkspaceId
x forall a. [a] -> [a] -> [a]
++ WorkspaceId
" " forall a. [a] -> [a] -> [a]
++ WorkspaceId
y
instance (LayoutModifier m a, LayoutClass l a, Typeable m) => LayoutClass (ModifiedLayout m l) a where
runLayout :: Workspace WorkspaceId (ModifiedLayout m l a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (ModifiedLayout m l a))
runLayout (Workspace WorkspaceId
i (ModifiedLayout m a
m l a
l) Maybe (Stack a)
ms) Rectangle
r =
do (([(a, Rectangle)]
ws, Maybe (l a)
ml'),Maybe (m a)
mm') <- forall (m :: * -> *) a (l :: * -> *).
(LayoutModifier m a, LayoutClass l a) =>
m a
-> Workspace WorkspaceId (l a) a
-> Rectangle
-> X (([(a, Rectangle)], Maybe (l a)), Maybe (m a))
modifyLayoutWithUpdate m a
m (forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace WorkspaceId
i l a
l Maybe (Stack a)
ms) Rectangle
r
([(a, Rectangle)]
ws', Maybe (m a)
mm'') <- forall (m :: * -> *) a.
LayoutModifier m a =>
m a
-> Rectangle
-> Maybe (Stack a)
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (m a))
redoLayout (forall a. a -> Maybe a -> a
fromMaybe m a
m Maybe (m a)
mm') Rectangle
r Maybe (Stack a)
ms [(a, Rectangle)]
ws
let ml'' :: Maybe (ModifiedLayout m l a)
ml'' = case Maybe (m a)
mm'' forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe (m a)
mm' of
Just m a
m' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout m a
m' forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe l a
l Maybe (l a)
ml'
Maybe (m a)
Nothing -> forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout m a
m forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (l a)
ml'
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
ws', Maybe (ModifiedLayout m l a)
ml'')
handleMessage :: ModifiedLayout m l a
-> SomeMessage -> X (Maybe (ModifiedLayout m l a))
handleMessage (ModifiedLayout m a
m l a
l) SomeMessage
mess =
do Maybe (Either (m a) SomeMessage)
mm' <- forall (m :: * -> *) a.
LayoutModifier m a =>
m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))
handleMessOrMaybeModifyIt m a
m SomeMessage
mess
Maybe (l a)
ml' <- case Maybe (Either (m a) SomeMessage)
mm' of
Just (Right SomeMessage
mess') -> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l a
l SomeMessage
mess'
Maybe (Either (m a) SomeMessage)
_ -> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l a
l SomeMessage
mess
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe (Either (m a) SomeMessage)
mm' of
Just (Left m a
m') -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout m a
m' forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe l a
l Maybe (l a)
ml'
Maybe (Either (m a) SomeMessage)
_ -> forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout m a
m forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (l a)
ml'
description :: ModifiedLayout m l a -> WorkspaceId
description (ModifiedLayout m a
m l a
l) = forall (m :: * -> *) a (l :: * -> *).
(LayoutModifier m a, LayoutClass l a) =>
m a -> l a -> WorkspaceId
modifyDescription m a
m l a
l
data ModifiedLayout m l a = ModifiedLayout (m a) (l a) deriving ( ReadPrec [ModifiedLayout m l a]
ReadPrec (ModifiedLayout m l a)
ReadS [ModifiedLayout m l a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (m :: * -> *) (l :: * -> *) a.
(Read (m a), Read (l a)) =>
ReadPrec [ModifiedLayout m l a]
forall (m :: * -> *) (l :: * -> *) a.
(Read (m a), Read (l a)) =>
ReadPrec (ModifiedLayout m l a)
forall (m :: * -> *) (l :: * -> *) a.
(Read (m a), Read (l a)) =>
Int -> ReadS (ModifiedLayout m l a)
forall (m :: * -> *) (l :: * -> *) a.
(Read (m a), Read (l a)) =>
ReadS [ModifiedLayout m l a]
readListPrec :: ReadPrec [ModifiedLayout m l a]
$creadListPrec :: forall (m :: * -> *) (l :: * -> *) a.
(Read (m a), Read (l a)) =>
ReadPrec [ModifiedLayout m l a]
readPrec :: ReadPrec (ModifiedLayout m l a)
$creadPrec :: forall (m :: * -> *) (l :: * -> *) a.
(Read (m a), Read (l a)) =>
ReadPrec (ModifiedLayout m l a)
readList :: ReadS [ModifiedLayout m l a]
$creadList :: forall (m :: * -> *) (l :: * -> *) a.
(Read (m a), Read (l a)) =>
ReadS [ModifiedLayout m l a]
readsPrec :: Int -> ReadS (ModifiedLayout m l a)
$creadsPrec :: forall (m :: * -> *) (l :: * -> *) a.
(Read (m a), Read (l a)) =>
Int -> ReadS (ModifiedLayout m l a)
Read, Int -> ModifiedLayout m l a -> WorkspaceId -> WorkspaceId
forall a.
(Int -> a -> WorkspaceId -> WorkspaceId)
-> (a -> WorkspaceId)
-> ([a] -> WorkspaceId -> WorkspaceId)
-> Show a
forall (m :: * -> *) (l :: * -> *) a.
(Show (m a), Show (l a)) =>
Int -> ModifiedLayout m l a -> WorkspaceId -> WorkspaceId
forall (m :: * -> *) (l :: * -> *) a.
(Show (m a), Show (l a)) =>
[ModifiedLayout m l a] -> WorkspaceId -> WorkspaceId
forall (m :: * -> *) (l :: * -> *) a.
(Show (m a), Show (l a)) =>
ModifiedLayout m l a -> WorkspaceId
showList :: [ModifiedLayout m l a] -> WorkspaceId -> WorkspaceId
$cshowList :: forall (m :: * -> *) (l :: * -> *) a.
(Show (m a), Show (l a)) =>
[ModifiedLayout m l a] -> WorkspaceId -> WorkspaceId
show :: ModifiedLayout m l a -> WorkspaceId
$cshow :: forall (m :: * -> *) (l :: * -> *) a.
(Show (m a), Show (l a)) =>
ModifiedLayout m l a -> WorkspaceId
showsPrec :: Int -> ModifiedLayout m l a -> WorkspaceId -> WorkspaceId
$cshowsPrec :: forall (m :: * -> *) (l :: * -> *) a.
(Show (m a), Show (l a)) =>
Int -> ModifiedLayout m l a -> WorkspaceId -> WorkspaceId
Show )