@@ -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
@@ -16,12 +19,18 @@ module Obelisk.Command.Project
1619 , toObeliskDir
1720 , withProjectRoot
1821 , bashEscape
22+ , getHaskellManifestProjectPath
23+ , AssetSource(..)
24+ , describeImpureAssetSource
25+ , watchStaticFilesDerivation
1926 ) where
2027
2128import Control.Concurrent.MVar (MVar, newMVar, withMVarMasked)
22−import Control.Lens ((.~), (?~), (<&>))
29+import Control.Lens ((.~), (?~), (<&>), (^.), _2, _3)
2330import Control.Monad
31+import Control.Monad.Except
2432import Control.Monad.IO.Class (liftIO)
33+import Control.Monad.Log
2534import Control.Monad.State
2635import qualified Data.Aeson as Json
2736import qualified Data.ByteString.UTF8 as BSU
@@ -30,24 +39,31 @@ import qualified Data.ByteString.Lazy as BSL
3039import Data.Default (def)
3140import Data.Function ((&), on)
3241import Data.Map (Map)
42+import Data.Maybe (isJust)
3343import Data.Text (Text)
3444import qualified Data.Text as T
3545import Data.Text.Encoding (decodeUtf8, encodeUtf8)
3646import Data.Traversable (for)
47+import Reflex
48+import Reflex.FSNotify
49+import Reflex.Host.Headless
3750import System.Directory
3851import System.Environment (lookupEnv)
52+import System.Exit (ExitCode(..))
3953import System.FilePath
54+import System.FSNotify (defaultConfig, eventPath)
4055import System.IO.Temp
4156import System.IO.Unsafe (unsafePerformIO)
4257import System.PosixCompat.Files
4358import System.PosixCompat.Types
4459import System.PosixCompat.User
60+import qualified System.Process as Proc
4561import Text.ShellEscape (bash, bytes)
4662
4763import GitHub.Data.GitData (Branch)
4864import GitHub.Data.Name (Name)
4965
50−import Obelisk.App (MonadObelisk)
66+import Obelisk.App (MonadObelisk, runObelisk, getObelisk)
5167import Obelisk.CliApp
5268import Obelisk.Command.Nix
5369import Obelisk.Command.Thunk
@@ -334,7 +350,21 @@ nixShellWithHoogle root isPure shell' command = do
334350 \})).project.shells.${shell}"
335351 & nixShellConfig_common . nixCmdConfig_args .~ [ strArg "shell" shell' ]
336352
337−findProjectAssets :: MonadObelisk m => FilePath -> m Text
353+-- | Describes the provenance of static assets (i.e., are they the result of a derivation
354+-- that was built, or just a folder full of files.
355+data AssetSource = AssetSource_Derivation
356+ | AssetSource_Files
357+ deriving (Eq)
358+
359+-- | Some log messages to make it easier to tell where static files are coming from
360+describeImpureAssetSource :: AssetSource -> Text -> Text
361+describeImpureAssetSource src path = case src of
362+ AssetSource_Files -> "Assets impurely loaded from: " <> path
363+ AssetSource_Derivation -> "Assets derivation built and impurely loaded from: " <> path
364+
365+-- | Determine where the static files of a project are and whether they're plain files or a derivation.
366+-- If they are a derivation, that derivation will be built.
367+findProjectAssets :: MonadObelisk m => FilePath -> m (AssetSource, Text)
338368findProjectAssets root = do
339369 isDerivation <- readProcessAndLogStderr Debug $ setCwd (Just root) $
340370 proc nixExePath
@@ -346,10 +376,90 @@ findProjectAssets root = do
346376 ]
347377 -- Check whether the impure static files are a derivation (and so must be built)
348378 if isDerivation == "1"
349− then fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $ -- Strip whitespace here because nix-build has no --raw option
350− proc nixBuildExePath
351− [ "--no-out-link"
379+ then do
380+ _ <- buildStaticFilesDerivationAndSymlink
381+ (readProcessAndLogStderr Debug)
382+ root
383+ pure (AssetSource_Derivation, T.pack $ root </> "static.out")
384+ else fmap (AssetSource_Files,) $ readProcessAndLogStderr Debug $ setCwd (Just root) $
385+ proc nixExePath ["eval", "-f", ".", "passthru.staticFilesImpure", "--raw"]
386+
387+-- | Get the nix store path to the generated static asset manifest module (e.g., "obelisk-generated-static")
388+getHaskellManifestProjectPath :: MonadObelisk m => FilePath -> m Text
389+getHaskellManifestProjectPath root = fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $
390+ proc nixBuildExePath
391+ [ "--no-out-link"
392+ , "-E"
393+ , "(let a = import ./. {}; in a.passthru.processedStatic.haskellManifest)"
394+ ]
395+
396+-- | Watch the project directory for file changes and check whether those file changes
397+-- cause changes in the static files nix derivation. If so, rebuild it.
398+watchStaticFilesDerivation
399+ :: (MonadIO m, MonadObelisk m)
400+ => FilePath
401+ -> m ()
402+watchStaticFilesDerivation root = do
403+ ob <- getObelisk
404+ drv0 <- showDerivation
405+ liftIO $ runHeadlessApp $ do
406+ pb <- getPostBuild
407+ checkForChanges <- batchOccurrences 0.25 =<< watchDirectoryTree
408+ defaultConfig
409+ (root <$ pb)
410+ ((/="static.out") . takeFileName . eventPath)
411+ drv <- performEvent $ ffor checkForChanges $ \_ ->
412+ liftIO $ runObelisk ob showDerivation
413+ drvs <- foldDyn (\new (_, old, _) -> (old, new, old /= new)) (drv0, drv0, False) drv
414+ void $ throttleBatchWithLag
415+ (\e -> performEvent $ ffor e $ \_ -> liftIO $ runObelisk ob $ do
416+ putLog Notice "Static assets being built..."
417+ buildStaticCatchErrors >>= \case
418+ Nothing -> pure ()
419+ Just _ -> putLog Notice "Static assets built and symlinked to static.out"
420+ )
421+ ((() <$) . ffilter (\x -> isJust (x ^._2) && x ^._3) $ updated drvs)
422+ pure never
423+ where
424+ handleBuildFailure
425+ :: MonadObelisk m
426+ => (ExitCode, String, String)
427+ -> m (Maybe Text)
428+ handleBuildFailure (ex, out, err) = case ex of
429+ ExitSuccess -> pure $ Just $ T.pack out
430+ _ -> do
431+ putLog Error $
432+ ("Static assets build failed: " <>) $
433+ T.unlines $ reverse $ take 10 $ reverse $ T.lines $ T.pack err
434+ pure Nothing
435+ showDerivation :: MonadObelisk m => m (Maybe Text)
436+ showDerivation =
437+ handleBuildFailure <=< readCreateProcessWithExitCode $
438+ setCwd (Just root) $ ProcessSpec
439+ { _processSpec_createProcess = Proc.proc nixExePath
440+ [ "show-derivation"
441+ , "-f", "."
442+ , "passthru.staticFilesImpure"
443+ ]
444+ , _processSpec_overrideEnv = Nothing
445+ }
446+ buildStaticCatchErrors :: MonadObelisk m => m (Maybe Text)
447+ buildStaticCatchErrors = handleBuildFailure =<<
448+ buildStaticFilesDerivationAndSymlink
449+ readCreateProcessWithExitCode
450+ root
451+
452+buildStaticFilesDerivationAndSymlink
453+ :: MonadObelisk m
454+ => (ProcessSpec -> m a)
455+ -> FilePath
456+ -> m a
457+buildStaticFilesDerivationAndSymlink f root = f $
458+ setCwd (Just root) $ ProcessSpec
459+ { _processSpec_createProcess = Proc.proc
460+ nixBuildExePath
461+ [ "-o", "static.out"
352462 , "-E", "(import ./. {}).passthru.staticFilesImpure"
353463 ]
354− else readProcessAndLogStderr Debug $ setCwd (Just root) $
355− proc nixExePath ["eval", "-f", ".", "passthru.staticFilesImpure", "--raw"]
464+ , _processSpec_overrideEnv = Nothing
465+ }