39dc7b4 · obelisk · git.iko.soy

git.iko.soy/obelisk

Split out backend and frontend monad transformers for config lookup

commit39dc7b4a1616bca1709f4f3d3a3e7469f16395a4 authorKen Micklas <ken.micklas@obsidian.systems> dateTue 30 Apr 2019, 15:38 (7 years ago) parent4ec9772

26 files changed+378−212

compare with master

unifiedsplit

default.nix+2−1

@@ -49,11 +49,12 @@ let

4949 } + /template) {};

5050 })

5151

52+ pkgs.obeliskExecutableConfig.haskellOverlay

53+

5254 # Add obelisk packages

5355 (self: super: let

5456 pkgs = self.callPackage ({ pkgs }: pkgs) {};

5557 in {

56− obelisk-executable-config = pkgs.obeliskExecutableConfig.haskellPackage self;

5758 obelisk-executable-config-inject = pkgs.obeliskExecutableConfig.platforms.web.inject self;

5859

5960 obelisk-asset-manifest = self.callCabal2nix "obelisk-asset-manifest" (hackGet ./lib/asset + "/manifest") {};

lib/backend/obelisk-backend.cabal+3

@@ -8,6 +8,7 @@ library

88 build-depends: base,

99 bytestring,

1010 categories,

11+ containers,

1112 cookie,

1213 data-default,

1314 dependent-sum,

@@ -15,6 +16,8 @@ library

1516 lens,

1617 mtl,

1718 obelisk-asset-serve-snap,

19+ obelisk-executable-config-backend,

20+ obelisk-executable-config-lookup,

1821 obelisk-frontend,

1922 obelisk-route,

2023 obelisk-snap-extras,

lib/backend/src/Obelisk/Backend.hs+52−19

@@ -11,6 +11,7 @@ module Obelisk.Backend

1111 ( Backend (..)

1212 -- * Re-exports

1313 , Default (def)

14+ , ComponentConfigs(..)

1415 , getPageName

1516 , getRouteWith

1617 , runSnapWithCommandLineArgs

@@ -19,6 +20,7 @@ module Obelisk.Backend

1920 , runBackend

2021 , staticRenderContentType

2122 , mkRouteToUrl

23+ , getComponentConfigs

2224 ) where

2325

2426import Prelude hiding (id, (.))

@@ -32,11 +34,15 @@ import Data.Default (Default (..))

3234import Data.Dependent.Sum

3335import Data.Functor.Sum

3436import Data.Functor.Identity

37+import Data.Map (Map)

38+import qualified Data.Map as Map

3539import Data.Monoid ((<>))

3640import Data.Text (Text)

3741import qualified Data.Text as T

3842import Data.Text.Encoding

3943import Obelisk.Asset.Serve.Snap (serveAsset)

44+import Obelisk.ExecutableConfig.Backend

45+import Obelisk.ExecutableConfig.Lookup

4046import Obelisk.Frontend

4147import Obelisk.Route

4248import Obelisk.Snap.Extras (doNotCache, serveFileIfExistsAs)

@@ -49,7 +55,14 @@ import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)

4955

5056data Backend backendRoute frontendRoute = Backend

5157 { _backend_routeEncoder :: Encoder (Either Text) Identity (R (Sum backendRoute (ObeliskRoute frontendRoute))) PageName

52− , _backend_run :: ((R backendRoute -> Snap ()) -> IO ()) -> IO ()

58+ , _backend_run :: ((R backendRoute -> BackendConfigsT Snap ()) -> BackendConfigsT IO ()) -> BackendConfigsT IO ()

59+ }

60+

61+-- | All the configs separated by which context they are accessible in. (Common

62+-- configs are present in both.)

63+data ComponentConfigs = ComponentConfigs

64+ { _componentConfigs_backend :: Map Text Text

65+ , _componentConfigs_frontend :: Map Text Text

5366 }

5467

5568-- | The static assets provided must contain a compiled GHCJS app that corresponds exactly to the Frontend provided

@@ -67,9 +80,10 @@ serveDefaultObeliskApp

6780 -> ([Text]

6881 -> m ())

6982 -> Frontend (R appRoute)

83+ -> Map Text Text

7084 -> R (ObeliskRoute appRoute)

7185 -> m ()

72−serveDefaultObeliskApp urlEnc serveStaticAsset frontend = serveObeliskApp urlEnc serveStaticAsset frontendApp

86+serveDefaultObeliskApp urlEnc serveStaticAsset frontend configs = serveObeliskApp urlEnc serveStaticAsset frontendApp configs

7387 where frontendApp = GhcjsApp

7488 { _ghcjsApp_compiled = defaultFrontendGhcjsAssets

7589 , _ghcjsApp_value = frontend

@@ -94,16 +108,16 @@ defaultFrontendGhcjsAssets = StaticAssets

94108 , _staticAssets_unprocessed = "frontend.jsexe"

95109 }

96110

97−runSnapWithCommandLineArgs :: Snap () -> IO ()

111+runSnapWithCommandLineArgs :: MonadIO m => Snap () -> m ()

98112runSnapWithCommandLineArgs a = do

99113 -- Get the web server configuration from the command line

100− cmdLineConf <- commandLineConfig defaultConfig

114+ cmdLineConf <- liftIO $ commandLineConfig defaultConfig

101115 let httpConf = cmdLineConf

102116 { accessLog = Just $ ConfigIoLog BSC8.putStrLn

103117 , errorLog = Just $ ConfigIoLog BSC8.putStrLn

104118 }

105119 -- Start the web server

106− httpServe httpConf a

120+ liftIO $ httpServe httpConf a

107121

108122getPageName :: (MonadSnap m) => m PageName

109123getPageName = do

@@ -125,13 +139,14 @@ serveObeliskApp

125139 => (R appRoute -> Text)

126140 -> ([Text] -> m ())

127141 -> GhcjsApp (R appRoute)

142+ -> Map Text Text

128143 -> R (ObeliskRoute appRoute)

129144 -> m ()

130−serveObeliskApp urlEnc serveStaticAsset frontendApp = \case

131− ObeliskRoute_App appRouteComponent :=> Identity appRouteRest -> serveGhcjsApp urlEnc frontendApp $ GhcjsAppRoute_App appRouteComponent :/ appRouteRest

145+serveObeliskApp urlEnc serveStaticAsset frontendApp config = \case

146+ ObeliskRoute_App appRouteComponent :=> Identity appRouteRest -> serveGhcjsApp urlEnc frontendApp config $ GhcjsAppRoute_App appRouteComponent :/ appRouteRest

132147 ObeliskRoute_Resource resComponent :=> Identity resRest -> case resComponent :=> Identity resRest of

133148 ResourceRoute_Static :=> Identity pathSegments -> serveStaticAsset pathSegments

134− ResourceRoute_Ghcjs :=> Identity pathSegments -> serveGhcjsApp urlEnc frontendApp $ GhcjsAppRoute_Resource :/ pathSegments

149+ ResourceRoute_Ghcjs :=> Identity pathSegments -> serveGhcjsApp urlEnc frontendApp config $ GhcjsAppRoute_Resource :/ pathSegments

135150 ResourceRoute_JSaddleWarp :=> Identity _ -> do

136151 let msg = "Error: Obelisk.Backend received jsaddle request"

137152 liftIO $ putStrLn $ T.unpack msg

@@ -159,24 +174,30 @@ serveGhcjsApp

159174 :: (MonadSnap m, HasCookies m)

160175 => (R appRouteComponent -> Text)

161176 -> GhcjsApp (R appRouteComponent)

177+ -> Map Text Text

162178 -> R (GhcjsAppRoute appRouteComponent)

163179 -> m ()

164−serveGhcjsApp urlEnc app = \case

180+serveGhcjsApp urlEnc app config = \case

165181 GhcjsAppRoute_App appRouteComponent :=> Identity appRouteRest -> do

166182 modifyResponse $ setContentType staticRenderContentType

167− writeBS <=< renderGhcjsFrontend urlEnc (appRouteComponent :/ appRouteRest) $ _ghcjsApp_value app

183+ writeBS <=< renderGhcjsFrontend urlEnc (appRouteComponent :/ appRouteRest) config $ _ghcjsApp_value app

168184 GhcjsAppRoute_Resource :=> Identity pathSegments -> serveStaticAssets (_ghcjsApp_compiled app) pathSegments

169185

170186runBackend :: Backend fullRoute frontendRoute -> Frontend (R frontendRoute) -> IO ()

171187runBackend backend frontend = case checkEncoder $ _backend_routeEncoder backend of

172188 Left e -> fail $ "backend error:\n" <> T.unpack e

173− Right validFullEncoder -> _backend_run backend $ \serveRoute -> do

174− runSnapWithCommandLineArgs $ do

175− getRouteWith validFullEncoder >>= \case

176− Identity r -> case r of

177− InL backendRoute :=> Identity a -> serveRoute $ backendRoute :/ a

178− InR obeliskRoute :=> Identity a ->

179− serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) (serveStaticAssets defaultStaticAssets) frontend $ obeliskRoute :/ a

