1258495 · obelisk · git.iko.soy

git.iko.soy/obelisk

on master help sign in

obelisk-run: Serve head as part of index html

1258495Luigy Leon8 years ago

lib/run/obelisk-run.cabal+1

compare with master

unifiedsplit

@@ -12,6 +12,7 @@ library

12 , bytestring

13 , http-client

14 , http-reverse-proxy

15+ , http-types

15 , jsaddle

16 , jsaddle

16 , jsaddle-warp

17 , jsaddle-warp

17 , lens

18 , lens

lib/run/src/Obelisk/Run.hs+24−6

@@ -9,6 +9,7 @@ import Control.Lens ((^?), _Just, _Right)

9import qualified Data.Attoparsec.ByteString.Char8 as A

10import Data.ByteString (ByteString)

11import qualified Data.ByteString.Char8 as BSC

12+import qualified Data.ByteString.Lazy.Char8 as BSLC

12import Data.List (uncons)

13import Data.List (uncons)

13import Data.Maybe

14import Data.Maybe

14import Data.Semigroup ((<>))

15import Data.Semigroup ((<>))

@@ -18,10 +19,13 @@ import Language.Javascript.JSaddle.Run (syncPoint)

18import Language.Javascript.JSaddle.WebSockets

19import Language.Javascript.JSaddle.WebSockets

19import Network.HTTP.Client (Manager, defaultManagerSettings, newManager)

20import Network.HTTP.Client (Manager, defaultManagerSettings, newManager)

20import qualified Network.HTTP.ReverseProxy as RP

21import qualified Network.HTTP.ReverseProxy as RP

22+import qualified Network.HTTP.Types as H

21import Network.Socket

23import Network.Socket

22import Network.Wai (Application)

24import Network.Wai (Application)

25+import qualified Network.Wai as W

23import Network.Wai.Handler.Warp

26import Network.Wai.Handler.Warp

24import Network.Wai.Handler.Warp.Internal (settingsHost, settingsPort)

27import Network.Wai.Handler.Warp.Internal (settingsHost, settingsPort)

28+import Network.WebSockets (ConnectionOptions)

25import Network.WebSockets.Connection (defaultConnectionOptions)

29import Network.WebSockets.Connection (defaultConnectionOptions)

26import Obelisk.ExecutableConfig (get)

30import Obelisk.ExecutableConfig (get)

27import Reflex.Dom.Core

31import Reflex.Dom.Core

@@ -34,7 +38,7 @@ import Text.URI.Lens

35run :: Int -- ^ Port to run the backend

39run :: Int -- ^ Port to run the backend

36 -> IO () -- ^ Backend

40 -> IO () -- ^ Backend

37− -> (Widget () (), Widget () ()) -- ^ Frontend widget (head, body)

41+ -> (StaticWidget () (), Widget () ()) -- ^ Frontend widget (head, body)

38 -> IO ()

42 -> IO ()

39run port backend frontend = do

43run port backend frontend = do

40 let handleBackendErr (_ :: SomeException) = hPutStrLn stderr "backend stopped; make a change to your code to reload"

44 let handleBackendErr (_ :: SomeException) = hPutStrLn stderr "backend stopped; make a change to your code to reload"

@@ -52,7 +56,7 @@ getConfigRoute = do

52defAppUri :: URI

56defAppUri :: URI

53defAppUri = fromMaybe (error "defAppUri") $ URI.mkURI "http://127.0.0.1:8000"

57defAppUri = fromMaybe (error "defAppUri") $ URI.mkURI "http://127.0.0.1:8000"

55−runWidget :: RunConfig -> (Widget () (), Widget () ()) -> IO ()

59+runWidget :: RunConfig -> (StaticWidget () (), Widget () ()) -> IO ()

56runWidget conf (h, b) = do

60runWidget conf (h, b) = do

57 uri <- fromMaybe defAppUri <$> getConfigRoute

61 uri <- fromMaybe defAppUri <$> getConfigRoute

58 let port = fromIntegral $ fromMaybe 80 $ uri ^? uriAuthority . _Right . authPort . _Just

62 let port = fromIntegral $ fromMaybe 80 $ uri ^? uriAuthority . _Right . authPort . _Just

@@ -66,12 +70,26 @@ runWidget conf (h, b) = do

66 close

70 close

67 (\skt -> do

71 (\skt -> do

68 man <- newManager defaultManagerSettings

72 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)

73 runSettingsSocket settings skt app)

74 runSettingsSocket settings skt app)

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+

75-- | like 'bindPortTCP' but reconnects on exception

93-- | like 'bindPortTCP' but reconnects on exception

76bindPortTCPRetry :: Settings

94bindPortTCPRetry :: Settings

77 -> (IOError -> IO ()) -- ^ Action to run the first time an exception is caught

95 -> (IOError -> IO ()) -- ^ Action to run the first time an exception is caught

skeleton/frontend/src/Frontend.hs+2−3

@@ -3,14 +3,13 @@

3{-# LANGUAGE TypeApplications #-}

4module Frontend where

6−import Reflex.Dom

7−

8import qualified Data.Text as T

6import qualified Data.Text as T

7+import Reflex.Dom.Core

10import Common.Api

9import Common.Api

11import Static

10import Static

13−frontend :: (Widget x (), Widget x ())

12+frontend :: (StaticWidget x (), Widget x ())

14frontend = (head', body)

13frontend = (head', body)

15 where

14 where

16 head' = el "title" $ text "Obelisk Minimal Example"

15 head' = el "title" $ text "Obelisk Minimal Example"

skeleton/frontend/src/main.hs+1−1

@@ -2,4 +2,4 @@ import Reflex.Dom

2import Frontend

4main :: IO ()

5−main = mainWidget frontend

5+main = mainWidget $ snd frontend