{-# LANGUAGE OverloadedStrings #-}

module System.Directory.Watchman
    ( version
    , shutdownServer
    , WatchmanVersion(..)
    , WatchResponse(..)
    , WatchmanSocket
    , WatchmanSubscription
    , watch
    , query
    , withConnect
    , subscribe
    , unsubscribe
    , stateEnter
    , stateLeave
    , readNotification
    , watchList
    ) where

import Control.Concurrent (ThreadId, forkIO, killThread)
import Control.Concurrent.Chan
import Control.Concurrent.MVar
import Control.Exception (bracket, bracketOnError)
import Control.Exception (throwIO, try)
import Control.Monad (unless, forever)
import Data.ByteString (ByteString)
import Data.Map.Strict (Map)
import qualified Data.ByteString.Char8 as BC
import qualified Data.Map.Strict as M
import qualified Data.Sequence as Seq
import qualified Network.Socket as Net

import System.Directory.Watchman.BSER
import System.Directory.Watchman.BSER.Parser
import System.Directory.Watchman.BSER.Protocol
import System.Directory.Watchman.Expression (Expression)
import System.Directory.Watchman.Fields
import System.Directory.Watchman.Query
import System.Directory.Watchman.State
import System.Directory.Watchman.Subscribe
import System.Directory.Watchman.Types
import System.Directory.Watchman.WFilePath
import System.Directory.Watchman.WatchmanException

newtype WatchmanWarning = WatchmanWarning String
    deriving (Int -> WatchmanWarning -> ShowS
[WatchmanWarning] -> ShowS
WatchmanWarning -> String
(Int -> WatchmanWarning -> ShowS)
-> (WatchmanWarning -> String)
-> ([WatchmanWarning] -> ShowS)
-> Show WatchmanWarning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WatchmanWarning] -> ShowS
$cshowList :: [WatchmanWarning] -> ShowS
show :: WatchmanWarning -> String
$cshow :: WatchmanWarning -> String
showsPrec :: Int -> WatchmanWarning -> ShowS
$cshowsPrec :: Int -> WatchmanWarning -> ShowS
Show, WatchmanWarning -> WatchmanWarning -> Bool
(WatchmanWarning -> WatchmanWarning -> Bool)
-> (WatchmanWarning -> WatchmanWarning -> Bool)
-> Eq WatchmanWarning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WatchmanWarning -> WatchmanWarning -> Bool
$c/= :: WatchmanWarning -> WatchmanWarning -> Bool
== :: WatchmanWarning -> WatchmanWarning -> Bool
$c== :: WatchmanWarning -> WatchmanWarning -> Bool
Eq, Eq WatchmanWarning
Eq WatchmanWarning
-> (WatchmanWarning -> WatchmanWarning -> Ordering)
-> (WatchmanWarning -> WatchmanWarning -> Bool)
-> (WatchmanWarning -> WatchmanWarning -> Bool)
-> (WatchmanWarning -> WatchmanWarning -> Bool)
-> (WatchmanWarning -> WatchmanWarning -> Bool)
-> (WatchmanWarning -> WatchmanWarning -> WatchmanWarning)
-> (WatchmanWarning -> WatchmanWarning -> WatchmanWarning)
-> Ord WatchmanWarning
WatchmanWarning -> WatchmanWarning -> Bool
WatchmanWarning -> WatchmanWarning -> Ordering
WatchmanWarning -> WatchmanWarning -> WatchmanWarning
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WatchmanWarning -> WatchmanWarning -> WatchmanWarning
$cmin :: WatchmanWarning -> WatchmanWarning -> WatchmanWarning
max :: WatchmanWarning -> WatchmanWarning -> WatchmanWarning
$cmax :: WatchmanWarning -> WatchmanWarning -> WatchmanWarning
>= :: WatchmanWarning -> WatchmanWarning -> Bool
$c>= :: WatchmanWarning -> WatchmanWarning -> Bool
> :: WatchmanWarning -> WatchmanWarning -> Bool
$c> :: WatchmanWarning -> WatchmanWarning -> Bool
<= :: WatchmanWarning -> WatchmanWarning -> Bool
$c<= :: WatchmanWarning -> WatchmanWarning -> Bool
< :: WatchmanWarning -> WatchmanWarning -> Bool
$c< :: WatchmanWarning -> WatchmanWarning -> Bool
compare :: WatchmanWarning -> WatchmanWarning -> Ordering
$ccompare :: WatchmanWarning -> WatchmanWarning -> Ordering
$cp1Ord :: Eq WatchmanWarning
Ord)

data WatchmanCommand a b = WatchmanCommand (a -> BSERValue) (BSERValue -> Parser b)