189+ Right validFullEncoder -> do

190+ configs <- getComponentConfigs

191+ runBackendConfigsT (_componentConfigs_backend configs) $

192+ _backend_run backend $ \serveRoute -> do

193+ runSnapWithCommandLineArgs $ do

194+ getRouteWith validFullEncoder >>= \case

195+ Identity r -> case r of

196+ InL backendRoute :=> Identity a ->

197+ runBackendConfigsT (_componentConfigs_backend configs) $

198+ serveRoute $ backendRoute :/ a

199+ InR obeliskRoute :=> Identity a ->

200+ serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) (serveStaticAssets defaultStaticAssets) frontend (_componentConfigs_frontend configs) $ obeliskRoute :/ a

180201

181202mkRouteToUrl :: Encoder Identity parse (R (Sum f (ObeliskRoute r))) PageName -> R r -> Text

182203mkRouteToUrl validFullEncoder =

@@ -187,13 +208,25 @@ renderGhcjsFrontend

187208 :: (MonadSnap m, HasCookies m)

188209 => (route -> Text)

189210 -> route

211+ -> Map Text Text

190212 -> Frontend route

191213 -> m ByteString

192−renderGhcjsFrontend urlEnc route f = do

214+renderGhcjsFrontend urlEnc route configs f = do

193215 let ghcjsPreload = elAttr "link" ("rel" =: "preload" <> "as" =: "script" <> "href" =: "ghcjs/all.js") blank

194216 ghcjsScript = elAttr "script" ("language" =: "javascript" <> "src" =: "ghcjs/all.js" <> "defer" =: "defer") blank

195217 cookies <- askCookies

196− renderFrontendHtml cookies urlEnc route f ghcjsPreload ghcjsScript

218+ renderFrontendHtml configs cookies urlEnc route f ghcjsPreload ghcjsScript

197219

198220instance HasCookies Snap where

199221 askCookies = map (\c -> (cookieName c, cookieValue c)) <$> getsRequest rqCookies

222+

223+getComponentConfigs :: IO ComponentConfigs

224+getComponentConfigs = do

225+ allConfigs <- getConfigs

226+ return $ ComponentConfigs

227+ { _componentConfigs_backend =

228+ Map.filterWithKey (\k _ -> isMemberOf k ["common", "backend"]) allConfigs

229+ , _componentConfigs_frontend =

230+ Map.filterWithKey (\k _ -> isMemberOf k ["common", "frontend"]) allConfigs

231+ }

232+ where isMemberOf k dirs = or $ map (\dir -> ("config/" <> dir) `T.isPrefixOf` k) dirs

lib/executable-config/backend/obelisk-executable-config-backend.cabalnew file+20

@@ -0,0 +1,20 @@

1+name: obelisk-executable-config-backend

2+version: 0.1

3+cabal-version: >= 1.2

4+build-type: Simple

6+library

7+ hs-source-dirs: src

8+ build-depends: base,

9+ containers,

10+ monad-control,

11+ mtl,

12+ primitive,

13+ ref-tf,

14+ snap-core,

15+ text,

16+ transformers,

17+ transformers-base

18+ exposed-modules:

19+ Obelisk.ExecutableConfig.Backend

20+ ghc-options: -Wall

lib/executable-config/backend/src/Obelisk/ExecutableConfig/Backend.hsnew file+77

@@ -0,0 +1,77 @@

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE DataKinds #-}

