diff --git a/src/QBar/Configuration.hs b/src/QBar/Configuration.hs deleted file mode 100644 index db02a5b053e37a8299714c38d232474faae71f09..0000000000000000000000000000000000000000 --- a/src/QBar/Configuration.hs +++ /dev/null @@ -1,73 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module QBar.Configuration where - -import QBar.Blocks -import QBar.Core - -import Data.Aeson.TH -import Data.Maybe (fromMaybe) -import qualified Data.Text.Lazy as T -import Control.Monad.Reader -import Pipes - -data BarConfiguration = BarConfiguration { - intervalSeconds :: Maybe Int, - blocks :: [BlockConfiguration] -} - -data BlockConfiguration = Modify ModifyConfiguration - | Date - | ExternalCommand ExternalCommandConfiguration - -data ModifyConfiguration = ModifyConfiguration { - block :: BlockConfiguration, - enableAutoPadding :: Maybe Bool, - icon :: Maybe T.Text -} - -data ExternalCommandConfiguration = ExternalCommandConfiguration { - command :: FilePath, - persistent :: Maybe Bool -} - -$(deriveJSON defaultOptions ''BarConfiguration) -$(deriveJSON defaultOptions ''BlockConfiguration) -$(deriveJSON defaultOptions ''ModifyConfiguration) -$(deriveJSON defaultOptions ''ExternalCommandConfiguration) - - -type ConfigurationM = Reader (PullBlock -> CachedBlock) - -cachePullBlock :: PullBlock -> ConfigurationM CachedBlock -cachePullBlock pullBlock = ask <*> return pullBlock - - - -applyBarConfiguration :: BarConfiguration -> BarIO () -applyBarConfiguration barConfiguration@BarConfiguration{ intervalSeconds } = do - cachePullBlock' <- sharedInterval $ fromMaybe 10 intervalSeconds - let blocks' = runReader (evaluateBarConfiguration barConfiguration) cachePullBlock' - mapM_ addBlock blocks' - -evaluateBarConfiguration :: BarConfiguration -> ConfigurationM [CachedBlock] -evaluateBarConfiguration BarConfiguration { blocks } = mapM evaluateBlockConfiguration blocks - - -evaluateBlockConfiguration :: BlockConfiguration -> ConfigurationM CachedBlock - -evaluateBlockConfiguration (Modify ModifyConfiguration { enableAutoPadding, icon, block }) = do - block' <- evaluateBlockConfiguration block - let block'' = case icon of - Just icon' -> block' >-> modify (addIcon icon') - Nothing -> block' - let block''' = if enableAutoPadding == Just True - then block'' >-> autoPadding - else block'' - return block''' - -evaluateBlockConfiguration Date = return $ toCachedBlock dateBlock - -evaluateBlockConfiguration (ExternalCommand ExternalCommandConfiguration { command, persistent }) = if fromMaybe False persistent - then return $ startPersistentBlockScript command - else cachePullBlock $ blockScript command diff --git a/src/QBar/Server.hs b/src/QBar/Server.hs index 81756a7eb22346adabd32c59cb4e877c755ac62a..9a282a9fc3822fc1ca45fa6b1e6cea25dbccab9b 100644 --- a/src/QBar/Server.hs +++ b/src/QBar/Server.hs @@ -168,7 +168,7 @@ renderInitialBlocks options handle blockFilter = do runBarConfiguration :: BarIO () -> MainOptions -> IO () -runBarConfiguration generateBarConfig options = do +runBarConfiguration defaultBarConfig options = do -- Create IORef to contain the active filter let initialBlockFilter = StaticFilter None activeFilter <- newIORef initialBlockFilter @@ -221,8 +221,8 @@ runBarConfiguration generateBarConfig options = do loadBlocks :: BarIO () loadBlocks = do when (indicator options) $ addBlock renderIndicator - -- Evaluate config - generateBarConfig + + defaultBarConfig createCommandChan :: IO CommandChan