@@ -1,6 +1,9 @@
11{-# LANGUAGE FlexibleContexts #-}
22{-# LANGUAGE LambdaCase #-}
33{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE ScopedTypeVariables #-}
5+{-# LANGUAGE TupleSections #-}
6+
47module Obelisk.Command.Project
58 ( InitSource (..)
69 , findProjectObeliskCommand
@@ -17,12 +20,16 @@ module Obelisk.Command.Project
1720 , withProjectRoot
1821 , bashEscape
1922 , getHaskellManifestProjectPath
23+ , AssetSource(..)
24+ , describeImpureAssetSource
25+ , watchStaticFilesDerivation
2026 ) where
2127
2228import Control.Concurrent.MVar (MVar, newMVar, withMVarMasked)
23−import Control.Lens ((.~), (?~), (<&>))
29+import Control.Lens ((.~), (?~), (<&>), (^.), _3)
2430import Control.Monad
2531import Control.Monad.IO.Class (liftIO)
32+import Control.Monad.Log
2633import Control.Monad.State
2734import qualified Data.Aeson as Json
2835import qualified Data.ByteString.UTF8 as BSU
@@ -35,14 +42,19 @@ import Data.Text (Text)
3542import qualified Data.Text as T
3643import Data.Text.Encoding (decodeUtf8, encodeUtf8)
3744import Data.Traversable (for)
45+import Reflex
46+import Reflex.FSNotify
47+import Reflex.Host.Headless
3848import System.Directory
3949import System.Environment (lookupEnv)
4050import System.FilePath
51+import System.FSNotify (defaultConfig)
4152import System.IO.Temp
4253import System.IO.Unsafe (unsafePerformIO)
4354import System.PosixCompat.Files
4455import System.PosixCompat.Types
4556import System.PosixCompat.User
57+import qualified System.Process as Proc
4658import Text.ShellEscape (bash, bytes)
4759
4860import GitHub.Data.GitData (Branch)
@@ -335,7 +347,21 @@ nixShellWithHoogle root isPure shell' command = do
335347 \})).project.shells.${shell}"
336348 & nixShellConfig_common . nixCmdConfig_args .~ [ strArg "shell" shell' ]
337349
338−findProjectAssets :: MonadObelisk m => FilePath -> m Text
350+-- | Describes the provenance of static assets (i.e., are they the result of a derivation
351+-- that was built, or just a folder full of files.
352+data AssetSource = AssetSource_Derivation
353+ | AssetSource_Files
354+ deriving (Eq)
355+
356+-- | Some log messages to make it easier to tell where static files are coming from
357+describeImpureAssetSource :: AssetSource -> Text -> Text
358+describeImpureAssetSource src path = case src of
359+ AssetSource_Files -> "Assets impurely loaded from: " <> path
360+ AssetSource_Derivation -> "Assets derivation built and impurely loaded from: " <> path
361+
362+-- | Determine where the static files of a project are and whether they're plain files or a derivation.
363+-- If they are a derivation, that derivation will be built.
364+findProjectAssets :: MonadObelisk m => FilePath -> m (AssetSource, Text)
339365findProjectAssets root = do
340366 isDerivation <- readProcessAndLogStderr Debug $ setCwd (Just root) $
341367 proc nixExePath
@@ -349,14 +375,13 @@ findProjectAssets root = do
349375 if isDerivation == "1"
350376 then do
351377 _ <- readProcessAndLogStderr Debug $ setCwd (Just root) $
352− proc nixBuildExePath
353− [ "-o", "static.out"
354− , "-E", "(import ./. {}).passthru.staticFilesImpure"
355− ]
356− pure $ T.pack $ root </> "static.out"
357− else readProcessAndLogStderr Debug $ setCwd (Just root) $
378+ proc nixBuildExePath staticFilesDrvSymlinkArgs
379+
380+ pure (AssetSource_Derivation, T.pack $ root </> "static.out")
381+ else fmap (AssetSource_Files,) $ readProcessAndLogStderr Debug $ setCwd (Just root) $
358382 proc nixExePath ["eval", "-f", ".", "passthru.staticFilesImpure", "--raw"]
359383
384+-- | Get the nix store path to the generated static asset manifest module (e.g., "obelisk-generated-static")
360385getHaskellManifestProjectPath :: MonadObelisk m => FilePath -> m Text
361386getHaskellManifestProjectPath root = fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $
362387 proc nixBuildExePath
@@ -364,3 +389,43 @@ getHaskellManifestProjectPath root = fmap T.strip $ readProcessAndLogStderr Debu
364389 , "-E"
365390 , "(let a = import ./. {}; in a.passthru.processedStatic.haskellManifest)"
366391 ]
392+
393+staticFilesDrvSymlinkArgs :: [String]
394+staticFilesDrvSymlinkArgs =
395+ [ "-o", "static.out"
396+ , "-E", "(import ./. {}).passthru.staticFilesImpure"
397+ ]
398+
399+-- | Watch the project directory for file changes and check whether those file changes
400+-- cause changes in the static files nix derivation. If so, rebuild it.
401+watchStaticFilesDerivation
402+ :: MonadObelisk m
403+ => FilePath
404+ -> m ()
405+watchStaticFilesDerivation root = do
406+ cfg <- getCliConfig
407+ drv0 <- liftIO runShowDrv
408+ liftIO $ runHeadlessApp $ do
409+ pb <- getPostBuild
410+ checkForChanges <- watchDirectoryTree defaultConfig (root <$ pb) (const True)
411+ drv <- performEvent $ liftIO runShowDrv <$ checkForChanges
412+ drvs <- foldDyn (\new (_, old, _) -> (old, new, old /= new)) (drv0, drv0, False) drv
413+ out <- throttleBatchWithLag
414+ (\e -> performEvent $ ffor e $ \_ -> liftIO $ void runDrvBuild)
415+ (void $ ffilter (^._3) $ updated drvs)
416+ performEvent_ $ ffor out $ \_ ->
417+ runCli cfg $
418+ putLog Informational "Static assets rebuilt and symlinked to static.out"
419+ pure never
420+ where
421+ showDrv :: Proc.CreateProcess
422+ showDrv = (Proc.proc nixExePath
423+ [ "show-derivation"
424+ , "-f", "."
425+ , "passthru.staticFilesImpure"
426+ ]) { Proc.cwd = Just root }
427+ runShowDrv :: IO String
428+ runShowDrv = Proc.readCreateProcess showDrv ""
429+ runDrvBuild :: IO String
430+ runDrvBuild = Proc.readCreateProcess
431+ ((Proc.proc nixBuildExePath staticFilesDrvSymlinkArgs) { Proc.cwd = Just root }) ""