aefb66a · obelisk · git.iko.soy

git.iko.soy/obelisk

Make getFrontendConfigs return a Map and abstract out directory listing

commitaefb66aa778b41a35f9bfe6c0ca008b46b291c36 authorKen Micklas <ken.micklas@obsidian.systems> dateMon 29 Apr 2019, 16:55 (7 years ago) parent3c1c727

11 files changed+71−94

compare with master

unifiedsplit

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

@@ -9,6 +9,7 @@ library

99 build-depends:

1010 base,

1111 bytestring,

12+ containers,

1213 filepath,

1314 obelisk-executable-config,

1415 reflex-dom-core,

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

@@ -3,6 +3,7 @@ module Obelisk.ExecutableConfig.Inject where

44import Control.Monad (mapM_)

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

6+import qualified Data.Map as Map

67import Data.Semigroup ((<>))

78import Data.ByteString (ByteString)

89import Data.Text (Text)

@@ -31,4 +32,4 @@ injectPure key value =

3132injectExecutableConfigs :: (MonadIO m, DomBuilder t m) => m ()

3233injectExecutableConfigs = do

3334 cfg <- liftIO getFrontendConfigs

34− mapM_ (uncurry injectPure) cfg

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

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

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

77 exposed-modules: Obelisk.ExecutableConfig

88 exposed-modules: Obelisk.ExecutableConfig.Internal

99 if os(ios)

10− hs-source-dirs: src-ios

10+ hs-source-dirs: src-ios, src-directory

11+ other-modules: Obelisk.ExecutableConfig.Internal.ConfigDirectory

1112 build-depends: jsaddle-wkwebview

1213 build-depends: directory

1314 else

@@ -22,12 +23,14 @@ library

2223 hs-source-dirs: src-ghcjs

2324 build-depends: ghcjs-dom

2425 else

25− hs-source-dirs: src

26+ hs-source-dirs: src, src-directory

27+ other-modules: Obelisk.ExecutableConfig.Internal.ConfigDirectory

2628 build-depends: directory

2729

2830 build-depends:

2931 base,

3032 bytestring,

33+ containers,

3134 filepath,

3235 text,

3336 transformers

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

@@ -4,14 +4,12 @@ module Obelisk.ExecutableConfig.Internal where

44import Control.Exception (bracket)

55import Control.Monad (forM)

66import qualified Data.ByteString as BS

7−import Data.List (sortOn)

8−import Data.Maybe (catMaybes, maybe)

7+import Data.Map (Map)

8+import qualified Data.Map as Map

99import Data.Text (Text)

10−import qualified Data.Text as T

1110import qualified Data.Text.Encoding as T

1211import Foreign.C.String (withCString)

1312import Foreign.Ptr (nullPtr)

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

1513

1614import Obelisk.ExecutableConfig.Internal.AssetManager

1715

@@ -29,7 +27,7 @@ getFromMgr mgr name = do

2927 l <- asset_getLength asset

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

3129

32−getFrontendConfigs :: IO [(Text, Text)]

30+getFrontendConfigs :: IO (Map Text Text)

3331getFrontendConfigs = bracket getAssets freeAssetManager $ \mgrObj -> do

3432 mgr <- assetManagerFromJava mgrObj

3533 let openDir = do

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

4543 l <- asset_getLength asset

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

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

48− fmap catMaybes $ forM configPaths $ \fp ->

49− fmap (\v -> (T.decodeUtf8 fp,v)) <$> getFromMgr mgr fp

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

47+ getFromMgr mgr fp >>= \case

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

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

5050

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

5252lines0 ps

lib/executable-config/lookup/src-directory/Obelisk/ExecutableConfig/Internal/ConfigDirectory.hsnew file+24

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

1+module Obelisk.ExecutableConfig.Internal.ConfigDirectory where

3+import Data.Map (Map)

4+import qualified Data.Map as Map

5+import Data.Text (Text)

6+import Data.Text as T

7+import Data.Text.IO as T

8+import System.Directory

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

10+

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

12+getConfigs base fp = do

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

14+ if dir

15+ then do

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

