1 files changed, 87 insertions, 0 deletions
diff --git a/src/Rahm/Desktop/Layout/Flip.hs b/src/Rahm/Desktop/Layout/Flip.hs
new file mode 100644
index 0000000..e0d3abc
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/Flip.hs
@@ -0,0 +1,87 @@
+{-# 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 ""