{-# 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 Control.Arrow (second)
import Data.List (intercalate)
import XMonad
  ( Default (..),
    LayoutClass (description),
    Message,
    Rectangle (Rectangle),
    fromMessage,
  )
import XMonad.Layout.LayoutModifier
  ( LayoutModifier (modifyDescription, pureMess, pureModifier),
    ModifiedLayout (..),
  )

-- 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
  (DoFlip a) <> (DoFlip b) = DoFlip (a . b)

instance Monoid DoFlip where
  mempty = DoFlip id
  mappend = (<>)

-- 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 ""