@@ -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,38 +19,54 @@ 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)
2229import Control.Lens ((.~), (?~), (<&>))
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
2837import Data.Bits
2938import qualified Data.ByteString.Lazy as BSL
3039import Data.Default (def)
40+import qualified Data.Foldable as F (toList)
3141import Data.Function ((&), on)
42+import Data.List (isPrefixOf)
3243import Data.Map (Map)
44+import qualified Data.Set as Set
3345import Data.Text (Text)
3446import qualified Data.Text as T
3547import Data.Text.Encoding (decodeUtf8, encodeUtf8)
3648import Data.Traversable (for)
49+import Reflex
50+import Reflex.FSNotify
51+import Reflex.Host.Headless
3752import System.Directory
3853import System.Environment (lookupEnv)
54+import System.Exit (ExitCode(..))
3955import System.FilePath
56+import System.FSNotify (defaultConfig, eventPath, WatchConfig(..))
57+import qualified System.Info as SysInfo
4058import System.IO.Temp
4159import System.IO.Unsafe (unsafePerformIO)
4260import System.PosixCompat.Files
4361import System.PosixCompat.Types
4462import System.PosixCompat.User
63+import qualified System.Process as Proc
4564import Text.ShellEscape (bash, bytes)
4665
4766import GitHub.Data.GitData (Branch)
4867import GitHub.Data.Name (Name)
4968
50−import Obelisk.App (MonadObelisk)
69+import Obelisk.App (MonadObelisk, runObelisk, getObelisk)
5170import Obelisk.CliApp
5271import Obelisk.Command.Nix
5372import Obelisk.Command.Thunk
@@ -334,7 +353,21 @@ nixShellWithHoogle root isPure shell' command = do
334353 \})).project.shells.${shell}"
335354 & nixShellConfig_common . nixCmdConfig_args .~ [ strArg "shell" shell' ]
336355
337−findProjectAssets :: MonadObelisk m => FilePath -> m Text
356+-- | Describes the provenance of static assets (i.e., are they the result of a derivation
357+-- that was built, or just a folder full of files.
358+data AssetSource = AssetSource_Derivation
359+ | AssetSource_Files
360+ deriving (Eq)
361+
362+-- | Some log messages to make it easier to tell where static files are coming from
363+describeImpureAssetSource :: AssetSource -> Text -> Text
364+describeImpureAssetSource src path = case src of
365+ AssetSource_Files -> "Assets impurely loaded from: " <> path
366+ AssetSource_Derivation -> "Assets derivation built and impurely loaded from: " <> path
367+
368+-- | Determine where the static files of a project are and whether they're plain files or a derivation.
369+-- If they are a derivation, that derivation will be built.
370+findProjectAssets :: MonadObelisk m => FilePath -> m (AssetSource, Text)
338371findProjectAssets root = do
339372 isDerivation <- readProcessAndLogStderr Debug $ setCwd (Just root) $
340373 proc nixExePath
@@ -346,10 +379,121 @@ findProjectAssets root = do
346379 ]
347380 -- Check whether the impure static files are a derivation (and so must be built)
348381 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"
382+ then do
383+ _ <- buildStaticFilesDerivationAndSymlink
384+ (readProcessAndLogStderr Debug)
385+ root
386+ pure (AssetSource_Derivation, T.pack $ root </> "static.out")
387+ else fmap (AssetSource_Files,) $ readProcessAndLogStderr Debug $ setCwd (Just root) $
388+ proc nixExePath ["eval", "-f", ".", "passthru.staticFilesImpure", "--raw"]
389+
390+-- | Get the nix store path to the generated static asset manifest module (e.g., "obelisk-generated-static")
391+getHaskellManifestProjectPath :: MonadObelisk m => FilePath -> m Text
392+getHaskellManifestProjectPath root = fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $
393+ proc nixBuildExePath
394+ [ "--no-out-link"
395+ , "-E"
396+ , "(let a = import ./. {}; in a.passthru.processedStatic.haskellManifest)"
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+ :: (MonadIO m, MonadObelisk m)
403+ => FilePath
404+ -> m ()
405+watchStaticFilesDerivation root = do
406+ ob <- getObelisk
407+ liftIO $ runHeadlessApp $ do
408+ pb <- getPostBuild
409+ let filterEvents x =
410+ let fn = takeFileName x
411+ dirs = Set.fromList $ splitDirectories x
412+ ignoredFilenames = Set.fromList
413+ [ "ghcid-output.txt"
414+ , ".cabal-sandbox"
415+ , "cabal.sandbox.config"
416+ , ".attr-cache"
417+ , "result"
418+ , "ctags"
419+ , "tags"
420+ , "TAGS"
421+ , "cabal.project.local"
422+ , "4913" -- Vim temporary file
423+ ]
424+ ignoredDirectories = Set.fromList
425+ [ ".git"
426+ , "dist"
427+ , "dist-newstyle"
428+ , "profile"
429+ ]
430+ ignoredExtensions = Set.fromList
431+ [ ".hi"
432+ , ".o"
433+ , ".swo"
434+ , ".swp"
435+ ]
436+ in not $
437+ "static.out" `isPrefixOf` fn ||
438+ "result-" `isPrefixOf` fn ||
439+ fn `Set.member` ignoredFilenames ||
440+ takeExtension fn `Set.member` ignoredExtensions ||
441+ not (Set.null $ Set.intersection ignoredDirectories dirs)
442+
443+ checkForChanges <- batchOccurrences 0.25 =<< watchDirectoryTree
444+ -- On macOS, use the polling backend due to https://github.com/luite/hfsevents/issues/13
445+ (defaultConfig { confUsePolling = SysInfo.os == "darwin", confPollInterval = 250000 })
446+ (root <$ pb)
447+ (filterEvents . eventPath)
448+ performEvent_
449+ $ liftIO
450+ . runObelisk ob
451+ . putLog Debug
452+ . ("Regenerating static.out due to file changes: "<>)
453+ . T.intercalate ", "
454+ . fmap (T.pack . eventPath)
455+ . F.toList
456+ <$> checkForChanges
457+ void $ flip throttleBatchWithLag checkForChanges $ \e ->
458+ performEvent $ ffor e $ \_ -> liftIO $ runObelisk ob $ do
459+ putLog Notice "Static assets being built..."
460+ buildStaticCatchErrors >>= \case
461+ Nothing -> pure ()
462+ Just n -> do
463+ putLog Notice $ "Static assets built and symlinked to static.out"
464+ putLog Debug $ "Generated static asset nix path: " <> n
465+ pure never
466+ where
467+ handleBuildFailure
468+ :: MonadObelisk m
469+ => (ExitCode, String, String)
470+ -> m (Maybe Text)
471+ handleBuildFailure (ex, out, err) = case ex of
472+ ExitSuccess ->
473+ let out' = T.strip $ T.pack out
474+ in pure $ if T.null out' then Nothing else Just out'
475+ _ -> do
476+ putLog Error $
477+ ("Static assets build failed: " <>) $
478+ T.unlines $ reverse $ take 20 $ reverse $ T.lines $ T.pack err
479+ pure Nothing
480+ buildStaticCatchErrors :: MonadObelisk m => m (Maybe Text)
481+ buildStaticCatchErrors = handleBuildFailure =<<
482+ buildStaticFilesDerivationAndSymlink
483+ readCreateProcessWithExitCode
484+ root
485+
486+buildStaticFilesDerivationAndSymlink
487+ :: MonadObelisk m
488+ => (ProcessSpec -> m a)
489+ -> FilePath
490+ -> m a
491+buildStaticFilesDerivationAndSymlink f root = f $
492+ setCwd (Just root) $ ProcessSpec
493+ { _processSpec_createProcess = Proc.proc
494+ nixBuildExePath
495+ [ "-o", "static.out"
352496 , "-E", "(import ./. {}).passthru.staticFilesImpure"
353497 ]
354− else readProcessAndLogStderr Debug $ setCwd (Just root) $
355− proc nixExePath ["eval", "-f", ".", "passthru.staticFilesImpure", "--raw"]
498+ , _processSpec_overrideEnv = Nothing
499+ }