2 files changed, 65 insertions, 40 deletions
diff --git a/src/Rahm/Desktop/Layout/Layout.hs b/src/Rahm/Desktop/Layout/Layout.hs
index a871aa6..88143cd 100644
--- a/src/Rahm/Desktop/Layout/Layout.hs
+++ b/src/Rahm/Desktop/Layout/Layout.hs
@@ -29,10 +29,13 @@ import Rahm.Desktop.Windows
 import Rahm.Desktop.Layout.ReinterpretMessage
 import Rahm.Desktop.Layout.Pop
 import Rahm.Desktop.Layout.Flip
+import Rahm.Desktop.Layout.Rotate
 
 import qualified Data.Map as M
 import qualified XMonad.StackSet as W
 
+mods = reinterpretResize . poppable . flippable . rotateable
+
 myLayout =
   fullscreenFull $
     avoidStruts $
@@ -88,12 +91,6 @@ reinterpretIncMaster ::
   l a -> ModifiedLayout (ReinterpretMessage "IncMasterToResizeMaster") l a
 reinterpretIncMaster = ModifiedLayout ReinterpretMessage
 
-mods =
-  reinterpretResize .
-    poppable .
-      flippable .
-      ModifiedLayout (Rotateable False)
-
 
 data ModifyDescription m l a = ModifyDescription m (l a)
   deriving (Show, Read)
@@ -138,37 +135,3 @@ instance DescriptionModifier TallDescriptionModifier Tall where
 instance DescriptionModifier ThreeColDescMod ThreeCol where
   newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")"
   newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")"
-
-newtype Rotateable a = Rotateable Bool -- True if rotated
-  deriving (Show, Read)
-
-data DoRotate = DoRotate deriving (Typeable)
-
-instance Message DoRotate where
-
-instance (Eq a) => LayoutModifier Rotateable a where
-  pureModifier (Rotateable 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 (Rotateable rot) mess =
-    fmap (\DoRotate -> Rotateable (not rot)) (fromMessage mess)
-
-  modifyDescription (Rotateable rot) underlying =
-    let descr = description underlying in
-      if rot
-        then descr ++ " Rotated"
-        else descr
diff --git a/src/Rahm/Desktop/Layout/Rotate.hs b/src/Rahm/Desktop/Layout/Rotate.hs
new file mode 100644
index 0000000..8a8583a
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/Rotate.hs
@@ -0,0 +1,62 @@
+{-# 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