{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.StateFull
-- Description :  The StateFull Layout & FocusTracking Layout Transformer
-- Copyright   :  (c) 2018  L. S. Leary
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  L. S. Leary
-- Stability   :  unstable
-- Portability :  unportable
--
-- Provides StateFull: a stateful form of Full that does not misbehave when
-- floats are focused, and the FocusTracking layout transformer by means of
-- which StateFull is implemented. FocusTracking simply holds onto the last
-- true focus it was given and continues to use it as the focus for the
-- transformed layout until it sees another. It can be used to improve the
-- behaviour of a child layout that has not been given the focused window.
--------------------------------------------------------------------------------

module XMonad.Layout.StateFull (
  -- * Usage
  -- $Usage
  pattern StateFull,
  StateFull,
  FocusTracking(..),
  focusTracking
) where

import XMonad hiding ((<&&>))
import XMonad.Prelude (fromMaybe, (<|>))
import qualified XMonad.StackSet as W
import XMonad.Util.Stack (findZ)

-- $Usage
--
-- To use it, first you need to:
--
-- > import XMonad.Layout.StateFull
--
-- Then to toggle your tiled layout with @StateFull@, you can do:
--
-- > main = xmonad def { layoutHook = someTiledLayout ||| StateFull }
--
-- Or, some child layout that depends on focus information can be made to fall
-- back on the last focus it had:
--
-- > main = xmonad def
-- >  { layoutHook = someParentLayoutWith aChild (focusTracking anotherChild) }

-- | The @FocusTracking@ data type for which the @LayoutClass@ instance is
--   provided.
data FocusTracking l a = FocusTracking (Maybe a) (l a)
  deriving (Int -> FocusTracking l a -> ShowS
[FocusTracking l a] -> ShowS
FocusTracking l a -> String
(Int -> FocusTracking l a -> ShowS)
-> (FocusTracking l a -> String)
-> ([FocusTracking l a] -> ShowS)
-> Show (FocusTracking l a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l :: * -> *) a.
(Show a, Show (l a)) =>
Int -> FocusTracking l a -> ShowS
forall (l :: * -> *) a.
(Show a, Show (l a)) =>
[FocusTracking l a] -> ShowS
forall (l :: * -> *) a.
(Show a, Show (l a)) =>
FocusTracking l a -> String
showList :: [FocusTracking l a] -> ShowS
$cshowList :: forall (l :: * -> *) a.
(Show a, Show (l a)) =>
[FocusTracking l a] -> ShowS
show :: FocusTracking l a -> String
$cshow :: forall (l :: * -> *) a.
(Show a, Show (l a)) =>
FocusTracking l a -> String
showsPrec :: Int -> FocusTracking l a -> ShowS
$cshowsPrec :: forall (l :: * -> *) a.
(Show a, Show (l a)) =>
Int -> FocusTracking l a -> ShowS
Show, ReadPrec [FocusTracking l a]
ReadPrec (FocusTracking l a)
Int -> ReadS (FocusTracking l a)
ReadS [FocusTracking l a]
(Int -> ReadS (FocusTracking l a))
-> ReadS [FocusTracking l a]
-> ReadPrec (FocusTracking l a)
-> ReadPrec [FocusTracking l a]
-> Read (FocusTracking l a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadPrec [FocusTracking l a]
forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadPrec (FocusTracking l a)
forall (l :: * -> *) a.
(Read a, Read (l a)) =>
Int -> ReadS (FocusTracking l a)
forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadS [FocusTracking l a]
readListPrec :: ReadPrec [FocusTracking l a]
$creadListPrec :: forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadPrec [FocusTracking l a]
readPrec :: ReadPrec (FocusTracking l a)
$creadPrec :: forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadPrec (FocusTracking l a)
readList :: ReadS [FocusTracking l a]
$creadList :: forall (l :: * -> *) a.
(Read a, Read (l a)) =>
ReadS [FocusTracking l a]
readsPrec :: Int -> ReadS (FocusTracking l a)
$creadsPrec :: forall (l :: * -> *) a.
(Read a, Read (l a)) =>
Int -> ReadS (FocusTracking l a)
Read)

-- | Transform a layout into one that remembers and uses its last focus.
focusTracking :: l a -> FocusTracking l a
focusTracking :: forall (l :: * -> *) a. l a -> FocusTracking l a
focusTracking = Maybe a -> l a -> FocusTracking l a
forall (l :: * -> *) a. Maybe a -> l a -> FocusTracking l a
FocusTracking Maybe a
forall a. Maybe a
Nothing

-- | A type synonym to match the @StateFull@ pattern synonym.
type StateFull = FocusTracking Full

-- | A pattern synonym for the primary use case of the @FocusTracking@
--   transformer; using @Full@.
pattern StateFull :: FocusTracking Full a
pattern $bStateFull :: forall a. FocusTracking Full a
$mStateFull :: forall {r} {a}.
FocusTracking Full a -> (Void# -> r) -> (Void# -> r) -> r
StateFull = FocusTracking Nothing Full

instance LayoutClass l Window => LayoutClass (FocusTracking l) Window where

  description :: FocusTracking l Window -> String
description (FocusTracking Maybe Window
_ l Window
child)
    | String
chDesc String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Full"  = String
"StateFull"
    | Char
' ' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
chDesc = String
"FocusTracking (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
chDesc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    | Bool
otherwise           = String
"FocusTracking " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
chDesc
    where chDesc :: String
chDesc = l Window -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l Window
child

  runLayout :: Workspace String (FocusTracking l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (FocusTracking l Window))
runLayout (W.Workspace String
i (FocusTracking Maybe Window
mOldFoc l Window
childL) Maybe (Stack Window)
mSt) Rectangle
sr = do

    Maybe Window
mRealFoc <- (XState -> Maybe Window) -> X (Maybe Window)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Maybe Window)
-> (XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset)
    let mGivenFoc :: Maybe Window
mGivenFoc = Stack Window -> Window
forall a. Stack a -> a
W.focus (Stack Window -> Window) -> Maybe (Stack Window) -> Maybe Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Stack Window)
mSt
        passedMSt :: Maybe (Stack Window)
passedMSt = if Maybe Window
mRealFoc Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Window
mGivenFoc then Maybe (Stack Window)
mSt
                    else (Maybe Window
mOldFoc Maybe Window
-> (Window -> Maybe (Stack Window)) -> Maybe (Stack Window)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
oF -> (Window -> Bool) -> Maybe (Stack Window) -> Maybe (Stack Window)
forall a. (a -> Bool) -> Zipper a -> Zipper a
findZ (Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
==Window
oF) Maybe (Stack Window)
mSt) Maybe (Stack Window)
-> Maybe (Stack Window) -> Maybe (Stack Window)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Stack Window)
mSt

    ([(Window, Rectangle)]
wrs, Maybe (l Window)
mChildL') <- Workspace String (l Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> l Window
-> Maybe (Stack Window)
-> Workspace String (l Window) Window
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
i l Window
childL Maybe (Stack Window)
passedMSt) Rectangle
sr
    let newFT :: Maybe (FocusTracking l Window)
