@@ -26,7 +26,7 @@ module Obelisk.Command.Project
2626 ) where
2727
2828import Control.Concurrent.MVar (MVar, newMVar, withMVarMasked)
29−import Control.Lens ((.~), (?~), (<&>), (^.), _2, _3)
29+import Control.Lens ((.~), (?~), (<&>))
3030import Control.Monad
3131import Control.Monad.Except
3232import Control.Monad.IO.Class (liftIO)
@@ -37,9 +37,11 @@ import qualified Data.ByteString.UTF8 as BSU
3737import Data.Bits
3838import qualified Data.ByteString.Lazy as BSL
3939import Data.Default (def)
40+import qualified Data.Foldable as F (toList)
4041import Data.Function ((&), on)
42+import Data.List (isPrefixOf)
4143import Data.Map (Map)
42−import Data.Maybe (isJust)
44+import qualified Data.Set as Set
4345import Data.Text (Text)
4446import qualified Data.Text as T
4547import Data.Text.Encoding (decodeUtf8, encodeUtf8)
@@ -402,25 +404,64 @@ watchStaticFilesDerivation
402404 -> m ()
403405watchStaticFilesDerivation root = do
404406 ob <- getObelisk
405− drv0 <- showDerivation
406407 liftIO $ runHeadlessApp $ do
407408 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+
408443 checkForChanges <- batchOccurrences 0.25 =<< watchDirectoryTree
409444 -- On macOS, use the polling backend due to https://github.com/luite/hfsevents/issues/13
410445 (defaultConfig { confUsePolling = SysInfo.os == "darwin", confPollInterval = 250000 })
411446 (root <$ pb)
412− ((/="static.out") . takeFileName . eventPath)
413− drv <- performEvent $ ffor checkForChanges $ \_ ->
414− liftIO $ runObelisk ob showDerivation
415− drvs <- foldDyn (\new (_, old, _) -> (old, new, old /= new)) (drv0, drv0, False) drv
416− void $ throttleBatchWithLag
417− (\e -> performEvent $ ffor e $ \_ -> liftIO $ runObelisk ob $ do
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
418459 putLog Notice "Static assets being built..."
419460 buildStaticCatchErrors >>= \case
420461 Nothing -> pure ()
421− Just _ -> putLog Notice "Static assets built and symlinked to static.out"
422− )
423− ((() <$) . ffilter (\x -> isJust (x ^._2) && x ^._3) $ updated drvs)
462+ Just n -> do
463+ putLog Notice $ "Static assets built and symlinked to static.out"
464+ putLog Debug $ "Generated static asset nix path: " <> n
424465 pure never
425466 where
426467 handleBuildFailure
@@ -428,23 +469,14 @@ watchStaticFilesDerivation root = do
428469 => (ExitCode, String, String)
429470 -> m (Maybe Text)
430471 handleBuildFailure (ex, out, err) = case ex of
431− ExitSuccess -> pure $ Just $ T.pack out
472+ ExitSuccess ->
473+ let out' = T.strip $ T.pack out
474+ in pure $ if T.null out' then Nothing else Just out'
432475 _ -> do
433476 putLog Error $
434477 ("Static assets build failed: " <>) $
435− T.unlines $ reverse $ take 10 $ reverse $ T.lines $ T.pack err
478+ T.unlines $ reverse $ take 20 $ reverse $ T.lines $ T.pack err
436479 pure Nothing
437− showDerivation :: MonadObelisk m => m (Maybe Text)
438− showDerivation =
439− handleBuildFailure <=< readCreateProcessWithExitCode $
440− setCwd (Just root) $ ProcessSpec
441− { _processSpec_createProcess = Proc.proc nixExePath
442− [ "show-derivation"
443− , "-f", "."
444− , "passthru.staticFilesImpure"
445− ]
446− , _processSpec_overrideEnv = Nothing
447− }
448480 buildStaticCatchErrors :: MonadObelisk m => m (Maybe Text)
449481 buildStaticCatchErrors = handleBuildFailure =<<
450482 buildStaticFilesDerivationAndSymlink