{-# 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 ()
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]
-> 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
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 ->
() -> 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
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
String -> IO ()
forall a. HasCallStack => String -> a
error String
"TODO 2392362"
Just MVar BSERValue
var -> do
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!"
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
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
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
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
Socket -> BSERValue -> IO ()
sendBSERMessage Socket
sock BSERValue
msg
BSERValue
_rsp <- MVar BSERValue -> IO BSERValue
forall a. MVar a -> IO a
readMVar MVar BSERValue
rspVar
let unsubscribe_ :: IO a
unsubscribe_ = do
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
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
Socket -> BSERValue -> IO ()
sendBSERMessage Socket
sock BSERValue
msg
BSERValue
rsp <- MVar BSERValue -> IO BSERValue
forall a. MVar a -> IO a
readMVar MVar BSERValue
rspVar
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 ->
() -> 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
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
Socket -> BSERValue -> IO ()
sendBSERMessage Socket
sock BSERValue
msg
BSERValue
rsp <- MVar BSERValue -> IO BSERValue
forall a. MVar a -> IO a
readMVar MVar BSERValue
rspVar
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 ->
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()