master..60d56bc · obelisk

git.iko.soy/obelisk

ChangeLog.md+10

@@ -2,6 +2,16 @@

3This project's release branch is `master`. This log is written from the perspective of the release branch: when changes hit `master`, they are considered released.

5+## Unreleased

7+* Use TemplateHaskell to determine asset file paths

8+ * Migration: All uses of `static @"some/path"` become `$(static "some/path")`. Instead of requiring `TypeApplications` and `DataKinds`, modules calling `static` must now enable `TemplateHaskell`.

9+ * Deprecation: Deprecate static asset modules generated via 'obelisk-asset-manifest-generate' in favor of modules generated via 'obelisk-asset-th-generate'. The new executable takes the same arguments as the old and should be a drop-in replacement. To preserve the old behavior, set `__deprecated.useObeliskAssetManifestGenerate = true;` in your obelisk project configuration.

10+ * Feature: Files added to the static directory while `ob run` is active no longer require `ob run` to be restarted

11+* Feature: When `staticFiles` is a derivation, as opposed to a regular directory, produce a symlink to the result of that derivation at `static.out` and have `ob run` serve static assets from that symlink. This makes it possible for the static asset derivation to be rebuilt and the new results served without restarting `ob run`.

12+* Feature: Rebuild static asset derivations while `ob run` is active as long as the change to the derivation is within the project folder. `ob run` now displays a message ("Static assets rebuilt and symlinked to static.out") whenever static assets have been rebuilt and the new static assets are being served.

13+* Feature: Add `staticFilePath` to `Obelisk.Generated.Static`. Like `static`, this uses TH to generate a reference to a file. Unlike `static`, this `staticFilePath` generates a path on the filesystem instead of URL path.

14+

5## v0.9.1.0

15## v0.9.1.0