3+{-# LANGUAGE DefaultSignatures #-}

4+{-# LANGUAGE DeriveFunctor #-}

5+{-# LANGUAGE FlexibleContexts #-}

6+{-# LANGUAGE FlexibleInstances #-}

7+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

8+{-# LANGUAGE MultiParamTypeClasses #-}

9+{-# LANGUAGE OverloadedStrings #-}

10+{-# LANGUAGE RankNTypes #-}

11+{-# LANGUAGE TypeFamilies #-}

12+{-# LANGUAGE UndecidableInstances #-}

13+module Obelisk.ExecutableConfig.Backend

14+ ( HasBackendConfigs(..)

15+ , BackendConfigsT

16+ , runBackendConfigsT

17+ , mapBackendConfigsT

18+ ) where

19+

20+import Control.Applicative

21+import Control.Monad

22+import Control.Monad.Base

23+import Control.Monad.Fix

24+import Control.Monad.Primitive

25+import Control.Monad.Ref

26+import Control.Monad.IO.Class

27+import Control.Monad.Trans.Class

28+import Control.Monad.Trans.Control

29+import Control.Monad.Trans.Reader

30+import Data.Map (Map)

31+import qualified Data.Map as Map

32+import Data.Text (Text)

33+import Snap.Core (MonadSnap)

34+

35+class Monad m => HasBackendConfigs m where

36+ getBackendConfig :: Text -> m (Maybe Text)

37+ default getBackendConfig :: (HasBackendConfigs m', m ~ t m', MonadTrans t) => Text -> m (Maybe Text)

38+ getBackendConfig = lift . getBackendConfig

39+ getCommonConfig :: Text -> m (Maybe Text)

40+ default getCommonConfig :: (HasBackendConfigs m', m ~ t m', MonadTrans t) => Text -> m (Maybe Text)

41+ getCommonConfig = lift . getCommonConfig

42+

43+newtype BackendConfigsT m a = BackendConfigsT { unBackendConfigsT :: ReaderT (Map Text Text) m a }

44+ deriving

45+ ( Functor

46+ , Applicative

47+ , Monad

48+ , MonadPlus

49+ , Alternative

50+ , MonadFix

51+ , MonadIO

52+ , MonadBase m'

53+ , MonadBaseControl m'

54+ , MonadRef

55+ , MonadTrans

56+ , MonadSnap

57+ )

58+

59+instance PrimMonad m => PrimMonad (BackendConfigsT m) where

60+ type PrimState (BackendConfigsT m) = PrimState m

61+ primitive = lift . primitive

62+

63+runBackendConfigsT

64+ :: Map Text Text

65+ -> BackendConfigsT m a

66+ -> m a

67+runBackendConfigsT cs child = runReaderT (unBackendConfigsT child) cs

68+

69+instance Monad m => HasBackendConfigs (BackendConfigsT m) where

70+ getBackendConfig k = BackendConfigsT $ Map.lookup ("config/backend/" <> k) <$> ask

71+ getCommonConfig k = BackendConfigsT $ Map.lookup ("config/common/" <> k) <$> ask

72+

73+mapBackendConfigsT

74+ :: (forall x. m x -> n x)

75+ -> BackendConfigsT m a

76+ -> BackendConfigsT n a

77+mapBackendConfigsT f (BackendConfigsT x) = BackendConfigsT $ mapReaderT f x

lib/executable-config/default.nix+5−1

@@ -19,7 +19,11 @@ let injectConfig = config: assets: nixpkgs.runCommand "inject-config" {} (''

1919 (cd $out && find config -type f -print0 >config.files)

2020 '');

2121in with nixpkgs.haskell.lib; {

22− haskellPackage = self: self.callPackage (filterGitSource ./lookup) {};

22+ haskellOverlay = self: super: {

23+ obelisk-executable-config-backend = self.callCabal2nix "obelisk-executable-config-backend" (filterGitSource ./backend) {};

24+ obelisk-executable-config-frontend = self.callCabal2nix "obelisk-executable-config-frontend" (filterGitSource ./frontend) {};

25+ obelisk-executable-config-lookup = self.callPackage (filterGitSource ./lookup) {};

26+ };

2327 platforms = {

2428 android = {

2529 # Inject the given config directory into an android assets folder

lib/executable-config/frontend/obelisk-executable-config-frontend.cabalnew file+21

@@ -0,0 +1,21 @@

1+name: obelisk-executable-config-frontend

2+version: 0.1

3+cabal-version: >= 1.2

4+build-type: Simple

6+library

7+ hs-source-dirs: src

8+ build-depends: base,

9+ containers,

10+ ghcjs-dom,

11+ jsaddle,

12+ mtl,

13+ primitive,

14+ ref-tf,

15+ reflex,

16+ reflex-dom-core,

17+ text,

18+ transformers

19+ exposed-modules:

20+ Obelisk.ExecutableConfig.Frontend

21+ ghc-options: -Wall

lib/executable-config/frontend/src/Obelisk/ExecutableConfig/Frontend.hsnew file+102

@@ -0,0 +1,102 @@

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE DataKinds #-}

3+{-# LANGUAGE DefaultSignatures #-}

4+{-# LANGUAGE DeriveFunctor #-}

5+{-# LANGUAGE FlexibleContexts #-}

6+{-# LANGUAGE FlexibleInstances #-}

7+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

8+{-# LANGUAGE MultiParamTypeClasses #-}

9+{-# LANGUAGE OverloadedStrings #-}

10+{-# LANGUAGE RankNTypes #-}

11+{-# LANGUAGE TypeFamilies #-}

12+{-# LANGUAGE UndecidableInstances #-}

13+module Obelisk.ExecutableConfig.Frontend

14+ ( HasFrontendConfigs(..)

15+ , FrontendConfigsT

16+ , runFrontendConfigsT

17+ , mapFrontendConfigsT

18+ ) where

19+

20+import Control.Monad.Fix

21+import Control.Monad.Primitive

22+import Control.Monad.Ref

23+import Control.Monad.IO.Class

24+import Control.Monad.Trans.Class

25+import Control.Monad.Trans.Reader

26+import Data.Map (Map)

27+import qualified Data.Map as Map

28+import Data.Text (Text)

29+import Reflex

30+import Reflex.Host.Class

31+import Reflex.Dom.Core

32+#ifndef ghcjs_HOST_OS

33+import GHCJS.DOM.Types (MonadJSM)

34+#endif

35+

36+class Monad m => HasFrontendConfigs m where

37+ getFrontendConfig :: Text -> m (Maybe Text)

38+ default getFrontendConfig :: (HasFrontendConfigs m', m ~ t m', MonadTrans t) => Text -> m (Maybe Text)

39+ getFrontendConfig = lift . getFrontendConfig

40+ getCommonConfig :: Text -> m (Maybe Text)

41+ default getCommonConfig :: (HasFrontendConfigs m', m ~ t m', MonadTrans t) => Text -> m (Maybe Text)

42+ getCommonConfig = lift . getCommonConfig

43+

44+instance HasFrontendConfigs m => HasFrontendConfigs (BehaviorWriterT t w m)

45+instance HasFrontendConfigs m => HasFrontendConfigs (DynamicWriterT t w m)

46+instance HasFrontendConfigs m => HasFrontendConfigs (EventWriterT t w m)

47+instance HasFrontendConfigs m => HasFrontendConfigs (PostBuildT t m)

48+instance HasFrontendConfigs m => HasFrontendConfigs (QueryT t q m)

49+instance HasFrontendConfigs m => HasFrontendConfigs (ReaderT r m)

50+instance HasFrontendConfigs m => HasFrontendConfigs (RequesterT t request response m)

51+instance HasFrontendConfigs m => HasFrontendConfigs (StaticDomBuilderT t m)

52+instance HasFrontendConfigs m => HasFrontendConfigs (TriggerEventT t m)

53+

54+newtype FrontendConfigsT m a = FrontendConfigsT { unFrontendConfigsT :: ReaderT (Map Text Text) m a }

55+ deriving

56+ ( Functor

57+ , Applicative

58+ , DomBuilder t

59+ , Monad

60+ , MonadFix

61+ , MonadHold t

62+ , MonadIO

63+#ifndef ghcjs_HOST_OS

64+ , MonadJSM

65+#endif

66+ , MonadRef

67+ , MonadReflexCreateTrigger t

68+ , MonadSample t

69+ , MonadTrans

70+ , NotReady t

71+ , PerformEvent t

72+ , PostBuild t

73+ , Prerender js t

74+ , TriggerEvent t

75+ , HasDocument

76+ )

77+

78+instance Adjustable t m => Adjustable t (FrontendConfigsT m) where

79+ runWithReplace a e = FrontendConfigsT $ runWithReplace (unFrontendConfigsT a) (unFrontendConfigsT <$> e)

80+ traverseDMapWithKeyWithAdjust f m e = FrontendConfigsT $ traverseDMapWithKeyWithAdjust (\k v -> unFrontendConfigsT $ f k v) m e

81+ traverseIntMapWithKeyWithAdjust f m e = FrontendConfigsT $ traverseIntMapWithKeyWithAdjust (\k v -> unFrontendConfigsT $ f k v) m e

82+ traverseDMapWithKeyWithAdjustWithMove f m e = FrontendConfigsT $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unFrontendConfigsT $ f k v) m e

83+

84+instance PrimMonad m => PrimMonad (FrontendConfigsT m) where

85+ type PrimState (FrontendConfigsT m) = PrimState m

86+ primitive = lift . primitive

87+

88+runFrontendConfigsT

89+ :: Map Text Text

90+ -> FrontendConfigsT m a

91+ -> m a

92+runFrontendConfigsT cs child = runReaderT (unFrontendConfigsT child) cs

93+

94+instance Monad m => HasFrontendConfigs (FrontendConfigsT m) where

95+ getFrontendConfig k = FrontendConfigsT $ Map.lookup ("config/frontend/" <> k) <$> ask

96+ getCommonConfig k = FrontendConfigsT $ Map.lookup ("config/common/" <> k) <$> ask

97+

98+mapFrontendConfigsT

99+ :: (forall x. m x -> n x)

100+ -> FrontendConfigsT m a

101+ -> FrontendConfigsT n a

102+mapFrontendConfigsT f (FrontendConfigsT x) = FrontendConfigsT $ mapReaderT f x

lib/executable-config/inject/obelisk-executable-config-inject.cabal−3

@@ -8,10 +8,7 @@ library

99 build-depends:

1010 base,

11− bytestring,

1211 containers,

13− filepath,

14− obelisk-executable-config,

1512 reflex-dom-core,

1613 text

1714

lib/executable-config/inject/src/Obelisk/ExecutableConfig/Inject.hs+6−19

@@ -2,23 +2,13 @@

22module Obelisk.ExecutableConfig.Inject where

44import Control.Monad (mapM_)

5−import Control.Monad.IO.Class (MonadIO, liftIO)

5+import Control.Monad.IO.Class (MonadIO)

6+import Data.Map (Map)

67import qualified Data.Map as Map

78import Data.Semigroup ((<>))

8−import Data.ByteString (ByteString)

99import Data.Text (Text)

10−import qualified Data.Text as T

11−import qualified Data.Text.IO as T

12−import Obelisk.ExecutableConfig (getFrontendConfigs)

1310import Reflex.Dom.Core hiding (value)

1411

15−-- | Produces a @<script>@ tag containing the contents of the config item,

16−-- rendered as a 'ByteString'.

17−inject :: FilePath -> IO ByteString

18−inject key = do

19− value <- T.readFile key

20− fmap snd $ renderStatic $ injectPure (T.pack key) value

21−

2212-- | Produces a @<script>@ tag with an @id@ attribute containing the key and

2313-- whose value is the provided configuration

2414injectPure :: DomBuilder t m => Text -> Text -> m ()

@@ -26,10 +16,7 @@ injectPure key value =

2616 let attrs = ("type" =: "text/plain" <> "id" =: ("config-" <> key) <> "class" =: "obelisk-executable-config-inject")

2717 in elAttr "script" attrs $ text value

2818

29−-- | Scans the "common" and "frontend" configuration folders and produces

30−-- injectable @<script>@ tags containing the configuration keys (filepaths) and

31−-- values.

32−injectExecutableConfigs :: (MonadIO m, DomBuilder t m) => m ()

33−injectExecutableConfigs = do

34− cfg <- liftIO getFrontendConfigs

35− mapM_ (uncurry injectPure) $ Map.toList cfg

19+-- | Produces injectable @<script>@ tags containing the configuration keys

20+-- (filepaths) and values.

21+injectExecutableConfigs :: (MonadIO m, DomBuilder t m) => Map Text Text -> m ()

22+injectExecutableConfigs = mapM_ (uncurry injectPure) . Map.toList

lib/executable-config/lookup/default.nix+1−1

@@ -6,7 +6,7 @@ let isAndroid = hostPlatform.libc == "bionic";

66 isIOS = hostPlatform.isDarwin && hostPlatform.isAarch64;

77 isGhcjs = ghc.isGhcjs or false;

88in mkDerivation {

9− pname = "obelisk-executable-config";

9+ pname = "obelisk-executable-config-lookup";

1010 version = "0.1";

1111 src = ./.;

1212 libraryHaskellDepends = [

lib/executable-config/lookup/obelisk-executable-config.cabal → lib/executable-config/lookup/obelisk-executable-config-lookup.cabalrenamed+2−2

@@ -1,10 +1,10 @@

1−name: obelisk-executable-config

1+name: obelisk-executable-config-lookup

22version: 0.1.1

33cabal-version: >= 1.2

44build-type: Simple

66library

7− exposed-modules: Obelisk.ExecutableConfig

7+ exposed-modules: Obelisk.ExecutableConfig.Lookup

88 if os(ios)

99 hs-source-dirs: src-ios, src-directory

1010 other-modules: Obelisk.ExecutableConfig.Internal.ConfigDirectory

lib/executable-config/lookup/src-android/Obelisk/ExecutableConfig.hs → lib/executable-config/lookup/src-android/Obelisk/ExecutableConfig/Lookup.hsrenamed+3−3

@@ -1,5 +1,5 @@

11{-# LANGUAGE LambdaCase #-}

2−module Obelisk.ExecutableConfig where

2+module Obelisk.ExecutableConfig.Lookup where

44import Control.Exception (bracket)

55import Control.Monad (forM)

@@ -27,8 +27,8 @@ getFromMgr mgr name = do

2727 l <- asset_getLength asset

2828 fmap T.decodeUtf8 $ BS.packCStringLen (b, fromIntegral l)

2929

30−getFrontendConfigs :: IO (Map Text Text)

31−getFrontendConfigs = bracket getAssets freeAssetManager $ \mgrObj -> do

30+getConfigs :: IO (Map Text Text)

31+getConfigs = bracket getAssets freeAssetManager $ \mgrObj -> do

3232 mgr <- assetManagerFromJava mgrObj

3333 let openDir = do

3434 d <- withCString "config.files" $ \fn ->

lib/executable-config/lookup/src-directory/Obelisk/ExecutableConfig/Internal/ConfigDirectory.hs+3−3

@@ -8,13 +8,13 @@ import Data.Text.IO as T

88import System.Directory

99import System.FilePath.Posix ((</>))

1010

11−getConfigs :: FilePath -> FilePath -> IO (Map Text Text)

12−getConfigs base fp = do

11+getConfigsFromDirectory :: FilePath -> FilePath -> IO (Map Text Text)

12+getConfigsFromDirectory base fp = do

1313 dir <- doesDirectoryExist (base </> fp)

1414 if dir

1515 then do

1616 ps <- listDirectory (base </> fp)

17− fmap mconcat $ mapM (\p -> getConfigs base $ fp </> p) ps

17+ fmap mconcat $ mapM (\p -> getConfigsFromDirectory base $ fp </> p) ps

1818 else do

1919 file <- doesFileExist (base </> fp)

2020 if file

lib/executable-config/lookup/src-ghcjs/Obelisk/ExecutableConfig.hs → lib/executable-config/lookup/src-ghcjs/Obelisk/ExecutableConfig/Lookup.hsrenamed+3−3

@@ -1,5 +1,5 @@

11{-# LANGUAGE OverloadedStrings #-}

2−module Obelisk.ExecutableConfig where

2+module Obelisk.ExecutableConfig.Lookup where

44import Data.Map (Map)

55import qualified Data.Map as Map

@@ -13,8 +13,8 @@ import GHCJS.DOM.Document (getHead)

1313import GHCJS.DOM.Element (getElementsByClassName, getId, getInnerHTML)

1414import GHCJS.DOM.HTMLCollection (item, getLength)

1515

16−getFrontendConfigs :: IO (Map Text Text)

17−getFrontendConfigs = do

16+getConfigs :: IO (Map Text Text)

17+getConfigs = do

1818 Just doc <- currentDocument

1919 Just hd <- getHead doc

2020 es <- collToList =<< getElementsByClassName hd ("obelisk-executable-config-inject" :: Text)

lib/executable-config/lookup/src-ios/Obelisk/ExecutableConfig.hs → lib/executable-config/lookup/src-ios/Obelisk/ExecutableConfig/Lookup.hsrenamed+4−4

@@ -1,5 +1,5 @@

11{-# LANGUAGE LambdaCase #-}

2−module Obelisk.ExecutableConfig where

2+module Obelisk.ExecutableConfig.Lookup where

44import Data.Map (Map)

55import Data.Text (Text)

@@ -9,7 +9,7 @@ import Language.Javascript.JSaddle.WKWebView

1010import Obelisk.ExecutableConfig.Internal.ConfigDirectory

1111

12−getFrontendConfigs :: IO (Map Text Text)

13−getFrontendConfigs = mainBundleResourcePath >>= \case

12+getConfigs :: IO (Map Text Text)

13+getConfigs = mainBundleResourcePath >>= \case

1414 Nothing -> error "Could not get bundle resource path."

15− Just p -> getConfigs (T.unpack (T.decodeUtf8 p)) "config"

15+ Just p -> getConfigsFromDirectory (T.unpack (T.decodeUtf8 p)) "config"

lib/executable-config/lookup/src/Obelisk/ExecutableConfig.hsdeleted−12

@@ -1,12 +0,0 @@

1−module Obelisk.ExecutableConfig where

2−

3−import Data.Map (Map)

4−import Data.Text (Text)

5−

6−import Obelisk.ExecutableConfig.Internal.ConfigDirectory

7−

8−getFrontendConfigs :: IO (Map Text Text)

9−getFrontendConfigs = do

10− cfgC <- getConfigs "." "config/common"

11− cfgF <- getConfigs "." "config/frontend"

12− return $ cfgC <> cfgF

lib/executable-config/lookup/src/Obelisk/ExecutableConfig/Lookup.hsnew file+9

@@ -0,0 +1,9 @@

1+module Obelisk.ExecutableConfig.Lookup where

3+import Data.Map (Map)

4+import Data.Text (Text)

6+import Obelisk.ExecutableConfig.Internal.ConfigDirectory

8+getConfigs :: IO (Map Text Text)

9+getConfigs = getConfigsFromDirectory "." "config"

lib/frontend/obelisk-frontend.cabal+2−2

@@ -14,8 +14,9 @@ library

1414 jsaddle,

1515 lens,

1616 mtl,

17− obelisk-executable-config,

17+ obelisk-executable-config-frontend,

1818 obelisk-executable-config-inject,

19+ obelisk-executable-config-lookup,

1920 obelisk-route,

2021 primitive,

2122 ref-tf,

@@ -25,6 +26,5 @@ library

2526 transformers

2627 exposed-modules:

2728 Obelisk.Frontend

28− Obelisk.Frontend.Config

2929 Obelisk.Frontend.Cookie

3030 ghc-options: -Wall

lib/frontend/src/Obelisk/Frontend.hs+12−12

@@ -44,13 +44,13 @@ import GHCJS.DOM.Element (getElementsByClassName)

4444import GHCJS.DOM.HTMLCollection (item, getLength)

4545import GHCJS.DOM.Node (removeChild_)

4646import Language.Javascript.JSaddle (JSM)

47−import Obelisk.Frontend.Config

4847import Obelisk.Frontend.Cookie

4948import Obelisk.Route.Frontend

5049import Reflex.Dom.Core

5150import Reflex.Host.Class

51+import Obelisk.ExecutableConfig.Frontend

5252import Obelisk.ExecutableConfig.Inject (injectExecutableConfigs)

53−import Obelisk.ExecutableConfig (getFrontendConfigs)

53+import Obelisk.ExecutableConfig.Lookup (getConfigs)

5454import Web.Cookie

5555

5656makePrisms ''Sum

@@ -74,7 +74,7 @@ type ObeliskWidget js t route m =

7474 , Prerender js t m

7575 , PrebuildAgnostic t route m

7676 , PrebuildAgnostic t route (Client m)

77− , HasConfigs m

77+ , HasFrontendConfigs m

7878 , HasCookies m

7979 )

8080

@@ -110,7 +110,7 @@ runFrontend

110110 -> Frontend (R route)

111111 -> JSM ()

112112runFrontend validFullEncoder frontend = do

113− configs <- liftIO getFrontendConfigs

113+ configs <- liftIO getConfigs

114114#ifdef ghcjs_HOST_OS

115115 removeHTMLConfigs

116116#endif

@@ -130,11 +130,11 @@ runFrontendWithConfigs configs validFullEncoder frontend = do

130130 runHydrationWidgetWithHeadAndBody (pure ()) $ \appendHead appendBody -> do

131131 rec switchover <- runRouteViewT ve switchover $ do

132132 (switchover'', fire) <- newTriggerEvent

133− mapRoutedT (mapSetRouteT (mapRouteToUrlT (appendHead . runConfigsT configs))) $ do

133+ mapRoutedT (mapSetRouteT (mapRouteToUrlT (appendHead . runFrontendConfigsT configs))) $ do

134134 -- The order here is important - baseTag has to be before headWidget!

135135 baseTag

136136 _frontend_head frontend

137− mapRoutedT (mapSetRouteT (mapRouteToUrlT (appendBody . runConfigsT configs))) $ do

137+ mapRoutedT (mapSetRouteT (mapRouteToUrlT (appendBody . runFrontendConfigsT configs))) $ do

138138 _frontend_body frontend

139139 switchover' <- lift $ lift $ lift $ lift $ HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_switchover

140140 performEvent_ $ liftIO (fire ()) <$ switchover'

@@ -144,23 +144,23 @@ runFrontendWithConfigs configs validFullEncoder frontend = do

144144renderFrontendHtml

145145 :: ( t ~ DomTimeline

146146 , MonadIO m

147− , widget ~ RoutedT t r (SetRouteT t r (RouteToUrlT r (ConfigsT (CookiesT (PostBuildT t (StaticDomBuilderT t (PerformEventT t DomHost)))))))

147+ , widget ~ RoutedT t r (SetRouteT t r (RouteToUrlT r (FrontendConfigsT (CookiesT (PostBuildT t (StaticDomBuilderT t (PerformEventT t DomHost)))))))

148148 )

149− => Cookies

149+ => Map Text Text

150+ -> Cookies

150151 -> (r -> Text)

151152 -> r

152153 -> Frontend r

153154 -> widget ()

154155 -> widget ()

155156 -> m ByteString

156−renderFrontendHtml cookies urlEnc route frontend headExtra bodyExtra = do

157+renderFrontendHtml configs cookies urlEnc route frontend headExtra bodyExtra = do

157158 --TODO: We should probably have a "NullEventWriterT" or a frozen reflex timeline

158− configs <- liftIO getFrontendConfigs

159− html <- fmap snd $ liftIO $ renderStatic $ fmap fst $ runCookiesT cookies $ runConfigsT configs $ flip runRouteToUrlT urlEnc $ runSetRouteT $ flip runRoutedT (pure route) $

159+ html <- fmap snd $ liftIO $ renderStatic $ fmap fst $ runCookiesT cookies $ runFrontendConfigsT configs $ flip runRouteToUrlT urlEnc $ runSetRouteT $ flip runRoutedT (pure route) $

160160 el "html" $ do

161161 el "head" $ do

162162 baseTag

163− injectExecutableConfigs

163+ injectExecutableConfigs configs

164164 _frontend_head frontend

165165 headExtra

166166 el "body" $ do

lib/frontend/src/Obelisk/Frontend/Config.hsdeleted−103

@@ -1,103 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DataKinds #-}

3−{-# LANGUAGE DefaultSignatures #-}

4−{-# LANGUAGE DeriveFunctor #-}

5−{-# LANGUAGE FlexibleContexts #-}

6−{-# LANGUAGE FlexibleInstances #-}

7−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

8−{-# LANGUAGE MultiParamTypeClasses #-}

9−{-# LANGUAGE RankNTypes #-}

10−{-# LANGUAGE TypeFamilies #-}

11−{-# LANGUAGE UndecidableInstances #-}

12−

13−module Obelisk.Frontend.Config where

14−

15−import Control.Monad.Fix

16−import Control.Monad.Primitive

17−import Control.Monad.Ref

18−import Control.Monad.IO.Class

19−import Control.Monad.Trans.Class

20−import Control.Monad.Trans.Reader

21−import Data.Map (Map)

22−import qualified Data.Map as Map

23−import Data.Text (Text)

24−import Reflex

25−import Reflex.Host.Class

26−import Reflex.Dom.Core

27−#ifndef ghcjs_HOST_OS

28−import GHCJS.DOM.Types (MonadJSM)

29−#endif

30−

31−import Obelisk.Frontend.Cookie (CookiesT, HasCookies)

32−import Obelisk.Route.Frontend

33−

34−newtype Configs = Configs { unConfigs :: Map Text Text }

35−

36−class Monad m => HasConfigs m where

37− getConfig :: Text -> m (Maybe Text)

38− default getConfig :: (HasConfigs m', m ~ t m', MonadTrans t) => Text -> m (Maybe Text)

39− getConfig = lift . getConfig

40−

41−instance HasConfigs m => HasConfigs (BehaviorWriterT t w m)

42−instance HasConfigs m => HasConfigs (DynamicWriterT t w m)

43−instance HasConfigs m => HasConfigs (EventWriterT t w m)

44−instance HasConfigs m => HasConfigs (PostBuildT t m)

45−instance HasConfigs m => HasConfigs (QueryT t q m)

46−instance HasConfigs m => HasConfigs (ReaderT r m)

47−instance HasConfigs m => HasConfigs (RequesterT t request response m)

48−instance HasConfigs m => HasConfigs (RouteToUrlT t m)

49−instance HasConfigs m => HasConfigs (SetRouteT t r m)

50−instance HasConfigs m => HasConfigs (StaticDomBuilderT t m)

51−instance HasConfigs m => HasConfigs (TriggerEventT t m)

52−instance HasConfigs m => HasConfigs (RoutedT t r m)

53−instance HasConfigs m => HasConfigs (CookiesT m)

54−instance HasCookies m => HasCookies (ConfigsT m)

55−

56−newtype ConfigsT m a = ConfigsT { unConfigsT :: ReaderT Configs m a }

57− deriving

58− ( Functor

59− , Applicative

60− , DomBuilder t

61− , Monad

62− , MonadFix

63− , MonadHold t

64− , MonadIO

65−#ifndef ghcjs_HOST_OS

66− , MonadJSM

67−#endif

68− , MonadRef

69− , MonadReflexCreateTrigger t

70− , MonadSample t

71− , MonadTrans

72− , NotReady t

73− , PerformEvent t

74− , PostBuild t

75− , Prerender js t

76− , TriggerEvent t

77− , HasDocument

78− )

79−

80−instance Adjustable t m => Adjustable t (ConfigsT m) where

81− runWithReplace a e = ConfigsT $ runWithReplace (unConfigsT a) (unConfigsT <$> e)

82− traverseDMapWithKeyWithAdjust f m e = ConfigsT $ traverseDMapWithKeyWithAdjust (\k v -> unConfigsT $ f k v) m e

83− traverseIntMapWithKeyWithAdjust f m e = ConfigsT $ traverseIntMapWithKeyWithAdjust (\k v -> unConfigsT $ f k v) m e

84− traverseDMapWithKeyWithAdjustWithMove f m e = ConfigsT $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unConfigsT $ f k v) m e

85−

86−instance PrimMonad m => PrimMonad (ConfigsT m) where

87− type PrimState (ConfigsT m) = PrimState m

88− primitive = lift . primitive

89−

90−runConfigsT

91− :: Map Text Text

92− -> ConfigsT m a

93− -> m a

94−runConfigsT cs child = runReaderT (unConfigsT child) (Configs cs)

95−

96−instance Monad m => HasConfigs (ConfigsT m) where

97− getConfig k = ConfigsT $ Map.lookup k . unConfigs <$> ask

98−

99−mapConfigsT

100− :: (forall x. m x -> n x)

101− -> ConfigsT m a

102− -> ConfigsT n a

103−mapConfigsT f (ConfigsT x) = ConfigsT $ mapReaderT f x

lib/frontend/src/Obelisk/Frontend/Cookie.hs+3

@@ -26,6 +26,7 @@ import GHCJS.DOM.Document (getCookie, Document)

2626import GHCJS.DOM.Types (MonadJSM)

2727import Web.Cookie

2828

29+import Obelisk.ExecutableConfig.Frontend

2930import Obelisk.Route.Frontend

3031

3132class Monad m => HasCookies m where

@@ -45,6 +46,8 @@ instance HasCookies m => HasCookies (SetRouteT t r m)

4546instance HasCookies m => HasCookies (StaticDomBuilderT t m)

4647instance HasCookies m => HasCookies (TriggerEventT t m)

4748instance HasCookies m => HasCookies (RoutedT t r m)

49+instance HasCookies m => HasCookies (FrontendConfigsT m)

50+instance HasFrontendConfigs m => HasFrontendConfigs (CookiesT m)

4851

4952newtype CookiesT m a = CookiesT { unCookiesT :: ReaderT Cookies m a }

5053 deriving

lib/route/obelisk-route.cabal+1

@@ -21,6 +21,7 @@ library

2121 monad-control,

2222 mtl,

2323 network-uri,

24+ obelisk-executable-config-frontend,

2425 primitive,

2526 ref-tf,

2627 reflex,

lib/route/src/Obelisk/Route/Frontend.hs+7

@@ -55,6 +55,7 @@ module Obelisk.Route.Frontend

5555

5656import Prelude hiding ((.), id)

5757

58+import Obelisk.ExecutableConfig.Frontend

5859import Obelisk.Route

5960

6061import Control.Category (Category (..), (.))

@@ -176,6 +177,8 @@ instance (Monad m, MonadQuery t vs m) => MonadQuery t vs (RoutedT t r m) where

176177 askQueryResult = lift askQueryResult

177178 queryIncremental = lift . queryIncremental

178179

180+instance HasFrontendConfigs m => HasFrontendConfigs (RoutedT t r m)

181+

179182instance (Monad m, RouteToUrl r m) => RouteToUrl r (QueryT t q m)

180183

181184instance (Monad m, SetRoute t r m) => SetRoute t r (QueryT t q m)

@@ -338,6 +341,8 @@ instance PrimMonad m => PrimMonad (SetRouteT t r m ) where

338341 type PrimState (SetRouteT t r m) = PrimState m

339342 primitive = lift . primitive

340343

344+instance HasFrontendConfigs m => HasFrontendConfigs (SetRouteT t r m)

345+

341346instance (MonadHold t m, Adjustable t m) => Adjustable t (SetRouteT t r m) where

342347 runWithReplace a0 a' = SetRouteT $ runWithReplace (coerce a0) $ coerceEvent a'

343348 traverseIntMapWithKeyWithAdjust f a0 a' = SetRouteT $ traverseIntMapWithKeyWithAdjust (coerce f) (coerce a0) $ coerce a'

@@ -435,6 +440,8 @@ instance (Monad m, MonadQuery t vs m) => MonadQuery t vs (RouteToUrlT r m) where

435440 askQueryResult = lift askQueryResult

436441 queryIncremental = lift . queryIncremental

437442

443+instance HasFrontendConfigs m => HasFrontendConfigs (RouteToUrlT t m)

444+

438445runRouteViewT

439446 :: forall t m r a.

440447 ( TriggerEvent t m

lib/run/obelisk-run.cabal+1−1

@@ -26,7 +26,7 @@ library

2626 , network

2727 , obelisk-asset-serve-snap

2828 , obelisk-backend

29− , obelisk-executable-config

29+ , obelisk-executable-config-backend

3030 , obelisk-frontend

3131 , obelisk-route

3232 , process

lib/run/src/Obelisk/Run.hs+39−23

@@ -18,7 +18,6 @@ import Control.Category

1818import Control.Concurrent

1919import Control.Exception

2020import Control.Lens ((%~), (^?), _Just, _Right)

21−import Control.Monad.IO.Class

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

2322import Data.ByteString (ByteString)

2423import qualified Data.ByteString.Char8 as BSC

@@ -27,6 +26,7 @@ import Data.Dependent.Sum (DSum (..))

2726import Data.Functor.Identity

2827import Data.Functor.Sum

2928import Data.List (uncons)

29+import Data.Map (Map)

3030import qualified Data.Map as Map

3131import Data.Maybe

3232import Data.Semigroup ((<>))

@@ -48,7 +48,7 @@ import Network.WebSockets (ConnectionOptions)

4848import Network.WebSockets.Connection (defaultConnectionOptions)

4949import qualified Obelisk.Asset.Serve.Snap as Snap

5050import Obelisk.Backend

51−import Obelisk.ExecutableConfig (getFrontendConfigs)

51+import Obelisk.ExecutableConfig.Backend

5252import Obelisk.Frontend

5353import Obelisk.Route.Frontend

5454import Reflex.Dom.Core

@@ -75,23 +75,27 @@ run port serveStaticAsset backend frontend = do

7575 case checkEncoder $ _backend_routeEncoder backend of

7676 Left e -> hPutStrLn stderr $ "backend error:\n" <> T.unpack e

7777 Right validFullEncoder -> do

78+ configs <- getComponentConfigs

7879 backendTid <- forkIO $ handle handleBackendErr $ withArgs ["--quiet", "--port", show port] $ do

79− _backend_run backend $ \serveRoute -> do

80− runSnapWithCommandLineArgs $ do

81− getRouteWith validFullEncoder >>= \case

82− Identity r -> case r of

83− InL backendRoute :=> Identity a -> serveRoute $ backendRoute :/ a

84− InR obeliskRoute :=> Identity a ->

85− serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) serveStaticAsset frontend $ obeliskRoute :/ a

80+ runBackendConfigsT (_componentConfigs_backend configs) $

81+ _backend_run backend $ \serveRoute -> do

82+ runSnapWithCommandLineArgs $ do

83+ getRouteWith validFullEncoder >>= \case

84+ Identity r -> case r of

85+ InL backendRoute :=> Identity a ->

86+ runBackendConfigsT (_componentConfigs_backend configs) $

87+ serveRoute $ backendRoute :/ a

88+ InR obeliskRoute :=> Identity a ->

89+ serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) serveStaticAsset frontend (_componentConfigs_frontend configs) $ obeliskRoute :/ a

8690 let conf = defRunConfig { _runConfig_redirectPort = port }

87− runWidget conf frontend validFullEncoder `finally` killThread backendTid

91+ runWidget conf (_componentConfigs_frontend configs) frontend validFullEncoder `finally` killThread backendTid

8892

8993-- Convenience wrapper to handle path segments for 'Snap.serveAsset'

9094runServeAsset :: FilePath -> [Text] -> Snap ()

9195runServeAsset rootPath = Snap.serveAsset "" rootPath . T.unpack . T.intercalate "/"

9296

93−getConfigRoute :: IO (Maybe URI)

94−getConfigRoute = (Map.lookup "config/common/route" <$> getFrontendConfigs) >>= \case

97+getConfigRoute :: Map Text Text -> IO (Maybe URI)

98+getConfigRoute configs = case Map.lookup "common/route" configs of

9599 Just r -> case URI.mkURI $ T.strip r of

96100 Just route -> pure $ Just route

97101 Nothing -> do

@@ -102,9 +106,14 @@ getConfigRoute = (Map.lookup "config/common/route" <$> getFrontendConfigs) >>= \

102106defAppUri :: URI

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

104108

105−runWidget :: RunConfig -> Frontend (R route) -> Encoder Identity Identity (R (Sum backendRoute (ObeliskRoute route))) PageName -> IO ()

106−runWidget conf frontend validFullEncoder = do

107− uri <- fromMaybe defAppUri <$> getConfigRoute

109+runWidget

110+ :: RunConfig

111+ -> Map Text Text

112+ -> Frontend (R route)

113+ -> Encoder Identity Identity (R (Sum backendRoute (ObeliskRoute route))) PageName

114+ -> IO ()

115+runWidget conf configs frontend validFullEncoder = do

116+ uri <- fromMaybe defAppUri <$> getConfigRoute configs

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

109118 redirectHost = _runConfig_redirectHost conf

110119 redirectPort = _runConfig_redirectPort conf

@@ -116,19 +125,20 @@ runWidget conf frontend validFullEncoder = do

116125 close

117126 (\skt -> do

118127 man <- newManager defaultManagerSettings

119− app <- obeliskApp defaultConnectionOptions frontend validFullEncoder uri $ fallbackProxy redirectHost redirectPort man

128+ app <- obeliskApp configs defaultConnectionOptions frontend validFullEncoder uri $ fallbackProxy redirectHost redirectPort man

120129 runSettingsSocket settings skt app)

121130

122131obeliskApp

123− :: forall route backendRoute. ConnectionOptions

132+ :: forall route backendRoute

133+ . Map Text Text

134+ -> ConnectionOptions

124135 -> Frontend (R route)

125136 -> Encoder Identity Identity (R (Sum backendRoute (ObeliskRoute route))) PageName

126137 -> URI

127138 -> Application

128139 -> IO Application

129−obeliskApp opts frontend validFullEncoder uri backend = do

140+obeliskApp configs opts frontend validFullEncoder uri backend = do

130141 let entryPoint = do

131− configs <- liftIO getFrontendConfigs

132142 removeHTMLConfigs

133143 runFrontendWithConfigs configs validFullEncoder frontend

134144 syncPoint

@@ -145,15 +155,21 @@ obeliskApp opts frontend validFullEncoder uri backend = do

145155 }

146156 InR (ObeliskRoute_App appRouteComponent) :=> Identity appRouteRest -> do

147157 let cookies = maybe [] parseCookies $ lookup (fromString "Cookie") (W.requestHeaders req)

148− html <- renderJsaddleFrontend cookies (mkRouteToUrl validFullEncoder) (appRouteComponent :/ appRouteRest) frontend

158+ html <- renderJsaddleFrontend configs cookies (mkRouteToUrl validFullEncoder) (appRouteComponent :/ appRouteRest) frontend

149159 sendResponse $ W.responseLBS H.status200 [("Content-Type", staticRenderContentType)] $ BSLC.fromStrict html

150160 _ -> backend req sendResponse

151161

152−renderJsaddleFrontend :: Cookies -> (route -> Text) -> route -> Frontend route -> IO ByteString

153−renderJsaddleFrontend cookies urlEnc r f =

162+renderJsaddleFrontend

163+ :: Map Text Text

164+ -> Cookies

165+ -> (route -> Text)

166+ -> route

167+ -> Frontend route

168+ -> IO ByteString

169+renderJsaddleFrontend configs cookies urlEnc r f =

154170 let jsaddleScript = elAttr "script" ("src" =: "/jsaddle/jsaddle.js") blank

155171 jsaddlePreload = elAttr "link" ("rel" =: "preload" <> "as" =: "script" <> "href" =: "/jsaddle/jsaddle.js") blank

156− in renderFrontendHtml cookies urlEnc r f jsaddlePreload jsaddleScript

172+ in renderFrontendHtml configs cookies urlEnc r f jsaddlePreload jsaddleScript

157173

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

159175bindPortTCPRetry :: Settings