Created
August 8, 2017 23:07
-
-
Save dalaing/73b24b9faea0f51c8e4cbc6d1311516e to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
build-depends: base >=4.9 && <4.10 | |
, mtl >=2.2 && <2.3 | |
, filepath >=1.4 && <1.5 | |
, directory >=1.3 && <1.4 | |
, text >=1.2 && <1.3 | |
, containers >=0.5 && <0.6 | |
, reflex-dom-core | |
, jsaddle | |
, jsaddle-warp | |
, warp | |
, wai-middleware-static | |
, websockets |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- with the appropriate ghci file to bring everything together | |
ghcid -T "runner testMe" --reload=css |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE RankNTypes #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
{-# LANGUAGE OverloadedStrings #-} | |
module Run ( | |
runner | |
) where | |
import Control.Monad.Reader (ReaderT, runReaderT) | |
import Data.Foldable (traverse_) | |
import Reflex.Dom.Core | |
import Network.Wai.Handler.Warp (defaultSettings, | |
runSettings, setPort, | |
setTimeout) | |
import Network.WebSockets (defaultConnectionOptions) | |
import Language.Javascript.JSaddle.Run (syncPoint) | |
import Language.Javascript.JSaddle.WebSockets | |
import Network.Wai.Middleware.Static | |
import System.FilePath ((</>)) | |
import System.Directory (listDirectory) | |
import qualified Data.Text as Text | |
import qualified Data.Map as Map | |
runner' :: | |
FilePath -> | |
Int -> | |
(forall x. Widget x ()) -> | |
IO () | |
runner' cssPath port w = | |
do | |
cssFiles <- listDirectory $ "." </> cssPath | |
let | |
f = do | |
let | |
stylesheet s = | |
elAttr "link" (Map.fromList [("rel", "stylesheet"), ("href", s)]) $ | |
return () | |
mainWidgetWithHead | |
(traverse_ (\f -> stylesheet . Text.pack $ cssPath </> f) cssFiles) | |
w | |
serveFiles = staticPolicy $ hasPrefix cssPath | |
debugWrapper $ \refreshMiddleware registerContext -> do | |
app <- jsaddleOr | |
defaultConnectionOptions | |
(registerContext >> f >> syncPoint) | |
(refreshMiddleware jsaddleApp) | |
runSettings (setPort port (setTimeout 3600 defaultSettings)) $ | |
serveFiles app | |
runner :: | |
(forall x. Widget x ()) | |
-> IO () | |
runner = | |
runner' "css" 8080 | |
More recent example at https://github.com/qfpl/reflex-tutorial/blob/00cc7904e75a647b5852a9444402b9718f702d04/code/exercises/src/Util/Run.hs (thanks to @dalaing)
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
I had to replace
jsaddleApp
byjsaddleAppWithJs $ jsaddleJs True
to make auto reload work for me.