{-# LANGUAGE DeriveAnyClass #-}

-- Layout modifier which optionally rotates the underlying layout. This actually
-- uses the mirrorRect, so it's not strictly rotating, but when combined with
-- flipping it works.
module Rahm.Desktop.Layout.Rotate (
  rotateable,
  rotateLayout,
  Rotate) where

import XMonad
import XMonad.Layout.LayoutModifier
import Data.Default (Default(..))
import Control.Arrow (second)

-- Just a wrapper over a Bool.
newtype Rotate a = Rotate Bool
  deriving (Read, Show, Eq, Ord)

-- Returns a layout that can be rotated.
rotateable :: l a -> ModifiedLayout Rotate l a
rotateable = ModifiedLayout def

-- Message to rotate the layout.
rotateLayout :: RotateMessage
rotateLayout = RotateMessage $ \(Rotate n) -> Rotate (not n)

-- Default instance just defaults to false..
instance Default (Rotate a) where
  def = Rotate False

-- Rotate message is a wrapper over a function to modify a Rotate instance.
data RotateMessage where
  RotateMessage :: (forall k (a :: k). Rotate a -> Rotate a) -> RotateMessage
  deriving (Message)

instance (Eq a) => LayoutModifier Rotate a where
  pureModifier (Rotate rotate) (Rectangle x' y' sw sh) _ returned =
    if rotate
      then (map (second (unzero . scaleRect . mirrorRect . zero)) returned, Nothing)
      else (returned, Nothing)
    where
      zero (Rectangle x y w h) = Rectangle (x - x') (y - y') w h
      unzero (Rectangle x y w h) = Rectangle (x + x') (y + y') w h

      scaleRect (Rectangle x y w h) =
        Rectangle (x * fi sw `div` fi sh)
                  (y * fi sh `div` fi sw)
                  (w * sw `div` sh)
                  (h * sh `div` sw)

      fi = fromIntegral


  pureMess r (fromMessage -> Just (RotateMessage f)) = Just (f r)
  pureMess _ _ = Nothing

  modifyDescription (Rotate rot) underlying =
    let descr = description underlying in
      if rot
        then descr ++ " Rotated"
        else descr