Accordion - a few cleanups

  - Use `RecordWildCards` language extension
  - Use `concurrently_` and `mapConcurrently_` instead of `withAsync`
  - Use `Bool` instead of `Maybe ()`
  - Use `whenM` instead of `when`
  - Add signature to `loop`

1 files changed, 36 insertions, 36 deletions

diff --git a/src/Xmobar/Plugins/Accordion.hs b/src/Xmobar/Plugins/Accordion.hs
index 9ae71bc..ce15cee 100644
--- a/src/Xmobar/Plugins/Accordion.hs
+++ b/src/Xmobar/Plugins/Accordion.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TupleSections, FlexibleContexts #-}
+{-# LANGUAGE RecordWildCards #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -17,14 +18,14 @@
 
 module Xmobar.Plugins.Accordion (defaultTuning, makeAccordion, makeAccordion', Tuning(..)) where
 
-import Control.Concurrent.Async (withAsync)
+import Control.Concurrent.Async (concurrently_, mapConcurrently_)
 import Control.Exception (finally)
-import Control.Monad (forever, join, when)
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Reader (runReaderT, ask)
-import Control.Monad.State.Strict (evalStateT, get, modify')
+import Control.Monad.Extra (whenM)
+import Control.Monad (forever, join)
+import Control.Monad.IO.Class (liftIO, MonadIO)
+import Control.Monad.Reader (MonadReader, runReaderT, ask)
+import Control.Monad.State.Strict (MonadState, evalStateT, get, modify')
 import Data.IORef (atomicModifyIORef', newIORef, readIORef, IORef)
-import Data.Maybe (isJust)
 import GHC.IO.Handle.FD (withFileBlocking)
 import System.Directory (removeFile)
 import System.IO (IOMode(ReadMode), hGetContents')
@@ -64,46 +65,45 @@ defaultTuning = Tuning {
 }
 
 instance Exec a => Exec (Accordion a) where
-  alias (Accordion Tuning { alias' = name } _ _) = name
-  start (Accordion Tuning { initial = initial'
-                          , expand = expandIcon
-                          , shrink = shrinkIcon }
-                   runnables
-                   shortRunnables)
-        cb = do
-    clicked <- newIORef Nothing
+  alias (Accordion Tuning{..} _ _) = alias'
+  start (Accordion Tuning{..} runnables shortRunnables) cb = do
+    clicked <- newIORef False
     (_, n, _) <- readProcessWithExitCode "uuidgen" [] ""
     let pipe = "/tmp/accordion-" ++ removeLinebreak n
     (_, _, _) <- readProcessWithExitCode "mkfifo" [pipe] ""
-    withAsync (forever $ do "" <- withFileBlocking pipe ReadMode hGetContents'
-                            atomicModifyIORef' clicked (const (Just (), ())))
-              (const $ do
-                  strRefs <- mapM (newIORef . const "") runnables
-                  strRefs' <- mapM (newIORef . const "") shortRunnables
-                  foldr (\(runnable, strRef) acc -> withAsync (start runnable (writeToRef strRef)) (const acc))
-                        (forever (do liftIO (tenthSeconds 1)
-                                     clicked' <- liftIO $ readIORef clicked
-                                     when (isJust clicked')
-                                          (do liftIO $ clear clicked
-                                              modify' not)
-                                     b <- get
-                                     loop b pipe)
-                                 `runReaderT` (strRefs, strRefs')
-                                 `evalStateT` initial')
-                        (zip (runnables ++ shortRunnables)
-                             (strRefs ++ strRefs')))
+    concurrently_ (forever $ do "" <- withFileBlocking pipe ReadMode hGetContents'
+                                atomicModifyIORef' clicked (const (True, ())))
+                  (do
+                      strRefs <- mapM (newIORef . const "") runnables
+                      strRefs' <- mapM (newIORef . const "") shortRunnables
+                      let processClick = forever (do liftIO (tenthSeconds 1)
+                                                     whenM (liftIO $ readIORef clicked)
+                                                           (do liftIO $ clear clicked
+                                                               modify' not)
+                                                     get >>= loop pipe)
+                                           `runReaderT` (strRefs, strRefs')
+                                           `evalStateT` initial
+                      let startRunnables = zipWith start
+                                                   (runnables ++ shortRunnables)
+                                                   (map writeToRef $ strRefs ++ strRefs')
+                      parallel_ $ processClick:startRunnables)
       `finally` removeFile pipe
     where
-      loop b p = do
+      loop :: (MonadIO m,
+               MonadState Bool m,
+               MonadReader ([IORef String], [IORef String]) m)
+           => String -> Bool -> m ()
+      loop pipe bool = do
         (strRefs, strRefs') <- ask
-        text <- join <$> mapM (liftIO . readIORef) (if b then strRefs else strRefs')
-        liftIO $ cb $ text ++ attachClick p (if b then shrinkIcon else expandIcon)
+        text <- join <$> mapM (liftIO . readIORef) (if bool then strRefs else strRefs')
+        liftIO $ cb $ text ++ attachClick pipe (if bool then shrink else expand)
+      parallel_ = mapConcurrently_ id
 
 writeToRef :: IORef a -> a -> IO ()
 writeToRef strRef = atomicModifyIORef' strRef . const . (,())
 
-clear :: IORef (Maybe a) -> IO ()
-clear = (`atomicModifyIORef'` const (Nothing, ()))
+clear :: IORef Bool -> IO ()
+clear = (`atomicModifyIORef'` const (False, ()))
 
 removeLinebreak :: [a] -> [a]
 removeLinebreak = init