{-# LANGUAGE DeriveAnyClass #-}

-- Layout modifier to flip a layout either horizontally or vertically or both.
module Rahm.Desktop.Layout.Flip (
    Flip(..),
    flippable,
    flipVertically,
    flipHorizontally,
    DoFlip
  ) where

import XMonad
import XMonad.Layout.LayoutModifier

import Control.Arrow (second)
import Data.List (intercalate)
import Data.Default (Default(..))

-- A flipped layout is either flipped horizontally or vertically.
data Flip a =
  Flip {
    horiz :: Bool
  , vert :: Bool
  } deriving (Eq, Show, Ord, Read)

-- Default instance for Flip. Both are set to false.
instance Default (Flip a) where
  def = Flip False False

-- Message for altering the Flip layout modifier.
data DoFlip where
  -- Contains a function to modify Flip
  DoFlip :: (forall k (a :: k). Flip a -> Flip a) -> DoFlip
  deriving Message

-- DoFlip is a monoid.
instance Semigroup DoFlip where
 (<>) = mappend
instance Monoid DoFlip where
  mempty = DoFlip id
  mappend (DoFlip a) (DoFlip b) = DoFlip (a . b)

-- Makes a layout Flippable.
flippable :: l a -> ModifiedLayout Flip l a
flippable = ModifiedLayout def

-- Message to send a flipVertically message
flipVertically :: DoFlip
flipVertically = DoFlip $ \f -> f { vert = not (vert f) }

-- Message to send a flipHorizontally message.
flipHorizontally :: DoFlip
flipHorizontally = DoFlip $ \f -> f { horiz = not (horiz f) }

instance LayoutModifier Flip a where

  -- Modifies the layout. For each rectangle returned from the underlying
  -- layout, flip it relative to the screen.
  pureModifier flip (Rectangle sx sy sw sh) stack returned =
    (map (second doFlip) returned, Nothing)
    where
      -- doFlip -- the composition of maybe flipping horizontally and
      -- vertically.
      doFlip =
        (if horiz flip then flipHoriz else id) .
        (if vert flip then flipVert else id)

      flipVert (Rectangle x y w h) =
        Rectangle ((sx + fromIntegral sw) - x - fromIntegral w + sx) y w h
      flipHoriz (Rectangle x y w h) =
        Rectangle x ((sy + fromIntegral sh) - y - fromIntegral h + sy) w h
  
  -- Handle DoFlip messages.
  pureMess flip (fromMessage -> Just (DoFlip f)) = Just (f flip)
  pureMess _ _ = Nothing

  -- Modify the description to show if the layout has been flipped.
  modifyDescription flip (description -> descr) =
    (++) descr $
      if horiz flip || vert flip
        then intercalate " and " (
          map snd $
            filter fst [
              (horiz flip, "Horizontally"),
              (vert flip, "Vertically")])
          ++ " Flipped"
        else ""