@@ -1,9 +1,6 @@
11{-# LANGUAGE FlexibleContexts #-}
22{-# LANGUAGE LambdaCase #-}
33{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE ScopedTypeVariables #-}
5−{-# LANGUAGE TupleSections #-}
6−
74module Obelisk.Command.Project
85 ( InitSource (..)
96 , findProjectObeliskCommand
@@ -19,58 +16,42 @@ module Obelisk.Command.Project
1916 , toObeliskDir
2017 , withProjectRoot
2118 , bashEscape
22− , getHaskellManifestProjectPath
23− , AssetSource(..)
24− , describeImpureAssetSource
25− , watchStaticFilesDerivation
2619 ) where
2720
2821import Control.Concurrent.MVar (MVar, newMVar, withMVarMasked)
2922import Control.Lens ((.~), (?~), (<&>))
3023import Control.Monad
31−import Control.Monad.Except
3224import Control.Monad.IO.Class (liftIO)
33−import Control.Monad.Log
3425import Control.Monad.State
3526import qualified Data.Aeson as Json
3627import qualified Data.ByteString.UTF8 as BSU
3728import Data.Bits
3829import qualified Data.ByteString.Lazy as BSL
3930import Data.Default (def)
40−import qualified Data.Foldable as F (toList)
4131import Data.Function ((&), on)
42−import Data.List (isPrefixOf)
4332import Data.Map (Map)
44−import qualified Data.Set as Set
4533import Data.Text (Text)
4634import qualified Data.Text as T
4735import Data.Text.Encoding (decodeUtf8, encodeUtf8)
4836import Data.Traversable (for)
49−import Reflex
50−import Reflex.FSNotify
51−import Reflex.Host.Headless
5237import System.Directory
5338import System.Environment (lookupEnv)
54−import System.Exit (ExitCode(..))
5539import System.FilePath
56−import System.FSNotify (defaultConfig, eventPath, WatchConfig(..))
57−import qualified System.Info as SysInfo
5840import System.IO.Temp
5941import System.IO.Unsafe (unsafePerformIO)
6042import System.PosixCompat.Files
6143import System.PosixCompat.Types
6244import System.PosixCompat.User
63−import qualified System.Process as Proc
6445import Text.ShellEscape (bash, bytes)
6546
6647import GitHub.Data.GitData (Branch)
6748import GitHub.Data.Name (Name)
6849
69−import Obelisk.App (MonadObelisk, runObelisk, getObelisk)
50+import Obelisk.App (MonadObelisk)
7051import Obelisk.CliApp
7152import Obelisk.Command.Nix
7253import Obelisk.Command.Thunk
73−import Obelisk.Command.Utils (nixBuildExePath, nixExePath, toNixPath, cp, nixShellPath, lnPath)
54+import Obelisk.Command.Utils (nixBuildExePath, nixExePath, toNixPath, cp, nixShellPath)
7455
7556--TODO: Make this module resilient to random exceptions
7657
@@ -353,21 +334,7 @@ nixShellWithHoogle root isPure shell' command = do
353334 \})).project.shells.${shell}"
354335 & nixShellConfig_common . nixCmdConfig_args .~ [ strArg "shell" shell' ]
355336
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)
337+findProjectAssets :: MonadObelisk m => FilePath -> m Text
371338findProjectAssets root = do
372339 isDerivation <- readProcessAndLogStderr Debug $ setCwd (Just root) $
373340 proc nixExePath
@@ -379,125 +346,10 @@ findProjectAssets root = do
379346 ]
380347 -- Check whether the impure static files are a derivation (and so must be built)
381348 if isDerivation == "1"
382− then do
383− _ <- buildStaticFilesDerivationAndSymlink
384− (readProcessAndLogStderr Debug)
385− root
386− pure (AssetSource_Derivation, T.pack $ root </> "static.out")
387− else fmap (AssetSource_Files,) $ do
388− path <- readProcessAndLogStderr Debug $ setCwd (Just root) $
389− proc nixExePath ["eval", "-f", ".", "passthru.staticFilesImpure", "--raw"]
390− _ <- readProcessAndLogStderr Debug $ setCwd (Just root) $
391− proc lnPath ["-s", "-f", T.unpack path, "static.out"]
392− pure path
393−
394−-- | Get the nix store path to the generated static asset manifest module (e.g., "obelisk-generated-static")
395−getHaskellManifestProjectPath :: MonadObelisk m => FilePath -> m Text
396−getHaskellManifestProjectPath root = fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $
397− proc nixBuildExePath
398− [ "--no-out-link"
399− , "-E"
400− , "(let a = import ./. {}; in a.passthru.processedStatic.haskellManifest)"
401− ]
402−
403−-- | Watch the project directory for file changes and check whether those file changes
404−-- cause changes in the static files nix derivation. If so, rebuild it.
405−watchStaticFilesDerivation
406− :: (MonadIO m, MonadObelisk m)
407− => FilePath
408− -> m ()
409−watchStaticFilesDerivation root = do
410− ob <- getObelisk
411− liftIO $ runHeadlessApp $ do
412− pb <- getPostBuild
413− let filterEvents x =
414− let fn = takeFileName x
415− dirs = Set.fromList $ splitDirectories x
416− ignoredFilenames = Set.fromList
417− [ "ghcid-output.txt"
418− , ".cabal-sandbox"
419− , "cabal.sandbox.config"
420− , ".attr-cache"
421− , "result"
422− , "ctags"
423− , "tags"
424− , "TAGS"
425− , "cabal.project.local"
426− , "4913" -- Vim temporary file
427− ]
428− ignoredDirectories = Set.fromList
429− [ ".git"
430− , "dist"
431− , "dist-newstyle"
432− , "profile"
433− ]
434− ignoredExtensions = Set.fromList
435− [ ".hi"
436− , ".o"
437− , ".swo"
438− , ".swp"
439− ]
440− in not $
441− "static.out" `isPrefixOf` fn ||
442− "result-" `isPrefixOf` fn ||
443− fn `Set.member` ignoredFilenames ||
444− takeExtension fn `Set.member` ignoredExtensions ||
445− not (Set.null $ Set.intersection ignoredDirectories dirs)
446−
447− checkForChanges <- batchOccurrences 0.25 =<< watchDirectoryTree
448− -- On macOS, use the polling backend due to https://github.com/luite/hfsevents/issues/13
449− (defaultConfig { confUsePolling = SysInfo.os == "darwin", confPollInterval = 250000 })
450− (root <$ pb)
451− (filterEvents . eventPath)
452− performEvent_
453− $ liftIO
454− . runObelisk ob
455− . putLog Debug
456− . ("Regenerating static.out due to file changes: "<>)
457− . T.intercalate ", "
458− . fmap (T.pack . eventPath)
459− . F.toList
460− <$> checkForChanges
461− void $ flip throttleBatchWithLag checkForChanges $ \e ->
462− performEvent $ ffor e $ \_ -> liftIO $ runObelisk ob $ do
463− putLog Notice "Static assets being built..."
464− buildStaticCatchErrors >>= \case
465− Nothing -> pure ()
466− Just n -> do
467− putLog Notice $ "Static assets built and symlinked to static.out"
468− putLog Debug $ "Generated static asset nix path: " <> n
469− pure never
470− where
471− handleBuildFailure
472− :: MonadObelisk m
473− => (ExitCode, String, String)
474− -> m (Maybe Text)
475− handleBuildFailure (ex, out, err) = case ex of
476− ExitSuccess ->
477− let out' = T.strip $ T.pack out
478− in pure $ if T.null out' then Nothing else Just out'
479− _ -> do
480− putLog Error $
481− ("Static assets build failed: " <>) $
482− T.unlines $ reverse $ take 20 $ reverse $ T.lines $ T.pack err
483− pure Nothing
484− buildStaticCatchErrors :: MonadObelisk m => m (Maybe Text)
485− buildStaticCatchErrors = handleBuildFailure =<<
486− buildStaticFilesDerivationAndSymlink
487− readCreateProcessWithExitCode
488− root
489−
490−buildStaticFilesDerivationAndSymlink
491− :: MonadObelisk m
492− => (ProcessSpec -> m a)
493− -> FilePath
494− -> m a
495−buildStaticFilesDerivationAndSymlink f root = f $
496− setCwd (Just root) $ ProcessSpec
497− { _processSpec_createProcess = Proc.proc
498− nixBuildExePath
499− [ "-o", "static.out"
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"
500352 , "-E", "(import ./. {}).passthru.staticFilesImpure"
501353 ]
502− , _processSpec_overrideEnv = Nothing
503− }
354+ else readProcessAndLogStderr Debug $ setCwd (Just root) $
355+ proc nixExePath ["eval", "-f", ".", "passthru.staticFilesImpure", "--raw"]