@@ -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,28 +39,36 @@ 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, WatchConfig(..))
55+import qualified System.Info as SysInfo
4056import System.IO.Temp
4157import System.IO.Unsafe (unsafePerformIO)
4258import System.PosixCompat.Files
4359import System.PosixCompat.Types
4460import System.PosixCompat.User
61+import qualified System.Process as Proc
4562import Text.ShellEscape (bash, bytes)
4663
4764import GitHub.Data.GitData (Branch)
4865import GitHub.Data.Name (Name)
4966
50−import Obelisk.App (MonadObelisk)
67+import Obelisk.App (MonadObelisk, runObelisk, getObelisk)
5168import Obelisk.CliApp
5269import Obelisk.Command.Nix
5370import Obelisk.Command.Thunk
54−import Obelisk.Command.Utils (nixBuildExePath, nixExePath, toNixPath, cp, nixShellPath)
71+import Obelisk.Command.Utils (nixBuildExePath, nixExePath, toNixPath, cp, nixShellPath, lnPath)
5572
5673--TODO: Make this module resilient to random exceptions
5774
@@ -334,7 +351,21 @@ nixShellWithHoogle root isPure shell' command = do
334351 \})).project.shells.${shell}"
335352 & nixShellConfig_common . nixCmdConfig_args .~ [ strArg "shell" shell' ]
336353
337−findProjectAssets :: MonadObelisk m => FilePath -> m Text
354+-- | Describes the provenance of static assets (i.e., are they the result of a derivation
355+-- that was built, or just a folder full of files.
356+data AssetSource = AssetSource_Derivation
357+ | AssetSource_Files
358+ deriving (Eq)
359+
360+-- | Some log messages to make it easier to tell where static files are coming from
361+describeImpureAssetSource :: AssetSource -> Text -> Text
362+describeImpureAssetSource src path = case src of
363+ AssetSource_Files -> "Assets impurely loaded from: " <> path
364+ AssetSource_Derivation -> "Assets derivation built and impurely loaded from: " <> path
365+
366+-- | Determine where the static files of a project are and whether they're plain files or a derivation.
367+-- If they are a derivation, that derivation will be built.
368+findProjectAssets :: MonadObelisk m => FilePath -> m (AssetSource, Text)
338369findProjectAssets root = do
339370 isDerivation <- readProcessAndLogStderr Debug $ setCwd (Just root) $
340371 proc nixExePath
@@ -346,10 +377,95 @@ findProjectAssets root = do
346377 ]
347378 -- Check whether the impure static files are a derivation (and so must be built)
348379 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"
380+ then do
381+ _ <- buildStaticFilesDerivationAndSymlink
382+ (readProcessAndLogStderr Debug)
383+ root
384+ pure (AssetSource_Derivation, T.pack $ root </> "static.out")
385+ else fmap (AssetSource_Files,) $ do
386+ path <- readProcessAndLogStderr Debug $ setCwd (Just root) $
387+ proc nixExePath ["eval", "-f", ".", "passthru.staticFilesImpure", "--raw"]
388+ _ <- readProcessAndLogStderr Debug $ setCwd (Just root) $
389+ proc lnPath ["-sfT", T.unpack path, "./static.out"]
390+ pure path
391+
392+-- | Get the nix store path to the generated static asset manifest module (e.g., "obelisk-generated-static")
393+getHaskellManifestProjectPath :: MonadObelisk m => FilePath -> m Text
394+getHaskellManifestProjectPath root = fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $
395+ proc nixBuildExePath
396+ [ "--no-out-link"
397+ , "-E"
398+ , "(let a = import ./. {}; in a.passthru.processedStatic.haskellManifest)"
399+ ]
400+
401+-- | Watch the project directory for file changes and check whether those file changes
402+-- cause changes in the static files nix derivation. If so, rebuild it.
403+watchStaticFilesDerivation
404+ :: (MonadIO m, MonadObelisk m)
405+ => FilePath
406+ -> m ()
407+watchStaticFilesDerivation root = do
408+ ob <- getObelisk
409+ drv0 <- showDerivation
410+ liftIO $ runHeadlessApp $ do
411+ pb <- getPostBuild
412+ checkForChanges <- batchOccurrences 0.25 =<< watchDirectoryTree
413+ -- On macOS, use the polling backend due to https://github.com/luite/hfsevents/issues/13
414+ (defaultConfig { confUsePolling = SysInfo.os == "darwin", confPollInterval = 250000 })
415+ (root <$ pb)
416+ ((/="static.out") . takeFileName . eventPath)
417+ drv <- performEvent $ ffor checkForChanges $ \_ ->
418+ liftIO $ runObelisk ob showDerivation
419+ drvs <- foldDyn (\new (_, old, _) -> (old, new, old /= new)) (drv0, drv0, False) drv
420+ void $ throttleBatchWithLag
421+ (\e -> performEvent $ ffor e $ \_ -> liftIO $ runObelisk ob $ do
422+ putLog Notice "Static assets being built..."
423+ buildStaticCatchErrors >>= \case
424+ Nothing -> pure ()
425+ Just _ -> putLog Notice "Static assets built and symlinked to static.out"
426+ )
427+ ((() <$) . ffilter (\x -> isJust (x ^._2) && x ^._3) $ updated drvs)
428+ pure never
429+ where
430+ handleBuildFailure
431+ :: MonadObelisk m
432+ => (ExitCode, String, String)
433+ -> m (Maybe Text)
434+ handleBuildFailure (ex, out, err) = case ex of
435+ ExitSuccess -> pure $ Just $ T.pack out
436+ _ -> do
437+ putLog Error $
438+ ("Static assets build failed: " <>) $
439+ T.unlines $ reverse $ take 10 $ reverse $ T.lines $ T.pack err
440+ pure Nothing
441+ showDerivation :: MonadObelisk m => m (Maybe Text)
442+ showDerivation =
443+ handleBuildFailure <=< readCreateProcessWithExitCode $
444+ setCwd (Just root) $ ProcessSpec
445+ { _processSpec_createProcess = Proc.proc nixExePath
446+ [ "show-derivation"
447+ , "-f", "."
448+ , "passthru.staticFilesImpure"
449+ ]
450+ , _processSpec_overrideEnv = Nothing
451+ }
452+ buildStaticCatchErrors :: MonadObelisk m => m (Maybe Text)
453+ buildStaticCatchErrors = handleBuildFailure =<<
454+ buildStaticFilesDerivationAndSymlink
455+ readCreateProcessWithExitCode
456+ root
457+
458+buildStaticFilesDerivationAndSymlink
459+ :: MonadObelisk m
460+ => (ProcessSpec -> m a)
461+ -> FilePath
462+ -> m a
463+buildStaticFilesDerivationAndSymlink f root = f $
464+ setCwd (Just root) $ ProcessSpec
465+ { _processSpec_createProcess = Proc.proc
466+ nixBuildExePath
467+ [ "-o", "static.out"
352468 , "-E", "(import ./. {}).passthru.staticFilesImpure"
353469 ]
354− else readProcessAndLogStderr Debug $ setCwd (Just root) $
355− proc nixExePath ["eval", "-f", ".", "passthru.staticFilesImpure", "--raw"]
470+ , _processSpec_overrideEnv = Nothing
471+ }