1 files changed, 36 insertions, 20 deletions

diff --git a/src/Xmobar/Plugins/Accordion.hs b/src/Xmobar/Plugins/Accordion.hs
index 6377928..c1967c2 100644
--- a/src/Xmobar/Plugins/Accordion.hs
+++ b/src/Xmobar/Plugins/Accordion.hs
@@ -15,7 +15,7 @@
 --
 -----------------------------------------------------------------------------
 
-module Xmobar.Plugins.Accordion (defaultTuning, makeAccordion, Tuning(..)) where
+module Xmobar.Plugins.Accordion (defaultTuning, makeAccordion, makeAccordion', Tuning(..)) where
 
 import Control.Concurrent.Async (withAsync)
 import Control.Exception (finally)
@@ -23,7 +23,7 @@ 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 Data.IORef (atomicModifyIORef', newIORef, readIORef)
+import Data.IORef (atomicModifyIORef', newIORef, readIORef, IORef)
 import Data.Maybe (isJust)
 import System.Directory (removeFile)
 import System.Exit (ExitCode(..))
@@ -38,10 +38,14 @@ import Xmobar.Run.Exec (Exec(..), tenthSeconds)
 data Accordion a = Accordion {
     tuning :: Tuning
   , plugins :: [a]
+  , shortPlugins :: [a]
 } deriving (Show, Read)
 
 makeAccordion :: Exec a => Tuning -> [a] -> Accordion a
-makeAccordion t rs = Accordion { tuning = t, plugins = rs }
+makeAccordion t rs = Accordion { tuning = t, plugins = rs, shortPlugins = [] }
+
+makeAccordion' :: Exec a => Tuning -> [a] -> [a] -> Accordion a
+makeAccordion' t rs rs' = Accordion { tuning = t, plugins = rs, shortPlugins = rs' }
 
 data Tuning = Tuning {
     alias' :: String
@@ -59,11 +63,12 @@ defaultTuning = Tuning {
 }
 
 instance (Exec a, Read a, Show a) => Exec (Accordion a) where
-  alias (Accordion Tuning { alias' = name } _) = name
+  alias (Accordion Tuning { alias' = name } _ _) = name
   start (Accordion Tuning { initial = initial'
-                          , expand = expand'
-                          , shrink = shrink' }
-                   runnables)
+                          , expand = expandIcon
+                          , shrink = shrinkIcon }
+                   runnables
+                   shortRunnables)
         cb = do
     clicked <- newIORef Nothing
     (_, n, _) <- readProcessWithExitCode "uuidgen" [] ""
@@ -74,24 +79,35 @@ instance (Exec a, Read a, Show a) => Exec (Accordion a) where
                               ExitSuccess -> atomicModifyIORef' clicked (const (Just (), ()))
                               ExitFailure _ -> error "how is this possible?")
               (const $ do
-                  srefs <- mapM (newIORef . const "") runnables
-                  foldr (\(runnable, sref) acc -> withAsync (start runnable (writeToRef sref)) (const acc))
+                  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
-                                     if b then loop pipe else liftIO $ cb (click pipe expand'))
-                                 `runReaderT` srefs `evalStateT` initial')
-                        (zip runnables srefs))
+                                     loop b pipe)
+                                 `runReaderT` (strRefs, strRefs')
+                                 `evalStateT` initial')
+                        (zip (runnables ++ shortRunnables)
+                             (strRefs ++ strRefs')))
       `finally` removeFile pipe
     where
-      click file icon = "<action=`echo 1 > " ++ file ++ "`>" ++ icon ++ "</action>"
-      clear = (`atomicModifyIORef'` const (Nothing, ()))
-      removeLinebreak = init
-      writeToRef strRef = atomicModifyIORef' strRef . const . (,())
-      loop p = do
-        srefs <- ask
-        text <- join <$> mapM (liftIO . readIORef) srefs
-        liftIO $ cb $ text ++ click p shrink'
+      loop b p = 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)
+
+writeToRef :: IORef a -> a -> IO ()
+writeToRef strRef = atomicModifyIORef' strRef . const . (,())
+
+clear :: IORef (Maybe a) -> IO ()
+clear = (`atomicModifyIORef'` const (Nothing, ()))
+
+removeLinebreak :: [a] -> [a]
+removeLinebreak = init
+
+attachClick :: String -> String -> String
+attachClick file icon = "<action=`echo 1 > " ++ file ++ "`>" ++ icon ++ "</action>"