Add support for specifying script block poll interval

src/QBar/Blocks/Script.hs

@@ -4,6 +4,7 @@ import QBar.BlockHelper
 import QBar.BlockOutput
 import QBar.Core
 import QBar.TagParser
+import QBar.Time
 
 import Control.Exception (IOException)
 import qualified Data.ByteString.Lazy.Char8 as C8
@@ -18,8 +19,8 @@ import System.Process.Typed (Process, shell, setStdin, setStdout,
   getStdout, closed, createPipe, readProcessStdout, startProcess, stopProcess)
 
 
-pollScriptBlock :: FilePath -> Block
-pollScriptBlock path = runPollBlock $ forever $ yieldBlockUpdate =<< (lift blockScriptAction)
+pollScriptBlock :: Interval -> FilePath -> Block
+pollScriptBlock interval path = runPollBlock' interval $ forever $ yieldBlockUpdate =<< (lift blockScriptAction)
   where
     blockScriptAction :: BarIO BlockOutput
     blockScriptAction = do

src/QBar/Cli.hs

@@ -9,8 +9,10 @@ import QBar.Core
 import QBar.DefaultConfig
 import QBar.Server
 import QBar.Theme
+import QBar.Time
 
 import Control.Monad (join)
+import Data.Maybe (fromMaybe)
 import qualified Data.Text.Lazy as T
 import Options.Applicative
 
@@ -92,6 +94,15 @@ blockParser =
 
 scriptBlockParser :: Parser (BarIO ())
 scriptBlockParser = helper <*> do
-  poll <- switch $ long "poll" <> short 'p' <> help "Run script in poll mode (every line of output updates the block)."
+  poll <- switch $ long "poll" <> short 'p' <> help "Run script in poll mode (at regular intervals)"
+  -- HACK optparse-applicative does not support options of style --poll[=INTERVAL],
+  -- so we add a second option to specify the interval explicitly instead
+  -- https://github.com/pcapriotti/optparse-applicative/issues/243
+  pollInterval <- fromMaybe defaultInterval <$> (optional $ IntervalSeconds <$> option auto (
+    long "interval" <>
+    short 'i' <>
+    metavar "SECONDS" <>
+    (help $ "Interval to use for --poll mode (default: " <> humanReadableInterval defaultInterval <> ")")
+    ))
   script <- strArgument (metavar "SCRIPT" <> help "The script that will be executed with a shell.")
-  return $ (if poll then addBlock . pollScriptBlock else addBlock . scriptBlock) script
+  return $ (if poll then addBlock . pollScriptBlock pollInterval else addBlock . scriptBlock) script

src/QBar/Time.hs

 {-# LANGUAGE OverloadedLists #-}
 
-module QBar.Time (SleepScheduler, HasSleepScheduler(..), Interval, createSleepScheduler, sleepUntil, sleepUntil', sleepUntilInterval, sleepUntilInterval', everyMinute, everyNSeconds, nextIntervalTime) where
+module QBar.Time (SleepScheduler, HasSleepScheduler(..), Interval(..), createSleepScheduler, sleepUntil, sleepUntil', sleepUntilInterval, sleepUntilInterval', everyMinute, everyNSeconds, nextIntervalTime, humanReadableInterval) where
 
 import Control.Concurrent.Async
 import Control.Concurrent.MVar
@@ -10,6 +10,7 @@ import Data.SortedList (SortedList, toSortedList, fromSortedList, singleton, par
 import Data.Ord (comparing)
 
 newtype Interval = IntervalSeconds Integer
+  deriving (Read, Show)
 
 -- |Describes an interval that is run every "n" seconds after midnight.
 everyNSeconds :: Integer -> Interval
@@ -29,6 +30,8 @@ nextIntervalTime (IntervalSeconds intervalSeconds) = liftIO $ do
     utctDayTime = fromInteger $ (intervalId + 1) * intervalSeconds
   }
 
+humanReadableInterval :: Interval -> String
+humanReadableInterval (IntervalSeconds i) = show i <> "s"
 
 data SleepScheduler = SleepScheduler (MVar (SortedList ScheduledEvent, [ScheduledEvent])) Event.Event
 data ScheduledEvent = ScheduledEvent {