fix ghc-6.12.1 warnings andd fix issue 17

Ignore-this: 868a877e7a107ddc8bc4085f3eb7fc8ae64597ee
ghc-6.12.1 has native support for locales (very cool indeed!!), which
simplify the code - unless for the compatibility layer with past ghc
versions. xmobar has now support for every locale supported by ghc.

The rest of the patch are just redundant import warnings and some
xmobar.cabal updates.

darcs-hash:20100210122927-d6583-e131c86cf89ce26adea9aa2ae06467bfdc40e14b.gz

5 files changed, 47 insertions, 47 deletions

diff --git a/Main.hs b/Main.hs
index 74ed8cd..1a0653f 100644
--- a/Main.hs
+++ b/Main.hs
@@ -64,7 +64,6 @@ main = do
   vars  <- mapM startCommand cl
   (r,w) <- createWin d fs conf
   eventLoop (XConf d r w fs conf) vars
-  releaseFont d fs
 
 -- | Reads the configuration files or quits with an error
 readConfig :: FilePath -> IO (Config,[String])
diff --git a/Runnable.hs b/Runnable.hs
index fe39c80..4cd33dd 100644
--- a/Runnable.hs
+++ b/Runnable.hs
@@ -23,7 +23,6 @@ module Runnable where
 
 import Control.Monad
 import Text.Read
-import Text.ParserCombinators.ReadPrec
 import Config (runnableTypes)
 import Commands
 
diff --git a/XUtil.hsc b/XUtil.hsc
index 2a61283..afdc782 100644
--- a/XUtil.hsc
+++ b/XUtil.hsc
@@ -16,7 +16,6 @@ module XUtil
     , initFont
     , initCoreFont
     , initUtf8Font
-    , releaseFont
     , textExtents
     , textWidth
     , printString
@@ -32,19 +31,18 @@ module XUtil
     ) where
 
 import Control.Concurrent
-import Control.Monad
 import Control.Monad.Trans
 import Data.IORef
 import Foreign
 import Graphics.X11.Xlib hiding (textExtents, textWidth)
 import qualified Graphics.X11.Xlib as Xlib (textExtents, textWidth)
 import Graphics.X11.Xlib.Extras
+import System.Mem.Weak ( addFinalizer )
 import System.Posix.Types (Fd(..))
 import System.IO
-import System.IO.Unsafe (unsafePerformIO)
 #if defined XFT || defined UTF8
-import Foreign.C
 # if __GLASGOW_HASKELL__ < 612
+import Foreign.C
 import qualified System.IO.UTF8 as UTF8 (readFile,hGetLine)
 # else
 import qualified System.IO as UTF8 (readFile,hGetLine)
@@ -82,49 +80,46 @@ data XFont =Core FontStruct
 initFont :: Display ->String -> IO XFont
 initFont d s =
 #ifdef XFT
-  if xftPrefix `isPrefixOf` s then
-     do setupLocale
-        xftdraw <- xftFontOpen d (defaultScreenOfDisplay d) (drop (length xftPrefix) s)
-        return (Xft xftdraw)
-  else
+       let xftPrefix = "xft:" in
+       if  xftPrefix `isPrefixOf` s then
+           fmap Xft $ initXftFont d s
+       else
 #endif
-#ifdef UTF8
-      (setupLocale >> initUtf8Font d s >>= return . Utf8)
+#if defined UTF8 ||  __GLASGOW_HASKELL__ >= 612
+           fmap Utf8 $ initUtf8Font d s
 #else
-      (initCoreFont d s >>= return . Core)
-#endif
-#ifdef XFT
-  where xftPrefix = "xft:"
-#endif
-
-releaseFont :: Display -> XFont -> IO ()
-#ifdef XFT
-releaseFont d (Xft xftfont) = xftFontClose    d xftfont
+           fmap Core $ initCoreFont d s
 #endif
-releaseFont d (Utf8     fs) = releaseUtf8Font d fs
-releaseFont d (Core     fs) = releaseCoreFont d fs
 
 -- | Given a fontname returns the font structure. If the font name is
 --  not valid the default font will be loaded and returned.
 initCoreFont :: Display -> String -> IO FontStruct
