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 Data.Maybe (isNothing)
import Control.Monad (when) 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 -- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: -- 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 sh <- io $ getWMNormalHints d w
pointer <- io $ queryPointer d w >>= return . pointerPos pointer <- io $ queryPointer d w >>= return . pointerPos
let uv = (pointer - wpos) / wsize let uv = zipP (/) (zipP (-) pointer wpos) wsize
fc = mapP f uv 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 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 atl = zipP (*) (zipP (-) (1, 1) fc) mul
abr = fc * mul abr = zipP (*) fc mul
mouseDrag (\ex ey -> io $ do mouseDrag (\ex ey -> io $ do
let offset = (fromIntegral ex, fromIntegral ey) - pointer let offset = zipP (-) (fromIntegral ex, fromIntegral ey) pointer
npos = wpos + offset * atl npos = zipP (*) wpos $ zipP (*) offset atl
nbr = (wpos + wsize) + offset * abr nbr = zipP (+) (zipP (+) wpos wsize) (zipP (*) offset abr)
ntl = minP (nbr - (32, 32)) npos --minimum size ntl = minP (zipP (-) nbr (32, 32)) npos --minimum size
nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (nbr - ntl) nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (zipP (-) nbr ntl)
moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth
return ()) return ())
(float w) (float w)
@ -100,14 +100,14 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
float w float w
where where
pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py)
winAttrs :: WindowAttributes -> [Pnt] winAttrs :: WindowAttributes -> [(Double, Double)]
winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height] 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 :: [a] -> [(a,a)]
pairUp [] = [] pairUp [] = []
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 :: Ord a => (a,a) -> (a,a) -> (a,a)
minP = zipP min 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 -- Copyright : (c) Spencer Janssen 2007

View File

@ -1,5 +1,4 @@
{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
{-# OPTIONS -fglasgow-exts #-}
-- deriving Typeable for ghc-6.6 compatibility, which is retained in the core -- 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 :: KeyMask -> KeyStroke -> XP ()
keyPressHandle m (ks,str) = do keyPressHandle m (ks,str) = do
km <- gets (promptKeymap . config) km <- gets (promptKeymap . config)
mask <- cleanMask m kmask <- cleanMask m -- mask is defined in ghc7
case M.lookup (mask,ks) km of case M.lookup (kmask,ks) km of
Just action -> action >> updateWindows Just action -> action >> updateWindows
Nothing -> case str of Nothing -> case str of
"" -> eventLoop handle "" -> eventLoop handle
_ -> when (mask .&. controlMask == 0) $ do _ -> when (kmask .&. controlMask == 0) $ do
insertString (decodeString str) insertString (decodeString str)
updateWindows updateWindows
completed <- tryAutoComplete 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 interpolation, whereas the safeSpawn example can be safe because
Firefox doesn't need any arguments if it is just being started. -} Firefox doesn't need any arguments if it is just being started. -}
safeSpawn :: MonadIO m => FilePath -> [String] -> m () safeSpawn :: MonadIO m => FilePath -> [String] -> m ()
safeSpawn prog args = io $ void $ forkProcess $ do safeSpawn prog args = io $ void_ $ forkProcess $ do
uninstallSignalHandlers uninstallSignalHandlers
_ <- createSession _ <- createSession
executeFile prog True args Nothing 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): -- | Simplified 'safeSpawn'; only takes a program (and no arguments):
-- --