[XMonad] Use sequenceT to define forkM

This commit is contained in:
Ivan Malison 2017-09-20 16:28:26 -07:00
parent d3fb2bb4cb
commit 0781c6a55a
No known key found for this signature in database
GPG Key ID: 62530EFBE99DC2F8
2 changed files with 24 additions and 26 deletions

View File

@ -13,23 +13,24 @@ cabal-version: >=1.10
executable imalison-xmonad executable imalison-xmonad
main-is: xmonad.hs main-is: xmonad.hs
build-depends: X11>=1.8, build-depends: aeson>=0.11.2.1
aeson>=0.11.2.1, , X11>=1.8
base >=4.9 && <4.10, , base >=4.9 && <4.10
bytestring>=0.10.8.1, , bytestring>=0.10.8.1
containers>=0.5.7.1, , containers>=0.5.7.1
directory>=1.2.6.2, , directory>=1.2.6.2
filepath>=1.4.1.0, , filepath>=1.4.1.0
gtk-traymanager>=0.1.6, , gtk-traymanager>=0.1.6
hostname>=1.0, , hostname>=1.0
mtl>=2.2.1, , mtl>=2.2.1
multimap>=1.2.1, , multimap>=1.2.1
process>=1.4.3.0, , process>=1.4.3.0
split, , split
taffybar>=0.4.6, , taffybar>=0.4.6
transformers>=0.5.2.0, , transformers>=0.5.2.0
utf8-string, , tuple >= 0.3.0.2
xmonad-contrib>=0.13, , utf8-string
xmonad>=0.13 , xmonad-contrib>=0.13
, xmonad>=0.13
hs-source-dirs: . hs-source-dirs: .
default-language: Haskell2010 default-language: Haskell2010

View File

@ -3,6 +3,7 @@
FlexibleInstances, FlexibleContexts, ScopedTypeVariables #-} FlexibleInstances, FlexibleContexts, ScopedTypeVariables #-}
module Main where module Main where
import qualified Codec.Binary.UTF8.String as UTF8String (encode)
import qualified Control.Arrow as A import qualified Control.Arrow as A
import Control.Monad import Control.Monad
import Control.Monad.Trans import Control.Monad.Trans
@ -10,13 +11,13 @@ import Control.Monad.Trans.Maybe
import Data.Aeson import Data.Aeson
import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy as B
import Data.List import Data.List
import qualified Codec.Binary.UTF8.String as UTF8String (encode)
import Data.List.Split import Data.List.Split
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe import Data.Maybe
import Data.Monoid import Data.Monoid
import qualified Data.MultiMap as MM import qualified Data.MultiMap as MM
import Data.Proxy import Data.Proxy
import Data.Tuple.Sequence (sequenceT)
import Data.Typeable import Data.Typeable
import Graphics.X11.ExtraTypes.XF86 import Graphics.X11.ExtraTypes.XF86
import Network.HostName import Network.HostName
@ -67,7 +68,6 @@ import qualified XMonad.Util.Dmenu as DM
import qualified XMonad.Util.ExtensibleState as XS import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.Minimize import XMonad.Util.Minimize
import XMonad.Util.NamedScratchpad import XMonad.Util.NamedScratchpad
(NamedScratchpad(NS), nonFloating, namedScratchpadAction)
import XMonad.Util.NamedWindows (getName) import XMonad.Util.NamedWindows (getName)
import XMonad.Util.Run import XMonad.Util.Run
import XMonad.Util.WorkspaceCompare import XMonad.Util.WorkspaceCompare
@ -117,10 +117,7 @@ xRunCommand cmd = void $ io $ readCreateProcess (shell cmd) ""
(<..>) = fmap . fmap (<..>) = fmap . fmap
forkM :: Monad m => (i -> m a) -> (i -> m b) -> i -> m (a, b) forkM :: Monad m => (i -> m a) -> (i -> m b) -> i -> m (a, b)
forkM a b input = do forkM a b = sequenceT . (a A.&&& b)
resA <- a input
resB <- b input
return (resA, resB)
tee :: Monad m => (i -> m a) -> (i -> m b) -> i -> m a tee :: Monad m => (i -> m a) -> (i -> m b) -> i -> m a
tee = (fmap . fmap . fmap) (fmap fst) forkM tee = (fmap . fmap . fmap) (fmap fst) forkM
@ -469,7 +466,7 @@ setWorkspaceNames = withWindowSet $ \s -> withDisplay $ \dpy -> do
sort' <- getSortByIndex sort' <- getSortByIndex
let ws = sort' $ W.workspaces s let ws = sort' $ W.workspaces s
tagNames = map W.tag ws tagNames = map W.tag ws
getName tag = (maybe "" (" " ++)) <$> getWorkspaceName tag getName tag = maybe "" (" " ++) <$> getWorkspaceName tag
getFullName :: String -> X String getFullName :: String -> X String
getFullName tag = printf "%s%s" tag <$> getName tag getFullName tag = printf "%s%s" tag <$> getName tag
names <- mapM getFullName tagNames names <- mapM getFullName tagNames
@ -727,7 +724,7 @@ myKill =
-- Gather windows of same class -- Gather windows of same class
allWindows = concat <$> (mapWorkspaces $ return . W.integrate' . W.stack) allWindows = concat <$> mapWorkspaces (return . W.integrate' . W.stack)
windowsMatchingClass klass = windowsMatchingClass klass =
allWindows >>= filterM (((== klass) <$>) . getClass) allWindows >>= filterM (((== klass) <$>) . getClass)