From 084e4883f70987ef74ae63a3c150a061995301d1 Mon Sep 17 00:00:00 2001
From: Spencer Janssen <sjanssen@cse.unl.edu>
Date: Fri, 28 Sep 2007 20:16:14 +0200
Subject: Use LANGUAGE pragmas over -fglasgow-exts

darcs-hash:20070928181614-a5988-85415ed570690a468bf92cdf0f66d69494cecf4e.gz
---
 Accordion.hs          | 2 ++
 Circle.hs             | 1 +
 Combo.hs              | 4 +++-
 DragPane.hs           | 3 ++-
 FlexibleManipulate.hs | 2 +-
 FloatKeys.hs          | 7 ++++---
 LayoutScreens.hs      | 2 ++
 MagicFocus.hs         | 2 ++
 Roledex.hs            | 2 ++
 Tabbed.hs             | 3 ++-
 ThreeColumns.hs       | 2 ++
 TwoPane.hs            | 2 ++
 WorkspaceDir.hs       | 3 ++-
 XPrompt.hs            | 3 ++-
 14 files changed, 29 insertions(+), 9 deletions(-)

diff --git a/Accordion.hs b/Accordion.hs
index 72f9d13..91dc8f1 100644
--- a/Accordion.hs
+++ b/Accordion.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleInstances #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonadContrib.Accordion
diff --git a/Circle.hs b/Circle.hs
index 292e7a4..8d13cca 100644
--- a/Circle.hs
+++ b/Circle.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleInstances #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonadContrib.Circle
diff --git a/Combo.hs b/Combo.hs
index 67263e2..72463d5 100644
--- a/Combo.hs
+++ b/Combo.hs
@@ -1,4 +1,6 @@
-{-# OPTIONS -fallow-undecidable-instances #-}
+{-# OPTIONS_GHC -fallow-undecidable-instances #-}
+{-# LANGUAGE FlexibleInstances #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonadContrib.Combo
diff --git a/DragPane.hs b/DragPane.hs
index fcf4d99..329a60c 100644
--- a/DragPane.hs
+++ b/DragPane.hs
@@ -1,4 +1,5 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
+{-# LANGUAGE FlexibleInstances #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonadContrib.DragPane
diff --git a/FlexibleManipulate.hs b/FlexibleManipulate.hs
index cdf209e..bf340b1 100644
--- a/FlexibleManipulate.hs
+++ b/FlexibleManipulate.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
+{-# LANGUAGE FlexibleInstances #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonadContrib.FlexibleManipulate
diff --git a/FloatKeys.hs b/FloatKeys.hs
index 79d236f..5ea5e11 100644
--- a/FloatKeys.hs
+++ b/FloatKeys.hs
@@ -1,4 +1,3 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonadContrib.FloatKeys
@@ -87,8 +86,10 @@ keysAbsResizeWindow' :: SizeHints -> P -> D -> D -> D -> (P,D)
 keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (nw, nh))
     where
         (nw, nh) = applySizeHints sh (w + dx, h + dy)
-        nx :: Rational = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w
-        ny :: Rational = fromIntegral (ay * h + nh * (fromIntegral y - ay)) / fromIntegral h
+        nx :: Rational
+        nx = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w
+        ny :: Rational
+        ny = fromIntegral (ay * h + nh * (fromIntegral y - ay)) / fromIntegral h
 
 keysResizeWindow' :: SizeHints -> P -> D -> D -> G -> (P,D)
 keysResizeWindow' sh (x,y) (w,h) (dx,dy) (gx, gy) = ((nx, ny), (nw, nh))
diff --git a/LayoutScreens.hs b/LayoutScreens.hs
index c3de2ba..7e97a66 100644
--- a/LayoutScreens.hs
+++ b/LayoutScreens.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleInstances #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonadContrib.LayoutScreens
diff --git a/MagicFocus.hs b/MagicFocus.hs
index 0f7230b..44a6c09 100644
--- a/MagicFocus.hs
+++ b/MagicFocus.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleInstances #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonadContrib.MagicFocus
diff --git a/Roledex.hs b/Roledex.hs
index 015f703..6b6dfe4 100644
--- a/Roledex.hs
+++ b/Roledex.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleInstances #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonadContrib.Roledex
diff --git a/Tabbed.hs b/Tabbed.hs
index 4680f71..268f13a 100644
--- a/Tabbed.hs
+++ b/Tabbed.hs
@@ -1,4 +1,5 @@
-{-# OPTIONS -fno-warn-orphans -fglasgow-exts #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE FlexibleInstances #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonadContrib.Tabbed
diff --git a/ThreeColumns.hs b/ThreeColumns.hs
index 66862c3..334691b 100644
--- a/ThreeColumns.hs
+++ b/ThreeColumns.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleInstances #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonadContrib.ThreeColumns
diff --git a/TwoPane.hs b/TwoPane.hs
index 90c4f13..2f47b8b 100644
--- a/TwoPane.hs
+++ b/TwoPane.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleInstances #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonadContrib.TwoPane
diff --git a/WorkspaceDir.hs b/WorkspaceDir.hs
index 1570c46..603572f 100644
--- a/WorkspaceDir.hs
+++ b/WorkspaceDir.hs
@@ -1,4 +1,5 @@
-{-# OPTIONS -fglasgow-exts #-}
+{-# LANGUAGE FlexibleInstances #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonadContrib.WorkspaceDir
diff --git a/XPrompt.hs b/XPrompt.hs
index e2ac85d..cf2ce40 100644
--- a/XPrompt.hs
+++ b/XPrompt.hs
@@ -1,4 +1,5 @@
-{-# OPTIONS -fglasgow-exts #-}
+{-# LANGUAGE ExistentialQuantification #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonadContrib.XPrompt
-- 
cgit v1.2.3