Break the Flippable modifiers into their own file.

This also combines the two into a single type.

3 files changed, 93 insertions, 58 deletions

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 7ca6161..b8a4c4e 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -55,6 +55,7 @@ import Rahm.Desktop.Logger
 import Rahm.Desktop.RebindKeys
 import Rahm.Desktop.Swallow
 import Rahm.Desktop.Layout.Pop (PopMessage(..))
+import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
 import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward)
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
@@ -245,10 +246,10 @@ keymap = runKeys $ do
   bind xK_f $ do
     justMod  $
       doc "Flip the current layout vertically" $
-      sendMessage FlipLayout
+      sendMessage flipVertically
     shiftMod $
       doc "Flip the current layout horizontally" $
-      sendMessage HFlipLayout
+      sendMessage flipHorizontally
 
   bind xK_g $ do
     justMod $
@@ -625,6 +626,7 @@ mouseMap = runButtons $ do
       bind button13 $ do
         noMod $ noWindow $ click >> CopyWindow.kill1
 
+
       bind button14 $ do
         noMod $ noWindow $ click >> sendMessage TogglePop
 
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 ""
diff --git a/src/Rahm/Desktop/Layout/Layout.hs b/src/Rahm/Desktop/Layout/Layout.hs
index 135b9a0..a871aa6 100644
--- a/src/Rahm/Desktop/Layout/Layout.hs
+++ b/src/Rahm/Desktop/Layout/Layout.hs
@@ -28,6 +28,7 @@ import Rahm.Desktop.Layout.LayoutList
 import Rahm.Desktop.Windows
 import Rahm.Desktop.Layout.ReinterpretMessage
 import Rahm.Desktop.Layout.Pop
+import Rahm.Desktop.Layout.Flip
 
 import qualified Data.Map as M
 import qualified XMonad.StackSet as W
@@ -90,8 +91,7 @@ reinterpretIncMaster = ModifiedLayout ReinterpretMessage
 mods =
   reinterpretResize .
     poppable .
-      ModifiedLayout (Flippable False) .
-      ModifiedLayout (HFlippable False) .
+      flippable .
       ModifiedLayout (Rotateable False)
 
 
@@ -139,25 +139,11 @@ instance DescriptionModifier ThreeColDescMod ThreeCol where
   newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")"
   newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")"
 
-newtype Flippable a = Flippable Bool -- True if flipped
-  deriving (Show, Read)
-
-newtype HFlippable a = HFlippable Bool -- True if flipped
-  deriving (Show, Read)
-
 newtype Rotateable a = Rotateable Bool -- True if rotated
   deriving (Show, Read)
 
-data FlipLayout = FlipLayout deriving (Typeable)
-
-data HFlipLayout = HFlipLayout deriving (Typeable)
-
 data DoRotate = DoRotate deriving (Typeable)
 
-instance Message FlipLayout where
-
-instance Message HFlipLayout where
-
 instance Message DoRotate where
 
 instance (Eq a) => LayoutModifier Rotateable a where
@@ -186,43 +172,3 @@ instance (Eq a) => LayoutModifier Rotateable a where
       if rot
         then descr ++ " Rotated"
         else descr
-
-instance (Eq a) => LayoutModifier Flippable a where
-  pureModifier (Flippable flip) (Rectangle sx _ sw _) stack returned =
-    if flip
-      then (map (second doFlip) returned, Nothing)
-      else (returned, Nothing)
-    where
-      doFlip (Rectangle x y w h) =
-        Rectangle ((sx + fromIntegral sw) - x - fromIntegral w + sx) y w h
-
-  pureMess (Flippable flip) message =
-    case fromMessage message of
-      Just FlipLayout -> Just (Flippable (not flip))
-      Nothing -> Nothing
-
-  modifyDescription (Flippable flipped) underlying =
-    let descr = description underlying in
-      if flipped
-        then descr ++ " Flipped"
-        else descr
-
-instance (Eq a) => LayoutModifier HFlippable a where
-  pureModifier (HFlippable flip) (Rectangle _ sy _ sh) stack returned =
-    if flip
-      then (map (second doFlip) returned, Nothing)
-      else (returned, Nothing)
-    where
-      doFlip (Rectangle x y w h) =
-        Rectangle x ((sy + fromIntegral sh) - y - fromIntegral h + sy) w h
-
-  pureMess (HFlippable flip) message =
-    case fromMessage message of
-      Just HFlipLayout -> Just (HFlippable (not flip))
-      Nothing -> Nothing
-
-  modifyDescription (HFlippable flipped) underlying =
-    let descr = description underlying in
-      if flipped
-        then descr ++ " HFlipped"
-        else descr