5f26efc · obelisk · git.iko.soy

git.iko.soy/obelisk

run, deploy: Automatically inject common and frontend configurations

commit5f26efcbca11f153b7ece0d392b6e6a3a5ee8f4d authorAli Abrar <aliabrar@gmail.com> dateTue 7 Aug 2018, 18:01 (8 years ago) parent6cf35d7

5 files changed+33−5

compare with master

unifiedsplit

lib/backend/obelisk-backend.cabal+3 lib/backend/src/Obelisk/Backend.hs+25−1 lib/executable-config/inject/src/Obelisk/ExecutableConfig/Inject.hs+1−1 lib/executable-config/lookup/src/Obelisk/ExecutableConfig.hs+1−1 lib/run/src/Obelisk/Run.hs+3−2

lib/backend/obelisk-backend.cabal+3

@@ -10,9 +10,12 @@ library

1010 data-default,

1111 dependent-sum,

1212 dependent-sum-template,

13+ directory,

14+ filepath,

1315 lens,

1416 mtl,

1517 obelisk-asset-serve-snap,

18+ obelisk-executable-config-inject,

1619 obelisk-frontend,

1720 obelisk-route,

1821 obelisk-snap,

lib/backend/src/Obelisk/Backend.hs+25−1

@@ -16,8 +16,10 @@ module Obelisk.Backend

1616 , serveDefaultObeliskApp

1717 , prettifyOutput

1818 , runBackend

19+ , configureFrontend

1920 ) where

2021

22+import Control.Monad

2123import Control.Monad.Except

2224import qualified Data.ByteString.Char8 as BSC8

2325import Data.Default (Default (..))

@@ -26,13 +28,17 @@ import Data.Functor.Sum

2628import Data.Functor.Identity

2729import Data.Text (Text)

2830import qualified Data.Text as T

31+import qualified Data.Text.IO as T

2932import Data.Text.Encoding

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

34+import Obelisk.ExecutableConfig.Inject (injectPure)

3135import Obelisk.Frontend

3236import Obelisk.Route

3337import Snap (MonadSnap, Snap, commandLineConfig, defaultConfig, getsRequest, httpServe, rqPathInfo,

3438 rqQueryString, writeBS, writeText)

3539import Snap.Internal.Http.Server.Config (Config (accessLog, errorLog), ConfigLog (ConfigIoLog))

40+import System.Directory

41+import System.FilePath

3642import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)

3743

3844data Backend backendRoute frontendRoute = Backend

@@ -149,7 +155,7 @@ data GhcjsAppRoute :: (* -> *) -> * -> * where

149155serveGhcjsApp :: MonadSnap m => GhcjsApp (R appRouteComponent) -> R (GhcjsAppRoute appRouteComponent) -> m ()

150156serveGhcjsApp app = \case

151157 GhcjsAppRoute_App appRouteComponent :=> Identity appRouteRest ->

152− writeBS <=< liftIO $ renderFrontendHtml (appRouteComponent :/ appRouteRest) $ ghcjsFrontend $ _ghcjsApp_value app

158+ writeBS <=< liftIO $ renderFrontendHtml (appRouteComponent :/ appRouteRest) <=< configureFrontend $ ghcjsFrontend $ _ghcjsApp_value app

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

154160

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

@@ -162,3 +168,21 @@ runBackend backend frontend = case checkEncoder $ _backend_routeEncoder backend

162168 Right r -> case r of

163169 InL backendRoute :=> Identity a -> serveRoute $ backendRoute :/ a

164170 InR obeliskRoute :=> Identity a -> serveDefaultObeliskApp frontend $ obeliskRoute :/ a

171+

172+configureFrontend :: Frontend a -> IO (Frontend a)

173+configureFrontend f = do

174+ cfgC <- getConfigs "config/common"

175+ cfgF <- getConfigs "config/frontend"

176+ return $ f { _frontend_head = _frontend_head f >> mapM_ (uncurry injectPure) (cfgC <> cfgF) }

177+ where

178+ getConfigs :: FilePath -> IO [(FilePath, Text)]

179+ getConfigs fp = do

180+ ps <- listDirectory fp

181+ fmap concat $ forM ps $ \p -> do

182+ let fullpath = fp </> p

183+ dir <- doesDirectoryExist p

184+ if dir

185+ then getConfigs fullpath

186+ else do

187+ v <- T.readFile fullpath

188+ return [(fullpath, v)]

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

@@ -10,7 +10,7 @@ import System.FilePath ((</>))

1010

1111inject :: FilePath -> IO ByteString

1212inject item = do

13− f <- T.readFile $ "config" </> item

13+ f <- T.readFile item

1414 fmap snd $ renderStatic $ injectPure item f

1515

1616injectPure :: DomBuilder t m => FilePath -> T.Text -> m ()

lib/executable-config/lookup/src/Obelisk/ExecutableConfig.hs+1−1

@@ -10,4 +10,4 @@ import System.IO.Error

1010get :: Text -> IO (Maybe Text)

1111get path = do

1212 let doesNotExist = \e -> if isDoesNotExistError e then Just () else Nothing

13− catchJust doesNotExist (fmap Just $ T.readFile $ "config" </> T.unpack path) (\_ -> pure Nothing)

13+ catchJust doesNotExist (fmap Just $ T.readFile $ T.unpack path) (\_ -> pure Nothing)

lib/run/src/Obelisk/Run.hs+3−2

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

2323import Control.Concurrent

2424import Control.Exception

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

26+import Control.Monad

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

2728import Data.ByteString (ByteString)

2829import qualified Data.ByteString.Char8 as BSC

@@ -87,7 +88,7 @@ run port backend frontend = do

8788 runWidget conf frontend validFullEncoder `finally` killThread backendTid

8889

8990getConfigRoute :: IO (Maybe URI)

90−getConfigRoute = get "common/route" >>= \case

91+getConfigRoute = get "config/common/route" >>= \case

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

9293 Just route -> pure $ Just route

9394 Nothing -> do

@@ -139,7 +140,7 @@ obeliskApp opts frontend validFullEncoder uri backend = do

139140 { W.pathInfo = fst $ _validEncoder_encode jsaddleWarpRouteValidEncoder jsaddleRoute

140141 }

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

142− html <- renderFrontendHtml (appRouteComponent :/ appRouteRest) $ jsaddleFrontend frontend

143+ html <- renderFrontendHtml (appRouteComponent :/ appRouteRest) <=< configureFrontend $ jsaddleFrontend frontend

143144 sendResponse $ W.responseLBS H.status200 [("Content-Type", "text/html")] $ BSLC.fromStrict html

144145 _ -> backend req sendResponse

145146