{-# LANGUAGE ScopedTypeVariables #-}

module System.Directory.Watchman.WatchmanServer
    ( WatchmanServerLaunchException(..)
    , withWatchmanServer
    , launchWatchman
    , shutdownWatchmanProcess
    ) where

import Control.Concurrent.Async
import System.FilePath
import Control.Exception (Exception, IOException, bracket, bracketOnError, try, throwIO)
import Data.Maybe (fromMaybe)
import System.IO.Temp
import System.Process
import System.Directory.Watchman.Types
import qualified System.Directory.Watchman as Watchman
import System.Directory.Watchman.WatchmanException
import Control.Concurrent (threadDelay)
import System.IO
import System.Exit (ExitCode)
import qualified Data.ByteString.Char8 as BC8

data WatchmanServerLaunchException
    = WatchmanServerLaunchException_ExecFailure IOException
    | WatchmanServerLaunchException_ConnectTimeout
    | WatchmanServerLaunchException_ProcessFailure ExitCode String
    deriving (Int -> WatchmanServerLaunchException -> ShowS
[WatchmanServerLaunchException] -> ShowS
WatchmanServerLaunchException -> String
(Int -> WatchmanServerLaunchException -> ShowS)
-> (WatchmanServerLaunchException -> String)
-> ([WatchmanServerLaunchException] -> ShowS)
-> Show WatchmanServerLaunchException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WatchmanServerLaunchException] -> ShowS
$cshowList :: [WatchmanServerLaunchException] -> ShowS
show :: WatchmanServerLaunchException -> String
$cshow :: WatchmanServerLaunchException -> String
showsPrec :: Int -> WatchmanServerLaunchException -> ShowS
$cshowsPrec :: Int -> WatchmanServerLaunchException -> ShowS
Show)

instance Exception WatchmanServerLaunchException