newtype WatchmanVersion = WatchmanVersion String
    deriving (Int -> WatchmanVersion -> ShowS
[WatchmanVersion] -> ShowS
WatchmanVersion -> String
(Int -> WatchmanVersion -> ShowS)
-> (WatchmanVersion -> String)
-> ([WatchmanVersion] -> ShowS)
-> Show WatchmanVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WatchmanVersion] -> ShowS
$cshowList :: [WatchmanVersion] -> ShowS
show :: WatchmanVersion -> String
$cshow :: WatchmanVersion -> String
showsPrec :: Int -> WatchmanVersion -> ShowS
$cshowsPrec :: Int -> WatchmanVersion -> ShowS
Show, WatchmanVersion -> WatchmanVersion -> Bool
(WatchmanVersion -> WatchmanVersion -> Bool)
-> (WatchmanVersion -> WatchmanVersion -> Bool)
-> Eq WatchmanVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WatchmanVersion -> WatchmanVersion -> Bool
$c/= :: WatchmanVersion -> WatchmanVersion -> Bool
== :: WatchmanVersion -> WatchmanVersion -> Bool
$c== :: WatchmanVersion -> WatchmanVersion -> Bool
Eq, Eq WatchmanVersion
Eq WatchmanVersion
-> (WatchmanVersion -> WatchmanVersion -> Ordering)
-> (WatchmanVersion -> WatchmanVersion -> Bool)
-> (WatchmanVersion -> WatchmanVersion -> Bool)
-> (WatchmanVersion -> WatchmanVersion -> Bool)
-> (WatchmanVersion -> WatchmanVersion -> Bool)
-> (WatchmanVersion -> WatchmanVersion -> WatchmanVersion)
-> (WatchmanVersion -> WatchmanVersion -> WatchmanVersion)
-> Ord WatchmanVersion
WatchmanVersion -> WatchmanVersion -> Bool
WatchmanVersion -> WatchmanVersion -> Ordering
WatchmanVersion -> WatchmanVersion -> WatchmanVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WatchmanVersion -> WatchmanVersion -> WatchmanVersion
$cmin :: WatchmanVersion -> WatchmanVersion -> WatchmanVersion
max :: WatchmanVersion -> WatchmanVersion -> WatchmanVersion
$cmax :: WatchmanVersion -> WatchmanVersion -> WatchmanVersion
>= :: WatchmanVersion -> WatchmanVersion -> Bool
$c>= :: WatchmanVersion -> WatchmanVersion -> Bool
> :: WatchmanVersion -> WatchmanVersion -> Bool
$c> :: WatchmanVersion -> WatchmanVersion -> Bool
<= :: WatchmanVersion -> WatchmanVersion -> Bool
$c<= :: WatchmanVersion -> WatchmanVersion -> Bool
< :: WatchmanVersion -> WatchmanVersion -> Bool
$c< :: WatchmanVersion -> WatchmanVersion -> Bool
compare :: WatchmanVersion -> WatchmanVersion -> Ordering
$ccompare :: WatchmanVersion -> WatchmanVersion -> Ordering
$cp1Ord :: Eq WatchmanVersion
Ord)

instance FromBSER WatchmanVersion where
    parseBSER :: BSERValue -> Parser WatchmanVersion
parseBSER (BSERObject Map ByteString BSERValue
o) = do
        ByteString
v <- Map ByteString BSERValue
o Map ByteString BSERValue -> ByteString -> Parser ByteString
forall a.
FromBSER a =>
Map ByteString BSERValue -> ByteString -> Parser a
.: ByteString
"version"
        WatchmanVersion -> Parser WatchmanVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> WatchmanVersion
WatchmanVersion (ByteString -> String
BC.unpack ByteString
v))
    parseBSER BSERValue
_ = String -> Parser WatchmanVersion
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not an Object"

versionCmd :: WatchmanCommand () WatchmanVersion
versionCmd :: WatchmanCommand () WatchmanVersion
versionCmd =
    (() -> BSERValue)
-> (BSERValue -> Parser WatchmanVersion)
-> WatchmanCommand () WatchmanVersion
forall a b.
(a -> BSERValue) -> (BSERValue -> Parser b) -> WatchmanCommand a b
WatchmanCommand
        (BSERValue -> () -> BSERValue
forall a b. a -> b -> a
const (BSERValue -> () -> BSERValue) -> BSERValue -> () -> BSERValue
forall a b. (a -> b) -> a -> b
$ Seq BSERValue -> BSERValue
BSERArray (BSERValue -> Seq BSERValue
forall a. a -> Seq a
Seq.singleton (ByteString -> BSERValue
BSERString (String -> ByteString
BC.pack String
"version"))))
        BSERValue -> Parser WatchmanVersion
forall a. FromBSER a => BSERValue -> Parser a
parseBSER

version :: WatchmanSockFile -> IO WatchmanVersion
version :: String -> IO WatchmanVersion
version String
sockFile = String
-> WatchmanCommand () WatchmanVersion -> () -> IO WatchmanVersion
forall a b. String -> WatchmanCommand a b -> a -> IO b
runCommand String
sockFile WatchmanCommand () WatchmanVersion
versionCmd ()

-- | Checks to see if the response from the watchman server is an error response
readError :: BSERValue -> Maybe String
readError :: BSERValue -> Maybe String
readError (BSERObject Map ByteString BSERValue
o) =
    case ByteString -> Map ByteString BSERValue -> Maybe BSERValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ByteString
"error" Map ByteString BSERValue
o of
        Just (BSERString ByteString
errStr) -> String -> Maybe String
forall a. a -> Maybe a
Just (ByteString -> String
BC.unpack ByteString
errStr)
        Maybe BSERValue
_ -> Maybe String
forall a. Maybe a
Nothing
readError BSERValue
_ = Maybe String
forall a. Maybe a
Nothing

runCommand :: WatchmanSockFile -> WatchmanCommand a b -> a -> IO b
runCommand :: String -> WatchmanCommand a b -> a -> IO b
runCommand String
sockFile (WatchmanCommand a -> BSERValue
buildInput BSERValue -> Parser b
parseOutput) a
args = do
    IO WatchmanConnection
-> (WatchmanConnection -> IO ())
-> (WatchmanConnection -> IO b)
-> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        (String -> IO WatchmanConnection
connectToWatchman String
sockFile)
        WatchmanConnection -> IO ()
disconnectWatchman
        ((WatchmanConnection -> IO b) -> IO b)
