Commit 662ecf8b authored by Henrik Tramberend's avatar Henrik Tramberend
Browse files

Replace livereloadx with built-in server

parent 064cc7d3
......@@ -12,6 +12,7 @@ import Development.Shake
import Development.Shake.FilePath
import Embed
import Project
import Server
import System.Directory
import System.Exit
import System.FilePath ()
......@@ -75,7 +76,7 @@ main = do
--
phony "server" $ do
need ["watch", "support"]
runHttpServer publicDir True
runHttpServer dirs True
--
phony "example" writeExampleProject
--
......@@ -91,7 +92,7 @@ main = do
let src = replaceSuffix "-deck.pdf" "-deck.html" out
need [src]
putNormal $ src ++ " -> " ++ out
runHttpServer publicDir False
runHttpServer dirs False
code <-
cmd
"decktape.sh reveal"
......@@ -129,6 +130,7 @@ main = do
then indexSource
else indexSource <.> "generated"
markdownToHtmlPage src out
reloadBrowsers
--
indexSource <.> "generated" %> \out -> do
decks <- decksA
......@@ -161,6 +163,7 @@ main = do
phony "support" $ do
putNormal $ "# write embedded files for (" ++ supportDir ++ ")"
writeEmbeddedFiles deckerSupportDir supportDir
reloadBrowsers
--
phony "publish" $ do
need ["support"]
......
......@@ -15,7 +15,7 @@ $endif$
<title>$if(title-prefix)$$title-prefix$ – $endif$$pagetitle$</title>
<meta name="apple-mobile-web-app-capable" content="yes">
<meta name="apple-mobile-web-app-status-bar-style" content="black-translucent">
<meta name="viewport" content="width=device-width, initial-scale=1.0, maximum-scale=1.0, user-scalable=no, minimal-ui">
<meta name="viewport" content="width=device-width, initial-scale=1.0, maximum-scale=1.0, user-scalable=no">
<link rel="stylesheet" href="$revealjs-url$/css/reveal.css">
<style type="text/css">code{white-space: pre;}</style>
$if(quotes)$
......@@ -49,6 +49,12 @@ $endfor$
$if(math)$
$math$
$endif$
<script>
var socket = new WebSocket("ws://" + location.host + "/reload");
socket.onmessage = function () {
window.location.reload(true);
};
</script>
$for(header-includes)$
$header-includes$
$endfor$
......
......@@ -80,7 +80,6 @@ address p.date {
width: 75%;
margin: 0px auto;
}
.container video {
width: 75%;
margin: 0px auto;
......@@ -93,6 +92,12 @@ $endif$
<!--[if lt IE 9]>
<script src="//cdnjs.cloudflare.com/ajax/libs/html5shiv/3.7.3/html5shiv-printshiv.min.js"></script>
<![endif]-->
<script>
var socket = new WebSocket("ws://" + location.host + "/reload");
socket.onmessage = function () {
window.location.reload(true);
};
</script>
$for(header-includes)$
$header-includes$
$endfor$
......
......@@ -90,12 +90,10 @@ $endfor$
.container address p.date {
float: right;
}
.container img {
width: 75%;
margin: 0px auto;
}
.container video {
width: 75%;
margin: 0px auto;
......@@ -108,6 +106,12 @@ $endif$
<!--[if lt IE 9]>
<script src="//cdnjs.cloudflare.com/ajax/libs/html5shiv/3.7.3/html5shiv-printshiv.min.js"></script>
<![endif]-->
<script>
var socket = new WebSocket("ws://" + location.host + "/reload");
socket.onmessage = function () {
window.location.reload(true);
};
</script>
$for(header-includes)$
$header-includes$
$endfor$
......
......@@ -23,10 +23,11 @@ import Data.Typeable ()
import Development.Shake
import Project
import System.Process
import Server
data ActionContext = ActionContext
{ ctxFilesToWatch :: IORef [FilePath]
, ctxServerHandle :: IORef (Maybe ProcessHandle)
, ctxServerHandle :: IORef (Maybe Server)
, ctxDirs :: ProjectDirs
} deriving (Typeable, Show)
......@@ -76,12 +77,12 @@ setFilesToWatch files = do
ctx <- getActionContext
liftIO $ writeIORef (ctxFilesToWatch ctx) files
getServerHandle :: Action (Maybe ProcessHandle)
getServerHandle :: Action (Maybe Server)
getServerHandle = do
ctx <- getActionContext
liftIO $ readIORef $ ctxServerHandle ctx
setServerHandle :: Maybe ProcessHandle -> Action ()
setServerHandle :: Maybe Server -> Action ()
setServerHandle handle = do
ctx <- getActionContext
liftIO $ writeIORef (ctxServerHandle ctx) handle
......
......@@ -5,6 +5,7 @@ module Server
( startHttpServer
, stopHttpServer
, reloadClients
, Server
) where
import Control.Applicative
......
......@@ -32,6 +32,7 @@ module Utilities
, fixMustacheMarkupText
, globA
, toPandocMeta
, reloadBrowsers
, DeckerException(..)
) where
......@@ -70,6 +71,7 @@ import Network.HTTP.Simple
import Network.HTTP.Types.Status
import Network.URI
import Project
import Server
import qualified System.Directory as Dir
import System.FilePath as SF
import System.FilePath.Glob
......@@ -100,17 +102,23 @@ spawn = liftIO . spawnCommand
-- Runs liveroladx on the given directory, if it is not already running. If
-- open is True a browser window is opended.
runHttpServer dir open = do
process <- getServerHandle
case process of
runHttpServer :: ProjectDirs -> Bool -> Action ()
runHttpServer dirs open = do
server <- getServerHandle
case server of
Just _ -> return ()
Nothing -> do
putNormal "# livereloadx (on http://localhost:8888, see server.log)"
handle <-
spawn $ "livereloadx -s -p 8888 -d 500 " ++ dir ++ " 2>&1 > server.log"
setServerHandle $ Just handle
threadDelay' 200000
when open $ cmd ("open http://localhost:8888/" :: String) :: Action ()
let port = 8888
server <- liftIO $ startHttpServer dirs port
setServerHandle $ Just server
when open $ cmd ("open http://localhost:" ++ show port :: String) :: Action ()
reloadBrowsers :: Action ()
reloadBrowsers = do
server <- getServerHandle
case server of
Just handle -> liftIO $ reloadClients handle
Nothing -> return ()
threadDelay' :: Int -> Action ()
threadDelay' = liftIO . threadDelay
......@@ -135,17 +143,21 @@ runShakeInContext context options rules = do
cleanup
where
tryRunShake opts =
catch (shakeArgs opts rules) (\(SomeException e) -> return ())
handle (\(SomeException e) -> return ()) (shakeArgs opts rules)
cleanup = do
process <- readIORef $ ctxServerHandle context
case process of
Just handle -> terminateProcess handle
server <- readIORef $ ctxServerHandle context
case server of
Just handle -> stopHttpServer handle
Nothing -> return ()
nothingToWatch = do
files <- readIORef $ ctxFilesToWatch context
if null files
then return True
else do
server <- readIORef $ ctxServerHandle context
case server of
Just handle -> reloadClients handle
Nothing -> return ()
waitForTwitchPassive files
return False
......
---
csl: 'chicago-author-date.csl'
csl: 'acm-sig-proceedings.csl'
css:
- 'dummy.css'
---
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment