remove warnings and text dependency from H.WallpaperSetter

Ignore-this: e637d782c13bed48bafbc1458b3f983f

darcs-hash:20150310192933-1499c-dee75cc95b2719a3245e7ce6c075bfa50fcfb9d2.gz

2 files changed, 41 insertions, 44 deletions

diff --git a/XMonad/Hooks/WallpaperSetter.hs b/XMonad/Hooks/WallpaperSetter.hs
index feb409b..5f0f608 100644
--- a/XMonad/Hooks/WallpaperSetter.hs
+++ b/XMonad/Hooks/WallpaperSetter.hs
@@ -29,19 +29,18 @@ import qualified XMonad.Util.ExtensibleState as XS
 
 import System.IO
 import System.Process
-import System.Exit
 import System.Directory (getHomeDirectory, doesFileExist, doesDirectoryExist, getDirectoryContents)
 import System.FilePath ((</>))
-import System.Random (getStdRandom, randomR)
+import System.Random (randomRIO)
 
 import qualified Data.Map as M
-import qualified Data.Text as T
 import Data.List (intersperse, sortBy)
 import Data.Char (isAlphaNum)
 import Data.Ord (comparing)
 
-import Control.Monad (when, unless, join)
-import Data.Maybe (isNothing, fromJust, fromMaybe)
+import Control.Monad
+import Control.Applicative
+import Data.Maybe
 import Data.Monoid
 
 -- $usage
@@ -70,9 +69,9 @@ import Data.Monoid
 -- * find out how to merge multiple images from stdin to one (-> for caching all pictures in memory)
 
 -- | internal. to use XMonad state for memory in-between log-hook calls and remember PID of old external call
-data WCState = WCState [(String,String)] (Maybe ProcessHandle) deriving Typeable
+data WCState = WCState (Maybe [WorkspaceId]) (Maybe ProcessHandle) deriving Typeable
 instance ExtensionClass WCState where
-  initialValue = WCState [] Nothing
+  initialValue = WCState Nothing Nothing
 
 -- | Represents a wallpaper
 data Wallpaper = WallpaperFix FilePath -- ^ Single, fixed wallpaper
@@ -94,6 +93,7 @@ data WallpaperConf = WallpaperConf {
   } deriving (Show, Read)
 
 -- | default configuration. looks in \~\/.wallpapers/ for WORKSPACEID.jpg
+defWallpaperConf :: WallpaperConf
 defWallpaperConf = WallpaperConf "" $ WallpaperList []
 
 -- |returns the default association list (maps name to name.jpg, non-alphanumeric characters are omitted)
