@@ -9,6 +9,7 @@ import Control.Lens ((^?), _Just, _Right)
99import qualified Data.Attoparsec.ByteString.Char8 as A
1010import Data.ByteString (ByteString)
1111import qualified Data.ByteString.Char8 as BSC
12+import qualified Data.ByteString.Lazy.Char8 as BSLC
1213import Data.List (uncons)
1314import Data.Maybe
1415import Data.Semigroup ((<>))
@@ -18,10 +19,13 @@ import Language.Javascript.JSaddle.Run (syncPoint)
1819import Language.Javascript.JSaddle.WebSockets
1920import Network.HTTP.Client (Manager, defaultManagerSettings, newManager)
2021import qualified Network.HTTP.ReverseProxy as RP
22+import qualified Network.HTTP.Types as H
2123import Network.Socket
2224import Network.Wai (Application)
25+import qualified Network.Wai as W
2326import Network.Wai.Handler.Warp
2427import Network.Wai.Handler.Warp.Internal (settingsHost, settingsPort)
28+import Network.WebSockets (ConnectionOptions)
2529import Network.WebSockets.Connection (defaultConnectionOptions)
2630import Obelisk.ExecutableConfig (get)
2731import Reflex.Dom.Core
@@ -34,7 +38,7 @@ import Text.URI.Lens
3438
3539run :: Int -- ^ Port to run the backend
3640 -> IO () -- ^ Backend
37− -> (Widget () (), Widget () ()) -- ^ Frontend widget (head, body)
41+ -> (StaticWidget () (), Widget () ()) -- ^ Frontend widget (head, body)
3842 -> IO ()
3943run port backend frontend = do
4044 let handleBackendErr (_ :: SomeException) = hPutStrLn stderr "backend stopped; make a change to your code to reload"
@@ -52,7 +56,7 @@ getConfigRoute = do
5256defAppUri :: URI
5357defAppUri = fromMaybe (error "defAppUri") $ URI.mkURI "http://127.0.0.1:8000"
5458
55−runWidget :: RunConfig -> (Widget () (), Widget () ()) -> IO ()
59+runWidget :: RunConfig -> (StaticWidget () (), Widget () ()) -> IO ()
5660runWidget conf (h, b) = do
5761 uri <- fromMaybe defAppUri <$> getConfigRoute
5862 let port = fromIntegral $ fromMaybe 80 $ uri ^? uriAuthority . _Right . authPort . _Just
@@ -66,12 +70,26 @@ runWidget conf (h, b) = do
6670 close
6771 (\skt -> do
6872 man <- newManager defaultManagerSettings
69− app <- jsaddleWithAppOr
70− defaultConnectionOptions
71− (mainWidgetWithHead' (const h, const b) >> syncPoint)
72− (fallbackProxy redirectHost redirectPort man)
73+ app <- obeliskApp defaultConnectionOptions h b (fallbackProxy redirectHost redirectPort man)
7374 runSettingsSocket settings skt app)
7475
76+obeliskApp :: ConnectionOptions -> StaticWidget () () -> Widget () () -> Application -> IO Application
77+obeliskApp opts h b backend = do
78+ html <- BSLC.fromStrict <$> indexHtml h
79+ let entryPoint = mainWidget' b >> syncPoint
80+ jsaddleOr opts entryPoint $ \req sendResponse -> case (W.requestMethod req, W.pathInfo req) of
81+ ("GET", []) -> sendResponse $ W.responseLBS H.status200 [("Content-Type", "text/html")] html
82+ ("GET", ["jsaddle.js"]) -> sendResponse $ W.responseLBS H.status200 [("Content-Type", "application/javascript")] $ jsaddleJs False
83+ _ -> backend req sendResponse
84+
85+indexHtml :: StaticWidget () () -> IO ByteString
86+indexHtml h = do
87+ ((), bs) <- renderStatic $ el "html" $ do
88+ el "head" $ h
89+ el "body" $ return ()
90+ elAttr "script" ("src" =: "/jsaddle.js") $ return ()
91+ return $ "<!DOCTYPE html>" <> bs
92+
7593-- | like 'bindPortTCP' but reconnects on exception
7694bindPortTCPRetry :: Settings
7795 -> (IOError -> IO ()) -- ^ Action to run the first time an exception is caught