72 lines
2.3 KiB
Haskell
72 lines
2.3 KiB
Haskell
module Settings.StaticFiles.Webpack
|
|
( mkWebpackEntrypoints
|
|
) where
|
|
|
|
import ClassyPrelude
|
|
|
|
import Language.Haskell.TH
|
|
import Language.Haskell.TH.Syntax hiding (Lift(..))
|
|
import qualified Language.Haskell.TH.Syntax as TH (Lift(..))
|
|
|
|
import qualified Data.Yaml as Yaml
|
|
|
|
import qualified Data.Map as Map
|
|
|
|
import Yesod.Core (Route)
|
|
import Yesod.EmbeddedStatic (EmbeddedStatic)
|
|
import Yesod.EmbeddedStatic.Types
|
|
import Network.Mime (MimeType)
|
|
|
|
import Control.Lens.Indexed (iforM)
|
|
|
|
import Control.Monad.Writer.Class (MonadWriter(..))
|
|
import Control.Monad.Trans.Writer.Lazy (execWriterT)
|
|
import Control.Monad.Catch (MonadThrow(..))
|
|
|
|
import Utils (nubOn)
|
|
|
|
import System.FilePath (makeRelative)
|
|
|
|
|
|
mkWebpackEntrypoints :: FilePath -- ^ Path to YAML-manifest
|
|
-> [FilePath -> Generator]
|
|
-> FilePath -- ^ Path to static dir
|
|
-> DecsQ
|
|
mkWebpackEntrypoints manifest mkGen stDir = do
|
|
addDependentFile manifest
|
|
entrypoints <- decodeManifest manifest
|
|
|
|
staticEntries <- concat <$> mapM ($ stDir) mkGen
|
|
|
|
fmap (concat . Map.elems) . iforM entrypoints $ \entrypoint files -> do
|
|
entries <- execWriterT . forM_ files $ \file -> do
|
|
let fileEntries = filter (\entry -> makeRelative stDir (ebLocation entry) == file) staticEntries
|
|
forM_ fileEntries $ \entry -> case ebHaskellName entry of
|
|
Nothing -> lift . reportWarning $ concat
|
|
[ "Entry “"
|
|
, ebLocation entry
|
|
, "” of file “"
|
|
, file
|
|
, "” of webpack entrypoint “"
|
|
, entrypoint
|
|
, "” has no haskellName"
|
|
]
|
|
Just n -> tell $ pure (n, ebMimeType entry)
|
|
|
|
let entryName = mkName $ "webpackEntrypoint_" <> entrypoint
|
|
sequence
|
|
[ sigD entryName [t|[(Route EmbeddedStatic, MimeType)]|]
|
|
, funD entryName
|
|
[ clause [] (normalB . listE . map (\(n, mime) -> tupE [varE n, TH.lift mime]) $ nubOn fst entries) []
|
|
]
|
|
]
|
|
where
|
|
decodeManifest :: FilePath -> Q (Map String [FilePath])
|
|
decodeManifest manifest' = do
|
|
res <- liftIO $ Yaml.decodeFileWithWarnings manifest'
|
|
case res of
|
|
Left exc -> throwM exc
|
|
Right (ws, res') -> res' <$ mapM_ (\w -> reportWarning $ "Warning while parsing webpack manifest: " <> show w) ws
|
|
|
|
|