withWatchmanServer :: Maybe FilePath -> (WatchmanSockFile -> IO a) -> IO a
withWatchmanServer :: Maybe String -> (String -> IO a) -> IO a
withWatchmanServer Maybe String
mbWatchmanExe String -> IO a
action =
    String -> (String -> IO a) -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"hs_watchman" ((String -> IO a) -> IO a) -> (String -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \String
tmpDir -> do
        IO WatchmanServer
-> (WatchmanServer -> IO ()) -> (WatchmanServer -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
            (String -> String -> IO WatchmanServer
launchWatchman String
watchmanExe String
tmpDir)
            WatchmanServer -> IO ()
shutdownWatchmanProcess
            (\(WatchmanServer ProcessHandle
_ String
sockFile Handle
_ Handle
_ Handle
_) -> String -> IO a
action String
sockFile)
    where
    watchmanExe :: String
watchmanExe = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"watchman" Maybe String
mbWatchmanExe


data WatchmanServer = WatchmanServer !ProcessHandle !WatchmanSockFile !Handle !Handle !Handle

launchWatchman :: FilePath -> FilePath -> IO WatchmanServer
launchWatchman :: String -> String -> IO WatchmanServer
launchWatchman String
watchmanExe String
tmpDir = do
    IO WatchmanServer
-> (WatchmanServer -> IO ())
-> (WatchmanServer -> IO WatchmanServer)
-> IO WatchmanServer
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
        (String -> String -> IO WatchmanServer
launchWatchmanProcess String
watchmanExe String
tmpDir)
        WatchmanServer -> IO ()
terminateWatchmanProcess
        ((WatchmanServer -> IO WatchmanServer) -> IO WatchmanServer)
-> (WatchmanServer -> IO WatchmanServer) -> IO WatchmanServer
forall a b. (a -> b) -> a -> b
$ \ws :: WatchmanServer
ws@(WatchmanServer ProcessHandle
_ String
sockFile Handle
_ Handle
_ Handle
_) -> do
            IO () -> (Async () -> IO WatchmanServer) -> IO WatchmanServer
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (String -> IO ()
waitUntilRunningThread String
sockFile) ((Async () -> IO WatchmanServer) -> IO WatchmanServer)
-> (Async () -> IO WatchmanServer) -> IO WatchmanServer
forall a b. (a -> b) -> a -> b
$ \Async ()
waitUntilRunningA -> do
                IO () -> (Async () -> IO WatchmanServer) -> IO WatchmanServer
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (WatchmanServer -> IO ()
forall b. WatchmanServer -> IO b
checkProcessFailureThread WatchmanServer
ws) ((Async () -> IO WatchmanServer) -> IO WatchmanServer)
-> (Async () -> IO WatchmanServer) -> IO WatchmanServer
forall a b. (a -> b) -> a -> b
$ \Async ()
startupErrorA -> do
                    (Async (), ())
_ <- [Async ()] -> IO (Async (), ())
forall a. [Async a] -> IO (Async a, a)
waitAnyCancel [Async ()
waitUntilRunningA, Async ()
startupErrorA]
                    WatchmanServer -> IO WatchmanServer
forall (f :: * -> *) a. Applicative f => a -> f a
pure WatchmanServer
ws
    where
    watchmanConnectTimeoutMilliseconds :: Int
watchmanConnectTimeoutMilliseconds = Int
10000
    checkRunningSnoozeMilliseconds :: Int
checkRunningSnoozeMilliseconds = Int
4
    checkExitedSnoozeMilliseconds :: Int
checkExitedSnoozeMilliseconds = Int
10
    waitUntilRunningThread :: String -> IO ()
waitUntilRunningThread String
sockFile = do
        IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (String -> IO ()
waitUntilWatchmanConnect String
sockFile) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
connectA -> do
            IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (Int -> WatchmanServerLaunchException -> IO ()
forall e b. Exception e => Int -> e -> IO b
timeout Int
watchmanConnectTimeoutMilliseconds WatchmanServerLaunchException
WatchmanServerLaunchException_ConnectTimeout) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
timeoutA -> do
                (Async (), ())
_ <- [Async ()] -> IO (Async (), ())
forall a. [Async a] -> IO (Async a, a)
waitAnyCancel [Async ()
connectA, Async ()
timeoutA]
                () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    waitUntilWatchmanConnect :: String -> IO ()
waitUntilWatchmanConnect String
sockFile = do
        Bool
running <- String -> IO Bool
watchmanIsRunning String
sockFile
        if Bool
running
            then () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            else do
                Int -> IO ()
threadDelay (Int
checkRunningSnoozeMilliseconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000)
                String -> IO ()
waitUntilWatchmanConnect String
sockFile
    checkProcessFailureThread :: WatchmanServer -> IO b
checkProcessFailureThread ws :: WatchmanServer
ws@(WatchmanServer ProcessHandle
pid String
_ Handle
_ Handle
_ Handle
stderrH) = do
        Maybe ExitCode
mbExitCode <- ProcessHandle -> IO (Maybe ExitCode)
getProcessExitCode ProcessHandle
pid
        case Maybe ExitCode
mbExitCode of
            Just ExitCode
exitCode -> do
                ByteString
stderrText <- Handle -> IO ByteString
BC8.hGetContents Handle
stderrH
                WatchmanServerLaunchException -> IO b
forall e a. Exception e => e -> IO a
throwIO (WatchmanServerLaunchException -> IO b)
-> WatchmanServerLaunchException -> IO b
forall a b. (a -> b) -> a -> b
$ ExitCode -> String -> WatchmanServerLaunchException
WatchmanServerLaunchException_ProcessFailure ExitCode
exitCode (ByteString -> String
BC8.unpack ByteString
stderrText)
            Maybe ExitCode
Nothing -> do
                Int -> IO ()
threadDelay (Int
checkExitedSnoozeMilliseconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000)
                WatchmanServer -> IO b
checkProcessFailureThread WatchmanServer
ws
    timeout :: Int -> e -> IO b
timeout Int
milliseconds e
ex = do
        Int -> IO ()
threadDelay (Int
milliseconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000)
        e -> IO b
forall e a. Exception e => e -> IO a
throwIO e
ex

watchmanIsRunning :: WatchmanSockFile -> IO Bool
watchmanIsRunning :: String -> IO Bool
watchmanIsRunning String
sockFile = do
    Either WatchmanException WatchmanVersion
tryResult <- IO WatchmanVersion -> IO (Either WatchmanException WatchmanVersion)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO WatchmanVersion
 -> IO (Either WatchmanException WatchmanVersion))
-> IO WatchmanVersion
-> IO (Either WatchmanException WatchmanVersion)
forall a b. (a -> b) -> a -> b
$ String -> IO WatchmanVersion
Watchman.version String
sockFile
    case Either WatchmanException WatchmanVersion
tryResult of
        Left (WatchmanException
_ :: WatchmanException) -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        Right WatchmanVersion
_ -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

launchWatchmanProcess :: FilePath -> FilePath -> IO WatchmanServer
launchWatchmanProcess :: String -> String -> IO WatchmanServer
launchWatchmanProcess String
watchmanExe String
tmpDir = do
    Either
  IOException
  (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
tryResult <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO
     (Either
        IOException
        (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 -> IO
      (Either
         IOException
         (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)))
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO
     (Either
        IOException
        (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
forall a b. (a -> b) -> a -> b
$ CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (String -> [String] -> CreateProcess
proc String
watchmanExe [String]
args)
        { env :: Maybe [(String, String)]
env = [(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just []
        , cwd :: Maybe String
cwd = String -> Maybe String
forall a. a -> Maybe a
Just String
"/"
        , close_fds :: Bool
close_fds = Bool
True
        , std_in :: StdStream
std_in = StdStream
CreatePipe
        , std_out :: StdStream
std_out = StdStream
CreatePipe
        , std_err :: StdStream
std_err = StdStream
CreatePipe
        }
    case Either
  IOException
  (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
tryResult of
        Left IOException
ex -> WatchmanServerLaunchException -> IO WatchmanServer
forall e a. Exception e => e -> IO a
throwIO (WatchmanServerLaunchException -> IO WatchmanServer)
-> WatchmanServerLaunchException -> IO WatchmanServer
forall a b. (a -> b) -> a -> b
$ IOException -> WatchmanServerLaunchException
WatchmanServerLaunchException_ExecFailure IOException
ex
        Right (Just Handle
stdinH, Just Handle
stdoutH, Just Handle
stderrH, ProcessHandle
processHandle) -> WatchmanServer -> IO WatchmanServer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WatchmanServer -> IO WatchmanServer)
-> WatchmanServer -> IO WatchmanServer
forall a b. (a -> b) -> a -> b
$ ProcessHandle
-> String -> Handle -> Handle -> Handle -> WatchmanServer
WatchmanServer ProcessHandle
processHandle String
sockFile Handle
stdinH Handle
stdoutH Handle
stderrH
        Right (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
_ -> String -> IO WatchmanServer
forall a. HasCallStack => String -> a
error String
"launchWatchmanProcess: The Impossible Happened"
    where
    sockFile :: String
sockFile = String
tmpDir String -> ShowS
</> String
"watchman.sock"
    args :: [String]
args =
        [ String
"--sockname=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sockFile
        , String
"--logfile=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tmpDir String -> ShowS
</> String
"watchman.log"
        , String
"--pidfile=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tmpDir String -> ShowS
</> String
"watchman.pid"
        , String
"--statefile=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tmpDir String -> ShowS
</> String
"watchman.state"
        , String
"--no-save-state"
        , String
"--foreground"
        ]

terminateWatchmanProcess :: WatchmanServer -> IO ()
terminateWatchmanProcess :: WatchmanServer -> IO ()
terminateWatchmanProcess (WatchmanServer ProcessHandle
processHandle String
_ Handle
stdinH Handle
stdoutH Handle
stderrH) = do
    ProcessHandle -> IO ()
terminateProcess ProcessHandle
processHandle
    ExitCode
_ <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
processHandle
    Handle -> IO ()
hClose Handle
stdinH
    Handle -> IO ()
hClose Handle
stdoutH
    Handle -> IO ()
hClose Handle
stderrH

shutdownWatchmanProcess :: WatchmanServer -> IO ()
shutdownWatchmanProcess :: WatchmanServer -> IO ()
shutdownWatchmanProcess (WatchmanServer ProcessHandle
processHandle String
sockFile Handle
stdinH Handle
stdoutH Handle
stderrH) = do
    -- TODO If a timeout elapses, then force-kill the process with terminateProcess
    ShutdownServer
_ <- String -> IO ShutdownServer
Watchman.shutdownServer String
sockFile
    ExitCode
_ <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
processHandle
    Handle -> IO ()
hClose Handle
stdinH
    Handle -> IO ()
hClose Handle
stdoutH
    Handle -> IO ()
hClose Handle
stderrH