diff options
author | Adam Vogt <vogt.adam@gmail.com> | 2011-06-09 06:02:20 +0200 |
---|---|---|
committer | Adam Vogt <vogt.adam@gmail.com> | 2011-06-09 06:02:20 +0200 |
commit | cae4a749afe9b9928ce50f2dbb6414c595cfcb4b (patch) | |
tree | d56c110f3e562e6cd3c67dc5fe8c634b55fd1dd7 /XMonad | |
parent | 3cfa0ed22425b56f895abe2104643f8d83634566 (diff) | |
download | XMonadContrib-cae4a749afe9b9928ce50f2dbb6414c595cfcb4b.tar.gz XMonadContrib-cae4a749afe9b9928ce50f2dbb6414c595cfcb4b.tar.xz XMonadContrib-cae4a749afe9b9928ce50f2dbb6414c595cfcb4b.zip |
Move tests from ManageDocks to tests/
Ignore-this: 31d51fae83d88e15cdb69f29da003bf7
The change to use a newtype for RectC is kind of ugly, but this way instances
are less likely to conflict in the tests.
darcs-hash:20110609040220-1499c-3a64ffa1d978d1dcebf648774619b192b3b244e3.gz
Diffstat (limited to '')
-rw-r--r-- | XMonad/Hooks/ManageDocks.hs | 25 |
1 files changed, 12 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 ) |