-> (WatchmanConnection -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \(WatchmanConnection Socket
sock) -> do
            let m :: BSERValue
m = a -> BSERValue
buildInput a
args
            Socket -> BSERValue -> IO ()
sendBSERMessage Socket
sock BSERValue
m
            BSERValue
rsp <- Socket -> IO BSERValue
readBSERMessage Socket
sock
            case BSERValue -> Maybe String
readError BSERValue
rsp of
                Just String
err -> WatchmanException -> IO b
forall e a. Exception e => e -> IO a
throwIO (WatchmanException -> IO b) -> WatchmanException -> IO b
forall a b. (a -> b) -> a -> b
$ String -> WatchmanException
WatchmanException_ErrorResponse String
err
                Maybe String
Nothing -> case (BSERValue -> Parser b) -> BSERValue -> Result b
forall a b. (a -> Parser b) -> a -> Result b
parse BSERValue -> Parser b
parseOutput BSERValue
rsp of
                    Error String
err -> String -> IO b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
                    Success b
result -> b -> IO b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
result

connectToWatchman :: WatchmanSockFile -> IO WatchmanConnection
connectToWatchman :: String -> IO WatchmanConnection
connectToWatchman String
sockFile = do
    Either IOException WatchmanConnection
tryResult <- IO WatchmanConnection -> IO (Either IOException WatchmanConnection)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO WatchmanConnection
 -> IO (Either IOException WatchmanConnection))
-> IO WatchmanConnection
-> IO (Either IOException WatchmanConnection)
forall a b. (a -> b) -> a -> b
$ IO Socket
-> (Socket -> IO ())
-> (Socket -> IO WatchmanConnection)
-> IO WatchmanConnection
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
        (Family -> SocketType -> ProtocolNumber -> IO Socket
Net.socket Family
Net.AF_UNIX SocketType
Net.Stream ProtocolNumber
0)
        Socket -> IO ()
Net.close
        (\Socket
sock -> do
            Socket -> SockAddr -> IO ()
Net.connect Socket
sock (String -> SockAddr
Net.SockAddrUnix String
sockFile)
            WatchmanConnection -> IO WatchmanConnection
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Socket -> WatchmanConnection
WatchmanConnection Socket
sock))
    case Either IOException WatchmanConnection
tryResult of
        Left IOException
ex -> WatchmanException -> IO WatchmanConnection
forall e a. Exception e => e -> IO a
throwIO (WatchmanException -> IO WatchmanConnection)
-> WatchmanException -> IO WatchmanConnection
forall a b. (a -> b) -> a -> b
$ IOException -> WatchmanException
WatchmanException_SockError IOException
ex
        Right WatchmanConnection
c -> WatchmanConnection -> IO WatchmanConnection
forall (f :: * -> *) a. Applicative f => a -> f a
pure WatchmanConnection
c

disconnectWatchman :: WatchmanConnection -> IO ()
disconnectWatchman :: WatchmanConnection -> IO ()
disconnectWatchman (WatchmanConnection Socket
sock) = Socket -> IO ()
Net.close Socket
sock

shutdownServerCmd :: WatchmanCommand () ShutdownServer
shutdownServerCmd :: WatchmanCommand () ShutdownServer
shutdownServerCmd = (() -> BSERValue)
-> (BSERValue -> Parser ShutdownServer)
-> WatchmanCommand () ShutdownServer
forall a b.
(a -> BSERValue) -> (BSERValue -> Parser b) -> WatchmanCommand a b
WatchmanCommand
    (BSERValue -> () -> BSERValue
forall a b. a -> b -> a
const (BSERValue -> () -> BSERValue) -> BSERValue -> () -> BSERValue
forall a b. (a -> b) -> a -> b
$ Seq BSERValue -> BSERValue
BSERArray (BSERValue -> Seq BSERValue
forall a. a -> Seq a
Seq.singleton (ByteString -> BSERValue
BSERString (String -> ByteString
BC.pack String
"shutdown-server"))))
    BSERValue -> Parser ShutdownServer
forall a. FromBSER a => BSERValue -> Parser a
parseBSER

newtype ShutdownServer = ShutdownServer Bool
    deriving (Int -> ShutdownServer -> ShowS
[ShutdownServer] -> ShowS
ShutdownServer -> String
(Int -> ShutdownServer -> ShowS)
-> (ShutdownServer -> String)
-> ([ShutdownServer] -> ShowS)
-> Show ShutdownServer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShutdownServer] -> ShowS
$cshowList :: [ShutdownServer] -> ShowS
show :: ShutdownServer -> String
$cshow :: ShutdownServer -> String
showsPrec :: Int -> ShutdownServer -> ShowS
$cshowsPrec :: Int -> ShutdownServer -> ShowS
Show, ShutdownServer -> ShutdownServer -> Bool
(ShutdownServer -> ShutdownServer -> Bool)
-> (ShutdownServer -> ShutdownServer -> Bool) -> Eq ShutdownServer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShutdownServer -> ShutdownServer -> Bool
$c/= :: ShutdownServer -> ShutdownServer -> Bool
== :: ShutdownServer -> ShutdownServer -> Bool
$c== :: ShutdownServer -> ShutdownServer -> Bool
Eq, Eq ShutdownServer
Eq ShutdownServer
-> (ShutdownServer -> ShutdownServer -> Ordering)
-> (ShutdownServer -> ShutdownServer -> Bool)
-> (ShutdownServer -> ShutdownServer -> Bool)
-> (ShutdownServer -> ShutdownServer -> Bool)
-> (ShutdownServer -> ShutdownServer -> Bool)
-> (ShutdownServer -> ShutdownServer -> ShutdownServer)
-> (ShutdownServer -> ShutdownServer -> ShutdownServer)
-> Ord ShutdownServer
ShutdownServer -> ShutdownServer -> Bool
ShutdownServer -> ShutdownServer -> Ordering
ShutdownServer -> ShutdownServer -> ShutdownServer
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ShutdownServer -> ShutdownServer -> ShutdownServer
$cmin :: ShutdownServer -> ShutdownServer -> ShutdownServer
max :: ShutdownServer -> ShutdownServer -> ShutdownServer
$cmax :: ShutdownServer -> ShutdownServer -> ShutdownServer
>= :: ShutdownServer -> ShutdownServer -> Bool
$c>= :: ShutdownServer -> ShutdownServer -> Bool
> :: ShutdownServer -> ShutdownServer -> Bool
$c> :: ShutdownServer -> ShutdownServer -> Bool
<= :: ShutdownServer -> ShutdownServer -> Bool
$c<= :: ShutdownServer -> ShutdownServer -> Bool
< :: ShutdownServer -> ShutdownServer -> Bool
$c< :: ShutdownServer -> ShutdownServer -> Bool
compare :: ShutdownServer -> ShutdownServer -> Ordering
$ccompare :: ShutdownServer -> ShutdownServer -> Ordering
$cp1Ord :: Eq ShutdownServer
Ord)

