Yesod.EmbeddedStatic.Vite

Vite.hs

-- Copyright 2026 Steven Shuck.
-- Distributed under the GPLv3+.

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}

module Yesod.EmbeddedStatic.Vite (
    embedVite,
) where

import           Control.Monad              (forM, unless)
import           Data.Aeson
import qualified Data.Aeson.Key             as Key
import qualified Data.Aeson.KeyMap          as KeyMap
import           Data.Aeson.TH              (deriveFromJSON)
import           Data.Aeson.Types           (JSONPathElement(Key), Parser)
import           Data.Text                  (Text)
import           Language.Haskell.TH.Syntax (addDependentFile, runIO)
import           System.FilePath            ((</>))
import           Yesod.EmbeddedStatic       (embedFileAt, pathToName)
import           Yesod.EmbeddedStatic.Types (Generator, ebHaskellName)

data ViteManifestEntry = ViteManifestEntry{
    file    :: FilePath,
    isEntry :: Bool,
    src     :: FilePath}
deriveFromJSON defaultOptions ''ViteManifestEntry

-- TODO Move to shared module
withEntries :: Object -> (Text -> Value -> Parser a) -> Parser [a]
withEntries o f = forM (KeyMap.toList o) $ \(k, v) ->
    f (Key.toText k) v <?> Key k

newtype ViteManifest = ViteManifest{
    viteManifestEntries :: [ViteManifestEntry]}
instance FromJSON ViteManifest where
    parseJSON = withObject "Vite manifest" $ \o ->
        fmap ViteManifest $ withEntries o $ \_ v -> do
            entry <- parseJSON v
            unless (isEntry entry) $ fail "isEntry is false"
            return entry

-- | Use the manifest file in a given Vite dist dir to embed files whose names
-- change based on content hashes, but strip the content hashes from the
-- generated Haskell `Route` identifiers to keep them stable.  When the manifest
-- changes, re-run.
embedVite :: FilePath -> Generator
embedVite distDir = do
    let manifestPath = distDir </> ".vite/manifest.json"
    addDependentFile manifestPath
    ViteManifest{..} <- runIO (eitherDecodeFileStrict manifestPath) >>= \case
        Left msg       -> fail $ manifestPath ++ ": " ++ msg
        Right manifest -> return manifest

    fmap concat $ forM viteManifestEntries $ \ViteManifestEntry{..} -> do
        let pathFromCwd = distDir </> file
            stabilize entry = entry{
                ebHaskellName = Just $ pathToName src}
        map stabilize <$> embedFileAt file pathFromCwd