{-# LANGUAGE NumericUnderscores #-}

{- |
Module                  : DrCabal.Watch
Copyright               : (c) 2019 Alexander Gugel
                          (c) 2022 Dmitrii Kovanikov
SPDX-License-Identifier : MPL-2.0
Maintainer              : Dmitrii Kovanikov <kovanikov@gmail.com>
Stability               : Experimental
Portability             : Portable

Implementation of the @dr-cabal watch@ command.
-}

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

            -- output line to the watch worker for output redirection
            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

    -- parse status string to the 'Status' type
    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

    -- check if this line is a library: '-' separates library name and its version
    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]

-- | Add 'WatchAction' to end of the list
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  -- wait 80 ms to update spinner
                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  -- wait 80 ms to update spinner
                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