instance FromBSER ShutdownServer where
    parseBSER :: BSERValue -> Parser ShutdownServer
parseBSER (BSERObject Map ByteString BSERValue
o) = do
        Bool
v <- Map ByteString BSERValue
o Map ByteString BSERValue -> ByteString -> Parser Bool
forall a.
FromBSER a =>
Map ByteString BSERValue -> ByteString -> Parser a
.: ByteString
"shutdown-server"
        ShutdownServer -> Parser ShutdownServer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> ShutdownServer
ShutdownServer Bool
v)
    parseBSER BSERValue
_ = String -> Parser ShutdownServer
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not an Object"


shutdownServer :: WatchmanSockFile -> IO ShutdownServer
shutdownServer :: String -> IO ShutdownServer
shutdownServer String
sockFile = String
-> WatchmanCommand () ShutdownServer -> () -> IO ShutdownServer
forall a b. String -> WatchmanCommand a b -> a -> IO b
runCommand String
sockFile WatchmanCommand () ShutdownServer
shutdownServerCmd ()

data WatchResponse = WatchResponse
    { WatchResponse -> WFilePath
_WatchResponse_Watch :: WFilePath
    , WatchResponse -> String
_WatchResponse_Watcher :: String
    }
    deriving (Int -> WatchResponse -> ShowS
[WatchResponse] -> ShowS
WatchResponse -> String
(Int -> WatchResponse -> ShowS)
-> (WatchResponse -> String)
-> ([WatchResponse] -> ShowS)
-> Show WatchResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WatchResponse] -> ShowS
$cshowList :: [WatchResponse] -> ShowS
show :: WatchResponse -> String
$cshow :: WatchResponse -> String
showsPrec :: Int -> WatchResponse -> ShowS
$cshowsPrec :: Int -> WatchResponse -> ShowS
Show, WatchResponse -> WatchResponse -> Bool
(WatchResponse -> WatchResponse -> Bool)
-> (WatchResponse -> WatchResponse -> Bool) -> Eq WatchResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WatchResponse -> WatchResponse -> Bool
$c/= :: WatchResponse -> WatchResponse -> Bool
== :: WatchResponse -> WatchResponse -> Bool
$c== :: WatchResponse -> WatchResponse -> Bool
Eq)

instance FromBSER WatchResponse where
    parseBSER :: BSERValue -> Parser WatchResponse
parseBSER (BSERObject Map ByteString BSERValue
o) = do
        ByteString
watch_ <- Map ByteString BSERValue
o Map ByteString BSERValue -> ByteString -> Parser ByteString
forall a.
FromBSER a =>
Map ByteString BSERValue -> ByteString -> Parser a
.: ByteString
"watch"
        ByteString
watcher <- Map ByteString BSERValue
o Map ByteString BSERValue -> ByteString -> Parser ByteString
forall a.
FromBSER a =>
Map ByteString BSERValue -> ByteString -> Parser a
.: ByteString
"watcher"
        WatchResponse -> Parser WatchResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure WatchResponse :: WFilePath -> String -> WatchResponse
WatchResponse
            { _WatchResponse_Watch :: WFilePath
_WatchResponse_Watch = ByteString -> WFilePath
WFilePath ByteString
watch_
            , _WatchResponse_Watcher :: String
_WatchResponse_Watcher = ByteString -> String
BC.unpack ByteString
watcher
            }
    parseBSER BSERValue
_ = String -> Parser WatchResponse
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not an Object"

watchCmd :: WatchmanCommand WFilePath WatchResponse
watchCmd :: WatchmanCommand WFilePath WatchResponse
watchCmd = (WFilePath -> BSERValue)
-> (BSERValue -> Parser WatchResponse)
-> WatchmanCommand WFilePath WatchResponse
forall a b.
(a -> BSERValue) -> (BSERValue -> Parser b) -> WatchmanCommand a b
WatchmanCommand
    (\WFilePath
filepath -> Seq BSERValue -> BSERValue
BSERArray ([BSERValue] -> Seq BSERValue
forall a. [a] -> Seq a
Seq.fromList [ByteString -> BSERValue
BSERString (String -> ByteString
BC.pack String
"watch"), ByteString -> BSERValue
BSERString (WFilePath -> ByteString
toByteString WFilePath
filepath)]))
    BSERValue -> Parser WatchResponse
forall a. FromBSER a => BSERValue -> Parser a
parseBSER

watch :: WatchmanSockFile -> WFilePath -> IO WatchResponse
watch :: String -> WFilePath -> IO WatchResponse
watch String
sockFile WFilePath
filepath = String
-> WatchmanCommand WFilePath WatchResponse
-> WFilePath
-> IO WatchResponse
forall a b. String -> WatchmanCommand a b -> a -> IO b
runCommand String
sockFile WatchmanCommand WFilePath WatchResponse
watchCmd WFilePath
filepath

