dcaa9e4 · obelisk · git.iko.soy

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

compare with master

unifiedsplit

@@ -229,4 +229,4 @@ getComponentConfigs = do

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

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

67runBackendConfigsT cs child = runReaderT (unBackendConfigsT child) cs

68

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

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

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

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

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

72

73mapBackendConfigsT

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

lib/executable-config/frontend/src/Obelisk/ExecutableConfig/Frontend.hs+2−2

@@ -105,8 +105,8 @@ runFrontendConfigsT

105runFrontendConfigsT cs child = runReaderT (unFrontendConfigsT child) cs

106

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

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

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

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

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

110

111mapFrontendConfigsT

112 :: (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 #-}

1module Obelisk.ExecutableConfig.Internal.ConfigDirectory where

3module Obelisk.ExecutableConfig.Internal.ConfigDirectory where

2

4

5+import Control.Monad

3import Data.Map (Map)

6import Data.Map (Map)

4import qualified Data.Map as Map

7import qualified Data.Map as Map

5import Data.Text (Text)

8import Data.Text (Text)

@@ -8,17 +11,18 @@ import Data.Text.IO as T

8import System.Directory

11import System.Directory

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

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

10

13

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

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

12−getConfigsFromDirectory base fp = do

15+getConfigsFromDirectory base = do

13− dir <- doesDirectoryExist (base </> fp)

16+ doesDirectoryExist base >>= \case

14− if dir

17+ True -> do

15− then do

16− ps <- listDirectory (base </> fp)

18+ ps <- listDirectory base

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

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

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

18− else do

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

22+ False -> do

19− file <- doesFileExist (base </> fp)

23+ doesFileExist base >>= \case

20− if file

24+ True -> do

21− then do

22− f <- T.readFile (base </> fp)

25+ f <- T.readFile base

23− return $ Map.singleton (T.pack fp) f

26+ pure $ Map.singleton "" f

27+ False -> do

24− else return mempty

28+ pure mempty

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

@@ -6,4 +6,4 @@ import Data.Text (Text)

6import Obelisk.ExecutableConfig.Internal.ConfigDirectory

7

8getConfigs :: 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

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

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

96

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

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

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

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

100− Just route -> pure $ Just route

100+ Just route -> Right route

101− Nothing -> do

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

102− putStrLn $ "Route is invalid: " <> 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)

103− pure Nothing

104− Nothing -> pure Nothing

105−

106−defAppUri :: URI

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

108

103

109runWidget

104runWidget

110 :: RunConfig

105 :: RunConfig

@@ -113,7 +108,7 @@ runWidget

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

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

114 -> IO ()

109 -> IO ()

115runWidget conf configs frontend validFullEncoder = do

110runWidget conf configs frontend validFullEncoder = do

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

111+ uri <- either (fail . T.unpack) pure $ getConfigRoute configs

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

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

118 redirectHost = _runConfig_redirectHost conf

113 redirectHost = _runConfig_redirectHost conf

119 redirectPort = _runConfig_redirectPort conf

114 redirectPort = _runConfig_redirectPort conf