on master help sign in
Fix backend config loading
commit68caf2078e5930f41b9af08c5bdf94d02e6bd583 authorRyan Trinkle <ryan.trinkle@gmail.com> dateFri 24 May 2019, 21:38 (7 years ago) parentde99fc6
6 files changed+29−30
lib/backend/src/Obelisk/Backend.hs+1−1 lib/executable-config/backend/src/Obelisk/ExecutableConfig/Backend.hs+2−2 lib/executable-config/frontend/src/Obelisk/ExecutableConfig/Frontend.hs+2−2 lib/executable-config/lookup/src-directory/Obelisk/ExecutableConfig/Internal/ConfigDirectory.hs+18−14 lib/executable-config/lookup/src/Obelisk/ExecutableConfig/Lookup.hs+1−1 lib/run/src/Obelisk/Run.hs+5−10
lib/backend/src/Obelisk/Backend.hs+1−1
@@ -229,4 +229,4 @@ getComponentConfigs = do
229229 , _componentConfigs_frontend =
230230 Map.filterWithKey (\k _ -> isMemberOf k ["common", "frontend"]) allConfigs
231231 }
232− where isMemberOf k dirs = or $ map (\dir -> ("config/" <> dir) `T.isPrefixOf` k) dirs
232+ where isMemberOf k dirs = or $ map (`T.isPrefixOf` k) dirs
lib/executable-config/backend/src/Obelisk/ExecutableConfig/Backend.hs+2−2
@@ -67,8 +67,8 @@ runBackendConfigsT
6767runBackendConfigsT cs child = runReaderT (unBackendConfigsT child) cs
6868
6969instance 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
70+ getBackendConfig k = BackendConfigsT $ Map.lookup ("backend/" <> k) <$> ask
71+ getCommonConfig k = BackendConfigsT $ Map.lookup ("common/" <> k) <$> ask
7272
7373mapBackendConfigsT
7474 :: (forall x. m x -> n x)
lib/executable-config/frontend/src/Obelisk/ExecutableConfig/Frontend.hs+2−2
@@ -105,8 +105,8 @@ runFrontendConfigsT
105105runFrontendConfigsT cs child = runReaderT (unFrontendConfigsT child) cs
106106
107107instance Monad m => HasFrontendConfigs (FrontendConfigsT m) where
108− getFrontendConfig k = FrontendConfigsT $ Map.lookup ("config/frontend/" <> k) <$> ask
109− getCommonConfig k = FrontendConfigsT $ Map.lookup ("config/common/" <> k) <$> ask
108+ getFrontendConfig k = FrontendConfigsT $ Map.lookup ("frontend/" <> k) <$> ask
109+ getCommonConfig k = FrontendConfigsT $ Map.lookup ("common/" <> k) <$> ask
110110
111111mapFrontendConfigsT
112112 :: (forall x. m x -> n x)
lib/executable-config/lookup/src-directory/Obelisk/ExecutableConfig/Internal/ConfigDirectory.hs+18−14
@@ -1,5 +1,8 @@
1+{-# LANGUAGE LambdaCase #-}
2+{-# LANGUAGE OverloadedStrings #-}
13module Obelisk.ExecutableConfig.Internal.ConfigDirectory where
24
5+import Control.Monad
36import Data.Map (Map)
47import qualified Data.Map as Map
58import Data.Text (Text)
@@ -8,17 +11,18 @@ import Data.Text.IO as T
811import System.Directory
912import System.FilePath.Posix ((</>))
1013
11−getConfigsFromDirectory :: FilePath -> FilePath -> IO (Map Text Text)
12−getConfigsFromDirectory base fp = do
13− dir <- doesDirectoryExist (base </> fp)
14− if dir
15− then do
16− ps <- listDirectory (base </> fp)
17− fmap mconcat $ mapM (\p -> getConfigsFromDirectory base $ fp </> p) ps
18− else do
19− file <- doesFileExist (base </> fp)
20− if file
21− then do
22− f <- T.readFile (base </> fp)
23− return $ Map.singleton (T.pack fp) f
24− else return mempty
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/Obelisk/ExecutableConfig/Lookup.hs+1−1
@@ -6,4 +6,4 @@ import Data.Text (Text)
66import Obelisk.ExecutableConfig.Internal.ConfigDirectory
77
88getConfigs :: IO (Map Text Text)
9−getConfigs = getConfigsFromDirectory "." "config"
9+getConfigs = getConfigsFromDirectory "config"
lib/run/src/Obelisk/Run.hs+5−10
@@ -94,17 +94,12 @@ run port serveStaticAsset backend frontend = do
9494runServeAsset :: FilePath -> [Text] -> Snap ()
9595runServeAsset rootPath = Snap.serveAsset "" rootPath . T.unpack . T.intercalate "/"
9696
97−getConfigRoute :: Map Text Text -> IO (Maybe URI)
97+getConfigRoute :: Map Text Text -> Either Text URI
9898getConfigRoute configs = case Map.lookup "common/route" configs of
9999 Just r -> case URI.mkURI $ T.strip r of
100− Just route -> pure $ Just route
101− Nothing -> do
102− putStrLn $ "Route is invalid: " <> show r
103− pure Nothing
104− Nothing -> pure Nothing
105−
106−defAppUri :: URI
107−defAppUri = fromMaybe (error "defAppUri") $ URI.mkURI "http://127.0.0.1:8000"
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)
108103
109104runWidget
110105 :: RunConfig
@@ -113,7 +108,7 @@ runWidget
113108 -> Encoder Identity Identity (R (Sum backendRoute (ObeliskRoute route))) PageName
114109 -> IO ()
115110runWidget conf configs frontend validFullEncoder = do
116− uri <- fromMaybe defAppUri <$> getConfigRoute configs
111+ uri <- either (fail . T.unpack) pure $ getConfigRoute configs
117112 let port = fromIntegral $ fromMaybe 80 $ uri ^? uriAuthority . _Right . authPort . _Just
118113 redirectHost = _runConfig_redirectHost conf
119114 redirectPort = _runConfig_redirectPort conf