parseRoots :: BSERValue -> Parser [WFilePath]
parseRoots :: BSERValue -> Parser [WFilePath]
parseRoots (BSERObject Map ByteString BSERValue
o) = do
    [BSERValue]
roots <- Map ByteString BSERValue
o Map ByteString BSERValue -> ByteString -> Parser [BSERValue]
forall a.
FromBSER a =>
Map ByteString BSERValue -> ByteString -> Parser a
.: ByteString
"roots"
    (BSERValue -> Parser WFilePath)
-> [BSERValue] -> Parser [WFilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BSERValue -> Parser WFilePath
forall a. FromBSER a => BSERValue -> Parser a
parseBSER [BSERValue]
roots
parseRoots BSERValue
_ = String -> Parser [WFilePath]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not an Object"

watchListCmd :: WatchmanCommand () [WFilePath]
watchListCmd :: WatchmanCommand () [WFilePath]
watchListCmd = (() -> BSERValue)
-> (BSERValue -> Parser [WFilePath])
-> WatchmanCommand () [WFilePath]
forall a b.
(a -> BSERValue) -> (BSERValue -> Parser b) -> WatchmanCommand a b
WatchmanCommand
    (BSERValue -> () -> BSERValue
forall a b. a -> b -> a
const (BSERValue -> () -> BSERValue) -> BSERValue -> () -> BSERValue
forall a b. (a -> b) -> a -> b
$ Seq BSERValue -> BSERValue
BSERArray (BSERValue -> Seq BSERValue
forall a. a -> Seq a
Seq.singleton (ByteString -> BSERValue
BSERString (String -> ByteString
BC.pack String
"watch-list"))))
    BSERValue -> Parser [WFilePath]
parseRoots

watchList :: WatchmanSockFile -> IO [WFilePath]
watchList :: String -> IO [WFilePath]
watchList String
sockFile = String -> WatchmanCommand () [WFilePath] -> () -> IO [WFilePath]
forall a b. String -> WatchmanCommand a b -> a -> IO b
runCommand String
sockFile WatchmanCommand () [WFilePath]
watchListCmd ()

queryCmd :: [FileFieldLabel] -> WatchmanCommand (WFilePath, [Generators -> Generators], Expression, [QueryParams -> QueryParams]) QueryResult
queryCmd :: [FileFieldLabel]
-> WatchmanCommand
     (WFilePath, [Generators -> Generators], Expression,
      [QueryParams -> QueryParams])
     QueryResult
queryCmd [FileFieldLabel]
fileFieldLabels = ((WFilePath, [Generators -> Generators], Expression,
  [QueryParams -> QueryParams])
 -> BSERValue)
-> (BSERValue -> Parser QueryResult)
-> WatchmanCommand
     (WFilePath, [Generators -> Generators], Expression,
      [QueryParams -> QueryParams])
     QueryResult
forall a b.
(a -> BSERValue) -> (BSERValue -> Parser b) -> WatchmanCommand a b
WatchmanCommand
    (\(WFilePath
p, [Generators -> Generators]
g, Expression
e, [QueryParams -> QueryParams]
q) -> WFilePath
-> [Generators -> Generators]
-> Expression
-> [QueryParams -> QueryParams]
-> [FileFieldLabel]
-> BSERValue
renderQuery WFilePath
p [Generators -> Generators]
g Expression
e [QueryParams -> QueryParams]
q [FileFieldLabel]
fileFieldLabels)
    ([FileFieldLabel] -> BSERValue -> Parser QueryResult
parseQueryResult [FileFieldLabel]
fileFieldLabels)

query
    :: WatchmanSockFile
    -> WFilePath
    -> [Generators -> Generators]
    -> Expression
    -> [QueryParams -> QueryParams]
    -> [FileFieldLabel] -- ^ Must not be empty. Must not have duplicates
    -> IO QueryResult
query :: String
-> WFilePath
-> [Generators -> Generators]
-> Expression
-> [QueryParams -> QueryParams]
-> [FileFieldLabel]
-> IO QueryResult
query String
sockFile WFilePath
filepath [Generators -> Generators]
generators Expression
expr [QueryParams -> QueryParams]
queryParams [FileFieldLabel]
fileFields = String
-> WatchmanCommand
     (WFilePath, [Generators -> Generators], Expression,
      [QueryParams -> QueryParams])
     QueryResult
-> (WFilePath, [Generators -> Generators], Expression,
    [QueryParams -> QueryParams])
-> IO QueryResult
forall a b. String -> WatchmanCommand a b -> a -> IO b
runCommand String
sockFile ([FileFieldLabel]
-> WatchmanCommand
     (WFilePath, [Generators -> Generators], Expression,
      [QueryParams -> QueryParams])
     QueryResult
queryCmd [FileFieldLabel]
fileFields) (WFilePath
filepath, [Generators -> Generators]
generators, Expression
expr, [QueryParams -> QueryParams]
queryParams)

data WatchmanSocket = WatchmanSocket !Net.Socket !ThreadId !(MVar (MVar BSERValue)) !(MVar (Map SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)))

connect :: WatchmanSockFile -> IO WatchmanSocket
connect :: String -> IO WatchmanSocket
connect String
sockFile = do
    MVar (MVar BSERValue)
