{-# LANGUAGE NumericUnderscores #-}
module DrCabal.Watch
( runWatch
) where
import Colourista.Short (b)
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (wait, withAsync)
import Data.Aeson.Encode.Pretty (encodePretty)
import GHC.Clock (getMonotonicTimeNSec)
import System.Console.ANSI (clearLine, setCursorColumn)
import System.IO (isEOF)
import DrCabal.Cli (WatchArgs (..))
import DrCabal.Model (Entry (..), Line (..))
import qualified Colourista
import qualified Data.ByteString as ByteString
import qualified Data.Text as Text
runWatch :: WatchArgs -> IO ()
runWatch :: WatchArgs -> IO ()
runWatch WatchArgs{FilePath
watchArgsOutput :: WatchArgs -> FilePath
watchArgsOutput :: FilePath
..} = do
IORef [WatchAction]
watchRef <- forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef [WatchAction
Start]
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (IORef [WatchAction] -> IO ()
watchWorker IORef [WatchAction]
watchRef) forall a b. (a -> b) -> a -> b
$ \Async ()
workerAsync -> do
IORef [WatchAction] -> FilePath -> IO ()
readFromStdin IORef [WatchAction]
watchRef FilePath
watchArgsOutput
forall a. Async a -> IO a
wait Async ()
workerAsync
readFromStdin :: IORef [WatchAction] -> FilePath -> IO ()
readFromStdin :: IORef [WatchAction] -> FilePath -> IO ()
readFromStdin IORef [WatchAction]
watchRef FilePath
outputPath = [Line] -> IO ()
go []
where
go :: [Line] -> IO ()
go :: [Line] -> IO ()
go [Line]
cabalOutput = do
Bool
isEndOfInput <- IO Bool
isEOF
if Bool
isEndOfInput
then do
IORef [WatchAction] -> WatchAction -> IO ()
pushAction IORef [WatchAction]
watchRef forall a b. (a -> b) -> a -> b
$ FilePath -> [Line] -> WatchAction
End FilePath
outputPath [Line]
cabalOutput
else do
Word64
time <- IO Word64
getMonotonicTimeNSec
ByteString
line <- IO ByteString
ByteString.getLine
IORef [WatchAction] -> WatchAction -> IO ()
pushAction IORef [WatchAction]
watchRef forall a b. (a -> b) -> a -> b
$ ByteString -> WatchAction
Consume ByteString
line
[Line] -> IO ()
go forall a b. (a -> b) -> a -> b
$ Word64 -> ByteString -> Line
Line Word64
time ByteString
line forall a. a -> [a] -> [a]
: [Line]
cabalOutput
linesToEntries :: [Line] -> [Entry]
linesToEntries :: [Line] -> [Entry]
linesToEntries = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Line -> Maybe Entry
parseLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
parseLine :: Line -> Maybe Entry
parseLine :: Line -> Maybe Entry
parseLine Line{Word64
ByteString
lineLine :: Line -> ByteString
lineTime :: Line -> Word64
lineLine :: ByteString
lineTime :: Word64
..} = do
let txtLine :: Text
txtLine = forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
lineLine
Text
txtStatus : Text
library : [Text]
_ <- forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall t. IsText t "words" => t -> [t]
words Text
txtLine
Status
status <- forall a. Read a => FilePath -> Maybe a
readMaybe forall a b. (a -> b) -> a -> b
$ forall a. ToString a => a -> FilePath
toString Text
txtStatus
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Char -> Text -> Bool
Text.elem Char
'-' Text
library
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Entry
{ entryStatus :: Status
entryStatus = Status
status
, entryStart :: Word64
entryStart = Word64
lineTime
, entryLibrary :: Text
entryLibrary = Text
library
}
data WatchAction
= Start
| Consume ByteString
| End FilePath [Line]
pushAction :: IORef [WatchAction] -> WatchAction -> IO ()
pushAction :: IORef [WatchAction] -> WatchAction -> IO ()
pushAction IORef [WatchAction]
watchRef WatchAction
action =
forall (m :: * -> *) a b.
MonadIO m =>
IORef a -> (a -> (a, b)) -> m b
atomicModifyIORef' IORef [WatchAction]
watchRef forall a b. (a -> b) -> a -> b
$ \[WatchAction]
actions -> ([WatchAction]
actions forall a. [a] -> [a] -> [a]
++ [WatchAction
action], ())
data WorkerCommand
= Greeting
| WriteLine ByteString
| Wait
| Finish FilePath [Line]
watchWorker :: IORef [WatchAction] -> IO ()
watchWorker :: IORef [WatchAction] -> IO ()
watchWorker IORef [WatchAction]
watchRef = Text -> [Text] -> IO ()
go Text
"Watching build output" (forall a. [a] -> [a]
cycle [Text]
spinnerFrames)
where
spinnerFrames :: [Text]
spinnerFrames :: [Text]
spinnerFrames =
[ Text
"⠋"
, Text
"⠙"
, Text
"⠹"
, Text
"⠸"
, Text
"⠼"
, Text
"⠴"
, Text
"⠦"
, Text
"⠧"
, Text
"⠇"
, Text
"⠏"
]
go :: Text -> [Text] -> IO ()
go :: Text -> [Text] -> IO ()
go Text
_ [] = 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 Text
prevLine (Text
frame : [Text]
frames) = do
WorkerCommand
command <- forall (m :: * -> *) a b.
MonadIO m =>
IORef a -> (a -> (a, b)) -> m b
atomicModifyIORef' IORef [WatchAction]
watchRef [WatchAction] -> ([WatchAction], WorkerCommand)
popAction
case WorkerCommand
command of
WorkerCommand
Greeting -> do
[Text] -> Text -> IO ()
Colourista.formattedMessage
[forall str. IsString str => str
Colourista.blue, forall str. IsString str => str
Colourista.bold]
Text
"Watching cabal output..."
Text -> [Text] -> IO ()
go Text
prevLine (Text
frame forall a. a -> [a] -> [a]
: [Text]
frames)
WriteLine ByteString
line -> do
IO ()
resetLine
let l :: Text
l = forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
line
forall (m :: * -> *). MonadIO m => Text -> m ()
putText forall a b. (a -> b) -> a -> b
$ Text
frame forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
l
forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
stdout
Int -> IO ()
threadDelay Int
80_000
Text -> [Text] -> IO ()
go Text
l [Text]
frames
WorkerCommand
Wait -> do
IO ()
resetLine
forall (m :: * -> *). MonadIO m => Text -> m ()
putText forall a b. (a -> b) -> a -> b
$ Text
frame forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
prevLine
forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
stdout
Int -> IO ()
threadDelay Int
80_000
Text -> [Text] -> IO ()
go Text
prevLine [Text]
frames
Finish FilePath
outputPath [Line]
lns -> do
forall (m :: * -> *). MonadIO m => FilePath -> LByteString -> m ()
writeFileLBS FilePath
outputPath forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> LByteString
encodePretty forall a b. (a -> b) -> a -> b
$ [Line] -> [Entry]
linesToEntries [Line]
lns
IO ()
resetLine
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn forall a b. (a -> b) -> a -> b
$ forall t. IsText t "unlines" => [t] -> t
unlines
[ forall str. (IsString str, Semigroup str) => str -> str
b Text
"Build finished successfully!"
, Text
""
, Text
"To see the profiling output, run the following command:"
, Text
""
, Text
" dr-cabal profile --input=" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText FilePath
outputPath
]
popAction :: [WatchAction] -> ([WatchAction], WorkerCommand)
popAction :: [WatchAction] -> ([WatchAction], WorkerCommand)
popAction [] = ([], WorkerCommand
Wait)
popAction (WatchAction
x : [WatchAction]
xs) = case WatchAction
x of
WatchAction
Start -> ([WatchAction]
xs, WorkerCommand
Greeting)
Consume ByteString
l -> ([WatchAction]
xs, ByteString -> WorkerCommand
WriteLine ByteString
l)
End FilePath
path [Line]
lns -> ([], FilePath -> [Line] -> WorkerCommand
Finish FilePath
path [Line]
lns)
resetLine :: IO ()
resetLine :: IO ()
resetLine = do
IO ()
clearLine
Int -> IO ()
setCursorColumn Int
0