hashirama/reanimate
Watch
1
0
Fork
You've already forked reanimate
 0
mirror of https://github.com/reanimate/reanimate.git synced 2026-09-13 00:52:54 +00:00
Code Issues Projects Releases Wiki Activity

Merge pull request #2 from bradrn/master

Browse source 
Fix errors on Windows
This commit is contained in:
David Himmelstrup 2019-05-13 18:05:33 +08:00 • committed by GitHub
commit acde4155e0
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
2 changed files with 13 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

4
reanimate.cabal
View file

@ -50,12 +50,12 @@ library
Reanimate.Cache
Paths_reanimate
build-depends: base >=4.10 && <4.13,
time, text, unix, filepath, process, directory,
time, text, filepath, process, directory,
containers, reanimate-svg >= 0.7.0.0, xml, bytestring, lens, linear, mtl, matrix,
JuicyPixels, attoparsec, parallel, diagrams, diagrams-svg,
diagrams-core, diagrams-lib, diagrams-contrib,
svg-builder, matrices, cubicbezier, palette, websockets,
hashable, fsnotify
hashable, fsnotify, open-browser
Flag server
Description: Enable rendering server

27
src/Reanimate/Driver.hs
View file

@ -6,7 +6,7 @@ import Control.Exception (finally)
import Control.Monad.Fix (fix)
import qualified Data.Text as T
import Network.WebSockets
import System.Directory (findExecutable, findFile, listDirectory)
import System.Directory (findFile, listDirectory)
import System.Environment (getArgs, getProgName)
import System.FilePath
import System.FSNotify
@ -15,10 +15,11 @@ import System.IO (BufferMode (..), hPutStrLn, hSetBuffering,
import Data.Maybe
import Paths_reanimate
import Reanimate.Misc (runCmd, runCmdLazy, runCmd_, withTempDir,
import Reanimate.Misc (runCmdLazy, runCmd_, withTempDir,
withTempFile)
import Reanimate.Monad (Animation)
import Reanimate.Render (renderSvgs)
import Web.Browser (openBrowser)
opts = defaultConnectionOptions
{ connectionCompressionOptions = PermessageDeflateCompression defaultPermessageDeflate }
@ -32,9 +33,13 @@ reanimate animation = do
["once"] -> renderSvgs animation
_ -> withTempDir $ \tmpDir -> do
url <- getDataFileName "viewer/build/index.html"
openBrowser url
putStrLn "Opening browser..."
bSucc <- openBrowser url
if bSucc
then putStrLn "Browser opened."
else hPutStrLn stderr $ "Failed to open browser. Manually visit: " ++ url
runServerWith "127.0.0.1" 9161 opts $ \pending -> do
putStrLn "Server pending."
putStrLn "Server pending..."
prog <- getProgName
lst <- listDirectory "."
mbSelf <- findFile ("." : lst) prog
@ -47,7 +52,7 @@ reanimate animation = do
slave <- newEmptyMVar
let handler = modifyMVar_ slave $ \tid -> do
sendTextData conn (T.pack "Compiling")
putStrLn "Kill and respawn."
putStrLn "Killing and respawning..."
killThread tid
tid <- forkIO $ withTempFile ".exe" $ \tmpExecutable -> do
ret <- runCmd_ "stack" $ ["ghc", "--"] ++ ghcOptions tmpDir ++ [self, "-o", tmpExecutable]
@ -69,7 +74,7 @@ reanimate animation = do
sendTextData conn frame
loop (frame : acc)
return tid
putStrLn "Found self. Listening."
putStrLn "Found self. Listening..."
stop <- watchFile watch self handler
putMVar slave =<< forkIO (return ())
let loop = do
@ -86,13 +91,3 @@ ghcOptions :: FilePath -> [String]
ghcOptions tmpDir =
["-rtsopts", "--make", "-threaded", "-O2"] ++
["-odir", tmpDir, "-hidir", tmpDir]
openBrowser :: String -> IO ()
openBrowser url = do
xdgOpen <- findExecutable "xdg-open"
open <- findExecutable "open"
case listToMaybe (catMaybes [xdgOpen, open]) of
Nothing ->
hPutStrLn stderr $ "Failed to open browser. Manually visit: " ++ url
Just prog ->
runCmd prog [url]