cmdRspVar <- IO (MVar (MVar BSERValue))
forall a. IO (MVar a)
newEmptyMVar
    MVar
  (Map
     SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
subscriptions <- Map
  SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
-> IO
     (MVar
        (Map
           SubscriptionName
           ([FileFieldLabel], Chan SubscriptionNotification)))
forall a. a -> IO (MVar a)
newMVar Map
  SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
forall k a. Map k a
M.empty
    IO WatchmanConnection
-> (WatchmanConnection -> IO ())
-> (WatchmanConnection -> IO WatchmanSocket)
-> IO WatchmanSocket
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
        (String -> IO WatchmanConnection
connectToWatchman String
sockFile)
        WatchmanConnection -> IO ()
disconnectWatchman
        ((WatchmanConnection -> IO WatchmanSocket) -> IO WatchmanSocket)
-> (WatchmanConnection -> IO WatchmanSocket) -> IO WatchmanSocket
forall a b. (a -> b) -> a -> b
$ \(WatchmanConnection Socket
sock) -> IO ThreadId
-> (ThreadId -> IO ())
-> (ThreadId -> IO WatchmanSocket)
-> IO WatchmanSocket
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
            (IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Socket
-> MVar (MVar BSERValue)
-> MVar
     (Map
        SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
-> IO ()
forall b.
Socket
-> MVar (MVar BSERValue)
-> MVar
     (Map
        SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
-> IO b
readThread Socket
sock MVar (MVar BSERValue)
cmdRspVar MVar
  (Map
     SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
subscriptions)
            ThreadId -> IO ()
killThread
            ((ThreadId -> IO WatchmanSocket) -> IO WatchmanSocket)
-> (ThreadId -> IO WatchmanSocket) -> IO WatchmanSocket
forall a b. (a -> b) -> a -> b
$ \ThreadId
threadId -> do
                WatchmanSocket -> IO WatchmanSocket
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WatchmanSocket -> IO WatchmanSocket)
-> WatchmanSocket -> IO WatchmanSocket
forall a b. (a -> b) -> a -> b
$ Socket
-> ThreadId
-> MVar (MVar BSERValue)
-> MVar
     (Map
        SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
-> WatchmanSocket
WatchmanSocket Socket
sock ThreadId
threadId MVar (MVar BSERValue)
cmdRspVar MVar
  (Map
     SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
subscriptions
    where
    readThread :: Socket
-> MVar (MVar BSERValue)
-> MVar
     (Map
        SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
-> IO b
readThread Socket
sock MVar (MVar BSERValue)
cmdRspVar MVar
  (Map
     SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
subscriptionsVar = IO () -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO b) -> IO () -> IO b
forall a b. (a -> b) -> a -> b
$ do
        -- TODO Handle any errors
        BSERValue
rsp <- Socket -> IO BSERValue
readBSERMessage Socket
sock
        case BSERValue -> Maybe SubscriptionName
subscriptionNotification BSERValue
rsp of
            Just SubscriptionName
subscription -> do
                MVar
  (Map
     SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
-> (Map
      SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
    -> IO ())
-> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar
  (Map
     SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
subscriptionsVar ((Map
    SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
  -> IO ())
 -> IO ())
-> (Map
      SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
    -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Map
  SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
subscriptions -> do
                    case SubscriptionName
-> Map
     SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
-> Maybe ([FileFieldLabel], Chan SubscriptionNotification)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SubscriptionName
subscription Map
  SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
subscriptions of
                        Maybe ([FileFieldLabel], Chan SubscriptionNotification)
Nothing ->
                            -- We got a notification for a subscription that does not exist. It must have been just un-subscribed (while this notification was already on route).
                            -- We can just ignore the message
                            () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                        Just ([FileFieldLabel]
fileFieldLabels, Chan SubscriptionNotification
chan) -> do
                            case (BSERValue -> Parser SubscriptionNotification)
-> BSERValue -> Result SubscriptionNotification
forall a b. (a -> Parser b) -> a -> Result b
parse ([FileFieldLabel] -> BSERValue -> Parser SubscriptionNotification
parseSubscriptionNotification [FileFieldLabel]
fileFieldLabels) BSERValue
rsp of
                                Error String
err -> do
                                    -- TODO ...
                                    String -> IO ()
forall a. Show a => a -> IO ()
print String
err
                                    String -> IO ()
forall a. HasCallStack => String -> a
error String
"TODO 62462"
                                Success SubscriptionNotification
result -> do
                                    Chan SubscriptionNotification -> SubscriptionNotification -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan SubscriptionNotification
chan SubscriptionNotification
result
            Maybe SubscriptionName
Nothing -> do
                Maybe (MVar BSERValue)
mbVar <- MVar (MVar BSERValue) -> IO (Maybe (MVar BSERValue))
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar (MVar BSERValue)
cmdRspVar
                case Maybe (MVar BSERValue)
mbVar of
                    Maybe (MVar BSERValue)
Nothing -> do
                        -- TODO We received an unexpected message: It wasn't a subscription notification, and we don't have an in-flight command that is expecting a response.
                        -- This should probably be dealt with in the same way that we deal with an error from 'readBSERMessage' above
                        String -> IO ()
forall a. HasCallStack => String -> a
error String
"TODO 2392362"
                    Just MVar BSERValue
var -> do
                        -- When a command gives us an MVar, it is required to be an empty MVar
                        Bool
sanityCheck <- MVar BSERValue -> BSERValue -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar MVar BSERValue
var BSERValue
rsp
                        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
sanityCheck (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                            String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"The Impossible happened!"
    -- | Checks to see if the response from the watchman server is an error response
    subscriptionNotification :: BSERValue -> Maybe SubscriptionName
    subscriptionNotification :: BSERValue -> Maybe SubscriptionName
subscriptionNotification (BSERObject Map ByteString BSERValue
o) =
        case ByteString -> Map ByteString BSERValue -> Maybe BSERValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ByteString
"subscription" Map ByteString BSERValue
o of
            Just (BSERString ByteString
s) -> SubscriptionName -> Maybe SubscriptionName
forall a. a -> Maybe a
Just (ByteString -> SubscriptionName
SubscriptionName ByteString
s)
            Just BSERValue
_ -> Maybe SubscriptionName
forall a. Maybe a
Nothing
            Maybe BSERValue
Nothing -> Maybe SubscriptionName
forall a. Maybe a
Nothing
    subscriptionNotification BSERValue
_ = Maybe SubscriptionName
forall a. Maybe a
Nothing

disconnect :: WatchmanSocket -> IO ()
disconnect :: WatchmanSocket -> IO ()
disconnect (WatchmanSocket Socket
sock ThreadId
readThread MVar (MVar BSERValue)
_ MVar
  (Map
     SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
_) = do
    -- TODO Maybe we also need to do something about the MVars?
    ThreadId -> IO ()
killThread ThreadId
readThread
    WatchmanConnection -> IO ()
disconnectWatchman (Socket -> WatchmanConnection
WatchmanConnection Socket
sock)

withConnect :: WatchmanSockFile -> (WatchmanSocket -> IO a) -> IO a
withConnect :: String -> (WatchmanSocket -> IO a) -> IO a
withConnect String
sockFile = IO WatchmanSocket
-> (WatchmanSocket -> IO ()) -> (WatchmanSocket -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> IO WatchmanSocket
connect String
sockFile) WatchmanSocket -> IO ()
disconnect

data WatchmanSubscription = WatchmanSubscription !(IO ()) !(IO SubscriptionNotification)

subscribe :: WatchmanSocket -> WFilePath -> SubscriptionName -> Expression -> [SubscribeParams -> SubscribeParams] -> [FileFieldLabel] -> IO WatchmanSubscription
subscribe :: WatchmanSocket
-> WFilePath
-> SubscriptionName
-> Expression
-> [SubscribeParams -> SubscribeParams]
-> [FileFieldLabel]
-> IO WatchmanSubscription
subscribe (WatchmanSocket Socket
sock ThreadId
_ MVar (MVar BSERValue)
cmdRspVar MVar
  (Map
     SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
subscriptionsVar) WFilePath
filepath SubscriptionName
subscriptionName Expression
expr [SubscribeParams -> SubscribeParams]
subscribeParams [FileFieldLabel]
fileFields = do
    MVar BSERValue
rspVar <- IO (MVar BSERValue)
forall a. IO (MVar a)
newEmptyMVar

    Chan SubscriptionNotification
notificationsChan <- IO (Chan SubscriptionNotification)
forall a. IO (Chan a)
newChan

    -- TODO need 'bracketOnError' that will erase the subscription from the map
    MVar
  (Map
     SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
-> (Map
      SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
    -> IO
         (Map
            SubscriptionName
            ([FileFieldLabel], Chan SubscriptionNotification)))
-> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar
  (Map
     SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
subscriptionsVar ((Map
    SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
  -> IO
       (Map
          SubscriptionName
          ([FileFieldLabel], Chan SubscriptionNotification)))
 -> IO ())
-> (Map
      SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
    -> IO
         (Map
            SubscriptionName
            ([FileFieldLabel], Chan SubscriptionNotification)))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Map
  SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
subscriptions -> do
        case SubscriptionName
-> Map
     SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
-> Maybe ([FileFieldLabel], Chan SubscriptionNotification)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SubscriptionName
subscriptionName Map
  SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
subscriptions of
            Maybe ([FileFieldLabel], Chan SubscriptionNotification)
Nothing -> do
                let subscriptions' :: Map
  SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
subscriptions' = SubscriptionName
-> ([FileFieldLabel], Chan SubscriptionNotification)
-> Map
     SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
-> Map
     SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert SubscriptionName
subscriptionName ([FileFieldLabel]
fileFields, Chan SubscriptionNotification
notificationsChan) Map
  SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
subscriptions
                Map
  SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
-> IO
     (Map
        SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map
  SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification)
subscriptions'
            Just ([FileFieldLabel], Chan SubscriptionNotification)
_ -> WatchmanException
-> IO
     (Map
        SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
forall e a. Exception e => e -> IO a
throwIO (WatchmanException
 -> IO
      (Map
         SubscriptionName
         ([FileFieldLabel], Chan SubscriptionNotification)))
-> WatchmanException
-> IO
     (Map
        SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
forall a b. (a -> b) -> a -> b
$ SubscriptionName -> WatchmanException
WatchmanException_SubscriptionExists SubscriptionName
subscriptionName

    -- Give the read thread a place to put the response into. This also acts as a lock(mutex) that will block any concurrent commands until the response is received:
    MVar (MVar BSERValue) -> MVar BSERValue -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (MVar BSERValue)
cmdRspVar MVar BSERValue
rspVar

    let msg :: BSERValue
msg = WFilePath
-> SubscriptionName
-> Expression
-> [SubscribeParams -> SubscribeParams]
-> [FileFieldLabel]
-> BSERValue
renderSubscribe WFilePath
filepath SubscriptionName
subscriptionName Expression
expr [SubscribeParams -> SubscribeParams]
subscribeParams [FileFieldLabel]
fileFields
    -- TODO What happens if an async exception happens here? A partial send will leave the socket in a broken state. Might want to use 'uninterruptibleMask_' here.
    -- Then again, I think that 'sendBSERMessage' is an atomic operation.
    Socket -> BSERValue -> IO ()
sendBSERMessage Socket
sock BSERValue
msg

    -- Wait for the read thread to put the response into the place we gave it:
    BSERValue
_rsp <- MVar BSERValue -> IO BSERValue
forall a. MVar a -> IO a
readMVar MVar BSERValue
rspVar
    -- TODO Check if rsp is 'readError'
    let unsubscribe_ :: IO a
unsubscribe_ = do
            -- TODO Send message to sock
            -- TODO Remove subscription from Map
            a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> a
forall a. HasCallStack => String -> a
error String
"TODO 92834252642")
    let next :: IO SubscriptionNotification
next = Chan SubscriptionNotification -> IO SubscriptionNotification
forall a. Chan a -> IO a
readChan Chan SubscriptionNotification
notificationsChan
    WatchmanSubscription -> IO WatchmanSubscription
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WatchmanSubscription -> IO WatchmanSubscription)
-> WatchmanSubscription -> IO WatchmanSubscription
forall a b. (a -> b) -> a -> b
$ IO () -> IO SubscriptionNotification -> WatchmanSubscription
WatchmanSubscription IO ()
forall a. IO a
unsubscribe_ IO SubscriptionNotification
next

unsubscribe :: WatchmanSubscription -> IO ()
unsubscribe :: WatchmanSubscription -> IO ()
unsubscribe (WatchmanSubscription IO ()
unsubscribe_ IO SubscriptionNotification
_) = IO ()
unsubscribe_

readNotification :: WatchmanSubscription -> IO SubscriptionNotification
readNotification :: WatchmanSubscription -> IO SubscriptionNotification
readNotification (WatchmanSubscription IO ()
_ IO SubscriptionNotification
next) = IO SubscriptionNotification
next

stateEnter :: WatchmanSocket -> WFilePath -> StateName -> [StateParams -> StateParams] -> IO ()
stateEnter :: WatchmanSocket
-> WFilePath -> StateName -> [StateParams -> StateParams] -> IO ()
stateEnter (WatchmanSocket Socket
sock ThreadId
_ MVar (MVar BSERValue)
cmdRspVar MVar
  (Map
     SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
_) WFilePath
filepath StateName
stateName [StateParams -> StateParams]
stateParams = do
    MVar BSERValue
rspVar <- IO (MVar BSERValue)
forall a. IO (MVar a)
newEmptyMVar

    -- Give the read thread a place to put the response into. This also acts as a lock(mutex) that will block any concurrent commands until the response is received:
    MVar (MVar BSERValue) -> MVar BSERValue -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (MVar BSERValue)
cmdRspVar MVar BSERValue
rspVar

    let msg :: BSERValue
msg = WFilePath -> StateName -> [StateParams -> StateParams] -> BSERValue
renderStateEnter WFilePath
filepath StateName
stateName [StateParams -> StateParams]
stateParams
    -- TODO What happens if an async exception happens here? A partial send will leave the socket in a broken state. Might want to use 'uninterruptibleMask_' here.
    -- Then again, I think that 'sendBSERMessage' is an atomic operation.
    Socket -> BSERValue -> IO ()
sendBSERMessage Socket
sock BSERValue
msg

    -- Wait for the read thread to put the response into the place we gave it:
    BSERValue
rsp <- MVar BSERValue -> IO BSERValue
forall a. MVar a -> IO a
readMVar MVar BSERValue
rspVar
    -- TODO Check if rsp is 'readError'
    case BSERValue -> Maybe String
readError BSERValue
rsp of
        Just String
err -> WatchmanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (WatchmanException -> IO ()) -> WatchmanException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> WatchmanException
WatchmanException_ErrorResponse String
err
        Maybe String
Nothing ->
            -- "state-enter" response has fields: "clock", "root", "state-enter", "version".
            --
            -- We aren't
            () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

stateLeave :: WatchmanSocket -> WFilePath -> StateName -> [StateParams -> StateParams] -> IO ()
stateLeave :: WatchmanSocket
-> WFilePath -> StateName -> [StateParams -> StateParams] -> IO ()
stateLeave (WatchmanSocket Socket
sock ThreadId
_ MVar (MVar BSERValue)
cmdRspVar MVar
  (Map
     SubscriptionName ([FileFieldLabel], Chan SubscriptionNotification))
_) WFilePath
filepath StateName
stateName [StateParams -> StateParams]
stateParams = do
    MVar BSERValue
rspVar <- IO (MVar BSERValue)
forall a. IO (MVar a)
newEmptyMVar

    -- Give the read thread a place to put the response into. This also acts as a lock(mutex) that will block any concurrent commands until the response is received:
    MVar (MVar BSERValue) -> MVar BSERValue -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (MVar BSERValue)
cmdRspVar MVar BSERValue
rspVar

    let msg :: BSERValue
msg = WFilePath -> StateName -> [StateParams -> StateParams] -> BSERValue
renderStateLeave WFilePath
filepath StateName
stateName [StateParams -> StateParams]
stateParams
    -- TODO What happens if an async exception happens here? A partial send will leave the socket in a broken state. Might want to use 'uninterruptibleMask_' here.
    -- Then again, I think that 'sendBSERMessage' is an atomic operation.
    Socket -> BSERValue -> IO ()
sendBSERMessage Socket
sock BSERValue
msg

    -- Wait for the read thread to put the response into the place we gave it:
    BSERValue
rsp <- MVar BSERValue -> IO BSERValue
forall a. MVar a -> IO a
readMVar MVar BSERValue
rspVar
    -- TODO Check if rsp is 'readError'
    case BSERValue -> Maybe String
readError BSERValue
rsp of
        Just String
err -> WatchmanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (WatchmanException -> IO ()) -> WatchmanException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> WatchmanException
WatchmanException_ErrorResponse String
err
        Maybe String
Nothing ->
            -- "state-enter" response has fields: "clock", "root", "state-enter", "version".
            --
            -- We aren't
            () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()