From 66778fdb3245dfa48ddd3406acdcf3431fead5e7 Mon Sep 17 00:00:00 2001
From: Jens Nolte <jens@nightmarestudio.de>
Date: Mon, 2 Dec 2019 03:27:30 +0100
Subject: [PATCH] Simplify persistent block script
---
src/QBar/Core.hs | 16 +++-------------
1 file changed, 3 insertions(+), 13 deletions(-)
diff --git a/src/QBar/Core.hs b/src/QBar/Core.hs
index 0e90b35..3aa7a1a 100644
--- a/src/QBar/Core.hs
+++ b/src/QBar/Core.hs
@@ -272,39 +272,29 @@ blockScript path = forever $ yield =<< (lift $ blockScriptAction)
createScriptBlock :: T.Text -> BlockOutput
createScriptBlock text = pangoMarkup $ setBlockName (T.pack path) $ createBlock text
+
startPersistentBlockScript :: FilePath -> CachedBlock
--- This is only using 'CachedBlock' because the code was already written and tested
--- This could probably be massively simplified by using the new 'pushBlock'
startPersistentBlockScript path = do
bar <- lift $ ask
do
(output, input, seal) <- liftIO $ spawn' $ latest $ emptyBlock
- initialDataEvent <- liftIO $ Event.new
task <- liftIO $ async $ do
let processConfig = setStdin closed $ setStdout createPipe $ shell path
finally (
catch (
withProcessWait processConfig $ \ process -> do
let handle = getStdout process
- runEffect $ (fromHandle bar handle) >-> signalFirstBlock initialDataEvent >-> toOutput output
+ runEffect $ (fromHandle bar handle) >-> toOutput output
)
( \ e ->
-- output error
- runEffect $ (yield $ createErrorBlock $ "[" <> (T.pack $ show (e :: IOException)) <> "]") >-> signalFirstBlock initialDataEvent >-> toOutput output
+ runEffect $ (yield $ createErrorBlock $ "[" <> (T.pack $ show (e :: IOException)) <> "]") >-> toOutput output
)
)
(atomically seal)
liftIO $ link task
- liftIO $ Event.wait initialDataEvent
cacheFromInput input
where
- signalFirstBlock :: Event.Event -> Pipe BlockOutput BlockOutput IO ()
- signalFirstBlock event = do
- -- Await first block
- await >>= yield
- lift $ Event.set event
- -- Replace with cat
- cat
fromHandle :: Bar -> Handle -> Producer BlockOutput IO ()
fromHandle bar handle = forever $ do
line <- lift $ TIO.hGetLine handle
--
GitLab