Move BlockOutput from QBar.Core to QBar.BlockOutput

src/QBar/BlockOutput.hs

+{-# LANGUAGE TemplateHaskell #-}
+
+module QBar.BlockOutput where
+
+import QBar.BlockText
+
+import Control.Lens
+import Data.Aeson.TH
+import qualified Data.Text.Lazy as T
+
+data BlockOutput = BlockOutput
+  { _fullText :: BlockText
+  , _shortText :: Maybe BlockText
+  , _blockName :: Maybe T.Text
+  , _invalid :: Bool
+  }
+$(deriveJSON defaultOptions ''BlockOutput)
+makeLenses ''BlockOutput
+
+
+mkBlockOutput :: BlockText -> BlockOutput
+mkBlockOutput text = BlockOutput
+  { _fullText = text
+  , _shortText = Nothing
+  , _blockName = Nothing
+  , _invalid = False
+  }
+
+mkErrorOutput :: T.Text -> BlockOutput
+mkErrorOutput = mkBlockOutput . importantText criticalImportant
+
+emptyBlock :: BlockOutput
+emptyBlock = mkBlockOutput mempty
+
+addIcon :: T.Text -> BlockOutput -> BlockOutput
+addIcon icon = over fullText $ (<>) . normalText $ icon <> " "
+

src/QBar/Blocks/Battery.hs

@@ -5,6 +5,7 @@ module QBar.Blocks.Battery where
 
 
 import QBar.Core hiding (name)
+import QBar.BlockOutput
 import QBar.BlockText
 import Pipes
 
@@ -86,7 +87,7 @@ batteryBlock = do
 
 updateBatteryBlock :: Bool -> [BatteryState] -> Block ()
 updateBatteryBlock _ [] = yield Nothing
-updateBatteryBlock isPlugged bs = updateBlock $ (shortText.~shortText') $ createBlock fullText'
+updateBatteryBlock isPlugged bs = updateBlock $ (shortText.~shortText') $ mkBlockOutput fullText'
   where
     fullText' :: BlockText
     fullText' = normalText (batteryIcon <> " ") <> overallPercentage <> optionalEachBattery <> optionalOverallEstimate

src/QBar/Blocks/Date.hs

 module QBar.Blocks.Date where
 
+import QBar.BlockOutput
+import QBar.BlockText
 import QBar.Core
 import QBar.Time
-import QBar.BlockText
 
 import qualified Data.Text.Lazy as T
 import Data.Time.Format
@@ -24,4 +25,4 @@ dateBlockOutput = do
   let date = T.pack (formatTime defaultTimeLocale "%a %F" zonedTime)
   let time = T.pack (formatTime defaultTimeLocale "%R" zonedTime)
   let text = normalText ("📅\xFE0E " <> date <> " ") <> activeText time
-  return $ blockName ?~ "date" $ createBlock text
+  return $ blockName ?~ "date" $ mkBlockOutput text

src/QBar/ControlSocket.hs

@@ -7,6 +7,7 @@ import QBar.Cli (MainOptions(..))
 import QBar.Core
 -- TODO: remove dependency?
 import QBar.Filter
+import QBar.BlockOutput
 import QBar.BlockText
 
 import Control.Exception (handle)
@@ -17,6 +18,8 @@ import Control.Concurrent.Async
 import Control.Concurrent.STM.TChan (TChan, writeTChan)
 import Data.Aeson.TH
 import Data.ByteString (ByteString)
+import System.FilePath ((</>))
+import System.IO
 import Data.Either (either)
 import Data.Maybe (maybe)
 import Data.Text.Lazy (Text, pack)
@@ -30,9 +33,6 @@ import Pipes.Aeson.Unchecked (encode)
 import Pipes.Network.TCP (fromSocket, toSocket)
 import System.Directory (removeFile, doesFileExist)
 import System.Environment (getEnv)
-import System.FilePath ((</>))
-import System.IO
-
 type CommandChan = TChan Command
 
 data Command = SetFilter Filter
@@ -128,5 +128,5 @@ handleBlockStream producer = do
   where
     handleParsedBlock :: Producer ByteString IO () -> String -> PushBlock
     handleParsedBlock leftovers update = do
-      updateBlock $ createBlock . normalText $ TL.pack update
+      updateBlock $ mkBlockOutput . normalText $ TL.pack update
       handleBlockStream leftovers

src/QBar/Core.hs

@@ -3,16 +3,18 @@
 
 module QBar.Core where
 
+import QBar.BlockOutput
 import QBar.BlockText
 
-import Control.Exception (IOException)
-import Control.Monad (forever)
-import Control.Monad.Reader (ReaderT, runReaderT, ask)
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.Async
 import Control.Concurrent.Event as Event
 import Control.Concurrent.MVar
 import Control.Concurrent.STM.TChan (TChan, writeTChan)
+import Control.Exception (IOException)
+import Control.Lens
+import Control.Monad (forever)
+import Control.Monad.Reader (ReaderT, runReaderT, ask)
 import Data.Aeson.TH
 import qualified Data.ByteString.Lazy.Char8 as C8
 import Data.Int (Int64)
@@ -28,7 +30,6 @@ import System.Exit
 import System.IO
 import System.Process.Typed (Process, shell, setStdin, setStdout,
   getStdout, closed, createPipe, readProcessStdout, startProcess, stopProcess)
-import Control.Lens
 
 
 data BlockEvent = Click {
@@ -37,14 +38,6 @@ data BlockEvent = Click {
 } deriving Show
 $(deriveJSON defaultOptions ''BlockEvent)
 
-data BlockOutput = BlockOutput
-  { _fullText :: BlockText
-  , _shortText :: Maybe BlockText
-  , _blockName :: Maybe T.Text
-  , _invalid :: Bool
-  }
-$(deriveJSON defaultOptions ''BlockOutput)
-
 
 data PushMode = PushMode
 data PullMode = PullMode
@@ -84,7 +77,6 @@ data Bar = Bar {
   requestBarUpdate :: IO (),
   newBlockChan :: TChan CachedBlock
 }
-makeLenses ''BlockOutput
 
 instance IsBlock PushBlock where
   toCachedBlock = cachePushBlock
@@ -114,23 +106,6 @@ runBarIO bar action = runReaderT (runSafeT action) bar
 askBar :: BarIO Bar
 askBar = lift ask
 
-createBlock :: BlockText -> BlockOutput
-createBlock text = BlockOutput
-  { _fullText = text
-  , _shortText = Nothing
-  , _blockName = Nothing
-  , _invalid = False
-  }
-
-createErrorBlock :: T.Text -> BlockOutput
-createErrorBlock = createBlock . importantText criticalImportant
-
-emptyBlock :: BlockOutput
-emptyBlock = createBlock mempty
-
-addIcon :: T.Text -> BlockOutput -> BlockOutput
-addIcon icon = over fullText $ (<>) . normalText $ icon <> " "
-
 modify :: (BlockOutput -> BlockOutput)
        -> Pipe BlockState BlockState BarIO r
 modify x = PP.map (over (_Just . _1) x)
@@ -252,9 +227,9 @@ blockScript path = forever $ updateBlock =<< (lift blockScriptAction)
           (text:short:_) -> shortText ?~ pangoText short $ createScriptBlock text
           (text:_) -> createScriptBlock text
           [] -> createScriptBlock "-"
-        (ExitFailure nr) -> return $ createErrorBlock $ "[" <> T.pack (show nr) <> "]"
+        (ExitFailure nr) -> return $ mkErrorOutput $ "[" <> T.pack (show nr) <> "]"
     createScriptBlock :: T.Text -> BlockOutput
-    createScriptBlock text = blockName ?~ T.pack path $ createBlock . pangoText $ text
+    createScriptBlock text = blockName ?~ T.pack path $ mkBlockOutput . pangoText $ text
 
 startPersistentBlockScript :: FilePath -> PushBlock
 -- The outer catchP only catches errors that occur during process creation
@@ -262,7 +237,7 @@ startPersistentBlockScript path = catchP startScriptProcess handleError
   where
     handleError :: IOException -> PushBlock
     handleError e = do
-      updateBlock . createErrorBlock $ "[" <> T.pack (show e) <> "]"
+      updateBlock . mkErrorOutput $ "[" <> T.pack (show e) <> "]"
       exitBlock
     handleErrorWithProcess :: (Process i o e) -> IOException -> PushBlock
     handleErrorWithProcess process e = do
@@ -278,7 +253,7 @@ startPersistentBlockScript path = catchP startScriptProcess handleError
     blockFromHandle :: Handle -> PushBlock
     blockFromHandle handle = forever $ do
       line <- liftIO $ TIO.hGetLine handle
-      updateBlock $ createBlock . pangoText $ line
+      updateBlock $ mkBlockOutput . pangoText $ line
       lift updateBar
 
 addBlock :: IsBlock a => a -> BarIO ()

src/QBar/DefaultConfig.hs

 module QBar.DefaultConfig where
 
 import QBar.Blocks
+import QBar.BlockOutput
 import QBar.Core
 
 import Pipes

src/QBar/Filter.hs

@@ -2,7 +2,7 @@
 
 module QBar.Filter where
 
-import QBar.Core
+import QBar.BlockOutput
 import QBar.BlockText
 
 import Control.Monad.State.Lazy (State, evalState, get, put)

src/QBar/Server.hs

 module QBar.Server where
 
 import QBar.Blocks
+import QBar.BlockOutput
 import QBar.BlockText
 import QBar.Core
 import QBar.Cli
@@ -36,7 +37,7 @@ data Handle = Handle {
 
 renderIndicator :: CachedBlock
 -- Using 'cachedBlock' is a hack to actually get the block to update on every bar update (by doing this it will not get a cache later in the pipeline).
-renderIndicator = forever $ each $ map (mkBlockState . createBlock . normalText) ["/", "-", "\\", "|"]
+renderIndicator = forever $ each $ map (mkBlockState . mkBlockOutput . normalText) ["/", "-", "\\", "|"]
 
 runBlock :: CachedBlock -> BarIO (Maybe (BlockState, CachedBlock))
 runBlock producer = do
@@ -183,7 +184,7 @@ renderInitialBlocks options handle blockFilter = do
   date <- dateBlockOutput
   let initialBlocks = [mkBlockState date]
   -- Attach spinner indicator when verbose flag is set
-  let initialBlocks' = if indicator options then initialBlocks <> [mkBlockState $ createBlock . normalText $ "*"] else initialBlocks
+  let initialBlocks' = if indicator options then initialBlocks <> [mkBlockState $ mkBlockOutput . normalText $ "*"] else initialBlocks
   -- Render initial time block so the bar is not empty after startup
   renderLine options handle blockFilter initialBlocks' ""
 

src/QBar/Themes.hs

 module QBar.Themes where
 
-
+import QBar.BlockOutput
 import QBar.BlockText
-import QBar.Core
 
 import qualified Data.Text.Lazy as T