@@ -103,11 +103,9 @@ defWPNames xs = WallpaperList $ map (\x -> (x,WallpaperFix (filter isAlphaNum x+
 -- | Add this to your log hook with the workspace configuration as argument.
 wallpaperSetter :: WallpaperConf -> X ()
 wallpaperSetter wpconf = do
-  WCState st h <- XS.get
-  let oldws = fromMaybe "" $ M.lookup "oldws" $ M.fromList st
+  WCState oldws h <- XS.get
   visws <- getVisibleWorkspaces
-  when (show visws /= oldws) $ do
-    -- debug $ show visws
+  when (Just visws /= oldws) $ do
 
     wpconf' <- completeWPConf wpconf
     wspicpaths <- getPicPathsAndWSRects wpconf'
@@ -118,7 +116,7 @@ wallpaperSetter wpconf = do
       Just pid -> liftIO $ terminateProcess pid
 
     handle <- applyWallpaper wspicpaths
-    XS.put $ WCState [("oldws", show visws)] $ Just handle
+    XS.put $ WCState (Just visws) $ Just handle
 
 -- Helper functions
 -------------------
@@ -126,7 +124,7 @@ wallpaperSetter wpconf = do
 -- | Picks a random element from a list
 pickFrom :: [a] -> IO a
 pickFrom list = do
-  i <- getStdRandom $ randomR (0,length list - 1)
+  i <- randomRIO (0,length list - 1)
   return $ list !! i
 
 -- | get absolute picture path of the given wallpaper picture
@@ -149,9 +147,13 @@ getPicPath conf (WallpaperFix file) = do
 -- (requires imagemagick tool identify to be installed)
 getPicRes :: FilePath -> IO (Maybe (Int,Int))
 getPicRes picpath = do
-  (_, Just outh,_,pid) <- createProcess $ (proc "identify" [picpath]) { std_out = CreatePipe }
+  (_, Just outh,_,_pid) <- createProcess $ (proc "identify" ["-format", "%w %h", picpath]) { std_out = CreatePipe }
   output <- hGetContents outh
-  return $ if (length $ words output) < 3 then Nothing else splitRes (words output !! 2)
+  return $ case map reads (words output) of
+    -- mapM Text.Read.readMaybe is better but only in ghc>=7.6
+    [[(w,"")],[(h,"")]] -> Just (w,h)
+    _ -> Nothing
+
 
 -- |complete unset fields to default values (wallpaper directory = ~/.wallpapers,
 --  expects a file "NAME.jpg" for each workspace named NAME)
@@ -172,15 +174,15 @@ getVisibleWorkspaces = do
 getPicPathsAndWSRects :: WallpaperConf -> X [(Rectangle, FilePath)]
 getPicPathsAndWSRects wpconf = do
   winset <- gets windowset
-  paths <- liftIO $ getPicPaths wpconf
+  paths <- liftIO getPicPaths
   visws <- getVisibleWorkspaces
   let visscr = S.current winset : S.visible winset
       visrects = M.fromList $ map (\x -> ((S.tag . S.workspace) x, S.screenDetail x)) visscr
-      hasPicAndIsVisible (n, mp) = n `elem` visws && (not$isNothing mp)
+      hasPicAndIsVisible (n, mp) = n `elem` visws && (isJust mp)
       getRect tag = screenRect $ fromJust $ M.lookup tag visrects
       foundpaths = map (\(n,Just p)->(getRect n,p)) $ filter hasPicAndIsVisible paths
   return foundpaths
-  where getPicPaths wpconf = mapM (\(x,y) -> getPicPath wpconf y
+  where getPicPaths = mapM (\(x,y) -> getPicPath wpconf y
                              >>= \p -> return (x,p)) wl
         WallpaperList wl   = wallpapers wpconf
 
@@ -194,29 +196,25 @@ applyWallpaper parts = do
       endpart =" jpg:- | feh --no-xinerama --bg-tile --no-fehbg -"
       cmd = basepart ++ (concat $ intersperse " " layers) ++ endpart
   liftIO $ runCommand cmd
-  where
-  getVScreenDim = foldr maxXY (0,0) . map (screenRect . S.screenDetail) . S.screens
-    where maxXY (Rectangle x y w h) (mx,my) = ( fromIntegral ((fromIntegral x)+w) `max` mx
-                                              , fromIntegral ((fromIntegral y)+h) `max` my )
-  needsRotation (px,py) rect = let wratio = (fromIntegral $ rect_width rect) / (fromIntegral $ rect_height rect)
-                                   pratio = fromIntegral px / fromIntegral py
-                               in wratio > 1 && pratio < 1 || wratio < 1 && pratio > 1
-  layerCommand (rect, path) = do
-    res <- getPicRes path
-    if isNothing res then return ""
-      else do let rotate = needsRotation (fromJust res) rect
-              return $ " \\( '"++path++"' "++(if rotate then "-rotate 90 " else "")
-                        ++ " -scale "++(show$rect_width rect)++"x"++(show$rect_height rect)++"! \\)"
-                        ++ " -geometry +"++(show$rect_x rect)++"+"++(show$rect_y rect)++" -composite "
-
-
--- | internal. output string to /tmp/DEBUG
-debug str = liftIO $ runCommand $ "echo \"" ++ str ++ "\" >> /tmp/DEBUG"
-
--- |split a string at a delimeter
-split delim str = map T.unpack $ T.splitOn (T.pack delim) (T.pack str)
--- |XxY -> Maybe (X,Y)
-splitRes str = ret
-  where toks = map (\x -> read x :: Int) $ split "x" str
-        ret  = if length toks < 2 then Nothing else Just (toks!!0,toks!!1)
 
+
+getVScreenDim :: S.StackSet i l a sid ScreenDetail -> (Integer, Integer)
+getVScreenDim = foldr maxXY (0,0) . map (screenRect . S.screenDetail) . S.screens
+  where maxXY (Rectangle x y w h) (mx,my) = ( fromIntegral ((fromIntegral x)+w) `max` mx
+                                            , fromIntegral ((fromIntegral y)+h) `max` my )
+
+needsRotation :: Rectangle -> (Int,Int) -> Bool
+needsRotation rect (px,py) = let wratio, pratio :: Double
+                                 wratio = (fromIntegral $ rect_width rect) / (fromIntegral $ rect_height rect)
+                                 pratio = fromIntegral px / fromIntegral py
+                             in wratio > 1 && pratio < 1 || wratio < 1 && pratio > 1
+
+layerCommand :: (Rectangle, FilePath) -> IO String
+layerCommand (rect, path) = do
+  res <- getPicRes path
+  return $ case needsRotation rect <$> res of
+    Nothing -> ""
+    Just rotate ->
+                     " \\( '"++path++"' "++(if rotate then "-rotate 90 " else "")
+                      ++ " -scale "++(show$rect_width rect)++"x"++(show$rect_height rect)++"! \\)"
+                      ++ " -geometry +"++(show$rect_x rect)++"+"++(show$rect_y rect)++" -composite "
diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal
index 32dbbc7..c949aca 100644
--- a/xmonad-contrib.cabal
+++ b/xmonad-contrib.cabal
@@ -62,7 +62,6 @@ library
                     old-time,
                     process,
                     random,
-                    text,
                     mtl >= 1 && < 3,
                     unix,
                     X11>=1.6.1 && < 1.7,