From 6c7e8fc239da53383404e920acc54fc17eb9f905 Mon Sep 17 00:00:00 2001 From: Dmitry Malikov Date: Tue, 6 Jan 2015 13:43:37 +0300 Subject: [PATCH] Remove UnicodeSyntax --- .../Util/WorkspaceScreenshot/Internal.hs | 67 +++++++++---------- 1 file changed, 33 insertions(+), 34 deletions(-) diff --git a/src/XMonad/Util/WorkspaceScreenshot/Internal.hs b/src/XMonad/Util/WorkspaceScreenshot/Internal.hs index ceb53f3..c2e7a36 100644 --- a/src/XMonad/Util/WorkspaceScreenshot/Internal.hs +++ b/src/XMonad/Util/WorkspaceScreenshot/Internal.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE UnicodeSyntax #-} {-# OPTIONS_HADDOCK hide #-} -- | Provides an utility functions for easy and robust workspaces' screen capturing. module XMonad.Util.WorkspaceScreenshot.Internal @@ -30,98 +29,98 @@ import qualified XMonad.StackSet as S -- | Init gtk to enable a possibility of capturing workspaces. -initCapturing ∷ IO () +initCapturing :: IO () initCapturing = initGUI >> return () {-# WARNING initCapturing "Make sure you add `initCapturing' before `xmonad' call in xmonad.hs" #-} -- | Capture screens from workspaces satisfying given predicate. -captureWorkspacesWhen ∷ (WindowSpace → X Bool) → (FilePath → IO ()) → CapturingLayout → X () +captureWorkspacesWhen :: (WindowSpace -> X Bool) -> (FilePath -> IO ()) -> CapturingLayout -> X () captureWorkspacesWhen p hook = captureWorkspacesWhenId (workspaceIdToWindowSpace >=> p) hook where - workspaceIdToWindowSpace i = gets $ head . filter (\w → S.tag w == i) . S.workspaces . windowset + workspaceIdToWindowSpace i = gets $ head . filter (\w -> S.tag w == i) . S.workspaces . windowset -- | Capture screens from workspaces which id satisfies given predicate. -captureWorkspacesWhenId ∷ (WorkspaceId → X Bool) → (FilePath → IO ()) → CapturingLayout → X () +captureWorkspacesWhenId :: (WorkspaceId -> X Bool) -> (FilePath -> IO ()) -> CapturingLayout -> X () captureWorkspacesWhenId p hook mode = do - c ← gets $ S.currentTag . windowset - ps ← catMaybes <$> (mapM (\t → windows (S.view t) >> captureScreen) =<< filterM p =<< asks (workspaces . config)) + c <- gets $ S.currentTag . windowset + ps <- catMaybes <$> (mapM (\t -> windows (S.view t) >> captureScreen) =<< filterM p =<< asks (workspaces . config)) windows $ S.view c xfork $ merge mode ps >>= hook return () -- | Default predicate. Accepts every available workspace. -defaultPredicate ∷ a → X Bool +defaultPredicate :: a -> X Bool defaultPredicate = const (return True) -- | Default hook. Does nothing. -defaultHook ∷ a → IO () +defaultHook :: a -> IO () defaultHook = const (return ()) -- Capture screen with gtk pixbuf. -- Delay is necessary to get interfaces rendered. -captureScreen ∷ X (Maybe Pixbuf) +captureScreen :: X (Maybe Pixbuf) captureScreen = liftIO $ do threadDelay 100000 - rw ← drawWindowGetDefaultRootWindow - (w, h) ← drawableGetSize rw + rw <- drawWindowGetDefaultRootWindow + (w, h) <- drawableGetSize rw pixbufGetFromDrawable rw (Rectangle 0 0 w h) -- | Layout for resulting capture. data CapturingLayout = CapturingLayout - { dimensions ∷ [Pixbuf] → IO (Int, Int) -- ^ Maximum height and maximum width for capture - , fill ∷ [Pixbuf] → Pixbuf → IO () -- ^ Filling algorithm + { dimensions :: [Pixbuf] -> IO (Int, Int) -- ^ Maximum height and maximum width for capture + , fill :: [Pixbuf] -> Pixbuf -> IO () -- ^ Filling algorithm } -- | Capture screens layout horizontally. -horizontally ∷ CapturingLayout +horizontally :: CapturingLayout horizontally = CapturingLayout - { dimensions = \xs → - do h ← maximum <$> mapM pixbufGetHeight xs - w ← sum <$> mapM pixbufGetWidth xs + { dimensions = \xs -> + do h <- maximum <$> mapM pixbufGetHeight xs + w <- sum <$> mapM pixbufGetWidth xs return (h, w) - , fill = \ps p → foldM_ (addTo p) 0 ps + , fill = \ps p -> foldM_ (addTo p) 0 ps } where - addTo ∷ Pixbuf → Int → Pixbuf → IO Int + addTo :: Pixbuf -> Int -> Pixbuf -> IO Int addTo p a p' = - do w' ← pixbufGetWidth p' - h' ← pixbufGetHeight p' + do w' <- pixbufGetWidth p' + h' <- pixbufGetHeight p' pixbufCopyArea p' 0 0 w' h' p a 0 return (a + w') -- | Capture screens layout vertically. -vertically ∷ CapturingLayout +vertically :: CapturingLayout vertically = CapturingLayout - { dimensions = \xs → - do h ← sum <$> mapM pixbufGetHeight xs - w ← maximum <$> mapM pixbufGetWidth xs + { dimensions = \xs -> + do h <- sum <$> mapM pixbufGetHeight xs + w <- maximum <$> mapM pixbufGetWidth xs return (h, w) - , fill = \ps p → foldM_ (addTo p) 0 ps + , fill = \ps p -> foldM_ (addTo p) 0 ps } where - addTo ∷ Pixbuf → Int → Pixbuf → IO Int + addTo :: Pixbuf -> Int -> Pixbuf -> IO Int addTo p a p' = - do w' ← pixbufGetWidth p' - h' ← pixbufGetHeight p' + do w' <- pixbufGetWidth p' + h' <- pixbufGetHeight p' pixbufCopyArea p' 0 0 w' h' p 0 a return (a + h') -- Contruct final image from the list of pixbufs. -merge ∷ CapturingLayout → [Pixbuf] → IO FilePath +merge :: CapturingLayout -> [Pixbuf] -> IO FilePath merge layout ps = do - (h, w) ← dimensions layout ps - p ← pixbufNew ColorspaceRgb False 8 w h + (h, w) <- dimensions layout ps + p <- pixbufNew ColorspaceRgb False 8 w h fill layout ps p - dir ← getXMonadDir + dir <- getXMonadDir let filepath = (dir ++ "/screenshot.png") pixbufSave p filepath (fromString "png") ([] :: [(String,String)]) return filepath