7* [#801](https://github.com/obsidiansystems/obelisk/pull/801): Remove errors and warning for local packages without a library component

17* [#801](https://github.com/obsidiansystems/obelisk/pull/801): Remove errors and warning for local packages without a library component

default.nix+10−4

@@ -65,7 +65,7 @@ in rec {

65 '';

66 nullIfAbsent = p: if lib.pathExists p then p else null;

67 #TODO: Avoid copying files within the nix store. Right now, obelisk-asset-manifest-generate copies files into a big blob so that the android/ios static assets can be imported from there; instead, we should get everything lined up right before turning it into an APK, so that copies, if necessary, only exist temporarily.

68− processAssets = { src, packageName ? "obelisk-generated-static", moduleName ? "Obelisk.Generated.Static" }: pkgs.runCommand "asset-manifest" {

68+ processAssets = { src, packageName ? "obelisk-generated-static", moduleName ? "Obelisk.Generated.Static", exe ? "obelisk-asset-th-generate" }: pkgs.runCommand "asset-manifest" {

69 inherit src;

70 outputs = [ "out" "haskellManifest" "symlinked" ];

71 nativeBuildInputs = [ ghcObelisk.obelisk-asset-manifest ];

@@ -73,7 +73,7 @@ in rec {

73 set -euo pipefail

74 touch "$out"

75 mkdir -p "$symlinked"

76− obelisk-asset-manifest-generate "$src" "$haskellManifest" ${packageName} ${moduleName} "$symlinked"

76+ ${exe} "$src" "$haskellManifest" ${packageName} ${moduleName} "$symlinked"

77 '';

79 compressedJs = frontend: optimizationLevel: pkgs.runCommand "compressedJs" {} ''

@@ -237,13 +237,14 @@ in rec {

237 , withHoogle ? false # Setting this to `true` makes shell reloading far slower

238 , __closureCompilerOptimizationLevel ? "ADVANCED" # Set this to `null` to skip the closure-compiler step

239 , __withGhcide ? false

240+ , __deprecated ? {}

240 }:

241 }:

241 let

242 let

242 allConfig = nixpkgs.lib.makeExtensible (self: {

243 allConfig = nixpkgs.lib.makeExtensible (self: {

243 base = base';

244 base = base';

244 inherit args;

245 inherit args;

245 userSettings = {

246 userSettings = {

246− inherit android ios packages overrides tools shellToolOverrides withHoogle __closureCompilerOptimizationLevel __withGhcide;

247+ inherit android ios packages overrides tools shellToolOverrides withHoogle __closureCompilerOptimizationLevel __withGhcide __deprecated;

247 staticFiles = if staticFiles == null then self.base + /static else staticFiles;

248 staticFiles = if staticFiles == null then self.base + /static else staticFiles;

248 };

249 };

249 frontendName = "frontend";

250 frontendName = "frontend";

@@ -251,7 +252,12 @@ in rec {

251 commonName = "common";

252 commonName = "common";

252 staticName = "obelisk-generated-static";

253 staticName = "obelisk-generated-static";

253 staticFilesImpure = let fs = self.userSettings.staticFiles; in if lib.isDerivation fs then fs else toString fs;

254 staticFilesImpure = let fs = self.userSettings.staticFiles; in if lib.isDerivation fs then fs else toString fs;

255+ processedStatic = processAssets {

254− processedStatic = processAssets { src = self.userSettings.staticFiles; };

256+ src = self.userSettings.staticFiles;

257+ exe = if lib.attrByPath ["userSettings" "__deprecated" "useObeliskAssetManifestGenerate"] false self

258+ then builtins.trace "obelisk-asset-manifest-generate is deprecated. Use obelisk-asset-th-generate instead." "obelisk-asset-manifest-generate"

259+ else "obelisk-asset-th-generate";

260+ };

255 # The packages whose names and roles are defined by this package

261 # The packages whose names and roles are defined by this package

256 predefinedPackages = lib.filterAttrs (_: x: x != null) {

262 predefinedPackages = lib.filterAttrs (_: x: x != null) {

257 ${self.frontendName} = nullIfAbsent (self.base + "/frontend");

263 ${self.frontendName} = nullIfAbsent (self.base + "/frontend");

lib/asset/README.md+2−2

@@ -5,7 +5,7 @@

6**Efficiently served, aggressively cached static web resources.**

8−The `assets.nix` file contains nix expressions that are a mutually recursive set of attributes used to create static asset directories with hashable file encodings. This file should be incorporated within your project's `default.nix` file. (See `example/default.nix`, line 2)

8+The `assets.nix` file contains nix expressions that are a mutually recursive set of attributes used to create static asset directories with hashable file encodings. This file should be incorporated within your project's `default.nix` file.

10```nix

11{ assets ? import ./../assets.nix { inherit nixpkgs; } }:

@@ -19,7 +19,7 @@ In this example, `mkAssets` is used on a directory that has a `.png` file inside

19myAssets = assets.mkAssets ./static;

20```

22−Once you have successfully incorporated `assets.nix` into your project's nix file(s), use `nix-build` to generate a symlink of your `mkAssets` expression. The following command from `example/run-example` (line 3) will generate an immutable symlink that holds hashed static assets.

22+Once you have successfully incorporated `assets.nix` into your project's nix file(s), use `nix-build` to generate a symlink of your `mkAssets` expression. The following command will generate an immutable symlink that holds hashed static assets.

24```bash

25nix-build -o static.assets -A myAssets

lib/asset/manifest/obelisk-asset-manifest.cabal+11−1

@@ -27,6 +27,7 @@ library

27 , unix-compat

28 , vector

29 exposed-modules:

30+ Obelisk.Asset.Cabal

30 Obelisk.Asset.Gather

31 Obelisk.Asset.Gather

31 Obelisk.Asset.Promoted

32 Obelisk.Asset.Promoted

32 Obelisk.Asset.Symlink

33 Obelisk.Asset.Symlink

@@ -35,7 +36,7 @@ library

35 other-extensions: TemplateHaskell

36 other-extensions: TemplateHaskell

36 ghc-options:

37 ghc-options:

37 -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O2

38 -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O2

38− -fno-warn-unused-do-bind -funbox-strict-fields -fprof-auto-calls

39+ -fno-warn-unused-do-bind -funbox-strict-fields -fprof-auto-calls

40executable obelisk-asset-manifest-generate

41executable obelisk-asset-manifest-generate

41 hs-source-dirs: src-bin

42 hs-source-dirs: src-bin

@@ -44,3 +45,12 @@ executable obelisk-asset-manifest-generate

44 base

45 base

45 , obelisk-asset-manifest

46 , obelisk-asset-manifest

46 , text

47 , text

48+

49+executable obelisk-asset-th-generate

50+ hs-source-dirs: src-bin

51+ main-is: static-th.hs

52+ build-depends:

53+ base

54+ , obelisk-asset-manifest

55+ , filepath

56+ , text

lib/asset/manifest/src-bin/static-th.hsnew file+43

@@ -0,0 +1,43 @@

1+import qualified Data.Text as T

2+import Obelisk.Asset.Cabal

3+import Obelisk.Asset.Gather

4+import Obelisk.Asset.Symlink

5+import System.Environment

6+import System.FilePath

8+main :: IO ()

9+main = do

10+ --TODO: Usage

11+ [root, haskellTarget, packageName, moduleName, fileTarget] <- getArgs

12+ paths <- gatherHashedPaths root

13+ writeCabalProject haskellTarget $ SimplePkg

14+ { _simplePkg_name = T.pack packageName

15+ , _simplePkg_moduleName = T.pack moduleName

16+ , _simplePkg_dependencies = map T.pack

17+ [ "base"

18+ , "obelisk-asset-manifest"

19+ , "template-haskell"

20+ ]

21+ , _simplePkg_moduleContents = T.pack $ unlines

22+ [ "{-# Language CPP #-}"

23+ , "{-|"

24+ , " Description:"

25+ , " Automatically generated module that provides the 'static' TH function"

26+ , " to generate paths to static assets."

27+ , "-}"

28+ , "module " <> moduleName <> " ( static, staticFilePath ) where"

29+ , ""

30+ , "import Obelisk.Asset.TH"

31+ , "import Language.Haskell.TH"

32+ , ""

33+ , "static, staticFilePath :: FilePath -> Q Exp"

34+ , "#ifdef OBELISK_ASSET_PASSTHRU"

35+ , "static = staticAssetRaw"

36+ , "staticFilePath = staticAssetFilePathRaw \"static.out\""

37+ , "#else"

38+ , "static = staticAssetHashed " <> show root

39+ , "staticFilePath = staticAssetFilePathRaw " <> show root

40+ , "#endif"

41+ ]

42+ }

43+ copyAndSymlink paths root fileTarget

lib/asset/manifest/src/Obelisk/Asset/Cabal.hsnew file+42

@@ -0,0 +1,42 @@

1+{-# Language OverloadedStrings #-}

2+module Obelisk.Asset.Cabal where

4+import qualified Data.List as L

5+import Data.Text (Text)

6+import qualified Data.Text as T

7+import qualified Data.Text.IO as T

8+import System.Directory

9+import System.FilePath

10+

11+-- | A generated single-module package

12+data SimplePkg = SimplePkg

13+ { _simplePkg_name :: Text

14+ , _simplePkg_moduleName :: Text

15+ , _simplePkg_moduleContents :: Text

16+ , _simplePkg_dependencies :: [Text]

17+ }

18+

19+cabalFile :: SimplePkg -> Text

20+cabalFile (SimplePkg packageName moduleName _ deps) = T.unlines

21+ [ "name: " <> packageName

22+ , "version: 0"

23+ , "cabal-version: >= 1.2"

24+ , "build-type: Simple"

25+ , ""

26+ , "library"

27+ , " hs-source-dirs: src"

28+ , " build-depends:"

29+ , " " <> T.intercalate ", " deps

30+ , " exposed-modules: " <> moduleName

31+ ]

32+

33+writeCabalProject :: FilePath -> SimplePkg -> IO ()

34+writeCabalProject target pkg = do

35+ createDirectoryIfMissing True target

36+ T.writeFile (target </> T.unpack (_simplePkg_name pkg) <.> "cabal") $ cabalFile pkg

37+ let moduleName = _simplePkg_moduleName pkg

38+ (modName', moduleDirPath) = case L.uncons (reverse $ T.splitOn "." moduleName) of

39+ Nothing -> error $ "writeStaticProject: invalid module name " <> T.unpack moduleName

40+ Just (name, parents) -> (name, target </> "src" </> T.unpack (T.intercalate "/" $ reverse parents))

41+ createDirectoryIfMissing True moduleDirPath

42+ T.writeFile (moduleDirPath </> T.unpack modName' <.> "hs") $ _simplePkg_moduleContents pkg

lib/asset/manifest/src/Obelisk/Asset/Gather.hs+13−13

@@ -6,21 +6,21 @@ module Obelisk.Asset.Gather

6 , toHashedPath

7 ) where

9−import Control.DeepSeq

9+import Control.DeepSeq (force)

10import Control.Monad (forM)

11−import Data.Bits

11+import Data.Bits (shift, (.|.), (.&.))

12−import qualified Data.ByteString.Lazy as LBS

12+import qualified Data.ByteString.Lazy as LBS (readFile, toStrict, ByteString, length, index)

13−import qualified Data.ByteString.Lazy.Builder as LBS

13+import qualified Data.ByteString.Lazy.Builder as LBS (toLazyByteString, word8)

14−import Data.Char

14+import Data.Char (ord)

15−import Data.Digest.Pure.SHA

15+import Data.Digest.Pure.SHA (bytestringDigest, sha256)

16import Data.Map (Map)

17−import qualified Data.Map as Map

17+import qualified Data.Map as Map (singleton)

18−import qualified Data.Text as T

18+import qualified Data.Text as T (unpack)

19−import Data.Text.Encoding

19+import Data.Text.Encoding (decodeUtf8)

20−import qualified Data.Vector.Unboxed as UV

20+import qualified Data.Vector.Unboxed as UV ((!), fromList)

21−import Data.Word

21+import Data.Word (Word8)

22−import System.FilePath.Posix

22+import System.FilePath.Posix ((</>), splitFileName, normalise)

23−import System.Directory

23+import System.Directory (listDirectory, doesFileExist)

25-- | Given a path, recursively explore it, creating hashed paths for all files found

26gatherHashedPaths

lib/asset/manifest/src/Obelisk/Asset/Promoted.hs+8−27

@@ -10,7 +10,6 @@ module Obelisk.Asset.Promoted

10import Obelisk.Asset.Gather

12import Data.Foldable

13−import qualified Data.List as L

14import Language.Haskell.TH (runQ, pprint)

13import Language.Haskell.TH (runQ, pprint)

15import Language.Haskell.TH.Syntax hiding (lift)

14import Language.Haskell.TH.Syntax hiding (lift)

16import GHC.TypeLits

15import GHC.TypeLits

@@ -18,12 +17,11 @@ import Data.Sequence (Seq)

18import qualified Data.Sequence as Seq

17import qualified Data.Sequence as Seq

19import Control.Monad.Trans.Writer

18import Control.Monad.Trans.Writer

20import System.FilePath

19import System.FilePath

21−import System.Directory

22import Data.Text (Text)

20import Data.Text (Text)

23import qualified Data.Text as T

21import qualified Data.Text as T

24−import qualified Data.Text.IO as T

25import Data.Map (Map)

22import Data.Map (Map)

26import qualified Data.Map as Map

23import qualified Data.Map as Map

24+import Obelisk.Asset.Cabal (writeCabalProject, SimplePkg(..))

28data StaticConfig = StaticConfig

26data StaticConfig = StaticConfig

29 { _staticConfig_packageName :: Text --TODO: Better type

27 { _staticConfig_packageName :: Text --TODO: Better type

@@ -32,31 +30,14 @@ data StaticConfig = StaticConfig

33writeStaticProject :: Map FilePath FilePath -> FilePath -> StaticConfig -> IO ()

31writeStaticProject :: Map FilePath FilePath -> FilePath -> StaticConfig -> IO ()

34writeStaticProject paths target cfg = do

32writeStaticProject paths target cfg = do

35− createDirectoryIfMissing True target

36− T.writeFile (target </> T.unpack (_staticConfig_packageName cfg) <.> "cabal") $ staticCabalFile cfg

37 let modName = _staticConfig_moduleName cfg

33 let modName = _staticConfig_moduleName cfg

38− (modName', moduleDirPath) = case L.uncons (reverse $ T.splitOn "." modName) of

39− Nothing -> error $ "writeStaticProject: invalid module name " <> T.unpack modName

40− Just (name, parents) -> (name, target </> "src" </> T.unpack (T.intercalate "/" $ reverse parents))

41− createDirectoryIfMissing True moduleDirPath

42 modContents <- staticModuleFile modName paths

34 modContents <- staticModuleFile modName paths

43− T.writeFile (moduleDirPath </> T.unpack modName' <.> "hs") modContents

35+ writeCabalProject target $ SimplePkg

44−

36+ { _simplePkg_name = _staticConfig_packageName cfg

45−staticCabalFile :: StaticConfig -> Text

37+ , _simplePkg_moduleName = _staticConfig_moduleName cfg

46−staticCabalFile cfg = T.unlines

38+ , _simplePkg_moduleContents = modContents

47− [ "name: " <> _staticConfig_packageName cfg

39+ , _simplePkg_dependencies = ["base", "ghc-prim", "text"]

48− , "version: 0"

40+ }

49− , "cabal-version: >= 1.2"

50− , "build-type: Simple"

51− , ""

52− , "library"

53− , " hs-source-dirs: src"

54− , " build-depends:"

55− , " base,"

56− , " ghc-prim,"

57− , " text"

58− , " exposed-modules: " <> _staticConfig_moduleName cfg

59− ]

61staticModuleFile :: Text -> Map FilePath FilePath -> IO Text

42staticModuleFile :: Text -> Map FilePath FilePath -> IO Text

62staticModuleFile moduleName paths = do

43staticModuleFile moduleName paths = do

@@ -69,7 +50,7 @@ staticModuleFile moduleName paths = do

69 , "{-# LANGUAGE OverloadedStrings #-}"

50 , "{-# LANGUAGE OverloadedStrings #-}"

70 , "{-# LANGUAGE ScopedTypeVariables #-}"

51 , "{-# LANGUAGE ScopedTypeVariables #-}"

71 , "{-# LANGUAGE TypeApplications #-}"

52 , "{-# LANGUAGE TypeApplications #-}"

72− , "module " <> moduleName <> " where"

53+ , "module " <> moduleName <> " {-# DEPRECATED \"Generate this module with the 'obelisk-asset-th-generate' executable instead.\" #-} where"

73 , ""

54 , ""

74 , "import qualified GHC.Types"

55 , "import qualified GHC.Types"

75 , "import Data.Text (Text)"

56 , "import Data.Text (Text)"

lib/asset/manifest/src/Obelisk/Asset/TH.hs+34−3

@@ -1,14 +1,45 @@

1+{-|

2+Description:

3+ Template Haskell for generating asset paths.

4+-}

1module Obelisk.Asset.TH

5module Obelisk.Asset.TH

2 ( assetPath

6 ( assetPath

7+ , staticAssetRaw

8+ , staticAssetHashed

9+ , staticAssetFilePath

10+ , staticAssetFilePathRaw

3 ) where

11 ) where

5import Obelisk.Asset.Gather

13import Obelisk.Asset.Gather

15+import Language.Haskell.TH

7import Language.Haskell.TH.Syntax

16import Language.Haskell.TH.Syntax

8import System.FilePath.Posix

17import System.FilePath.Posix

19+-- | Produces the hashed path of a file

20+hashedAssetFilePath :: FilePath -> FilePath -> Q FilePath

21+hashedAssetFilePath root relativePath = do

22+ qAddDependentFile $ root </> relativePath

23+ runIO (toHashedPath root relativePath)

24+

10-- | Produces a string literal with the hashed path of the file

25-- | Produces a string literal with the hashed path of the file

11assetPath :: FilePath -> FilePath -> Q Exp

26assetPath :: FilePath -> FilePath -> Q Exp

12−assetPath root relativePath = do

27+assetPath root relativePath =

13− qAddDependentFile $ root </> relativePath

28+ LitE . StringL <$> hashedAssetFilePath root relativePath

14− LitE . StringL <$> runIO (toHashedPath root relativePath)

29+

30+staticPrefix :: FilePath

31+staticPrefix = "/static"

32+

33+staticAssetRaw :: FilePath -> Q Exp

34+staticAssetRaw fp = returnQ $ LitE $ StringL $ staticPrefix </> fp

35+

36+staticAssetHashed :: FilePath -> FilePath -> Q Exp

37+staticAssetHashed root fp = do

38+ LitE . StringL . (staticPrefix </>) <$> hashedAssetFilePath root fp

39+

40+staticAssetFilePathRaw :: FilePath -> FilePath -> Q Exp

41+staticAssetFilePathRaw root fp = returnQ $ LitE $ StringL $ root </> fp

42+

43+staticAssetFilePath :: FilePath -> FilePath -> Q Exp

44+staticAssetFilePath root fp = do

45+ LitE . StringL . (root </>) <$> hashedAssetFilePath root fp

lib/cliapp/src/Obelisk/CliApp/Logging.hs+5−1

@@ -44,7 +44,7 @@ import Data.Text (Text)

44import qualified Data.Text as T

45import qualified Data.Text.IO as T

46import GHC.IO.Encoding.Types

47−import System.Console.ANSI (Color (Red, Yellow), ColorIntensity (Vivid),

47+import System.Console.ANSI (Color (..), ColorIntensity (Vivid),

48 ConsoleIntensity (FaintIntensity), ConsoleLayer (Foreground),

49 SGR (SetColor, SetConsoleIntensity), clearLine)

50import System.Exit (ExitCode (..))

@@ -184,6 +184,8 @@ writeLog withNewLine noColor (WithSeverity severity s) = if T.null s then pure (

184 | noColor && severity <= Warning = liftIO $ putFn $ T.pack (show severity) <> ": " <> s

185 | not noColor && severity <= Error = TS.putStrWithSGR errorColors h withNewLine s

186 | not noColor && severity <= Warning = TS.putStrWithSGR warningColors h withNewLine s

187+ | not noColor && severity == Notice = TS.putStrWithSGR noticeColors h withNewLine s

188+ | not noColor && severity == Informational = TS.putStrWithSGR infoColors h withNewLine s

187 | not noColor && severity >= Debug = TS.putStrWithSGR debugColors h withNewLine s

189 | not noColor && severity >= Debug = TS.putStrWithSGR debugColors h withNewLine s

188 | otherwise = liftIO $ putFn s

190 | otherwise = liftIO $ putFn s

189

191

@@ -191,6 +193,8 @@ writeLog withNewLine noColor (WithSeverity severity s) = if T.null s then pure (

191 h = if severity <= Error then stderr else stdout

193 h = if severity <= Error then stderr else stdout

192 errorColors = [SetColor Foreground Vivid Red]

194 errorColors = [SetColor Foreground Vivid Red]

193 warningColors = [SetColor Foreground Vivid Yellow]

195 warningColors = [SetColor Foreground Vivid Yellow]

196+ infoColors = [SetColor Foreground Vivid Green]

197+ noticeColors = [SetColor Foreground Vivid Blue]

194 debugColors = [SetConsoleIntensity FaintIntensity]

198 debugColors = [SetConsoleIntensity FaintIntensity]

195

199

196-- | Allow the user to immediately switch to verbose logging upon pressing a particular key.

200-- | Allow the user to immediately switch to verbose logging upon pressing a particular key.

lib/command/obelisk-command.cabal+3

@@ -20,6 +20,7 @@ library

20 , exceptions

21 , extra

22 , filepath

23+ , fsnotify

23 , git

24 , git

24 , github

25 , github

25 , here

26 , here

@@ -39,6 +40,8 @@ library

39 , optparse-applicative

40 , optparse-applicative

40 , placeholders

41 , placeholders

41 , process

42 , process

43+ , reflex

44+ , reflex-fsnotify

42 , shell-escape

45 , shell-escape

43 , temporary

46 , temporary

44 , terminal-size

47 , terminal-size

lib/command/src/Obelisk/Command/Preprocessor.hs+1

@@ -59,6 +59,7 @@ writeOutput packageInfo' origPath outPath = withFile outPath WriteMode $ \hOut -

59 where

60 hPutTextBuilder h = BU.hPutBuilder h . TL.encodeUtf8Builder . TL.toLazyText

62+--NOTE: We cannot restrict the package set by adding '-package' flags to OPTIONS_GHC, because GHC rejects them there. It seems that we won't be able to properly handle that situation until GHC itself supports loading multiple packages officially in GHCi

62generateHeader :: FilePath -> CabalPackageInfo -> TL.Builder

63generateHeader :: FilePath -> CabalPackageInfo -> TL.Builder

63generateHeader origPath packageInfo =

64generateHeader origPath packageInfo =

64 hsExtensions <> ghcOptions <> lineNumberPragma origPath

65 hsExtensions <> ghcOptions <> lineNumberPragma origPath

lib/command/src/Obelisk/Command/Project.hs+142−13

@@ -1,6 +1,9 @@

1{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE LambdaCase #-}

3{-# LANGUAGE OverloadedStrings #-}

4+{-# LANGUAGE ScopedTypeVariables #-}

5+{-# LANGUAGE TupleSections #-}

4module Obelisk.Command.Project

7module Obelisk.Command.Project

5 ( InitSource (..)

8 ( InitSource (..)

6 , findProjectObeliskCommand

9 , findProjectObeliskCommand

@@ -11,17 +14,24 @@ module Obelisk.Command.Project

11 , nixShellRunProc

14 , nixShellRunProc

12 , nixShellWithHoogle

15 , nixShellWithHoogle

13 , nixShellWithoutPkgs

16 , nixShellWithoutPkgs

17+ , mkObNixShellProc

14 , obeliskDirName

18 , obeliskDirName

15 , toImplDir

19 , toImplDir

16 , toObeliskDir

20 , toObeliskDir

17 , withProjectRoot

21 , withProjectRoot

18 , bashEscape

22 , bashEscape

23+ , getHaskellManifestProjectPath

24+ , AssetSource(..)

25+ , describeImpureAssetSource

26+ , watchStaticFilesDerivation

19 ) where

27 ) where

21import Control.Concurrent.MVar (MVar, newMVar, withMVarMasked)

29import Control.Concurrent.MVar (MVar, newMVar, withMVarMasked)

22−import Control.Lens ((.~), (?~), (<&>))

30+import Control.Lens ((.~), (?~), (<&>), (^.), _2, _3)

23import Control.Monad

31import Control.Monad

32+import Control.Monad.Except

24import Control.Monad.IO.Class (liftIO)

33import Control.Monad.IO.Class (liftIO)

34+import Control.Monad.Log

25import Control.Monad.State

35import Control.Monad.State

26import qualified Data.Aeson as Json

36import qualified Data.Aeson as Json

27import qualified Data.ByteString.UTF8 as BSU

37import qualified Data.ByteString.UTF8 as BSU

@@ -30,28 +40,36 @@ import qualified Data.ByteString.Lazy as BSL

30import Data.Default (def)

40import Data.Default (def)

31import Data.Function ((&), on)

41import Data.Function ((&), on)

32import Data.Map (Map)

42import Data.Map (Map)

43+import Data.Maybe (isJust)

33import Data.Text (Text)

44import Data.Text (Text)

34import qualified Data.Text as T

45import qualified Data.Text as T

35import Data.Text.Encoding (decodeUtf8, encodeUtf8)

46import Data.Text.Encoding (decodeUtf8, encodeUtf8)

36import Data.Traversable (for)

47import Data.Traversable (for)

48+import Reflex

49+import Reflex.FSNotify

50+import Reflex.Host.Headless

37import System.Directory

51import System.Directory

38import System.Environment (lookupEnv)

52import System.Environment (lookupEnv)

53+import System.Exit (ExitCode(..))

39import System.FilePath

54import System.FilePath

55+import System.FSNotify (defaultConfig, eventPath, WatchConfig(..))

56+import qualified System.Info as SysInfo

40import System.IO.Temp

57import System.IO.Temp

41import System.IO.Unsafe (unsafePerformIO)

58import System.IO.Unsafe (unsafePerformIO)

42import System.PosixCompat.Files

59import System.PosixCompat.Files

43import System.PosixCompat.Types

60import System.PosixCompat.Types

44import System.PosixCompat.User

61import System.PosixCompat.User

62+import qualified System.Process as Proc

45import Text.ShellEscape (bash, bytes)

63import Text.ShellEscape (bash, bytes)

47import GitHub.Data.GitData (Branch)

65import GitHub.Data.GitData (Branch)

48import GitHub.Data.Name (Name)

66import GitHub.Data.Name (Name)

50−import Obelisk.App (MonadObelisk)

68+import Obelisk.App (MonadObelisk, runObelisk, getObelisk)

51import Obelisk.CliApp

69import Obelisk.CliApp

52import Obelisk.Command.Nix

70import Obelisk.Command.Nix

53import Obelisk.Command.Thunk

71import Obelisk.Command.Thunk

54−import Obelisk.Command.Utils (nixBuildExePath, nixExePath, toNixPath, cp, nixShellPath)

72+import Obelisk.Command.Utils (nixBuildExePath, nixExePath, toNixPath, cp, nixShellPath, lnPath)

56--TODO: Make this module resilient to random exceptions

74--TODO: Make this module resilient to random exceptions

@@ -300,7 +318,7 @@ bashEscape = BSU.toString . bytes . bash . BSU.fromString

300nixShellRunProc :: NixShellConfig -> ProcessSpec

318nixShellRunProc :: NixShellConfig -> ProcessSpec

301nixShellRunProc cfg = setDelegateCtlc True $ proc nixShellPath $ runNixShellConfig cfg

319nixShellRunProc cfg = setDelegateCtlc True $ proc nixShellPath $ runNixShellConfig cfg

302

320

303−nixShellWithoutPkgs

321+mkObNixShellProc

304 :: MonadObelisk m

322 :: MonadObelisk m

305 => FilePath -- ^ Path to project root

323 => FilePath -- ^ Path to project root

306 -> Bool -- ^ Should this be a pure shell?

324 -> Bool -- ^ Should this be a pure shell?

@@ -308,12 +326,12 @@ nixShellWithoutPkgs

308 -> Map Text FilePath -- ^ Package names mapped to their paths

326 -> Map Text FilePath -- ^ Package names mapped to their paths

309 -> String -- ^ Shell attribute to use (e.g. @"ghc"@, @"ghcjs"@, etc.)

327 -> String -- ^ Shell attribute to use (e.g. @"ghc"@, @"ghcjs"@, etc.)

310 -> Maybe String -- ^ If 'Just' run the given command; otherwise just open the interactive shell

328 -> Maybe String -- ^ If 'Just' run the given command; otherwise just open the interactive shell

311− -> m ()

329+ -> m ProcessSpec

312−nixShellWithoutPkgs root isPure chdirToRoot packageNamesAndPaths shellAttr command = do

330+mkObNixShellProc root isPure chdirToRoot packageNamesAndPaths shellAttr command = do

313 packageNamesAndAbsPaths <- liftIO $ for packageNamesAndPaths makeAbsolute

331 packageNamesAndAbsPaths <- liftIO $ for packageNamesAndPaths makeAbsolute

314 defShellConfig <- nixShellRunConfig root isPure command

332 defShellConfig <- nixShellRunConfig root isPure command

315 let setCwd_ = if chdirToRoot then setCwd (Just root) else id

333 let setCwd_ = if chdirToRoot then setCwd (Just root) else id

316− runProcess_ $ setCwd_ $ nixShellRunProc $ defShellConfig

334+ pure $ setCwd_ $ nixShellRunProc $ defShellConfig

317 & nixShellConfig_common . nixCmdConfig_target . target_expr ?~

335 & nixShellConfig_common . nixCmdConfig_target . target_expr ?~

318 "{root, pkgs, shell}: ((import root {}).passthru.__unstable__.self.extend (_: _: {\

336 "{root, pkgs, shell}: ((import root {}).passthru.__unstable__.self.extend (_: _: {\

319 \shellPackages = builtins.fromJSON pkgs;\

337 \shellPackages = builtins.fromJSON pkgs;\

@@ -324,6 +342,18 @@ nixShellWithoutPkgs root isPure chdirToRoot packageNamesAndPaths shellAttr comma

324 , strArg "shell" shellAttr

342 , strArg "shell" shellAttr

325 ]

343 ]

326

344

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+

327nixShellWithHoogle :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()

357nixShellWithHoogle :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()

328nixShellWithHoogle root isPure shell' command = do

358nixShellWithHoogle root isPure shell' command = do

329 defShellConfig <- nixShellRunConfig root isPure command

359 defShellConfig <- nixShellRunConfig root isPure command

@@ -334,7 +364,21 @@ nixShellWithHoogle root isPure shell' command = do

334 \})).project.shells.${shell}"

364 \})).project.shells.${shell}"

335 & nixShellConfig_common . nixCmdConfig_args .~ [ strArg "shell" shell' ]

365 & nixShellConfig_common . nixCmdConfig_args .~ [ strArg "shell" shell' ]

336

366

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.

337−findProjectAssets :: MonadObelisk m => FilePath -> m Text

381+findProjectAssets :: MonadObelisk m => FilePath -> m (AssetSource, Text)

338findProjectAssets root = do

382findProjectAssets root = do

339 isDerivation <- readProcessAndLogStderr Debug $ setCwd (Just root) $

383 isDerivation <- readProcessAndLogStderr Debug $ setCwd (Just root) $

340 proc nixExePath

384 proc nixExePath

@@ -346,10 +390,95 @@ findProjectAssets root = do

346 ]

390 ]

347 -- Check whether the impure static files are a derivation (and so must be built)

391 -- Check whether the impure static files are a derivation (and so must be built)

348 if isDerivation == "1"

392 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

349− then fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $ -- Strip whitespace here because nix-build has no --raw option

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) $

350− proc nixBuildExePath

408+ proc nixBuildExePath

351− [ "--no-out-link"

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"

352 , "-E", "(import ./. {}).passthru.staticFilesImpure"

481 , "-E", "(import ./. {}).passthru.staticFilesImpure"

353 ]

482 ]

354− else readProcessAndLogStderr Debug $ setCwd (Just root) $

483+ , _processSpec_overrideEnv = Nothing

355− proc nixExePath ["eval", "-f", ".", "passthru.staticFilesImpure", "--raw"]

484+ }

lib/command/src/Obelisk/Command/Run.hs+70−11

@@ -14,7 +14,8 @@ module Obelisk.Command.Run where

14import Control.Arrow ((&&&))

15import Control.Exception (Exception, bracket)

16import Control.Lens (ifor, (.~), (&))

17−import Control.Monad (filterM)

17+import Control.Concurrent (forkIO)

18+import Control.Monad (filterM, void)

18import Control.Monad.Except (runExceptT, throwError)

19import Control.Monad.Except (runExceptT, throwError)

19import Control.Monad.IO.Class (liftIO)

20import Control.Monad.IO.Class (liftIO)

20import Control.Monad.Reader (MonadIO)

21import Control.Monad.Reader (MonadIO)

@@ -45,13 +46,23 @@ import Debug.Trace (trace)

45import Distribution.Compiler (CompilerFlavor(..))

46import Distribution.Compiler (CompilerFlavor(..))

46import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)

47import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)

47import Distribution.Parsec.ParseResult (runParseResult)

48import Distribution.Parsec.ParseResult (runParseResult)

49+import Distribution.Pretty (prettyShow)

50+import Distribution.Simple.Compiler (PackageDB (GlobalPackageDB))

51+import Distribution.Simple.Configure (configCompilerEx, getInstalledPackages)

52+import Distribution.Simple.PackageIndex (InstalledPackageIndex, lookupDependency)

53+import Distribution.Simple.Program.Db (defaultProgramDb)

48import qualified Distribution.System as Dist

54import qualified Distribution.System as Dist

49−import Distribution.Types.BuildInfo (buildable, cppOptions, defaultExtensions, defaultLanguage, hsSourceDirs, options)

55+import Distribution.Types.BuildInfo (buildable, cppOptions, defaultExtensions, defaultLanguage, hsSourceDirs, options, targetBuildDepends)

50import Distribution.Types.CondTree (simplifyCondTree)

56import Distribution.Types.CondTree (simplifyCondTree)

57+import Distribution.Types.Dependency (Dependency (..), depPkgName)

51import Distribution.Types.GenericPackageDescription (ConfVar (Arch, Impl, OS), condLibrary)

58import Distribution.Types.GenericPackageDescription (ConfVar (Arch, Impl, OS), condLibrary)

59+import Distribution.Types.InstalledPackageInfo (compatPackageKey)

52import Distribution.Types.Library (libBuildInfo)

60import Distribution.Types.Library (libBuildInfo)

61+import Distribution.Types.PackageName (mkPackageName)

62+import Distribution.Types.VersionRange (anyVersion)

53import Distribution.Utils.Generic (toUTF8BS, readUTF8File)

63import Distribution.Utils.Generic (toUTF8BS, readUTF8File)

54import qualified Distribution.Parsec.Common as Dist

64import qualified Distribution.Parsec.Common as Dist

65+import qualified Distribution.Verbosity as Verbosity (silent)

55import qualified Hpack.Config as Hpack

66import qualified Hpack.Config as Hpack

56import qualified Hpack.Render as Hpack

67import qualified Hpack.Render as Hpack

57import qualified Hpack.Yaml as Hpack

68import qualified Hpack.Yaml as Hpack

@@ -63,7 +74,7 @@ import System.FilePath

63import qualified System.Info

74import qualified System.Info

64import System.IO.Temp (withSystemTempDirectory)

75import System.IO.Temp (withSystemTempDirectory)

66−import Obelisk.App (MonadObelisk)

77+import Obelisk.App (MonadObelisk, getObelisk, runObelisk)

67import Obelisk.CliApp (

78import Obelisk.CliApp (

68 Severity (..),

79 Severity (..),

69 failWith,

80 failWith,

@@ -77,7 +88,7 @@ import Obelisk.CliApp (

77 withSpinner,

88 withSpinner,

78 )

89 )

79import Obelisk.Command.Nix

90import Obelisk.Command.Nix

80−import Obelisk.Command.Project (nixShellWithoutPkgs, withProjectRoot, findProjectAssets, bashEscape)

91+import Obelisk.Command.Project

81import Obelisk.Command.Thunk (attrCacheFileName)

92import Obelisk.Command.Thunk (attrCacheFileName)

82import Obelisk.Command.Utils (findExePath, ghcidExePath)

93import Obelisk.Command.Utils (findExePath, ghcidExePath)

@@ -96,6 +107,8 @@ data CabalPackageInfo = CabalPackageInfo

96 -- ^ List of compiler-specific options (e.g., the "ghc-options" field of the cabal file)

107 -- ^ List of compiler-specific options (e.g., the "ghc-options" field of the cabal file)

97 , _cabalPackageInfo_cppOptions :: [String]

108 , _cabalPackageInfo_cppOptions :: [String]

98 -- ^ List of CPP (C Preprocessor) options (e.g. the "cpp-options" field of the cabal file)

109 -- ^ List of CPP (C Preprocessor) options (e.g. the "cpp-options" field of the cabal file)

110+ , _cabalPackageInfo_buildDepends :: [Dependency]

111+ -- ^ List of build dependencies listed in the cabal file

99 }

112 }

100

113

101-- | 'Bool' with a better name for its purpose.

114-- | 'Bool' with a better name for its purpose.

@@ -144,8 +157,8 @@ profile profileBasePattern rtsFlags = withProjectRoot "." $ \root -> do

144 , _target_attr = Just "__unstable__.profiledObRun"

157 , _target_attr = Just "__unstable__.profiledObRun"

145 , _target_expr = Nothing

158 , _target_expr = Nothing

146 }

159 }

147− assets <- findProjectAssets root

160+ (assetType, assets) <- findProjectAssets root

148− putLog Debug $ "Assets impurely loaded from: " <> assets

161+ putLog Debug $ describeImpureAssetSource assetType assets

149 time <- liftIO getCurrentTime

162 time <- liftIO getCurrentTime

150 let profileBaseName = formatTime defaultTimeLocale profileBasePattern time

163 let profileBaseName = formatTime defaultTimeLocale profileBasePattern time

151 liftIO $ createDirectoryIfMissing True $ takeDirectory $ root </> profileBaseName

164 liftIO $ createDirectoryIfMissing True $ takeDirectory $ root </> profileBaseName

@@ -163,9 +176,16 @@ profile profileBasePattern rtsFlags = withProjectRoot "." $ \root -> do

163run :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

176run :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

164run root interpretPaths = do

177run root interpretPaths = do

165 pkgs <- getParsedLocalPkgs root interpretPaths

178 pkgs <- getParsedLocalPkgs root interpretPaths

166− assets <- findProjectAssets root

179+ (assetType, assets) <- findProjectAssets root

167− putLog Debug $ "Assets impurely loaded from: " <> assets

180+ manifestPkg <- parsePackagesOrFail . (:[]) . T.unpack =<< getHaskellManifestProjectPath root

181+ putLog Debug $ describeImpureAssetSource assetType assets

182+ case assetType of

183+ AssetSource_Derivation -> do

184+ ob <- getObelisk

185+ putLog Debug "Starting static file derivation watcher..."

186+ void $ liftIO $ forkIO $ runObelisk ob $ watchStaticFilesDerivation root

187+ _ -> pure ()

168− ghciArgs <- getGhciSessionSettings pkgs root True

188+ ghciArgs <- getGhciSessionSettings (pkgs <> manifestPkg) root True

169 freePort <- getFreePort

189 freePort <- getFreePort

170 withGhciScriptArgs pkgs $ \dotGhciArgs -> do

190 withGhciScriptArgs pkgs $ \dotGhciArgs -> do

171 runGhcid root True (ghciArgs <> dotGhciArgs) pkgs $ Just $ unwords

191 runGhcid root True (ghciArgs <> dotGhciArgs) pkgs $ Just $ unwords

@@ -222,7 +242,12 @@ getLocalPkgs root interpretPaths = do

222 let rootsAndExclusions = calcIntepretFinds "" interpretPaths

242 let rootsAndExclusions = calcIntepretFinds "" interpretPaths

223

243

224 fmap fold $ for (MMap.toAscList rootsAndExclusions) $ \(interpretPathRoot, exclusions) ->

244 fmap fold $ for (MMap.toAscList rootsAndExclusions) $ \(interpretPathRoot, exclusions) ->

225− let allExclusions = obeliskPackageExclusions <> exclusions <> Set.singleton ("*" </> attrCacheFileName)

245+ let allExclusions = obeliskPackageExclusions

246+ <> exclusions

247+ <> Set.singleton ("*" </> attrCacheFileName)

248+ <> Set.singleton ("*" </> "lib/asset/manifest") -- NB: obelisk-asset-manifest is excluded because it generates

249+ -- a module that in turn imports it. This will cause ob run to

250+ -- fail in its current implementation.

226 in fmap (Set.fromList . map normalise) $ runFind $

251 in fmap (Set.fromList . map normalise) $ runFind $

227 ["-L", interpretPathRoot, "(", "-name", "*.cabal", "-o", "-name", Hpack.packageConfig, ")", "-a", "-type", "f"]

252 ["-L", interpretPathRoot, "(", "-name", "*.cabal", "-o", "-name", Hpack.packageConfig, ")", "-a", "-type", "f"]

228 <> concat [["-not", "-path", p </> "*"] | p <- toList allExclusions]

253 <> concat [["-not", "-path", p </> "*"] | p <- toList allExclusions]

@@ -354,6 +379,7 @@ parseCabalPackage' pkg = runExceptT $ do

354 defaultLanguage $ libBuildInfo lib

379 defaultLanguage $ libBuildInfo lib

355 , _cabalPackageInfo_compilerOptions = options $ libBuildInfo lib

380 , _cabalPackageInfo_compilerOptions = options $ libBuildInfo lib

356 , _cabalPackageInfo_cppOptions = cppOptions $ libBuildInfo lib

381 , _cabalPackageInfo_cppOptions = cppOptions $ libBuildInfo lib

382+ , _cabalPackageInfo_buildDepends = targetBuildDepends $ libBuildInfo lib

357 }

383 }

358 Right Nothing -> pure Nothing

384 Right Nothing -> pure Nothing

359 Left (_, errors) ->

385 Left (_, errors) ->

@@ -400,7 +426,8 @@ withGhciScriptArgs

400 => f CabalPackageInfo -- ^ List of packages to load into ghci

426 => f CabalPackageInfo -- ^ List of packages to load into ghci

401 -> ([String] -> m ()) -- ^ Action to run with the extra ghci arguments

427 -> ([String] -> m ()) -- ^ Action to run with the extra ghci arguments

402 -> m ()

428 -> m ()

403−withGhciScriptArgs packageInfos f = withGhciScript loadPreludeManually packageInfos $ \fp -> f ["-XNoImplicitPrelude", "-ghci-script", fp]

429+withGhciScriptArgs packageInfos f = withGhciScript loadPreludeManually packageInfos $ \fp ->

430+ f ["-XNoImplicitPrelude", "-ghci-script", fp]

404 where

431 where

405 -- These lines must be first and allow the session to support a custom Prelude when @-XNoImplicitPrelude@

432 -- These lines must be first and allow the session to support a custom Prelude when @-XNoImplicitPrelude@

406 -- is passed to the ghci session.

433 -- is passed to the ghci session.

@@ -450,6 +477,7 @@ getGhciSessionSettings (toList -> packageInfos) pathBase useRelativePaths = do

450 -- all paths to 'pathBase'.

477 -- all paths to 'pathBase'.

451 selfExe <- liftIO $ canonicalizePath =<< getExecutablePath

478 selfExe <- liftIO $ canonicalizePath =<< getExecutablePath

452 canonicalPathBase <- liftIO $ canonicalizePath pathBase

479 canonicalPathBase <- liftIO $ canonicalizePath pathBase

480+ installedPackageIndex <- loadPackageIndex packageInfos pathBase

453

481

454 (pkgFiles, pkgSrcPaths :: [NonEmpty FilePath]) <- fmap unzip $ liftIO $ for packageInfos $ \pkg -> do

482 (pkgFiles, pkgSrcPaths :: [NonEmpty FilePath]) <- fmap unzip $ liftIO $ for packageInfos $ \pkg -> do

455 canonicalSrcDirs <- traverse canonicalizePath $ (_cabalPackageInfo_packageRoot pkg </>) <$> _cabalPackageInfo_sourceDirs pkg

483 canonicalSrcDirs <- traverse canonicalizePath $ (_cabalPackageInfo_packageRoot pkg </>) <$> _cabalPackageInfo_sourceDirs pkg

@@ -458,16 +486,47 @@ getGhciSessionSettings (toList -> packageInfos) pathBase useRelativePaths = do

458

486

459 pure

487 pure

460 $ baseGhciOptions

488 $ baseGhciOptions

489+ <> ["-DOBELISK_ASSET_PASSTHRU"] -- For passthrough static assets

461 <> ["-F", "-pgmF", selfExe, "-optF", preprocessorIdentifier]

490 <> ["-F", "-pgmF", selfExe, "-optF", preprocessorIdentifier]

462 <> concatMap (\p -> ["-optF", p]) pkgFiles

491 <> concatMap (\p -> ["-optF", p]) pkgFiles

463 <> [ "-i" <> intercalate ":" (concatMap toList pkgSrcPaths) ]

492 <> [ "-i" <> intercalate ":" (concatMap toList pkgSrcPaths) ]

493+ <> concatMap (\packageId -> ["-package-id", packageId ])

494+ (packageIds installedPackageIndex)

464 where

495 where

465 relativeTo' = if useRelativePaths then relativeTo else const

496 relativeTo' = if useRelativePaths then relativeTo else const

497+ -- Package names we're building and not needed from the package DB

498+ packageNames =

499+ map (mkPackageName . T.unpack . _cabalPackageInfo_packageName)

500+ packageInfos

501+ packageIds installedPackageIndex =

502+ map (dependencyPackageId installedPackageIndex) $

503+ filter ((`notElem` packageNames) . depPkgName) $

504+ concatMap _cabalPackageInfo_buildDepends packageInfos <>

505+ [Dependency (mkPackageName "obelisk-run") anyVersion]

506+ dependencyPackageId installedPackageIndex dep =

507+ case lookupDependency installedPackageIndex dep of

508+ ((_version,installedPackageInfo:_) :_) ->

509+ compatPackageKey installedPackageInfo

510+ _ -> error $ "Couldn't resolve dependency for " <> prettyShow dep

511+

512+-- Load the package index used by the GHC in this path's nix project

513+loadPackageIndex :: MonadObelisk m => [CabalPackageInfo] -> FilePath -> m InstalledPackageIndex

514+loadPackageIndex packageInfos root = do

515+ ghcPath <- getPathInNixEnvironment "bash -c 'type -p ghc'"

516+ ghcPkgPath <- getPathInNixEnvironment "bash -c 'type -p ghc-pkg'"

517+ (compiler, _platform, programDb) <- liftIO

518+ $ configCompilerEx (Just GHC) (Just ghcPath) (Just ghcPkgPath) defaultProgramDb Verbosity.silent

519+ liftIO $ getInstalledPackages Verbosity.silent compiler [GlobalPackageDB] programDb

520+ where

521+ getPathInNixEnvironment cmd = do

522+ path <- readProcessAndLogStderr Debug =<< mkObNixShellProc root False True (packageInfoToNamePathMap packageInfos) "ghc" (Just cmd)

523+ liftIO $ canonicalizePath $ T.unpack $ T.strip path

466

524

467baseGhciOptions :: [String]

525baseGhciOptions :: [String]

468baseGhciOptions =

526baseGhciOptions =

469 [ "-ignore-dot-ghci"

527 [ "-ignore-dot-ghci"

470 , "-no-user-package-db"

528 , "-no-user-package-db"

529+ , "-hide-all-packages"

471 , "-package-env", "-"

530 , "-package-env", "-"

472 ]

531 ]

473

532

lib/command/src/Obelisk/Command/Utils.hs+3

@@ -75,6 +75,9 @@ gitPath = $(staticWhich "git")

75whichPath :: FilePath

76whichPath = $(staticWhich "which")

78+lnPath :: FilePath

79+lnPath = $(staticWhich "ln")

80+

78sshKeygenPath :: FilePath

81sshKeygenPath :: FilePath

79sshKeygenPath = $(staticWhich "ssh-keygen")

82sshKeygenPath = $(staticWhich "ssh-keygen")

skeleton/.gitignore+1

@@ -13,3 +13,4 @@ result

13result-*

14tags

15TAGS

16+static.out

skeleton/frontend/src/Frontend.hs+3−4

@@ -1,6 +1,5 @@

1−{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE OverloadedStrings #-}

1{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE TypeApplications #-}

2+{-# LANGUAGE TemplateHaskell #-}

5module Frontend where

4module Frontend where

@@ -27,7 +26,7 @@ frontend :: Frontend (R FrontendRoute)

27frontend = Frontend

26frontend = Frontend

28 { _frontend_head = do

27 { _frontend_head = do

29 el "title" $ text "Obelisk Minimal Example"

28 el "title" $ text "Obelisk Minimal Example"

30− elAttr "link" ("href" =: static @"main.css" <> "type" =: "text/css" <> "rel" =: "stylesheet") blank

29+ elAttr "link" ("href" =: $(static "main.css") <> "type" =: "text/css" <> "rel" =: "stylesheet") blank

31 , _frontend_body = do

30 , _frontend_body = do

32 el "h1" $ text "Welcome to Obelisk!"

31 el "h1" $ text "Welcome to Obelisk!"

33 el "p" $ text $ T.pack commonStuff

32 el "p" $ text $ T.pack commonStuff

@@ -38,7 +37,7 @@ frontend = Frontend

38 -- print "Hello, World!" on the client.

37 -- print "Hello, World!" on the client.

39 prerender_ blank $ liftJSM $ void $ eval ("console.log('Hello, World!')" :: T.Text)

38 prerender_ blank $ liftJSM $ void $ eval ("console.log('Hello, World!')" :: T.Text)

41− elAttr "img" ("src" =: static @"obelisk.jpg") blank

40+ elAttr "img" ("src" =: $(static "obelisk.jpg")) blank

42 el "div" $ do

41 el "div" $ do

43 exampleConfig <- getConfig "common/example"

42 exampleConfig <- getConfig "common/example"

44 case exampleConfig of

43 case exampleConfig of