newFT = if Maybe Window
mRealFoc Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Window
mGivenFoc then Maybe Window -> l Window -> FocusTracking l Window
forall (l :: * -> *) a. Maybe a -> l a -> FocusTracking l a
FocusTracking Maybe Window
mOldFoc (l Window -> FocusTracking l Window)
-> Maybe (l Window) -> Maybe (FocusTracking l Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (l Window)
mChildL'
                else FocusTracking l Window -> Maybe (FocusTracking l Window)
forall a. a -> Maybe a
Just (FocusTracking l Window -> Maybe (FocusTracking l Window))
-> FocusTracking l Window -> Maybe (FocusTracking l Window)
forall a b. (a -> b) -> a -> b
$ Maybe Window -> l Window -> FocusTracking l Window
forall (l :: * -> *) a. Maybe a -> l a -> FocusTracking l a
FocusTracking Maybe Window
mGivenFoc (l Window -> Maybe (l Window) -> l Window
forall a. a -> Maybe a -> a
fromMaybe l Window
childL Maybe (l Window)
mChildL')

    ([(Window, Rectangle)], Maybe (FocusTracking l Window))
-> X ([(Window, Rectangle)], Maybe (FocusTracking l Window))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
wrs, Maybe (FocusTracking l Window)
newFT)

  handleMessage :: FocusTracking l Window
-> SomeMessage -> X (Maybe (FocusTracking l Window))
handleMessage (FocusTracking Maybe Window
mf l Window
childLayout) SomeMessage
m =
    ((Maybe (l Window) -> Maybe (FocusTracking l Window))
-> X (Maybe (l Window)) -> X (Maybe (FocusTracking l Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (l Window) -> Maybe (FocusTracking l Window))
 -> X (Maybe (l Window)) -> X (Maybe (FocusTracking l Window)))
-> ((l Window -> FocusTracking l Window)
    -> Maybe (l Window) -> Maybe (FocusTracking l Window))
-> (l Window -> FocusTracking l Window)
-> X (Maybe (l Window))
-> X (Maybe (FocusTracking l Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (l Window -> FocusTracking l Window)
-> Maybe (l Window) -> Maybe (FocusTracking l Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Maybe Window -> l Window -> FocusTracking l Window
forall (l :: * -> *) a. Maybe a -> l a -> FocusTracking l a
FocusTracking Maybe Window
mf) (l Window -> SomeMessage -> X (Maybe (l Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l Window
childLayout SomeMessage
m)