{-# LANGUAGE DeriveAnyClass #-}

-- | The Pap layout modifier allows the user to "pop" the focused window into a
-- frame in the middle of the screen, sort of like fullscreen, but only taking
-- up a percentage of the screen rather than the whole screen so other windows
-- are still visible, alebeit typically not usable.
module Rahm.Desktop.Layout.Pop (
  Poppable(..),
  PopMessage(..),
  poppable,
  resizePop,
  togglePop,
  setPop) where

import XMonad
import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
import Data.Default (Default(..))
import qualified XMonad.StackSet as W

import Rahm.Desktop.Layout.ReinterpretMessage

data Poppable (l :: * -> *) (a :: *) = Poppable {
    -- True if the current window is popped out or not.
    isPopped :: Bool

    -- Fraction of the screen width around the window.
  , xFrac :: Float

    -- Fraction of the screen height around the window.
  , yFrac :: Float

  , wrap :: l  a
  } deriving (Show, Read, Eq, Ord)

data PopMessage where
  PopMessage :: (forall l a. Poppable l a -> Poppable l a) -> PopMessage
  deriving (Message)

resizePop :: Float -> PopMessage
resizePop f = PopMessage $ \(Poppable b x y l) -> 
  Poppable b (g $ x + f) (g $ y + f) l
  where
    g = max 0 . min 0.45

setPop :: (Bool -> Bool) -> PopMessage
setPop f = PopMessage $ \(Poppable b x y l) -> Poppable (f b) x y l

togglePop :: PopMessage
togglePop = setPop not

poppable :: l a -> Poppable l a
poppable = Poppable False 0.05 0.05

instance (LayoutClass l a, Eq a) => LayoutClass (Poppable l) a where
  
  -- If the current layout is not popped, then just return what the underlying
  -- layout returned.

  runLayout (W.Workspace
              t
              (Poppable True xs ys l)
              a@(Just (W.focus -> focused)))
            rect@(Rectangle x y w h) = do
    (returned, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
    return
      ((focused, newRect) : filter ((/=focused) . fst) returned,
       Poppable True xs ys <$> maybeNewLayout)
    where
      wp = floor $ fromIntegral w * xs
      hp = floor $ fromIntegral h * ys
      newRect = Rectangle
        (x + wp)
        (y + hp)
        (w - fromIntegral (wp * 2))
        (h - fromIntegral (hp * 2))

  -- If the pop is not active, just delegate to the underlying layout.
  runLayout (W.Workspace t (Poppable b x y l) a) rect = do
    (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
    return (rects, Poppable b x y <$> maybeNewLayout)

  -- If the message is a PopMessage, handle that here.
  handleMessage p (fromMessage -> Just (PopMessage f)) =
    return $ Just $ f p

  -- Intercept Shrink/Expand message if the pop is active, and resize the
  -- pop size.
  handleMessage p (fromMessage -> Just mess) | isPopped p =
    case mess of
      Shrink -> handleMessage p (SomeMessage $ resizePop 0.025)
      Expand -> handleMessage p (SomeMessage $ resizePop (-0.025))

  -- By default just pass the message to the underlying layout.
  handleMessage (Poppable b x y l) mess = do
    maybeNewLayout <- handleMessage l mess
    return (Poppable b x y <$> maybeNewLayout)