86a9584 · obelisk · git.iko.soy

git.iko.soy/obelisk

Merge pull request #452 from obsidiansystems/cg-bytestring-config

Use Bytestring for configuration files, fix hydration.

commit86a9584c6d7648bd5324ef57d62421fed1bf1978 authorAli Abrar <aliabrar@gmail.com> dateSat 15 Jun 2019, 14:20 (7 years ago) parent6bb56ab ed8518d

36 files changed+458−474

compare with master

unifiedsplit

.gitignore+1−3

@@ -4,12 +4,10 @@

44result

55*.o

66*.hi

7−

87TAGS

98tags

109ctags

1110dist-newstyle

1211cabal.project.local

1312.ghc.environment.*

14−

15−**/ghcid-output.txt

13+**/ghcid-output.txt

ChangeLog.md+4−1

@@ -3,7 +3,10 @@

33This project's release branch is `master`. This log is written from the perspective of the release branch: when changes hit `master`, they are considered released, and the date should reflect that release.

55## Unreleased

6−

6+* Configs become ByteStrings.

7+* FrontendConfigsT has been changed into ConfigsT and configs are made available via getConfig/getConfigs

8+ * The frontend will still only have access to configs that are placed in config/frontend and config/common, while the backend has access to the entire contents of the config directory via `Obelisk.ExecutableConfig.Lookup.getConfigs`.

9+* The backend no longer runs in BackendConfigsT.

710* Add tabulation package. See Data.Tabulation for details.

811* Add encoders for `DMap`, `HasFields` (cf. Data.Tabulation), and JSON.

912

default.nix−8

@@ -39,14 +39,6 @@ let

3939 rev = "42afdc21da5d9e076eab57eaa42bfdde938192b8";

4040 sha256 = "0psw384dx9bw2dp93xrzw8rd9amvcwgzn64jzzwby7sfspj6k349";

4141 }) {});

42− # Need 8.0.2 build support

43− # PR: https://github.com/dmwit/universe/pull/33

44− universe-template = self.callCabal2nix "universe-template" (pkgs.fetchFromGitHub {

45− owner = "obsidiansystems";

46− repo = "universe";

47− rev = "6a71119bfa5db2b9990a2491c941469ff8ef5d13";

48− sha256 = "0z8smyainnlzcglv3dlx6x1n9j6d2jv48aa8f2421iayfkxg3js5";

49− } + /template) {};

5042 })

5143

5244 pkgs.obeliskExecutableConfig.haskellOverlay

dep/reflex-platform/github.json+3−3

@@ -1,7 +1,7 @@

11{

22 "owner": "reflex-frp",

33 "repo": "reflex-platform",

4− "branch": "develop",

5− "rev": "d68ab80e3a92425d4bcbfa2da7c685aded550c16",

6− "sha256": "0d5hc4v56pldy65rl0pmdzx2jylh8rjqqg5n0qb48039yy3pp8cq"

4+ "branch": "cg-bump-reflex-dom",

5+ "rev": "7ecb4c255bb053a7a4796ffd6331cdbe210de91c",

6+ "sha256": "1mngxa24cfpvxxq4hgh77nw36vny4abl5wi2xmlwpkk25wzm0h0x"

77}

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

@@ -16,7 +16,7 @@ library

1616 lens,

1717 mtl,

1818 obelisk-asset-serve-snap,

19− obelisk-executable-config-backend,

19+ obelisk-executable-config-inject,

2020 obelisk-executable-config-lookup,

2121 obelisk-frontend,

2222 obelisk-route,

lib/backend/src/Obelisk/Backend.hs+22−37

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

1111 ( Backend (..)

1212 -- * Re-exports

1313 , Default (def)

14− , ComponentConfigs(..)

1514 , getPageName

1615 , getRouteWith

1716 , runSnapWithCommandLineArgs

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

2019 , runBackend

2120 , staticRenderContentType

2221 , mkRouteToUrl

23− , getComponentConfigs

22+ , getPublicConfigs

2423 ) where

2524

2625import Prelude hiding (id, (.))

@@ -41,8 +40,7 @@ import Data.Text (Text)

4140import qualified Data.Text as T

4241import Data.Text.Encoding

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

44−import Obelisk.ExecutableConfig.Backend

45−import Obelisk.ExecutableConfig.Lookup

43+import qualified Obelisk.ExecutableConfig.Lookup as Lookup

4644import Obelisk.Frontend

4745import Obelisk.Route

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

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

5553

5654data Backend backendRoute frontendRoute = Backend

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

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

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

6657 }

6758

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

@@ -80,7 +71,7 @@ serveDefaultObeliskApp

8071 -> ([Text]

8172 -> m ())

8273 -> Frontend (R appRoute)

83− -> Map Text Text

74+ -> Map Text ByteString

8475 -> R (ObeliskRoute appRoute)

8576 -> m ()

8677serveDefaultObeliskApp urlEnc serveStaticAsset frontend configs = serveObeliskApp urlEnc serveStaticAsset frontendApp configs

@@ -139,7 +130,7 @@ serveObeliskApp

139130 => (R appRoute -> Text)

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

141132 -> GhcjsApp (R appRoute)

142− -> Map Text Text

133+ -> Map Text ByteString

143134 -> R (ObeliskRoute appRoute)

144135 -> m ()

145136serveObeliskApp urlEnc serveStaticAsset frontendApp config = \case

@@ -174,7 +165,7 @@ serveGhcjsApp

174165 :: (MonadSnap m, HasCookies m)

175166 => (R appRouteComponent -> Text)

176167 -> GhcjsApp (R appRouteComponent)

177− -> Map Text Text

168+ -> Map Text ByteString

178169 -> R (GhcjsAppRoute appRouteComponent)

179170 -> m ()

180171serveGhcjsApp urlEnc app config = \case

@@ -187,17 +178,15 @@ runBackend :: Backend fullRoute frontendRoute -> Frontend (R frontendRoute) -> I

187178runBackend backend frontend = case checkEncoder $ _backend_routeEncoder backend of

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

189180 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

181+ publicConfigs <- getPublicConfigs

182+ _backend_run backend $ \serveRoute -> do

183+ runSnapWithCommandLineArgs $ do

184+ getRouteWith validFullEncoder >>= \case

185+ Identity r -> case r of

186+ InL backendRoute :=> Identity a -> serveRoute $ backendRoute :/ a

187+ InR obeliskRoute :=> Identity a ->

188+ serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) (serveStaticAssets defaultStaticAssets) frontend publicConfigs $

189+ obeliskRoute :/ a

201190

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

203192mkRouteToUrl validFullEncoder =

@@ -208,7 +197,7 @@ renderGhcjsFrontend

208197 :: (MonadSnap m, HasCookies m)

209198 => (route -> Text)

210199 -> route

211− -> Map Text Text

200+ -> Map Text ByteString

212201 -> Frontend route

213202 -> m ByteString

214203renderGhcjsFrontend urlEnc route configs f = do

@@ -220,13 +209,9 @@ renderGhcjsFrontend urlEnc route configs f = do

220209instance HasCookies Snap where

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

222211

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 (`T.isPrefixOf` k) dirs

212+-- | Get configs from the canonical "public" locations (i.e., locations that obelisk expects to make available

213+-- to frontend applications, and hence visible to end users).

214+getPublicConfigs :: IO (Map Text ByteString)

215+getPublicConfigs = Map.filterWithKey (\k _ -> isMemberOf k ["common", "frontend"]) <$> Lookup.getConfigs

216+ where

217+ isMemberOf k = any (`T.isPrefixOf` k)

lib/executable-config/backend/obelisk-executable-config-backend.cabaldeleted−20

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

1−name: obelisk-executable-config-backend

2−version: 0.1

3−cabal-version: >= 1.2

4−build-type: Simple

5−

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.hsdeleted−77

@@ -1,77 +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 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 ("backend/" <> k) <$> ask

