Accordion: new constructor to allow short version to have plugins too

1 files changed, 18 insertions, 13 deletions

diff --git a/src/Xmobar/Plugins/Accordion.hs b/src/Xmobar/Plugins/Accordion.hs
index 6922fba..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)
@@ -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 = expandIcon
                           , shrink = shrinkIcon }
-                   runnables)
+                   runnables
+                   shortRunnables)
         cb = do
     clicked <- newIORef Nothing
     (_, n, _) <- readProcessWithExitCode "uuidgen" [] ""
@@ -75,6 +80,7 @@ instance (Exec a, Read a, Show a) => Exec (Accordion a) where
                               ExitFailure _ -> error "how is this possible?")
               (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
@@ -82,18 +88,17 @@ instance (Exec a, Read a, Show a) => Exec (Accordion a) where
                                           (do liftIO $ clear clicked
                                               modify' not)
                                      b <- get
-                                     if b
-                                       then loop pipe
-                                       else liftIO $ cb (attachClick pipe expandIcon))
-                                 `runReaderT` strRefs
+                                     loop b pipe)
+                                 `runReaderT` (strRefs, strRefs')
                                  `evalStateT` initial')
-                        (zip runnables strRefs))
+                        (zip (runnables ++ shortRunnables)
+                             (strRefs ++ strRefs')))
       `finally` removeFile pipe
     where
-      loop p = do
-        strRefs <- ask
-        text <- join <$> mapM (liftIO . readIORef) strRefs
-        liftIO $ cb $ text ++ attachClick p shrinkIcon
+      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 . (,())