17+ fmap mconcat $ mapM (\p -> getConfigs 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

lib/executable-config/lookup/src-ghcjs/Obelisk/ExecutableConfig.hs+3−9

@@ -2,20 +2,14 @@

22module Obelisk.ExecutableConfig where

44import Control.Monad.Trans.Maybe

5−import Data.List (sortOn)

6−import Data.Maybe (catMaybes)

75import Data.Semigroup ((<>))

86import Data.Text (Text)

9−import qualified Data.Text as T

10−import Data.Traversable (for)

117import GHCJS.DOM

12−import GHCJS.DOM.Document (getHead)

13−import GHCJS.DOM.Element (Element, getElementsByTagName, getId, getInnerHTML)

14−import GHCJS.DOM.HTMLCollection (HTMLCollection, item, getLength)

8+import GHCJS.DOM.Element (getInnerHTML)

159import GHCJS.DOM.NonElementParentNode

1610

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

18−get item = runMaybeT $ do

12+get key = runMaybeT $ do

1913 doc <- MaybeT currentDocument

20− e <- MaybeT $ getElementById doc $ "config-" <> item

14+ e <- MaybeT $ getElementById doc $ "config-" <> key

2115 getInnerHTML e

lib/executable-config/lookup/src-ghcjs/Obelisk/ExecutableConfig/Internal.hs+13−12

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

11{-# LANGUAGE OverloadedStrings #-}

22module Obelisk.ExecutableConfig.Internal where

4−import Control.Monad.Trans.Maybe

5−import Data.List (sortOn)

4+import Data.Map (Map)

5+import qualified Data.Map as Map

66import Data.Maybe (catMaybes)

77import Data.Semigroup ((<>))

88import Data.Text (Text)

@@ -11,20 +11,21 @@ import Data.Traversable (for)

1111import GHCJS.DOM

1212import GHCJS.DOM.Document (getHead)

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

14−import GHCJS.DOM.HTMLCollection (HTMLCollection, item, getLength)

15−import GHCJS.DOM.NonElementParentNode

14+import GHCJS.DOM.HTMLCollection (item, getLength)

1615

17−getFrontendConfigs :: IO [(Text, Text)]

18−getFrontendConfigs = fmap concat $ runMaybeT $ do

19− doc <- MaybeT currentDocument

20− hd <- MaybeT $ getHead doc

16+getFrontendConfigs :: IO (Map Text Text)

17+getFrontendConfigs = do

18+ Just doc <- currentDocument

19+ Just hd <- getHead doc

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

22− cfg <- for es $ \e -> runMaybeT $ do

21+ cfg <- for es $ \e -> do

2322 ident <- getId e

24− k <- MaybeT $ pure $ T.stripPrefix "config-" ident

2523 v <- getInnerHTML e

26− pure (k,v)

27− pure $ sortOn fst $ catMaybes cfg

24+ return $ case T.stripPrefix "config-" ident of

25+ Just k -> (k, v)

26+ Nothing -> error $

27+ "Element '" <> show ident <> "' has class 'obelisk-executable-config-inject' but does not start with 'config-'."

28+ return $ Map.fromList cfg

2829 where

2930 collToList es = do

3031 len <- getLength es

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

@@ -2,20 +2,16 @@ module Obelisk.ExecutableConfig (get) where

33import Control.Exception

44import Control.Monad

5−import Control.Monad.Trans.Maybe

6−import Data.ByteString as BS

7−import Data.List (sortOn)

85import Data.Text (Text)

96import qualified Data.Text as T

107import qualified Data.Text.IO as T

118import qualified Data.Text.Encoding as T

129import Language.Javascript.JSaddle.WKWebView

13−import System.Directory

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

1511import System.IO.Error

1612

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

18−get name = fmap join $ mainBundleResourcePath >>= \mp -> forM mp $ \p ->

14+get name = fmap join $ mainBundleResourcePath >>= \mp -> forM mp $ \p ->

1915 catchDoesNotExist $ T.readFile $ T.unpack (T.decodeUtf8 p) </> T.unpack name

2016

2117catchDoesNotExist :: IO a -> IO (Maybe a)

lib/executable-config/lookup/src-ios/Obelisk/ExecutableConfig/Internal.hs+7−29

@@ -1,37 +1,15 @@

1+{-# LANGUAGE LambdaCase #-}

12module Obelisk.ExecutableConfig.Internal where

3−import Control.Exception

4−import Control.Monad

5−import Control.Monad.Trans.Maybe

6−import Data.ByteString as BS

7−import Data.List (sortOn)

4+import Data.Map (Map)

85import Data.Text (Text)

96import qualified Data.Text as T

10−import qualified Data.Text.IO as T

117import qualified Data.Text.Encoding as T

128import Language.Javascript.JSaddle.WKWebView

13−import System.Directory

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

15−import System.IO.Error

169

17−getFrontendConfigs :: IO [(Text, Text)]

18−getFrontendConfigs = fmap Prelude.concat $ mainBundleResourcePath >>= \mp -> forM mp $ \p -> do

19− let base = T.unpack (T.decodeUtf8 p)

20− cfgC <- getConfigs base "config/common"

21− cfgF <- getConfigs base "config/frontend"

22− return $ sortOn fst $ cfgC <> cfgF

10+import Obelisk.ExecutableConfig.Internal.ConfigDirectory

2311

24−getConfigs :: FilePath -> FilePath -> IO [(Text, Text)]

25−getConfigs base fp = do

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

27− if dir

28− then do

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

30− fmap Prelude.concat $ mapM (\p -> getConfigs base $ fp </> p) ps

31− else do

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

33− if file

34− then do

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

36− return [(T.pack fp, f)]

37− else return []

12+getFrontendConfigs :: IO (Map Text Text)

13+getFrontendConfigs = mainBundleResourcePath >>= \case

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

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

lib/executable-config/lookup/src/Obelisk/ExecutableConfig/Internal.hs+6−26

@@ -1,32 +1,12 @@

11module Obelisk.ExecutableConfig.Internal where

3−import Control.Exception

4−import Data.List (sortOn)

3+import Data.Map (Map)

54import Data.Text (Text)

6−import Data.Text as T

7−import Data.Text.IO as T

8−import System.Directory

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

10−import System.IO.Error

115

6+import Obelisk.ExecutableConfig.Internal.ConfigDirectory

127

13−getFrontendConfigs :: IO [(Text, Text)]

8+getFrontendConfigs :: IO (Map Text Text)

149getFrontendConfigs = do

15− cfgC <- getConfigs "config/common"

16− cfgF <- getConfigs "config/frontend"

17− return $ sortOn fst $ cfgC <> cfgF

18−

19−getConfigs :: FilePath -> IO [(Text, Text)]

20−getConfigs fp = do

21− dir <- doesDirectoryExist fp

22− if dir

23− then do

24− ps <- listDirectory fp

25− fmap Prelude.concat $ mapM (\p -> getConfigs $ fp </> p) ps

26− else do

27− file <- doesFileExist fp

28− if file

29− then do

30− f <- T.readFile fp

31− return [(T.pack fp, f)]

32− else return []

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

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

12+ return $ cfgC <> cfgF

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

@@ -31,7 +31,6 @@ import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)

3131import Data.ByteString (ByteString)

3232import Data.Foldable (for_)

3333import Data.Functor.Sum

34−import qualified Data.Map as Map

3534import Data.Maybe (catMaybes)

3635import Data.Monoid ((<>))

3736import Data.Text (Text)

@@ -114,7 +113,7 @@ runFrontend validFullEncoder frontend = do

114113 errorLeft = \case

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

116115 Right x -> Identity x

117− configs <- liftIO $ Map.fromList <$> getFrontendConfigs

116+ configs <- liftIO getFrontendConfigs

118117 removeHTMLConfigs

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

120119 rec switchover <- runRouteViewT ve switchover $ do

@@ -144,7 +143,7 @@ renderFrontendHtml

144143 -> m ByteString

145144renderFrontendHtml cookies urlEnc route frontend headExtra bodyExtra = do

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

147− configs <- liftIO $ Map.fromList <$> getFrontendConfigs

146+ configs <- liftIO getFrontendConfigs

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

149148 el "html" $ do

150149 el "head" $ do