{-# LANGUAGE NumericUnderscores #-}
module DrCabal.Watch
( watchBuild
) where
import Colourista.Short (b)
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently)
import GHC.Clock (getMonotonicTimeNSec)
import System.IO (isEOF)
import DrCabal.Model (Entry (..), Line (..), parseLine)
import DrCabal.Terminal (clearScreen)
import qualified Colourista
import qualified Data.ByteString as ByteString
watchBuild
:: ([Entry] -> Text)
-> IO [Entry]
watchBuild :: ([Entry] -> Text) -> IO [Entry]
watchBuild [Entry] -> Text
drawChart = do
IORef [InputAction]
inputActionRef <- forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef [InputAction
Start]
([Entry]
entries, ()
_) <- forall a b. IO a -> IO b -> IO (a, b)
concurrently
(IORef [InputAction] -> ([Entry] -> Text) -> IO [Entry]
interactiveWorker IORef [InputAction]
inputActionRef [Entry] -> Text
drawChart)
(IORef [InputAction] -> IO ()
stdinReaderWorker IORef [InputAction]
inputActionRef)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Entry]
entries
stdinReaderWorker :: IORef [InputAction] -> IO ()
stdinReaderWorker :: IORef [InputAction] -> IO ()
stdinReaderWorker IORef [InputAction]
inputActionRef = IO ()
go
where
go :: IO ()
go :: IO ()
go = do
Bool
isEndOfInput <- IO Bool
isEOF
if Bool
isEndOfInput
then do
IORef [InputAction] -> InputAction -> IO ()
pushAction IORef [InputAction]
inputActionRef InputAction
End
else do
Word64
time <- IO Word64
getMonotonicTimeNSec
ByteString
line <- IO ByteString
ByteString.getLine
let ln :: Line
ln = Word64 -> ByteString -> Line
Line Word64
time ByteString
line
IORef [InputAction] -> InputAction -> IO ()
pushAction IORef [InputAction]
inputActionRef forall a b. (a -> b) -> a -> b
$ Line -> InputAction
Consume Line
ln
IO ()
go
data InputAction
= Start
| Consume Line
| End
pushAction :: IORef [InputAction] -> InputAction -> IO ()
pushAction :: IORef [InputAction] -> InputAction -> IO ()
pushAction IORef [InputAction]
inputActionRef InputAction
action =
forall (m :: * -> *) a b.
MonadIO m =>
IORef a -> (a -> (a, b)) -> m b
atomicModifyIORef' IORef [InputAction]
inputActionRef forall a b. (a -> b) -> a -> b
$ \[InputAction]
actions -> ([InputAction]
actions forall a. [a] -> [a] -> [a]
++ [InputAction
action], ())
data InteractiveCommand
= Greeting
| UpdateChart Line
| Wait
| Finish
nextCommand :: IORef [InputAction] -> IO InteractiveCommand
nextCommand :: IORef [InputAction] -> IO InteractiveCommand
nextCommand IORef [InputAction]
inputActionRef = forall (m :: * -> *) a b.
MonadIO m =>
IORef a -> (a -> (a, b)) -> m b
atomicModifyIORef' IORef [InputAction]
inputActionRef [InputAction] -> ([InputAction], InteractiveCommand)
popAction
where
popAction :: [InputAction] -> ([InputAction], InteractiveCommand)
popAction :: [InputAction] -> ([InputAction], InteractiveCommand)
popAction [] = ([], InteractiveCommand
Wait)
popAction (InputAction
x : [InputAction]
xs) = case InputAction
x of
InputAction
Start -> ([InputAction]
xs, InteractiveCommand
Greeting)
Consume Line
l -> ([InputAction]
xs, Line -> InteractiveCommand
UpdateChart Line
l)
InputAction
End -> ([], InteractiveCommand
Finish)
data Output = Output
{ Output -> Text
outputCabalLog :: Text
, Output -> [Entry]
outputEntries :: [Entry]
}
interactiveWorker
:: IORef [InputAction]
-> ([Entry] -> Text)
-> IO [Entry]
interactiveWorker :: IORef [InputAction] -> ([Entry] -> Text) -> IO [Entry]
interactiveWorker IORef [InputAction]
inputActionRef [Entry] -> Text
drawChart =
Output -> [Text] -> IO [Entry]
go (Text -> [Entry] -> Output
Output Text
"Profiling 'cabal build' interactively..." []) (forall a. [a] -> [a]
cycle [Text]
spinnerFrames)
where
spinnerFrames :: [Text]
spinnerFrames :: [Text]
spinnerFrames =
[ Text
"⠋"
, Text
"⠙"
, Text
"⠹"
, Text
"⠸"
, Text
"⠼"
, Text
"⠴"
, Text
"⠦"
, Text
"⠧"
, Text
"⠇"
, Text
"⠏"
]
go :: Output -> [Text] -> IO [Entry]
go :: Output -> [Text] -> IO [Entry]
go Output
_ [] = do
Text -> IO ()
Colourista.errorMessage forall a b. (a -> b) -> a -> b
$
Text
"Panic! At the 'dr-cabal'! Impossible happened: list of frames is empty"
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
go Output
prevOutput (Text
frame : [Text]
frames) = do
InteractiveCommand
command <- IORef [InputAction] -> IO InteractiveCommand
nextCommand IORef [InputAction]
inputActionRef
case InteractiveCommand
command of
InteractiveCommand
Greeting -> do
Text -> Output -> Output -> IO ()
printOutput Text
frame Output
prevOutput Output
prevOutput
Output -> [Text] -> IO [Entry]
go Output
prevOutput (Text
frame forall a. a -> [a] -> [a]
: [Text]
frames)
UpdateChart line :: Line
line@Line{Word64
ByteString
lineLine :: Line -> ByteString
lineTime :: Line -> Word64
lineLine :: ByteString
lineTime :: Word64
..} -> case Line -> Maybe Entry
parseLine Line
line of
Maybe Entry
Nothing -> do
let newOutput :: Output
newOutput = Output
prevOutput { outputCabalLog :: Text
outputCabalLog = forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
lineLine }
Text -> Output -> Output -> IO ()
printOutput Text
frame Output
prevOutput Output
newOutput
Output -> [Text] -> IO [Entry]
go Output
newOutput [Text]
frames
Just Entry
entry -> do
let newOutput :: Output
newOutput = Output
{ outputCabalLog :: Text
outputCabalLog = forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
lineLine
, outputEntries :: [Entry]
outputEntries = Output -> [Entry]
outputEntries Output
prevOutput forall a. [a] -> [a] -> [a]
++ [Entry
entry]
}
Text -> Output -> Output -> IO ()
printOutput Text
frame Output
prevOutput Output
newOutput
Output -> [Text] -> IO [Entry]
go Output
newOutput [Text]
frames
InteractiveCommand
Wait -> do
Text -> Output -> Output -> IO ()
printOutput Text
frame Output
prevOutput Output
prevOutput
Output -> [Text] -> IO [Entry]
go Output
prevOutput [Text]
frames
InteractiveCommand
Finish -> do
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn forall a b. (a -> b) -> a -> b
$ forall str. (IsString str, Semigroup str) => str -> str
b Text
"Build finished successfully!"
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Output -> [Entry]
outputEntries Output
prevOutput
printOutput :: Text -> Output -> Output -> IO ()
printOutput :: Text -> Output -> Output -> IO ()
printOutput Text
frame Output
oldOutput Output
newOutput = do
Output -> IO ()
clearPreviousOutput Output
oldOutput
forall (m :: * -> *). MonadIO m => Text -> m ()
putText forall a b. (a -> b) -> a -> b
$ Text -> Output -> Text
fmtOutput Text
frame Output
newOutput
forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
stdout
Int -> IO ()
threadDelay Int
80_000
clearPreviousOutput :: Output -> IO ()
clearPreviousOutput :: Output -> IO ()
clearPreviousOutput Output
output = do
let fakeFrame :: Text
fakeFrame = Text
""
let screenHeight :: Int
screenHeight = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall t. IsText t "lines" => t -> [t]
lines forall a b. (a -> b) -> a -> b
$ Text -> Output -> Text
fmtOutput Text
fakeFrame Output
output
Int -> IO ()
clearScreen Int
screenHeight
fmtOutput :: Text -> Output -> Text
fmtOutput :: Text -> Output -> Text
fmtOutput Text
frame Output{[Entry]
Text
outputEntries :: [Entry]
outputCabalLog :: Text
outputEntries :: Output -> [Entry]
outputCabalLog :: Output -> Text
..} =
Text
chart forall a. Semigroup a => a -> a -> a
<> Text
log
where
chart :: Text
chart :: Text
chart = case [Entry]
outputEntries of
[] -> Text
""
[Entry]
_ -> [Entry] -> Text
drawChart [Entry]
outputEntries
log :: Text
log :: Text
log = Text
frame forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
outputCabalLog