Compile with ghc7

This commit is contained in:
Mats Rauhala 2011-05-04 19:24:55 +00:00
parent 8056bb5c2c
commit 2ab79a7c35
6 changed files with 21 additions and 38 deletions

View File

@ -35,11 +35,6 @@ import Data.List (find)
import Data.Maybe (isNothing)
import Control.Monad (when)
-- The following imports are to allow haddock to find links for documentation
-- only.
import XMonad.Actions.CopyWindow (copy)
import XMonad.Prompt (defaultXPConfig)
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--

View File

@ -82,17 +82,17 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
sh <- io $ getWMNormalHints d w
pointer <- io $ queryPointer d w >>= return . pointerPos
let uv = (pointer - wpos) / wsize
let uv = zipP (/) (zipP (-) pointer wpos) wsize
fc = mapP f uv
mul = mapP (\x -> 2 - 2 * abs(x - 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle
atl = ((1, 1) - fc) * mul
abr = fc * mul
atl = zipP (*) (zipP (-) (1, 1) fc) mul
abr = zipP (*) fc mul
mouseDrag (\ex ey -> io $ do
let offset = (fromIntegral ex, fromIntegral ey) - pointer
npos = wpos + offset * atl
nbr = (wpos + wsize) + offset * abr
ntl = minP (nbr - (32, 32)) npos --minimum size
nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (nbr - ntl)
let offset = zipP (-) (fromIntegral ex, fromIntegral ey) pointer
npos = zipP (*) wpos $ zipP (*) offset atl
nbr = zipP (+) (zipP (+) wpos wsize) (zipP (*) offset abr)
ntl = minP (zipP (-) nbr (32, 32)) npos --minimum size
nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (zipP (-) nbr ntl)
moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth
return ())
(float w)
@ -100,14 +100,14 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
float w
where
pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt
winAttrs :: WindowAttributes -> [Pnt]
pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py)
winAttrs :: WindowAttributes -> [(Double, Double)]
winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height]
-- Changed the type = Pnt implementation to use the zipP functionality
-- because (on ghc7) the previous implementation caused Orphan Instances
-- warnings
-- I'd rather I didn't have to do this, but I hate writing component 2d math
type Pnt = (Double, Double)
pairUp :: [a] -> [(a,a)]
pairUp [] = []
pairUp [_] = []
@ -120,15 +120,3 @@ zipP f (ax,ay) (bx,by) = (f ax bx, f ay by)
minP :: Ord a => (a,a) -> (a,a) -> (a,a)
minP = zipP min
instance Num Pnt where
(+) = zipP (+)
(-) = zipP (-)
(*) = zipP (*)
abs = mapP abs
signum = mapP signum
fromInteger = const undefined
instance Fractional Pnt where
fromRational = const undefined
recip = mapP recip

View File

@ -1,4 +1,5 @@
{-# OPTIONS_GHC -fno-warn-missing-signatures -fglasgow-exts -fno-warn-orphans #-}
{-# LANGUAGE PatternGuards #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Copyright : (c) Spencer Janssen 2007

View File

@ -1,5 +1,4 @@
{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
{-# OPTIONS -fglasgow-exts #-}
{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
-- deriving Typeable for ghc-6.6 compatibility, which is retained in the core
-----------------------------------------------------------------------------
-- |

View File

@ -442,12 +442,12 @@ defaultXPKeymap = M.fromList $
keyPressHandle :: KeyMask -> KeyStroke -> XP ()
keyPressHandle m (ks,str) = do
km <- gets (promptKeymap . config)
mask <- cleanMask m
case M.lookup (mask,ks) km of
kmask <- cleanMask m -- mask is defined in ghc7
case M.lookup (kmask,ks) km of
Just action -> action >> updateWindows
Nothing -> case str of
"" -> eventLoop handle
_ -> when (mask .&. controlMask == 0) $ do
_ -> when (kmask .&. controlMask == 0) $ do
insertString (decodeString str)
updateWindows
completed <- tryAutoComplete

View File

@ -105,11 +105,11 @@ it makes use of shell interpretation by relying on @$HOME@ and
interpolation, whereas the safeSpawn example can be safe because
Firefox doesn't need any arguments if it is just being started. -}
safeSpawn :: MonadIO m => FilePath -> [String] -> m ()
safeSpawn prog args = io $ void $ forkProcess $ do
safeSpawn prog args = io $ void_ $ forkProcess $ do
uninstallSignalHandlers
_ <- createSession
executeFile prog True args Nothing
where void = (>> return ()) -- TODO: replace with Control.Monad.void
where void_ = (>> return ()) -- TODO: replace with Control.Monad.void / void not in ghc6 apparently
-- | Simplified 'safeSpawn'; only takes a program (and no arguments):
--