71− getCommonConfig k = BackendConfigsT $ Map.lookup ("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+1−3

@@ -16,12 +16,10 @@ let injectConfig = config: assets: nixpkgs.runCommand "inject-config" {} (''

1616 exit 1

1717 fi

1818 cp -a "${config}"/* "$out/config"

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

19+ find "$out/config" -type f -printf '%P\0' >"$out/config.files"

2020 '');

2121in with nixpkgs.haskell.lib; {

2222 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) {};

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

2624 };

2725 platforms = {

lib/executable-config/frontend/obelisk-executable-config-frontend.cabaldeleted−21

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

1−name: obelisk-executable-config-frontend

2−version: 0.1

3−cabal-version: >= 1.2

4−build-type: Simple

5−

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.hsdeleted−115

@@ -1,115 +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 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− , PostBuild t

72− , TriggerEvent t

73− , HasDocument

74− , DomRenderHook t

75− , HasJSContext

76− , HasJS js

77− )

78−

79−instance PerformEvent t m => PerformEvent t (FrontendConfigsT m) where

80− type Performable (FrontendConfigsT m) = FrontendConfigsT (Performable m)

81− performEvent e = FrontendConfigsT $ ReaderT $ \configs ->

82− performEvent $ runFrontendConfigsT configs <$> e

83− performEvent_ e = FrontendConfigsT $ ReaderT $ \configs ->

84− performEvent_ $ runFrontendConfigsT configs <$> e

85−

86−instance Adjustable t m => Adjustable t (FrontendConfigsT m) where

87− runWithReplace a e = FrontendConfigsT $ runWithReplace (unFrontendConfigsT a) (unFrontendConfigsT <$> e)

88− traverseDMapWithKeyWithAdjust f m e = FrontendConfigsT $ traverseDMapWithKeyWithAdjust (\k v -> unFrontendConfigsT $ f k v) m e

89− traverseIntMapWithKeyWithAdjust f m e = FrontendConfigsT $ traverseIntMapWithKeyWithAdjust (\k v -> unFrontendConfigsT $ f k v) m e

90− traverseDMapWithKeyWithAdjustWithMove f m e = FrontendConfigsT $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unFrontendConfigsT $ f k v) m e

91−

92−instance Prerender js t m => Prerender js t (FrontendConfigsT m) where

93− type Client (FrontendConfigsT m) = FrontendConfigsT (Client m)

94− prerender server client = FrontendConfigsT $ ReaderT $ \configs ->

95− prerender (runFrontendConfigsT configs server) (runFrontendConfigsT configs client)

96−

97−instance PrimMonad m => PrimMonad (FrontendConfigsT m) where

98− type PrimState (FrontendConfigsT m) = PrimState m

99− primitive = lift . primitive

100−

101−runFrontendConfigsT

102− :: Map Text Text

103− -> FrontendConfigsT m a

104− -> m a

105−runFrontendConfigsT cs child = runReaderT (unFrontendConfigsT child) cs

106−

107−instance Monad m => HasFrontendConfigs (FrontendConfigsT m) where

108− getFrontendConfig k = FrontendConfigsT $ Map.lookup ("frontend/" <> k) <$> ask

109− getCommonConfig k = FrontendConfigsT $ Map.lookup ("common/" <> k) <$> ask

110−

111−mapFrontendConfigsT

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

113− -> FrontendConfigsT m a

114− -> FrontendConfigsT n a

115−mapFrontendConfigsT f (FrontendConfigsT x) = FrontendConfigsT $ mapReaderT f x

lib/executable-config/inject/obelisk-executable-config-inject.cabal+2

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

99 build-depends:

1010 base,

11+ bytestring,

12+ base64-bytestring,

1113 containers,

1214 reflex-dom-core,

1315 text

lib/executable-config/inject/src/Obelisk/ExecutableConfig/Inject.hs+8−5

@@ -3,20 +3,23 @@ module Obelisk.ExecutableConfig.Inject where

44import Control.Monad (mapM_)

55import Control.Monad.IO.Class (MonadIO)

6+import Data.ByteString (ByteString)

7+import qualified Data.ByteString.Base64 as B64

68import Data.Map (Map)

79import qualified Data.Map as Map

810import Data.Semigroup ((<>))

911import Data.Text (Text)

12+import qualified Data.Text.Encoding as T

1013import Reflex.Dom.Core hiding (value)

1114

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

13−-- whose value is the provided configuration

14−injectPure :: DomBuilder t m => Text -> Text -> m ()

16+-- whose value is the provided configuration, encoded in base64.

17+injectPure :: DomBuilder t m => Text -> ByteString -> m ()

1518injectPure key value =

16− let attrs = ("type" =: "text/plain" <> "data-obelisk-executable-config-inject-key" =: key)

17− in elAttr "script" attrs $ text value

19+ let attrs = ("type" =: "text/plain" <> "data-obelisk-executable-config-inject-key" =: key <> "data-hydration-skip" =: "")

20+ in elAttr "script" attrs $ text (T.decodeUtf8 (B64.encode value))

1821

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

2023-- (filepaths) and values.

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

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

2225injectExecutableConfigs = mapM_ (uncurry injectPure) . Map.toList

lib/executable-config/lookup/default.nix+4−2

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

11{ hostPlatform, ghc

2−, mkDerivation, base, bytestring, filepath, stdenv, text, transformers

2+, mkDerivation, base, base64-bytestring, bytestring, filepath, stdenv, text, transformers

3+, transformers-base, ref-tf, primitive, monad-control, reflex, reflex-dom

4+, jsaddle

35, android-activity ? null, jsaddle-wkwebview ? null, ghcjs-dom ? null

46}:

57let isAndroid = hostPlatform.libc == "bionic";

@@ -10,7 +12,7 @@ in mkDerivation {

1012 version = "0.1";

1113 src = ./.;

1214 libraryHaskellDepends = [

13− base bytestring filepath text transformers

15+ base bytestring filepath text transformers transformers-base ref-tf primitive monad-control reflex reflex-dom jsaddle

1416 ] ++ (if isAndroid then [

1517 android-activity

1618 ] else if isIOS then [

lib/executable-config/lookup/obelisk-executable-config-lookup.cabal+16−8

@@ -4,34 +4,42 @@ cabal-version: >= 1.2

44build-type: Simple

66library

7− exposed-modules: Obelisk.ExecutableConfig.Lookup

7+ exposed-modules: Obelisk.ExecutableConfig.Lookup, Obelisk.Configs

88 if os(ios)

9− hs-source-dirs: src-ios, src-directory

10− other-modules: Obelisk.ExecutableConfig.Internal.ConfigDirectory

9+ hs-source-dirs: src-ios, src

10+ other-modules: Obelisk.Configs.Internal.Directory

1111 build-depends: jsaddle-wkwebview

1212 build-depends: directory

1313 else

1414 if os(linux-android)

15− hs-source-dirs: src-android

15+ hs-source-dirs: src-android, src

1616 c-sources: cbits/ExecutableConfig.c

1717 other-modules: Obelisk.ExecutableConfig.Internal.AssetManager

1818 build-depends: android-activity

1919 ld-options: -landroid

2020 else

2121 if impl(ghcjs)

22− hs-source-dirs: src-ghcjs

22+ hs-source-dirs: src-ghcjs, src

2323 build-depends: ghcjs-dom

2424 else

25− hs-source-dirs: src, src-directory

26− other-modules: Obelisk.ExecutableConfig.Internal.ConfigDirectory

25+ hs-source-dirs: src-other, src

26+ other-modules: Obelisk.Configs.Internal.Directory

2727 build-depends: directory

2828

2929 build-depends:

3030 base,

31+ base64-bytestring,

3132 bytestring,

3233 containers,

3334 filepath,

3435 text,

35− transformers

36+ transformers,

37+ transformers-base,

38+ ref-tf,

39+ primitive,

40+ monad-control,

41+ reflex,

42+ reflex-dom,

43+ jsaddle

3644

3745 ghc-options: -Wall

lib/executable-config/lookup/src-android/Obelisk/ExecutableConfig/Lookup.hs+11−7

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

11{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE OverloadedStrings #-}

23module Obelisk.ExecutableConfig.Lookup where

45import Control.Exception (bracket)

56import Control.Monad (forM)

7+import Data.ByteString (ByteString)

68import qualified Data.ByteString as BS

79import Data.Map (Map)

810import qualified Data.Map as Map

@@ -13,7 +15,7 @@ import Foreign.Ptr (nullPtr)

1315

1416import Obelisk.ExecutableConfig.Internal.AssetManager

1517

16−getFromMgr :: AAssetManager -> BS.ByteString -> IO (Maybe Text)

18+getFromMgr :: AAssetManager -> BS.ByteString -> IO (Maybe ByteString)

1719getFromMgr mgr name = do

1820 let open = do

1921 a <- BS.useAsCString name $ \fn ->

@@ -25,10 +27,10 @@ getFromMgr mgr name = do

2527 bracket open close $ mapM $ \asset -> do

2628 b <- asset_getBuffer asset

2729 l <- asset_getLength asset

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

30+ BS.packCStringLen (b, fromIntegral l)

2931

30−getConfigs :: IO (Map Text Text)

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

32+getConfigs :: IO (Map Text ByteString)

33+getConfigs = fmap (Map.mapKeys T.decodeUtf8) $ bracket getAssets freeAssetManager $ \mgrObj -> do

3234 mgr <- assetManagerFromJava mgrObj

3335 let openDir = do

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

@@ -43,10 +45,12 @@ getConfigs = bracket getAssets freeAssetManager $ \mgrObj -> do

4345 l <- asset_getLength asset

4446 lines0 <$> BS.packCStringLen (b, fromIntegral l)

4547 Nothing -> error "could not open configuration manifest 'config.files'"

46− fmap Map.fromList $ forM configPaths $ \fp ->

47− getFromMgr mgr fp >>= \case

48− Just v -> return (T.decodeUtf8 fp, v)

48+ result <- fmap Map.fromList $ forM configPaths $ \fp ->

49+ getFromMgr mgr ("config/" <> fp) >>= \case

50+ Just v -> return (fp, v)

4951 Nothing -> error $ "Config present in config.files but not in assets: " <> show fp

52+ putStrLn $ "getConfigs: found " <> show result

53+ pure result

5054

5155lines0 :: BS.ByteString -> [BS.ByteString]

5256lines0 ps

lib/executable-config/lookup/src-directory/Obelisk/ExecutableConfig/Internal/ConfigDirectory.hsdeleted−28

@@ -1,28 +0,0 @@

1−{-# LANGUAGE LambdaCase #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−module Obelisk.ExecutableConfig.Internal.ConfigDirectory where

4−

5−import Control.Monad

6−import Data.Map (Map)

7−import qualified Data.Map as Map

8−import Data.Text (Text)

9−import Data.Text as T

10−import Data.Text.IO as T

11−import System.Directory

12−import System.FilePath.Posix ((</>))

13−

14−getConfigsFromDirectory :: FilePath -> IO (Map Text Text)

15−getConfigsFromDirectory base = do

16− doesDirectoryExist base >>= \case

17− True -> do

18− ps <- listDirectory base

19− fmap mconcat $ forM ps $ \p -> do

20− subdirConfigs <- getConfigsFromDirectory $ base </> p

21− pure $ Map.mapKeys (T.pack . (p </>) . T.unpack) subdirConfigs

22− False -> do

23− doesFileExist base >>= \case

24− True -> do

25− f <- T.readFile base

26− pure $ Map.singleton "" f

27− False -> do

28− pure mempty

lib/executable-config/lookup/src-ghcjs/Obelisk/ExecutableConfig/Lookup.hs+8−2

@@ -2,10 +2,13 @@

22{-# LANGUAGE OverloadedStrings #-}

33module Obelisk.ExecutableConfig.Lookup where

5+import Data.ByteString (ByteString)

6+import qualified Data.ByteString.Base64 as B64

57import Data.Map (Map)

68import qualified Data.Map as Map

79import Data.Maybe (catMaybes)

810import Data.Text (Text)

11+import qualified Data.Text.Encoding as T

912import Data.Traversable (for)

1013import GHCJS.DOM

1114import GHCJS.DOM.Document (getHead)

@@ -16,7 +19,7 @@ import GHCJS.DOM.NodeList (item, getLength)

1619import GHCJS.DOM.ParentNode (querySelectorAll)

1720import GHCJS.DOM.Types (Node(Node), castTo)

1821

19−getConfigs :: IO (Map Text Text)

22+getConfigs :: IO (Map Text ByteString)

2023getConfigs = do

2124 Just doc <- currentDocument

2225 Just hd <- getHead doc

@@ -28,9 +31,12 @@ getConfigs = do

2831 dataset <- getDataset e

2932 (,)

3033 <$> get dataset ("obelisk-executable-config-inject-key" :: Text)

31− <*> getInnerHTML e

34+ <*> (fmap decodeOrFail (getInnerHTML e))

3235 where

3336 collToList es = do

3437 len <- getLength es

3538 list <- traverse (item es) [0..len-1]

3639 pure $ catMaybes list

40+ decodeOrFail x = case B64.decode (T.encodeUtf8 x) of

41+ Left e -> error ("Obelisk.ExecutableConfig.Lookup.getConfigs: error when decoding base64: " ++ e)

42+ Right x' -> x'

lib/executable-config/lookup/src-ios/Obelisk/ExecutableConfig/Lookup.hs+5−3

@@ -1,15 +1,17 @@

11{-# LANGUAGE LambdaCase #-}

22module Obelisk.ExecutableConfig.Lookup where

4+import Data.ByteString (ByteString)

45import Data.Map (Map)

56import Data.Text (Text)

67import qualified Data.Text as T

78import qualified Data.Text.Encoding as T

89import Language.Javascript.JSaddle.WKWebView

10+import System.FilePath.Posix

911

10−import Obelisk.ExecutableConfig.Internal.ConfigDirectory

12+import Obelisk.Configs.Internal.Directory

1113

12−getConfigs :: IO (Map Text Text)

14+getConfigs :: IO (Map Text ByteString)

1315getConfigs = mainBundleResourcePath >>= \case

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

15− Just _ -> getConfigsFromDirectory "config"

17+ Just p -> getConfigsFromDirectory $ T.unpack (T.decodeUtf8 p) </> "config"

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

@@ -0,0 +1,18 @@

1+{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+module Obelisk.ExecutableConfig.Lookup where

5+import Data.Map (Map)

6+import qualified Data.Map as Map

7+import Data.Text (Text)

8+import qualified Data.Text as T

9+import Data.ByteString (ByteString)

10+import qualified Data.ByteString as BS

11+import System.Directory

12+import System.FilePath

13+import Control.Monad

14+

15+import Obelisk.Configs.Internal.Directory

16+

17+getConfigs :: IO (Map Text ByteString)

18+getConfigs = getConfigsFromDirectory "config"

lib/executable-config/lookup/src/Obelisk/Configs.hsnew file+124

@@ -0,0 +1,124 @@

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.Configs

14+ ( HasConfigs(..)

15+ , ConfigsT

16+ , runConfigsT

17+ , mapConfigsT

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.ByteString (ByteString)

31+import Data.Map (Map)

32+import qualified Data.Map as Map

33+import Data.Text (Text)

34+import Reflex

35+import Reflex.Host.Class

36+import Reflex.Dom

37+#ifndef ghcjs_HOST_OS

38+import Language.Javascript.JSaddle (MonadJSM)

39+#endif

40+

41+class Monad m => HasConfigs m where

42+ getConfigs :: m (Map Text ByteString)

43+ default getConfigs :: (HasConfigs m', m ~ t m', MonadTrans t) => m (Map Text ByteString)

44+ getConfigs = lift getConfigs

45+ getConfig :: Text -> m (Maybe ByteString)

46+ getConfig k = do

47+ configs <- getConfigs

48+ return $ Map.lookup k configs

49+

50+instance Monad m => HasConfigs (ConfigsT m) where

51+ getConfigs = ConfigsT ask

52+

53+instance HasConfigs m => HasConfigs (BehaviorWriterT t w m)

54+instance HasConfigs m => HasConfigs (DynamicWriterT t w m)

55+instance HasConfigs m => HasConfigs (EventWriterT t w m)

56+instance HasConfigs m => HasConfigs (PostBuildT t m)

57+instance HasConfigs m => HasConfigs (QueryT t q m)

58+instance HasConfigs m => HasConfigs (ReaderT r m)

59+instance HasConfigs m => HasConfigs (RequesterT t request response m)

60+instance HasConfigs m => HasConfigs (StaticDomBuilderT t m)

61+instance HasConfigs m => HasConfigs (TriggerEventT t m)

62+

63+newtype ConfigsT m a = ConfigsT { unConfigsT :: ReaderT (Map Text ByteString) m a }

64+ deriving

65+ ( Functor

66+ , Applicative

67+ , Monad

68+ , MonadPlus

69+ , Alternative

70+ , MonadFix

71+ , MonadIO

72+ , MonadBase m'

73+ , MonadBaseControl m'

74+ , MonadRef

75+ , MonadTrans

76+ , DomBuilder t

77+ , MonadHold t

78+ , MonadReflexCreateTrigger t

79+ , MonadSample t

80+ , NotReady t

81+ , PostBuild t

82+ , TriggerEvent t

83+ , HasDocument

84+ , DomRenderHook t

85+ , HasJSContext

86+ , HasJS js

87+#ifndef ghcjs_HOST_OS

88+ , MonadJSM

89+#endif

90+ )

91+

92+instance PerformEvent t m => PerformEvent t (ConfigsT m) where

93+ type Performable (ConfigsT m) = ConfigsT (Performable m)

94+ performEvent e = ConfigsT $ ReaderT $ \configs ->

95+ performEvent $ runConfigsT configs <$> e

96+ performEvent_ e = ConfigsT $ ReaderT $ \configs ->

97+ performEvent_ $ runConfigsT configs <$> e

98+

99+instance Adjustable t m => Adjustable t (ConfigsT m) where

100+ runWithReplace a e = ConfigsT $ runWithReplace (unConfigsT a) (unConfigsT <$> e)

101+ traverseDMapWithKeyWithAdjust f m e = ConfigsT $ traverseDMapWithKeyWithAdjust (\k v -> unConfigsT $ f k v) m e

102+ traverseIntMapWithKeyWithAdjust f m e = ConfigsT $ traverseIntMapWithKeyWithAdjust (\k v -> unConfigsT $ f k v) m e

103+ traverseDMapWithKeyWithAdjustWithMove f m e = ConfigsT $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unConfigsT $ f k v) m e

104+

105+instance Prerender js t m => Prerender js t (ConfigsT m) where

106+ type Client (ConfigsT m) = ConfigsT (Client m)

107+ prerender server client = ConfigsT $ ReaderT $ \configs ->

108+ prerender (runConfigsT configs server) (runConfigsT configs client)

109+

110+instance PrimMonad m => PrimMonad (ConfigsT m) where

111+ type PrimState (ConfigsT m) = PrimState m

112+ primitive = lift . primitive

113+

114+runConfigsT

115+ :: Map Text ByteString

116+ -> ConfigsT m a

117+ -> m a

118+runConfigsT cs child = runReaderT (unConfigsT child) cs

119+

120+mapConfigsT

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

122+ -> ConfigsT m a

123+ -> ConfigsT n a

124+mapConfigsT f (ConfigsT x) = ConfigsT $ mapReaderT f x

lib/executable-config/lookup/src/Obelisk/Configs/Internal/Directory.hsnew file+24

@@ -0,0 +1,24 @@

1+{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+module Obelisk.Configs.Internal.Directory where

5+import Control.Monad

6+import Data.ByteString (ByteString)

7+import qualified Data.ByteString as BS

8+import Data.Map (Map)

9+import qualified Data.Map as Map

10+import Data.Text (Text)

11+import qualified Data.Text as T

12+import System.Directory

13+import System.FilePath.Posix

14+

15+getConfigsFromDirectory :: FilePath -> IO (Map Text ByteString)

16+getConfigsFromDirectory base = doesDirectoryExist base >>= \case

17+ True -> do

18+ ps <- listDirectory base

19+ fmap mconcat $ forM ps $ \p -> do

20+ subdirConfigs <- getConfigsFromDirectory $ base </> p

21+ pure $ Map.mapKeys (T.pack . (p </>) . T.unpack) subdirConfigs

22+ False -> doesFileExist base >>= \case

23+ True -> Map.singleton "" <$> BS.readFile base

24+ False -> pure mempty

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

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

1−module Obelisk.ExecutableConfig.Lookup where

2−

3−import Data.Map (Map)

4−import Data.Text (Text)

5−

6−import Obelisk.ExecutableConfig.Internal.ConfigDirectory

7−

8−getConfigs :: IO (Map Text Text)

9−getConfigs = getConfigsFromDirectory "config"

lib/frontend/obelisk-frontend.cabal−1

@@ -14,7 +14,6 @@ library

1414 jsaddle,

1515 lens,

1616 mtl,

17− obelisk-executable-config-frontend,

1817 obelisk-executable-config-inject,

1918 obelisk-executable-config-lookup,

2019 obelisk-route,

lib/frontend/src/Obelisk/Frontend.hs+105−30

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

1−{-# LANGUAGE ConstraintKinds #-}

21{-# LANGUAGE CPP #-}

2+{-# LANGUAGE ConstraintKinds #-}

33{-# LANGUAGE FlexibleContexts #-}

44{-# LANGUAGE FlexibleInstances #-}

55{-# LANGUAGE LambdaCase #-}

@@ -15,9 +15,10 @@ module Obelisk.Frontend

1515 ( ObeliskWidget

1616 , Frontend (..)

1717 , runFrontend

18− , runFrontendWithConfigs

18+ , runFrontendWithConfigsAndCurrentRoute

1919 , renderFrontendHtml

2020 , removeHTMLConfigs

21+ , FrontendMode (..)

2122 , module Obelisk.Frontend.Cookie

2223 ) where

2324

@@ -38,21 +39,27 @@ import Data.Map (Map)

3839import Data.Maybe (catMaybes)

3940import Data.Monoid ((<>))

4041import Data.Text (Text)

42+import qualified GHCJS.DOM as DOM

43+import qualified GHCJS.DOM.Types as DOM

44+import qualified GHCJS.DOM.History as DOM

45+import qualified GHCJS.DOM.Window as DOM

46+import Language.Javascript.JSaddle (JSM, jsNull)

4147import GHCJS.DOM (currentDocument)

4248import GHCJS.DOM.Document (getHead)

4349import GHCJS.DOM.Node (removeChild_)

4450import GHCJS.DOM.NodeList (item, getLength)

4551import GHCJS.DOM.ParentNode (querySelectorAll)

46−import Language.Javascript.JSaddle (JSM)

4752import Obelisk.Frontend.Cookie

4853import Obelisk.Route.Frontend

4954import Reflex.Dom.Core

5055import Reflex.Host.Class

51−import Obelisk.ExecutableConfig.Frontend

56+import Obelisk.Configs

5257import Obelisk.ExecutableConfig.Inject (injectExecutableConfigs)

53−import Obelisk.ExecutableConfig.Lookup (getConfigs)

58+import qualified Obelisk.ExecutableConfig.Lookup as Lookup

5459import Web.Cookie

5560

61+import Debug.Trace

62+

5663makePrisms ''Sum

5764

5865type ObeliskWidget js t route m =

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

7481 , Prerender js t m

7582 , PrebuildAgnostic t route m

7683 , PrebuildAgnostic t route (Client m)

77− , HasFrontendConfigs m

84+ , HasConfigs m

7885 , HasCookies m

7986 )

8087

@@ -82,8 +89,8 @@ type PrebuildAgnostic t route m =

8289 ( SetRoute t route m

8390 , RouteToUrl route m

8491 , MonadFix m

85− , HasFrontendConfigs m

86− , HasFrontendConfigs (Performable m)

92+ , HasConfigs m

93+ , HasConfigs (Performable m)

8794 )

8895

8996data Frontend route = Frontend

@@ -106,49 +113,117 @@ removeHTMLConfigs = void $ runMaybeT $ do

106113 lst <- traverse (item es) $ take (fromIntegral len) $ [0..] -- fun with unsigned types ...

107114 pure $ catMaybes lst

108115

116+setInitialRoute :: Bool -> JSM ()

117+setInitialRoute useHash = do

118+ traceM "setInitialRoute"

119+ window <- DOM.currentWindowUnchecked

120+ initialLocation <- DOM.getLocation window

121+ initialUri <- getLocationUri initialLocation

122+ history <- DOM.getHistory window

123+ DOM.replaceState history jsNull ("" :: Text) $ Just $

124+ show $ setAdaptedUriPath useHash "/" initialUri

125+

126+data FrontendMode = FrontendMode

127+ { _frontendMode_hydrate :: Bool

128+ -- ^ There is already a rendering of the DOM in place; hydrate it rather

129+ -- than building new DOM

130+ , _frontendMode_adjustRoute :: Bool

131+ -- ^ The page can't use regular routes, so encode routes into the hash

132+ -- instead

133+ }

134+

135+-- | Run the frontend, setting the initial route to "/" on platforms where no

136+-- route exists ambiently in the context (e.g. anything but web).

137+-- Selects FrontendMode based on platform; this doesn't work for jsaddle-warp

109138runFrontend

110139 :: forall backendRoute route

111140 . Encoder Identity Identity (R (Sum backendRoute (ObeliskRoute route))) PageName

112141 -> Frontend (R route)

113142 -> JSM ()

114143runFrontend validFullEncoder frontend = do

115− configs <- liftIO getConfigs

144+ let mode = FrontendMode

145+ { _frontendMode_hydrate =

146+#ifdef ghcjs_HOST_OS

147+ True

148+#else

149+ False

150+#endif

151+ , _frontendMode_adjustRoute =

116152#ifdef ghcjs_HOST_OS

117− removeHTMLConfigs

153+ False

154+#else

155+ True

118156#endif

119− runFrontendWithConfigs configs validFullEncoder frontend

157+ }

158+ configs <- liftIO Lookup.getConfigs

159+ when (_frontendMode_hydrate mode) removeHTMLConfigs

160+ -- There's no fundamental reason that adjustRoute needs to control setting the

161+ -- initial route and *also* the useHash parameter; that's why these are

162+ -- separate here. However, currently, they are always the same.

163+ when (_frontendMode_adjustRoute mode) $ do

164+ setInitialRoute $ _frontendMode_adjustRoute mode

165+ runFrontendWithConfigsAndCurrentRoute mode configs validFullEncoder frontend

120166

121−runFrontendWithConfigs

167+runFrontendWithConfigsAndCurrentRoute

122168 :: forall backendRoute route

123− . Map Text Text

169+ . FrontendMode

170+ -> Map Text ByteString

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

125172 -> Frontend (R route)

126173 -> JSM ()

127−runFrontendWithConfigs configs validFullEncoder frontend = do

174+runFrontendWithConfigsAndCurrentRoute mode configs validFullEncoder frontend = do

128175 let ve = validFullEncoder . hoistParse errorLeft (prismEncoder (rPrism $ _InR . _ObeliskRoute_App))

129176 errorLeft = \case

130177 Left _ -> error "runFrontend: Unexpected non-app ObeliskRoute reached the frontend. This shouldn't happen."

131178 Right x -> Identity x

132− runHydrationWidgetWithHeadAndBody (pure ()) $ \appendHead appendBody -> do

133− rec switchover <- runRouteViewT ve switchover $ do

134− (switchover'', fire) <- newTriggerEvent

135− mapRoutedT (mapSetRouteT (mapRouteToUrlT (appendHead . runFrontendConfigsT configs))) $ do

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

137− baseTag

138− _frontend_head frontend

139− mapRoutedT (mapSetRouteT (mapRouteToUrlT (appendBody . runFrontendConfigsT configs))) $ do

140− _frontend_body frontend

141− switchover' <- lift $ lift $ lift $ lift $ HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_switchover

142− performEvent_ $ liftIO (fire ()) <$ switchover'

143− pure switchover''

144− pure ()

179+ w :: ( RawDocument (DomBuilderSpace (HydrationDomBuilderT s DomTimeline m)) ~ DOM.Document

180+ , Ref (Performable m) ~ Ref IO

181+ , Ref m ~ Ref IO

182+ , DomBuilder DomTimeline (HydrationDomBuilderT s DomTimeline m)

183+ , MonadHold DomTimeline m

184+ , MonadRef m

185+ , MonadRef (Performable m)

186+ , MonadReflexCreateTrigger DomTimeline m

187+ , PerformEvent DomTimeline m

188+ , PostBuild DomTimeline m

189+ , PrimMonad m

190+ , MonadSample DomTimeline (Performable m)

191+ , DOM.MonadJSM m

192+ , Monad (Performable (Client (HydrationDomBuilderT s DomTimeline m)))

193+ , MonadFix (Client (HydrationDomBuilderT s DomTimeline m))

194+ , MonadFix (Performable m)

195+ , MonadFix m

196+ , Prerender js DomTimeline (HydrationDomBuilderT s DomTimeline m)

197+ , MonadIO (Performable m)

198+ )

199+ => (forall c. HydrationDomBuilderT s DomTimeline m c -> FloatingWidget () c)

200+ -> (forall c. HydrationDomBuilderT s DomTimeline m c -> FloatingWidget () c)

201+ -> FloatingWidget () ()

202+ w appendHead appendBody = do

203+ rec switchover <- runRouteViewT ve switchover (_frontendMode_adjustRoute mode) $ do

204+ (switchover'', fire) <- newTriggerEvent

205+ mapRoutedT (mapSetRouteT (mapRouteToUrlT (appendHead . runConfigsT configs))) $ do

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

207+ baseTag

208+ _frontend_head frontend

209+ mapRoutedT (mapSetRouteT (mapRouteToUrlT (appendBody . runConfigsT configs))) $ do

210+ _frontend_body frontend

211+ switchover' <- case _frontendMode_hydrate mode of

212+ True -> lift $ lift $ lift $ lift $ HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_switchover

213+ False -> getPostBuild

214+ performEvent_ $ liftIO (fire ()) <$ switchover'

215+ pure switchover''

216+ pure ()

217+ if _frontendMode_hydrate mode

218+ then runHydrationWidgetWithHeadAndBody (pure ()) w

219+ else runImmediateWidgetWithHeadAndBody w

145220

146221renderFrontendHtml

147222 :: ( t ~ DomTimeline

148223 , MonadIO m

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

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

150225 )

151− => Map Text Text

226+ => Map Text ByteString

152227 -> Cookies

153228 -> (r -> Text)

154229 -> r

@@ -158,7 +233,7 @@ renderFrontendHtml

158233 -> m ByteString

159234renderFrontendHtml configs cookies urlEnc route frontend headExtra bodyExtra = do

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

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

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

162237 el "html" $ do

163238 el "head" $ do

164239 baseTag

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

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

2626import GHCJS.DOM.Types (MonadJSM)

2727import Web.Cookie

2828

29−import Obelisk.ExecutableConfig.Frontend

29+import Obelisk.Configs

3030import Obelisk.Route.Frontend

3131

3232class Monad m => HasCookies m where

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

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

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

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

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

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

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

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

5151

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

5353 deriving

lib/route/obelisk-route.cabal+3−3

@@ -14,7 +14,6 @@ library

1414 containers,

1515 dependent-map,

1616 dependent-sum,

17− dependent-sum-universe-orphans,

1817 dependent-sum-template,

1918 either,

2019 ghcjs-dom,

@@ -24,7 +23,7 @@ library

2423 monad-control,

2524 mtl,

2625 network-uri,

27− obelisk-executable-config-frontend,

26+ obelisk-executable-config-lookup,

2827 primitive,

2928 ref-tf,

3029 reflex,

@@ -32,9 +31,10 @@ library

3231 template-haskell,

3332 tabulation,

3433 text,

34+ th-extras,

3535 transformers,

3636 universe,

37− universe-template

37+ universe-dependent-sum

3838 exposed-modules: Obelisk.Route

3939 Obelisk.Route.TH

4040 Obelisk.Route.Frontend

lib/route/src/Obelisk/Route.hs+29−28

@@ -120,13 +120,12 @@ import Data.Maybe

120120import Data.Monoid ((<>))

121121import Data.Set (Set)

122122import qualified Data.Set as Set

123−import Data.Some (Some)

124−import qualified Data.Some as Some

125−import Data.Some.Universe.Orphans ()

123+import Data.Some (Some(Some))

126124import Data.Text (Text)

127125import qualified Data.Text as T

128−import Data.Text.Encoding

126+import qualified Data.Text.Encoding as T

129127import Data.Universe

128+import Data.Universe.Some

130129import Network.HTTP.Types.URI

131130import qualified Numeric.Lens

132131import Obelisk.Route.TH

@@ -165,7 +164,7 @@ pattern (:/) :: f a -> a -> R f

165164pattern a :/ b = a :=> Identity b

166165

167166mapSome :: (forall a. f a -> g a) -> Some f -> Some g

168−mapSome f (Some.This a) = Some.This $ f a

167+mapSome f (Some a) = Some $ f a

169168

170169hoistR :: (forall x. f x -> g x) -> R f -> R g

171170hoistR f (x :=> Identity y) = f x :/ y

@@ -359,8 +358,8 @@ nothingEncoder = prismEncoder _Nothing

359358

360359someConstEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Some (Const a)) a

361360someConstEncoder = unsafeMkEncoder $ EncoderImpl

362− { _encoderImpl_encode = \(Some.This (Const a)) -> a

363− , _encoderImpl_decode = pure . Some.This . Const

361+ { _encoderImpl_encode = \(Some (Const a)) -> a

362+ , _encoderImpl_decode = pure . Some . Const

364363 }

365364

366365-- | WARNING: This is only safe if the Show and Read instances for 'a' are

@@ -388,7 +387,7 @@ checkEnum1EncoderFunc

388387 -> check (EncoderFunc check' parse p r)

389388checkEnum1EncoderFunc f = do

390389 (encoderImpls :: DMap p (Flip (EncoderImpl parse) r)) <- DMap.fromList <$>

391− traverse (\(Some.This p) -> (p :=>) . Flip <$> unEncoder (f p)) universe

390+ traverse (\(Some p) -> (p :=>) . Flip <$> unEncoder (f p)) universe

392391 pure $ EncoderFunc $ \p -> unsafeMkEncoder . unFlip $

393392 DMap.findWithDefault (error "checkEnum1EncoderFunc: EncoderImpl not found (should be impossible)") p encoderImpls

394393

@@ -443,11 +442,11 @@ chainEncoder cons this rest = Encoder $ do

443442 pure $ EncoderImpl

444443 { _encoderImpl_decode = \v -> do

445444 (here, following) <- _encoderImpl_decode consValid v

446− Some.This r <- _encoderImpl_decode thisValid here

445+ Some r <- _encoderImpl_decode thisValid here

447446 (r :/) <$> _encoderImpl_decode (runIdentity . unEncoder $ rest r) following

448447 , _encoderImpl_encode = \(r :/ s) ->

449448 _encoderImpl_encode consValid

450− ( _encoderImpl_encode thisValid $ Some.This r

449+ ( _encoderImpl_encode thisValid $ Some r

451450 , _encoderImpl_encode (runIdentity . unEncoder $ rest r) s)

452451 }

453452

@@ -514,7 +513,7 @@ enum1Encoder

514513 , Show r

515514 )

516515 => (forall a. p a -> r) -> Encoder check parse (Some p) r

517−enum1Encoder f = enumEncoder $ \(Some.This p) -> f p

516+enum1Encoder f = enumEncoder $ \(Some p) -> f p

518517

519518-- | Encode an enumerable, bounded type. WARNING: Don't use this on types that

520519-- have a large number of values - it will use a lot of memory.

@@ -603,10 +602,10 @@ queryParametersTextEncoder = Encoder $ pure $ EncoderImpl

603602 in (urlDecodeText True k, urlDecodeText True <$> mv)

604603

605604urlEncodeText :: Bool -> Text -> Text

606−urlEncodeText q = decodeUtf8 . urlEncode q . encodeUtf8

605+urlEncodeText q = T.decodeUtf8 . urlEncode q . T.encodeUtf8

607606

608607urlDecodeText :: Bool -> Text -> Text

609−urlDecodeText q = decodeUtf8 . urlDecode q . encodeUtf8

608+urlDecodeText q = T.decodeUtf8 . urlDecode q . T.encodeUtf8

610609

611610listToNonEmptyEncoder :: (Applicative check, Applicative parse, Monoid a, Eq a) => Encoder check parse [a] (NonEmpty a)

612611listToNonEmptyEncoder = Encoder $ pure $ EncoderImpl

@@ -718,9 +717,11 @@ data ObeliskRoute :: (* -> *) -> * -> * where

718717 ObeliskRoute_App :: f a -> ObeliskRoute f a

719718 ObeliskRoute_Resource :: ResourceRoute a -> ObeliskRoute f a

720719

721−instance Universe (Some f) => Universe (Some (ObeliskRoute f)) where

722− universe = fmap (\(Some.This x) -> Some.This (ObeliskRoute_App x)) universe

723− ++ fmap (\(Some.This x) -> Some.This (ObeliskRoute_Resource x)) universe

720+instance UniverseSome f => UniverseSome (ObeliskRoute f) where

721+ universeSome = concat

722+ [ (\(Some x) -> Some (ObeliskRoute_App x)) <$> universe

723+ , (\(Some x) -> Some (ObeliskRoute_Resource x)) <$> universe

724+ ]

724725

725726instance GEq f => GEq (ObeliskRoute f) where

726727 geq (ObeliskRoute_App x) (ObeliskRoute_App y) = geq x y

@@ -808,12 +809,12 @@ indexOnlyRouteEncoder = pathComponentEncoder indexOnlyRouteSegment

808809

809810someSumEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Some (Sum a b)) (Either (Some a) (Some b))

810811someSumEncoder = Encoder $ pure $ EncoderImpl

811− { _encoderImpl_encode = \(Some.This t) -> case t of

812− InL l -> Left $ Some.This l

813− InR r -> Right $ Some.This r

812+ { _encoderImpl_encode = \(Some t) -> case t of

813+ InL l -> Left $ Some l

814+ InR r -> Right $ Some r

814815 , _encoderImpl_decode = pure . \case

815− Left (Some.This l) -> Some.This (InL l)

816− Right (Some.This r) -> Some.This (InR r)

816+ Left (Some l) -> Some (InL l)

817+ Right (Some r) -> Some (InR r)

817818 }

818819

819820data Void1 :: * -> * where {}

@@ -824,7 +825,7 @@ instance Universe (Some Void1) where

824825void1Encoder :: (Applicative check, MonadError Text parse) => Encoder check parse (Some Void1) a

825826void1Encoder = Encoder $ pure $ EncoderImpl

826827 { _encoderImpl_encode = \case

827− Some.This f -> case f of {}

828+ Some f -> case f of {}

828829 , _encoderImpl_decode = \_ -> throwError "void1Encoder: can't decode anything"

829830 }

830831

@@ -900,18 +901,18 @@ dmapEncoder :: forall check parse k k' v.

900901 -> Encoder check parse (DMap k' Identity) (Map k v)

901902dmapEncoder keyEncoder' valueEncoderFor = unsafeEncoder $ do

902903 keyEncoder :: Encoder Identity parse (Some k') k <- checkEncoder keyEncoder'

903− valueDecoders :: DMap k' (Decoder Identity parse v) <- fmap DMap.fromList . forM universe $ \(Some.This (k' :: k' t)) -> do

904+ valueDecoders :: DMap k' (Decoder Identity parse v) <- fmap DMap.fromList . forM universe $ \(Some (k' :: k' t)) -> do

904905 ve :: Encoder Identity parse t v <- checkEncoder (valueEncoderFor k')

905906 return $ (k' :: k' t) :=> (Decoder ve :: Decoder Identity parse v t)

906907 let keyError k = "dmapEncoder: key `" <> k <> "' was missing from the Universe instance for its type."

907908 return $ EncoderImpl

908909 { _encoderImpl_encode = \dm -> Map.fromList $ do

909910 ((k' :: k' t) :=> Identity v') <- DMap.toList dm

910− return ( encode keyEncoder (Some.This k')

911+ return ( encode keyEncoder (Some k')

911912 , encode (toEncoder (DMap.findWithDefault (error . keyError $ gshow k') k' valueDecoders)) v'

912913 )

913914 , _encoderImpl_decode = \m -> fmap DMap.fromList . forM (Map.toList m) $ \(k,v) -> do

914− Some.This (k' :: k' t) <- tryDecode keyEncoder k

915+ Some (k' :: k' t) <- tryDecode keyEncoder k

915916 case DMap.lookup k' valueDecoders of

916917 Nothing -> throwError . T.pack . keyError $ gshow k'

917918 Just (Decoder e) -> do

@@ -930,7 +931,7 @@ fieldMapEncoder :: forall check parse r.

930931 => Encoder check parse r (DMap (Field r) Identity)

931932fieldMapEncoder = unsafeEncoder $ do

932933 pure $ EncoderImpl

933− { _encoderImpl_encode = \r -> DMap.fromList [ f :=> Identity (indexField r f) | Some.This f <- universe ]

934+ { _encoderImpl_encode = \r -> DMap.fromList [ f :=> Identity (indexField r f) | Some f <- universe ]

934935 , _encoderImpl_decode = \dm -> tabulateFieldsA $ \f -> do

935936 case DMap.lookup f dm of

936937 Nothing -> throwError $ "fieldMapEncoder: Couldn't find key for `" <> T.pack (gshow f) <> "' in DMap."

@@ -947,8 +948,8 @@ jsonEncoder :: forall check parse r.

947948 => Encoder check parse r Text

948949jsonEncoder = unsafeEncoder $ do

949950 pure $ EncoderImpl

950− { _encoderImpl_encode = \r -> decodeUtf8 . BSL.toStrict $ Aeson.encode r

951− , _encoderImpl_decode = \t -> case Aeson.eitherDecodeStrict $ encodeUtf8 t of

951+ { _encoderImpl_encode = \r -> T.decodeUtf8 . BSL.toStrict $ Aeson.encode r

952+ , _encoderImpl_decode = \t -> case Aeson.eitherDecodeStrict $ T.encodeUtf8 t of

952953 Left err -> throwError ("jsonEncoder: " <> T.pack err)

953954 Right x -> return x

954955 }

lib/route/src/Obelisk/Route/Frontend.hs+24−24

@@ -52,11 +52,12 @@ module Obelisk.Route.Frontend

5252 , mapRouteToUrlT

5353 , routeLink

5454 , dynRouteLink

55+ , adaptedUriPath

56+ , setAdaptedUriPath

5557 ) where

5658

5759import Prelude hiding ((.), id)

5860

59−import Obelisk.ExecutableConfig.Frontend

6061import Obelisk.Route

6162

6263import Control.Category (Category (..), (.))

@@ -90,13 +91,13 @@ import Language.Javascript.JSaddle --TODO: Get rid of this - other platforms can

9091import Reflex.Dom.Core

9192import qualified GHCJS.DOM.Types as DOM

9293import Network.URI

93−#if defined(ios_HOST_OS)

9494import Data.Maybe (fromMaybe)

9595import qualified Data.List as L

96−#endif

9796

9897import Unsafe.Coerce

9998

99+import Obelisk.Configs

100+

100101infixr 5 :~

101102pattern (:~) :: Reflex t => f a -> Dynamic t a -> DSum f (Compose (Dynamic t) Identity)

102103pattern a :~ b <- a :=> (coerceDynamic . getCompose -> b)

@@ -178,7 +179,7 @@ instance (Monad m, MonadQuery t vs m) => MonadQuery t vs (RoutedT t r m) where

178179 askQueryResult = lift askQueryResult

179180 queryIncremental = lift . queryIncremental

180181

181−instance HasFrontendConfigs m => HasFrontendConfigs (RoutedT t r m)

182+instance HasConfigs m => HasConfigs (RoutedT t r m)

182183

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

184185

@@ -342,7 +343,7 @@ instance PrimMonad m => PrimMonad (SetRouteT t r m ) where

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

343344 primitive = lift . primitive

344345

345−instance HasFrontendConfigs m => HasFrontendConfigs (SetRouteT t r m)

346+instance HasConfigs m => HasConfigs (SetRouteT t r m)

346347

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

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

@@ -441,7 +442,7 @@ instance (Monad m, MonadQuery t vs m) => MonadQuery t vs (RouteToUrlT r m) where

441442 askQueryResult = lift askQueryResult

442443 queryIncremental = lift . queryIncremental

443444

444−instance HasFrontendConfigs m => HasFrontendConfigs (RouteToUrlT t m)

445+instance HasConfigs m => HasConfigs (RouteToUrlT t m)

445446

446447runRouteViewT

447448 :: forall t m r a.

@@ -453,17 +454,20 @@ runRouteViewT

453454 , MonadFix m

454455 )

455456 => (Encoder Identity Identity r PageName)

457+ --TODO: Get rid of the switchover and useHash arguments

458+ -- useHash can probably be baked into the encoder

456459 -> Event t () -- ^ Switchover event, nothing is done until this event fires. Used to prevent incorrect DOM expectations at hydration switchover time

460+ -> Bool

457461 -> RoutedT t r (SetRouteT t r (RouteToUrlT r m)) a

458462 -> m a

459−runRouteViewT routeEncoder switchover a = do

463+runRouteViewT routeEncoder switchover useHash a = do

460464 rec historyState <- manageHistory' switchover $ HistoryCommand_PushState <$> setState

461465 let theEncoder = pageNameEncoder . hoistParse (pure . runIdentity) routeEncoder

462466 -- NB: The can only fail if the uriPath doesn't begin with a '/' or if the uriQuery

463467 -- is nonempty, but begins with a character that isn't '?'. Since we don't expect

464468 -- this ever to happen, we'll just handle it by failing completely with 'error'.

465469 route :: Dynamic t r

466− route = fmap (errorLeft . tryDecode theEncoder . (adaptedUriPath &&& uriQuery) . _historyItem_uri) historyState

470+ route = fmap (errorLeft . tryDecode theEncoder . (adaptedUriPath useHash &&& uriQuery) . _historyItem_uri) historyState

467471 where

468472 errorLeft (Left e) = error (T.unpack e)

469473 errorLeft (Right x) = x

@@ -484,7 +488,7 @@ runRouteViewT routeEncoder switchover a = do

484488 -- we can change this function later to accommodate.

485489 -- See: https://github.com/whatwg/html/issues/2174

486490 , _historyStateUpdate_title = ""

487− , _historyStateUpdate_uri = Just $ setAdaptedUriPath newPath $ (_historyItem_uri currentHistoryState)

491+ , _historyStateUpdate_uri = Just $ setAdaptedUriPath useHash newPath $ (_historyItem_uri currentHistoryState)

488492 { uriQuery = newQuery

489493 }

490494 }

@@ -537,22 +541,18 @@ dynRouteLink dr w = do

537541-- On ios due to sandboxing when loading the page from a file adapt the

538542-- path to be based on the hash.

539543

540−adaptedUriPath :: URI -> String

541−#if defined(ios_HOST_OS)

542−adaptedUriPath = hashToPath . uriFragment

543−

544−hashToPath :: String -> String

545−hashToPath = ('/' :) . fromMaybe "" . L.stripPrefix "#"

546−#else

547−adaptedUriPath = uriPath

548−#endif

544+adaptedUriPath :: Bool -> URI -> String

545+adaptedUriPath = \case

546+ True -> hashToPath . uriFragment

547+ False -> uriPath

549548

550−setAdaptedUriPath :: String -> URI -> URI

551−#if defined(ios_HOST_OS)

552−setAdaptedUriPath s u = u { uriFragment = pathToHash s }

549+setAdaptedUriPath :: Bool -> String -> URI -> URI

550+setAdaptedUriPath useHash s u = case useHash of

551+ True -> u { uriFragment = pathToHash s }

552+ False -> u { uriPath = s }

553553

554554pathToHash :: String -> String

555555pathToHash = ('#' :) . fromMaybe "" . L.stripPrefix "/"

556−#else

557−setAdaptedUriPath s u = u { uriPath = s }

558−#endif

556+

557+hashToPath :: String -> String

558+hashToPath = ('/' :) . fromMaybe "" . L.stripPrefix "#"

lib/route/src/Obelisk/Route/TH.hs+4−5

@@ -1,8 +1,9 @@

11module Obelisk.Route.TH (deriveRouteComponent) where

3+import Data.Constraint.Extras.TH

34import Data.GADT.Show.TH

45import Data.GADT.Compare.TH

5−import Data.Universe.TH

6+import Data.Universe.Some.TH

67import Language.Haskell.TH

89-- | Derive all the typeclasses needed for a RouteComponent type. The argument should be the name of a type of kind @k -> *@

@@ -11,8 +12,6 @@ deriveRouteComponent x = concat <$> traverse ($ x)

1112 [ deriveGShow

1213 , deriveGEq

1314 , deriveGCompare

14− , deriveShowTagIdentity

15− , deriveEqTagIdentity

16− , deriveOrdTagIdentity

17− , deriveSomeUniverse

15+ , deriveUniverseSome

16+ , deriveArgDict

1817 ]

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-backend

29+ , obelisk-executable-config-lookup

3030 , obelisk-frontend

3131 , obelisk-route

3232 , process

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

@@ -34,6 +34,7 @@ import Data.Streaming.Network (bindPortTCP)

3434import Data.String (fromString)

3535import Data.Text (Text)

3636import qualified Data.Text as T

37+import qualified Data.Text.Encoding as T

3738import Language.Javascript.JSaddle.Run (syncPoint)

3839import Language.Javascript.JSaddle.WebSockets

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

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

4849import Network.WebSockets.Connection (defaultConnectionOptions)

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

5051import Obelisk.Backend

51−import Obelisk.ExecutableConfig.Backend

5252import Obelisk.Frontend

5353import Obelisk.Route.Frontend

5454import Reflex.Dom.Core

@@ -75,35 +75,34 @@ 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

78+ publicConfigs <- getPublicConfigs

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

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

80+ _backend_run backend $ \serveRoute -> do

81+ runSnapWithCommandLineArgs $ do

82+ getRouteWith validFullEncoder >>= \case

83+ Identity r -> case r of

84+ InL backendRoute :=> Identity a -> serveRoute $ backendRoute :/ a

85+ InR obeliskRoute :=> Identity a ->

86+ serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) serveStaticAsset frontend publicConfigs $ obeliskRoute :/ a

9087 let conf = defRunConfig { _runConfig_redirectPort = port }

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

88+ runWidget conf publicConfigs frontend validFullEncoder `finally` killThread backendTid

9289

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

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

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

9693

97−getConfigRoute :: Map Text Text -> Either Text URI

94+getConfigRoute :: Map Text ByteString -> Either Text URI

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

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

100− Just route -> Right route

101− Nothing -> Left $ "Couldn't parse route as URI; value read was: " <> T.pack (show r)

102− Nothing -> Left $ "Couldn't find config file common/route; it should contain the site's canonical root URI" <> T.pack (show $ Map.keys configs)

96+ Just r ->

97+ let stripped = T.strip (T.decodeUtf8 r)

98+ in case URI.mkURI stripped of

99+ Just route -> Right route

100+ Nothing -> Left $ "Couldn't parse route as URI; value read was: " <> T.pack (show stripped)

101+ Nothing -> Left $ "Couldn't find config file common/route; it should contain the site's canonical root URI" <> T.pack (show $ Map.keys configs)

103102

104103runWidget

105104 :: RunConfig

106− -> Map Text Text

105+ -> Map Text ByteString

107106 -> Frontend (R route)

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

109108 -> IO ()

@@ -125,7 +124,7 @@ runWidget conf configs frontend validFullEncoder = do

125124

126125obeliskApp

127126 :: forall route backendRoute

128− . Map Text Text

127+ . Map Text ByteString

129128 -> ConnectionOptions

130129 -> Frontend (R route)

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

@@ -133,9 +132,12 @@ obeliskApp

133132 -> Application

134133 -> IO Application

135134obeliskApp configs opts frontend validFullEncoder uri backend = do

136− let entryPoint = do

137− removeHTMLConfigs

138− runFrontendWithConfigs configs validFullEncoder frontend

135+ let mode = FrontendMode

136+ { _frontendMode_hydrate = True

137+ , _frontendMode_adjustRoute = False

138+ }

139+ entryPoint = do

140+ runFrontendWithConfigsAndCurrentRoute mode configs validFullEncoder frontend

139141 syncPoint

140142 jsaddlePath <- URI.mkPathPiece "jsaddle"

141143 let jsaddleUri = BSLC.fromStrict $ URI.renderBs $ uri & uriPath %~ (<>[jsaddlePath])

@@ -155,7 +157,7 @@ obeliskApp configs opts frontend validFullEncoder uri backend = do

155157 _ -> backend req sendResponse

156158

157159renderJsaddleFrontend

158− :: Map Text Text

160+ :: Map Text ByteString

159161 -> Cookies

160162 -> (route -> Text)

161163 -> route

skeleton/common/src/Common/Api.hs+1−1

@@ -1,4 +1,4 @@

11module Common.Api where

33commonStuff :: String

4−commonStuff = "Here is a string defined in code common to the frontend and backend."

4+commonStuff = "Here is a string defined in Common.Api"

skeleton/config/common/examplenew file+1

@@ -0,0 +1 @@

1+This string comes from config/common/example

skeleton/frontend/frontend.cabal+1

@@ -10,6 +10,7 @@ library

1010 , obelisk-frontend

1111 , obelisk-route

1212 , reflex-dom

13+ , obelisk-executable-config-lookup

1314 , obelisk-generated-static

1415 , text

1516 exposed-modules:

skeleton/frontend/src/Frontend.hs+8−1

@@ -4,7 +4,9 @@

44module Frontend where

66import qualified Data.Text as T

7+import qualified Data.Text.Encoding as T

78import Obelisk.Frontend

9+import Obelisk.Configs

810import Obelisk.Route

911import Reflex.Dom.Core

1012

@@ -12,7 +14,6 @@ import Common.Api

1214import Common.Route

1315import Obelisk.Generated.Static

1416

15−

1617frontend :: Frontend (R FrontendRoute)

1718frontend = Frontend

1819 { _frontend_head = el "title" $ text "Obelisk Minimal Example"

@@ -20,4 +21,10 @@ frontend = Frontend

2021 text "Welcome to Obelisk!"

2122 el "p" $ text $ T.pack commonStuff

2223 elAttr "img" ("src" =: static @"obelisk.jpg") blank

24+ el "div" $ do

25+ exampleConfig <- getConfig "common/example"

26+ case exampleConfig of

27+ Nothing -> text "No config file found in config/common/example"

28+ Just s -> text (T.decodeUtf8 s)

29+ return ()

2330 }