mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-14 09:32:22 +00:00
Use crossplatform filewatching library.
This commit is contained in:
parent
93e32f81b3
commit
fd24bac24f
4 changed files with 23 additions and 54 deletions
|
|
@ -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.
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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 =
|
||||||
|
|
|
||||||
|
|
@ -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 ()
|
|
||||||
Loading…
Reference in a new issue