Use open-browser package to support more platforms

This commit is contained in:
Brad Neimann 2019-04-05 17:15:29 +11:00
commit 2120f64463
2 changed files with 9 additions and 14 deletions

View file

@ -55,7 +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, fsnotify hashable, fsnotify, open-browser
Flag server Flag server
Description: Enable rendering server Description: Enable rendering server

View file

@ -6,7 +6,7 @@ import Control.Exception (finally)
import Control.Monad.Fix (fix) import Control.Monad.Fix (fix)
import qualified Data.Text as T import qualified Data.Text as T
import Network.WebSockets import Network.WebSockets
import System.Directory (findExecutable, findFile, listDirectory) import System.Directory (findFile, listDirectory)
import System.Environment (getArgs, getProgName) import System.Environment (getArgs, getProgName)
import System.FilePath import System.FilePath
import System.FSNotify import System.FSNotify
@ -15,10 +15,11 @@ import System.IO (BufferMode (..), hPutStrLn, hSetBuffering,
import Data.Maybe import Data.Maybe
import Paths_reanimate import Paths_reanimate
import Reanimate.Misc (runCmd, runCmdLazy, runCmd_, withTempDir, import Reanimate.Misc (runCmdLazy, runCmd_, withTempDir,
withTempFile) withTempFile)
import Reanimate.Monad (Animation) import Reanimate.Monad (Animation)
import Reanimate.Render (renderSvgs) import Reanimate.Render (renderSvgs)
import Web.Browser (openBrowser)
opts = defaultConnectionOptions opts = defaultConnectionOptions
{ connectionCompressionOptions = PermessageDeflateCompression defaultPermessageDeflate } { connectionCompressionOptions = PermessageDeflateCompression defaultPermessageDeflate }
@ -32,7 +33,11 @@ reanimate animation = do
["once"] -> renderSvgs animation ["once"] -> renderSvgs animation
_ -> withTempDir $ \tmpDir -> do _ -> withTempDir $ \tmpDir -> do
url <- getDataFileName "viewer/build/index.html" 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 runServerWith "127.0.0.1" 9161 opts $ \pending -> do
putStrLn "Server pending." putStrLn "Server pending."
prog <- getProgName prog <- getProgName
@ -86,13 +91,3 @@ ghcOptions :: FilePath -> [String]
ghcOptions tmpDir = ghcOptions tmpDir =
["-rtsopts", "--make", "-threaded", "-O2"] ++ ["-rtsopts", "--make", "-threaded", "-O2"] ++
["-odir", tmpDir, "-hidir", tmpDir] ["-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]