-initCoreFont dpy s = catch (getIt dpy) (fallBack dpy)
-      where getIt    d = loadQueryFont d s
-            fallBack d = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
-
-releaseCoreFont :: Display -> FontStruct -> IO ()
-releaseCoreFont d = freeFont d
+initCoreFont d s = do
+  f <- catch getIt fallBack
+  addFinalizer f (freeFont d f)
+  return f
+      where getIt    = loadQueryFont d s
+            fallBack = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
 
 -- | Given a fontname returns the font structure. If the font name is
 --  not valid the default font will be loaded and returned.
 initUtf8Font :: Display -> String -> IO FontSet
-initUtf8Font dpy s = do
-  (_,_,fs) <- catch (getIt dpy) (fallBack dpy)
-  return fs
-      where getIt    d = createFontSet d s
-            fallBack d = const $ createFontSet d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
+initUtf8Font d s = do
+  setupLocale
+  (_,_,f) <- catch getIt fallBack
+  addFinalizer f (freeFontSet d f)
+  return f
+      where getIt    = createFontSet d s
+            fallBack = const $ createFontSet d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
 
-releaseUtf8Font :: Display -> FontSet -> IO ()
-releaseUtf8Font d = freeFontSet d
+#ifdef XFT
+initXftFont :: Display -> String -> IO XftFont
+initXftFont d s = do
+  setupLocale
+  f <- xftFontOpen d (defaultScreenOfDisplay d) (drop 4 s)
+  addFinalizer f (xftFontClose d f)
+  return f
+#endif
 
 textWidth :: Display -> XFont -> String -> IO Int
 textWidth _   (Utf8 fs) s = return $ fi $ wcTextEscapement fs s
@@ -251,11 +246,14 @@ io = liftIO
 fi :: (Integral a, Num b) => a -> b
 fi = fromIntegral
 
-#if defined XFT || defined UTF8
+#if __GLASGOW_HASKELL__ < 612 && (defined XFT || defined UTF8)
 #include <locale.h>
 foreign import ccall unsafe "locale.h setlocale"
     setlocale :: CInt -> CString -> IO CString
 
-setupLocale :: IO CString
-setupLocale = withCString "" $ setlocale (#const LC_ALL)
+setupLocale :: IO ()
+setupLocale = withCString "" (setlocale $ #const LC_ALL) >> return ()
+# else
+setupLocale :: IO ()
+setupLocale = return ()
 #endif
diff --git a/Xmobar.hs b/Xmobar.hs
index 6292c46..898bd2e 100644
--- a/Xmobar.hs
+++ b/Xmobar.hs
@@ -40,7 +40,6 @@ import Control.Concurrent
 import Control.Concurrent.STM
 import Control.Exception hiding (handle)
 import Data.Bits
-import Data.Char
 import Data.Maybe(fromMaybe)
 import Data.Typeable (Typeable)
 
diff --git a/xmobar.cabal b/xmobar.cabal
index 7bddedd..6fb7ffe 100644
--- a/xmobar.cabal
+++ b/xmobar.cabal
@@ -34,23 +34,28 @@ flag with_inotify
 executable xmobar
     main-is:            Main.hs
     other-Modules:      Xmobar, Config, Parsers, Commands, XUtil, Runnable, Plugins
-    ghc-options:        -funbox-strict-fields -Wall
     ghc-prof-options:   -prof -auto-all
 
+    if true
+        ghc-options: -funbox-strict-fields -Wall
+
     if impl (ghc == 6.10.1) && arch (x86_64)
-            ghc-options:    -O0
+            ghc-options: -O0
+
+    if impl (ghc >= 6.12.1)
+            ghc-options: -fno-warn-unused-do-bind
 
     if flag(small_base)
-       build-depends:   base == 4.*, containers, process, old-time, old-locale, bytestring, directory
+       build-depends: base == 4.*, containers, process, old-time, old-locale, bytestring, directory
 
     else
-       build-depends:   base < 3
+       build-depends: base < 3
 
     if flag(with_xft)
         build-depends: utf8-string, X11-xft >= 0.2
         cpp-options: -DXFT
 
-    if flag(with_utf8)
+    if flag(with_utf8) && impl (ghc < 6.12.1)
         build-depends: utf8-string
         cpp-options: -DUTF8
 
@@ -58,4 +63,4 @@ executable xmobar
         build-depends: hinotify
         cpp-options: -DINOTIFY
 
-    build-depends:      X11>=1.3.0, mtl, unix, parsec, filepath, stm
+    build-depends: X11>=1.3.0, mtl, unix, parsec, filepath, stm