Use crossplatform filewatching library.

This commit is contained in:
David 2019-03-12 15:40:44 +01:00
commit fd24bac24f
4 changed files with 23 additions and 54 deletions

View file

@ -1,18 +0,0 @@
module Reanimate.FileWatch
( watchFile ) where
import Control.Concurrent
import System.Directory
watchFile :: FilePath -> IO () -> IO ()
watchFile path handler = do
t0 <- getModificationTime path
forkIO $ loop t0
return ()
where
loop lastModTime = do
t1 <- getModificationTime path
if t1 /= lastModTime
then handler >> loop t1
else threadDelay (10^3 * delay) >> loop lastModTime
delay = 1000 -- pool delay in ms.

View file

@ -32,9 +32,6 @@ Source-Repository head
Type: git Type: git
Location: git://github.com/lemmih/reanimate.git Location: git://github.com/lemmih/reanimate.git
Flag inotify
Description: Enable file watching using linux's inotify
library library
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
@ -51,7 +48,6 @@ library
Reanimate.Misc Reanimate.Misc
other-modules: Reanimate.Svg.NamedColors other-modules: Reanimate.Svg.NamedColors
Reanimate.Cache Reanimate.Cache
Reanimate.FileWatch
Paths_reanimate Paths_reanimate
build-depends: base >=4.10 && <4.13, build-depends: base >=4.10 && <4.13,
time, text, unix, filepath, process, directory, time, text, unix, filepath, process, directory,
@ -59,13 +55,7 @@ library
JuicyPixels, attoparsec, parallel, diagrams, diagrams-svg, JuicyPixels, attoparsec, parallel, diagrams, diagrams-svg,
diagrams-core, diagrams-lib, diagrams-contrib, diagrams-core, diagrams-lib, diagrams-contrib,
svg-builder, matrices, cubicbezier, palette, websockets, svg-builder, matrices, cubicbezier, palette, websockets,
hashable hashable, fsnotify
if os(linux) && flag(inotify)
hs-source-dirs: unix
build-depends: hinotify
else
hs-source-dirs: posix
Flag server Flag server
Description: Enable rendering server Description: Enable rendering server

View file

@ -1,28 +1,31 @@
module Reanimate.Driver ( reanimate ) where module Reanimate.Driver ( reanimate ) where
import Control.Concurrent (MVar, forkIO, killThread, modifyMVar_, import Control.Concurrent (MVar, forkIO, killThread, modifyMVar_,
newEmptyMVar, putMVar) newEmptyMVar, putMVar)
import Control.Monad.Fix (fix) import Control.Exception (finally)
import qualified Data.Text as T import Control.Monad.Fix (fix)
import qualified Data.Text as T
import Network.WebSockets import Network.WebSockets
import Reanimate.FileWatch (watchFile) import System.Directory (findExecutable, findFile, listDirectory)
import System.Directory (findFile, listDirectory, findExecutable) import System.Environment (getArgs, getProgName)
import System.Environment (getArgs, getProgName) import System.FilePath
import System.IO (BufferMode (..), hPutStrLn, hSetBuffering, import System.FSNotify
stderr, stdin) import System.IO (BufferMode (..), hPutStrLn, hSetBuffering,
stderr, stdin)
import Data.Maybe import Data.Maybe
import Paths_reanimate import Paths_reanimate
import Reanimate.Misc (runCmd, runCmdLazy, runCmd_, withTempDir, import Reanimate.Misc (runCmd, runCmdLazy, runCmd_, withTempDir,
withTempFile) withTempFile)
import Reanimate.Monad (Animation) import Reanimate.Monad (Animation)
import Reanimate.Render (renderSvgs) import Reanimate.Render (renderSvgs)
opts = defaultConnectionOptions opts = defaultConnectionOptions
{ connectionCompressionOptions = PermessageDeflateCompression defaultPermessageDeflate } { connectionCompressionOptions = PermessageDeflateCompression defaultPermessageDeflate }
reanimate :: Animation -> IO () reanimate :: Animation -> IO ()
reanimate animation = do reanimate animation = do
watch <- startManager
args <- getArgs args <- getArgs
hSetBuffering stdin NoBuffering hSetBuffering stdin NoBuffering
case args of case args of
@ -67,13 +70,17 @@ reanimate animation = do
loop (frame : acc) loop (frame : acc)
return tid return tid
putStrLn "Found self. Listening." putStrLn "Found self. Listening."
watchFile self handler stop <- watchFile watch self handler
putMVar slave =<< forkIO (return ()) putMVar slave =<< forkIO (return ())
let loop = do let loop = do
fps <- receiveData conn :: IO T.Text fps <- receiveData conn :: IO T.Text
handler handler
loop loop
loop loop `finally` stop
watchFile watch file action = watchDir watch (takeDirectory file) check (const action)
where
check event = takeFileName (eventPath event) == takeFileName file
ghcOptions :: FilePath -> [String] ghcOptions :: FilePath -> [String]
ghcOptions tmpDir = ghcOptions tmpDir =

View file

@ -1,10 +0,0 @@
module Reanimate.FileWatch
( watchFile ) where
import System.INotify
watchFile :: FilePath -> IO () -> IO ()
watchFile path handler = do
notify <- initINotify
addWatch notify [Modify] path (const handler)
return ()