colonelpanic/dotfiles
1
0
Fork 1
Code Issues Pull Requests Packages Projects Releases Wiki Activity

[XMonad] Use sequenceT to define forkM

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
dotfiles/config/xmonad/imalison-xmonad.cabal
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

13
dotfiles/config/xmonad/xmonad.hs
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)