@@ -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
@@ -14,24 +11,17 @@ module Obelisk.Command.Project
1411 , nixShellRunProc
1512 , nixShellWithHoogle
1613 , nixShellWithoutPkgs
17− , mkObNixShellProc
1814 , obeliskDirName
1915 , toImplDir
2016 , toObeliskDir
2117 , withProjectRoot
2218 , bashEscape
23− , getHaskellManifestProjectPath
24− , AssetSource(..)
25− , describeImpureAssetSource
26− , watchStaticFilesDerivation
2719 ) where
2820
2921import Control.Concurrent.MVar (MVar, newMVar, withMVarMasked)
30−import Control.Lens ((.~), (?~), (<&>), (^.), _2, _3)
22+import Control.Lens ((.~), (?~), (<&>))
3123import Control.Monad
32−import Control.Monad.Except
3324import Control.Monad.IO.Class (liftIO)
34−import Control.Monad.Log
3525import Control.Monad.State
3626import qualified Data.Aeson as Json
3727import qualified Data.ByteString.UTF8 as BSU
@@ -40,36 +30,28 @@ import qualified Data.ByteString.Lazy as BSL
4030import Data.Default (def)
4131import Data.Function ((&), on)
4232import Data.Map (Map)
43−import Data.Maybe (isJust)
4433import Data.Text (Text)
4534import qualified Data.Text as T
4635import Data.Text.Encoding (decodeUtf8, encodeUtf8)
4736import Data.Traversable (for)
48−import Reflex
49−import Reflex.FSNotify
50−import Reflex.Host.Headless
5137import System.Directory
5238import System.Environment (lookupEnv)
53−import System.Exit (ExitCode(..))
5439import System.FilePath
55−import System.FSNotify (defaultConfig, eventPath, WatchConfig(..))
56−import qualified System.Info as SysInfo
5740import System.IO.Temp
5841import System.IO.Unsafe (unsafePerformIO)
5942import System.PosixCompat.Files
6043import System.PosixCompat.Types
6144import System.PosixCompat.User
62−import qualified System.Process as Proc
6345import Text.ShellEscape (bash, bytes)
6446
6547import GitHub.Data.GitData (Branch)
6648import GitHub.Data.Name (Name)
6749
68−import Obelisk.App (MonadObelisk, runObelisk, getObelisk)
50+import Obelisk.App (MonadObelisk)
6951import Obelisk.CliApp
7052import Obelisk.Command.Nix
7153import Obelisk.Command.Thunk
72−import Obelisk.Command.Utils (nixBuildExePath, nixExePath, toNixPath, cp, nixShellPath, lnPath)
54+import Obelisk.Command.Utils (nixBuildExePath, nixExePath, toNixPath, cp, nixShellPath)
7355
7456--TODO: Make this module resilient to random exceptions
7557
@@ -318,7 +300,7 @@ bashEscape = BSU.toString . bytes . bash . BSU.fromString
318300nixShellRunProc :: NixShellConfig -> ProcessSpec
319301nixShellRunProc cfg = setDelegateCtlc True $ proc nixShellPath $ runNixShellConfig cfg
320302
321−mkObNixShellProc
303+nixShellWithoutPkgs
322304 :: MonadObelisk m
323305 => FilePath -- ^ Path to project root
324306 -> Bool -- ^ Should this be a pure shell?
@@ -326,12 +308,12 @@ mkObNixShellProc
326308 -> Map Text FilePath -- ^ Package names mapped to their paths
327309 -> String -- ^ Shell attribute to use (e.g. @"ghc"@, @"ghcjs"@, etc.)
328310 -> Maybe String -- ^ If 'Just' run the given command; otherwise just open the interactive shell
329− -> m ProcessSpec
330−mkObNixShellProc root isPure chdirToRoot packageNamesAndPaths shellAttr command = do
311+ -> m ()
312+nixShellWithoutPkgs root isPure chdirToRoot packageNamesAndPaths shellAttr command = do
331313 packageNamesAndAbsPaths <- liftIO $ for packageNamesAndPaths makeAbsolute
332314 defShellConfig <- nixShellRunConfig root isPure command
333315 let setCwd_ = if chdirToRoot then setCwd (Just root) else id
334− pure $ setCwd_ $ nixShellRunProc $ defShellConfig
316+ runProcess_ $ setCwd_ $ nixShellRunProc $ defShellConfig
335317 & nixShellConfig_common . nixCmdConfig_target . target_expr ?~
336318 "{root, pkgs, shell}: ((import root {}).passthru.__unstable__.self.extend (_: _: {\
337319 \shellPackages = builtins.fromJSON pkgs;\
@@ -342,18 +324,6 @@ mkObNixShellProc root isPure chdirToRoot packageNamesAndPaths shellAttr command
342324 , strArg "shell" shellAttr
343325 ]
344326
345−nixShellWithoutPkgs
346− :: MonadObelisk m
347− => FilePath -- ^ Path to project root
348− -> Bool -- ^ Should this be a pure shell?
349− -> Bool -- ^ Should we chdir to the package root in the shell?
350− -> Map Text FilePath -- ^ Package names mapped to their paths
351− -> String -- ^ Shell attribute to use (e.g. @"ghc"@, @"ghcjs"@, etc.)
352− -> Maybe String -- ^ If 'Just' run the given command; otherwise just open the interactive shell
353− -> m ()
354−nixShellWithoutPkgs root isPure chdirToRoot packageNamesAndPaths shellAttr command = do
355− runProcess_ =<< mkObNixShellProc root isPure chdirToRoot packageNamesAndPaths shellAttr command
356−
357327nixShellWithHoogle :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()
358328nixShellWithHoogle root isPure shell' command = do
359329 defShellConfig <- nixShellRunConfig root isPure command
@@ -364,21 +334,7 @@ nixShellWithHoogle root isPure shell' command = do
364334 \})).project.shells.${shell}"
365335 & nixShellConfig_common . nixCmdConfig_args .~ [ strArg "shell" shell' ]
366336
367−-- | Describes the provenance of static assets (i.e., are they the result of a derivation
368−-- that was built, or just a folder full of files.
369−data AssetSource = AssetSource_Derivation
370− | AssetSource_Files
371− deriving (Eq)
372−
373−-- | Some log messages to make it easier to tell where static files are coming from
374−describeImpureAssetSource :: AssetSource -> Text -> Text
375−describeImpureAssetSource src path = case src of
376− AssetSource_Files -> "Assets impurely loaded from: " <> path
377− AssetSource_Derivation -> "Assets derivation built and impurely loaded from: " <> path
378−
379−-- | Determine where the static files of a project are and whether they're plain files or a derivation.
380−-- If they are a derivation, that derivation will be built.
381−findProjectAssets :: MonadObelisk m => FilePath -> m (AssetSource, Text)
337+findProjectAssets :: MonadObelisk m => FilePath -> m Text
382338findProjectAssets root = do
383339 isDerivation <- readProcessAndLogStderr Debug $ setCwd (Just root) $
384340 proc nixExePath
@@ -390,95 +346,10 @@ findProjectAssets root = do
390346 ]
391347 -- Check whether the impure static files are a derivation (and so must be built)
392348 if isDerivation == "1"
393− then do
394− _ <- buildStaticFilesDerivationAndSymlink
395− (readProcessAndLogStderr Debug)
396− root
397− pure (AssetSource_Derivation, T.pack $ root </> "static.out")
398− else fmap (AssetSource_Files,) $ do
399− path <- readProcessAndLogStderr Debug $ setCwd (Just root) $
400− proc nixExePath ["eval", "-f", ".", "passthru.staticFilesImpure", "--raw"]
401− _ <- readProcessAndLogStderr Debug $ setCwd (Just root) $
402− proc lnPath ["-sfT", T.unpack path, "./static.out"]
403− pure path
404−
405−-- | Get the nix store path to the generated static asset manifest module (e.g., "obelisk-generated-static")
406−getHaskellManifestProjectPath :: MonadObelisk m => FilePath -> m Text
407−getHaskellManifestProjectPath root = fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $
408− proc nixBuildExePath
409− [ "--no-out-link"
410− , "-E"
411− , "(let a = import ./. {}; in a.passthru.processedStatic.haskellManifest)"
412− ]
413−
414−-- | Watch the project directory for file changes and check whether those file changes
415−-- cause changes in the static files nix derivation. If so, rebuild it.
416−watchStaticFilesDerivation
417− :: (MonadIO m, MonadObelisk m)
418− => FilePath
419− -> m ()
420−watchStaticFilesDerivation root = do
421− ob <- getObelisk
422− drv0 <- showDerivation
423− liftIO $ runHeadlessApp $ do
424− pb <- getPostBuild
425− checkForChanges <- batchOccurrences 0.25 =<< watchDirectoryTree
426− -- On macOS, use the polling backend due to https://github.com/luite/hfsevents/issues/13
427− (defaultConfig { confUsePolling = SysInfo.os == "darwin", confPollInterval = 250000 })
428− (root <$ pb)
429− ((/="static.out") . takeFileName . eventPath)
430− drv <- performEvent $ ffor checkForChanges $ \_ ->
431− liftIO $ runObelisk ob showDerivation
432− drvs <- foldDyn (\new (_, old, _) -> (old, new, old /= new)) (drv0, drv0, False) drv
433− void $ throttleBatchWithLag
434− (\e -> performEvent $ ffor e $ \_ -> liftIO $ runObelisk ob $ do
435− putLog Notice "Static assets being built..."
436− buildStaticCatchErrors >>= \case
437− Nothing -> pure ()
438− Just _ -> putLog Notice "Static assets built and symlinked to static.out"
439− )
440− ((() <$) . ffilter (\x -> isJust (x ^._2) && x ^._3) $ updated drvs)
441− pure never
442− where
443− handleBuildFailure
444− :: MonadObelisk m
445− => (ExitCode, String, String)
446− -> m (Maybe Text)
447− handleBuildFailure (ex, out, err) = case ex of
448− ExitSuccess -> pure $ Just $ T.pack out
449− _ -> do
450− putLog Error $
451− ("Static assets build failed: " <>) $
452− T.unlines $ reverse $ take 10 $ reverse $ T.lines $ T.pack err
453− pure Nothing
454− showDerivation :: MonadObelisk m => m (Maybe Text)
455− showDerivation =
456− handleBuildFailure <=< readCreateProcessWithExitCode $
457− setCwd (Just root) $ ProcessSpec
458− { _processSpec_createProcess = Proc.proc nixExePath
459− [ "show-derivation"
460− , "-f", "."
461− , "passthru.staticFilesImpure"
462− ]
463− , _processSpec_overrideEnv = Nothing
464− }
465− buildStaticCatchErrors :: MonadObelisk m => m (Maybe Text)
466− buildStaticCatchErrors = handleBuildFailure =<<
467− buildStaticFilesDerivationAndSymlink
468− readCreateProcessWithExitCode
469− root
470−
471−buildStaticFilesDerivationAndSymlink
472− :: MonadObelisk m
473− => (ProcessSpec -> m a)
474− -> FilePath
475− -> m a
476−buildStaticFilesDerivationAndSymlink f root = f $
477− setCwd (Just root) $ ProcessSpec
478− { _processSpec_createProcess = Proc.proc
479− nixBuildExePath
480− [ "-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"
481352 , "-E", "(import ./. {}).passthru.staticFilesImpure"
482353 ]
483− , _processSpec_overrideEnv = Nothing
484− }
354+ else readProcessAndLogStderr Debug $ setCwd (Just root) $
355+ proc nixExePath ["eval", "-f", ".", "passthru.staticFilesImpure", "--raw"]