aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--XMonad/Hooks/ManageDocks.hs25
-rw-r--r--tests/ManageDocks.hs21
2 files changed, 33 insertions, 13 deletions
diff --git a/XMonad/Hooks/ManageDocks.hs b/XMonad/Hooks/ManageDocks.hs
index 3946647..0e905c0 100644
--- a/XMonad/Hooks/ManageDocks.hs
+++ b/XMonad/Hooks/ManageDocks.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-}
-- deriving Typeable for ghc-6.6 compatibility, which is retained in the core
-----------------------------------------------------------------------------
-- |
@@ -22,6 +22,12 @@ module XMonad.Hooks.ManageDocks (
SetStruts(..),
module XMonad.Util.Types,
+#ifdef TESTING
+ r2c,
+ c2r,
+ RectC(..),
+#endif
+
-- for XMonad.Actions.FloatSnap
calcGap
) where
@@ -224,29 +230,22 @@ type Strut = (Direction2D, CLong, CLong, CLong)
-- | (Initial x pixel, initial y pixel,
-- final x pixel, final y pixel).
-type RectC = (CLong, CLong, CLong, CLong)
+newtype RectC = RectC (CLong, CLong, CLong, CLong) deriving (Eq,Show)
-- | Invertible conversion.
r2c :: Rectangle -> RectC
-r2c (Rectangle x y w h) = (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1)
+r2c (Rectangle x y w h) = RectC (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1)
-- | Invertible conversion.
c2r :: RectC -> Rectangle
-c2r (x1, y1, x2, y2) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1 + 1) (fi $ y2 - y1 + 1)
-
--- TODO: Add these QuickCheck properties to the test suite, along with
--- suitable Arbitrary instances.
-
--- prop_r2c_c2r :: RectC -> Bool
--- prop_r2c_c2r r = r2c (c2r r) == r
+c2r (RectC (x1, y1, x2, y2)) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1 + 1) (fi $ y2 - y1 + 1)
--- prop_c2r_r2c :: Rectangle -> Bool
--- prop_c2r_r2c r = c2r (r2c r) == r
reduce :: RectC -> Strut -> RectC -> RectC
-reduce (sx0, sy0, sx1, sy1) (s, n, l, h) (x0, y0, x1, y1) = case s of
+reduce (RectC (sx0, sy0, sx1, sy1)) (s, n, l, h) (RectC (x0, y0, x1, y1)) =
+ RectC $ case s of
L | p (y0, y1) && qh x1 -> (mx x0 sx0, y0 , x1 , y1 )
R | p (y0, y1) && qv sx1 x0 -> (x0 , y0 , mn x1 sx1, y1 )
U | p (x0, x1) && qh y1 -> (x0 , mx y0 sy0, x1 , y1 )
diff --git a/tests/ManageDocks.hs b/tests/ManageDocks.hs
new file mode 100644
index 0000000..dd1e4d2
--- /dev/null
+++ b/tests/ManageDocks.hs
@@ -0,0 +1,21 @@
+module ManageDocks where
+import XMonad
+import XMonad.Hooks.ManageDocks
+import Test.QuickCheck
+import Foreign.C.Types
+import Properties
+
+instance Arbitrary CLong where
+ arbitrary = fromIntegral `fmap` (arbitrary :: Gen Int)
+instance Arbitrary RectC where
+ arbitrary = do
+ (x,y) <- arbitrary
+ NonNegative w <- arbitrary
+ NonNegative h <- arbitrary
+ return $ RectC (x,y,x+w,y+h)
+
+prop_r2c_c2r :: RectC -> Bool
+prop_r2c_c2r r = r2c (c2r r) == r
+
+prop_c2r_r2c :: Rectangle -> Bool
+prop_c2r_r2c r = c2r (r2c r) == r