From 828571625f7d55fdabb9f3b563e131244d638409 Mon Sep 17 00:00:00 2001 From: Mats Rauhala Date: Wed, 4 May 2011 21:24:55 +0200 Subject: Compile with ghc7 Ignore-this: 218d2e19835f1e4315c01bd6214899ce darcs-hash:20110504192455-af521-ba19a95226d2527af9fbad8ed902982f2db567db.gz --- XMonad/Actions/DynamicWorkspaces.hs | 5 ----- XMonad/Actions/FlexibleManipulate.hs | 38 ++++++++++++------------------------ XMonad/Config/Droundy.hs | 3 ++- XMonad/Hooks/ManageDocks.hs | 3 +-- XMonad/Prompt.hs | 6 +++--- XMonad/Util/Run.hs | 4 ++-- 6 files changed, 21 insertions(+), 38 deletions(-) (limited to 'XMonad') diff --git a/XMonad/Actions/DynamicWorkspaces.hs b/XMonad/Actions/DynamicWorkspaces.hs index 0e66587..d91b654 100644 --- a/XMonad/Actions/DynamicWorkspaces.hs +++ b/XMonad/Actions/DynamicWorkspaces.hs @@ -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: -- diff --git a/XMonad/Actions/FlexibleManipulate.hs b/XMonad/Actions/FlexibleManipulate.hs index 6ec3739..54bf586 100644 --- a/XMonad/Actions/FlexibleManipulate.hs +++ b/XMonad/Actions/FlexibleManipulate.hs @@ -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 diff --git a/XMonad/Config/Droundy.hs b/XMonad/Config/Droundy.hs index 51356dc..5e0c9c8 100644 --- a/XMonad/Config/Droundy.hs +++ b/XMonad/Config/Droundy.hs @@ -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 diff --git a/XMonad/Hooks/ManageDocks.hs b/XMonad/Hooks/ManageDocks.hs index 6bb6502..3946647 100644 --- a/XMonad/Hooks/ManageDocks.hs +++ b/XMonad/Hooks/ManageDocks.hs @@ -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 ----------------------------------------------------------------------------- -- | diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs index d8133fd..1d2faba 100644 --- a/XMonad/Prompt.hs +++ b/XMonad/Prompt.hs @@ -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 diff --git a/XMonad/Util/Run.hs b/XMonad/Util/Run.hs index 30696f5..4b766d8 100644 --- a/XMonad/Util/Run.hs +++ b/XMonad/Util/Run.hs @@ -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): -- -- cgit v1.2.3