master...a5bbc16 · obelisk

ChangeLog.md+10

since splitsnapshots

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

2

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.

4

5+## Unreleased

6+

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

6

16

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 '';

78

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 @@

5

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

7

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.

9

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```

21

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.

23

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

39

40

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

7+

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

3+

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

8

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)

24

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

11

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(..))

27

25

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

32

30

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− ]

60

41

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

4

12

5import Obelisk.Asset.Gather

13import Obelisk.Asset.Gather

6

14

15+import Language.Haskell.TH

7import Language.Haskell.TH.Syntax

16import Language.Haskell.TH.Syntax

8import System.FilePath.Posix

17import System.FilePath.Posix

9

18

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

61

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+125−9

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

1{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE LambdaCase #-}

3{-# LANGUAGE OverloadedStrings #-}

4+{-# LANGUAGE ScopedTypeVariables #-}

5+{-# LANGUAGE TupleSections #-}

6+

4module Obelisk.Command.Project

7module Obelisk.Command.Project

5 ( InitSource (..)

8 ( InitSource (..)

6 , findProjectObeliskCommand

9 , findProjectObeliskCommand

@@ -16,12 +19,18 @@ module Obelisk.Command.Project

16 , toObeliskDir

19 , toObeliskDir

17 , withProjectRoot

20 , withProjectRoot

18 , bashEscape

21 , bashEscape

22+ , getHaskellManifestProjectPath

23+ , AssetSource(..)

24+ , describeImpureAssetSource

25+ , watchStaticFilesDerivation

19 ) where

26 ) where

20

27

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

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

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

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

23import Control.Monad

30import Control.Monad

31+import Control.Monad.Except

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

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

33+import Control.Monad.Log

25import Control.Monad.State

34import Control.Monad.State

26import qualified Data.Aeson as Json

35import qualified Data.Aeson as Json

27import qualified Data.ByteString.UTF8 as BSU

36import qualified Data.ByteString.UTF8 as BSU

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

30import Data.Default (def)

39import Data.Default (def)

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

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

32import Data.Map (Map)

41import Data.Map (Map)

42+import Data.Maybe (isJust)

33import Data.Text (Text)

43import Data.Text (Text)

34import qualified Data.Text as T

44import qualified Data.Text as T

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

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

36import Data.Traversable (for)

46import Data.Traversable (for)

47+import Reflex

48+import Reflex.FSNotify

49+import Reflex.Host.Headless

37import System.Directory

50import System.Directory

38import System.Environment (lookupEnv)

51import System.Environment (lookupEnv)

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

39import System.FilePath

53import System.FilePath

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

55+import qualified System.Info as SysInfo

40import System.IO.Temp

56import System.IO.Temp

41import System.IO.Unsafe (unsafePerformIO)

57import System.IO.Unsafe (unsafePerformIO)

42import System.PosixCompat.Files

58import System.PosixCompat.Files

43import System.PosixCompat.Types

59import System.PosixCompat.Types

44import System.PosixCompat.User

60import System.PosixCompat.User

61+import qualified System.Process as Proc

45import Text.ShellEscape (bash, bytes)

62import Text.ShellEscape (bash, bytes)

46

63

47import GitHub.Data.GitData (Branch)

64import GitHub.Data.GitData (Branch)

48import GitHub.Data.Name (Name)

65import GitHub.Data.Name (Name)

49

66

50−import Obelisk.App (MonadObelisk)

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

51import Obelisk.CliApp

68import Obelisk.CliApp

52import Obelisk.Command.Nix

69import Obelisk.Command.Nix

53import Obelisk.Command.Thunk

70import Obelisk.Command.Thunk

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

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

55

72

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

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

57

74

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

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

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

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

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

336

353

354+-- | Describes the provenance of static assets (i.e., are they the result of a derivation

355+-- that was built, or just a folder full of files.

356+data AssetSource = AssetSource_Derivation

357+ | AssetSource_Files

358+ deriving (Eq)

359+

360+-- | Some log messages to make it easier to tell where static files are coming from

361+describeImpureAssetSource :: AssetSource -> Text -> Text

362+describeImpureAssetSource src path = case src of

363+ AssetSource_Files -> "Assets impurely loaded from: " <> path

364+ AssetSource_Derivation -> "Assets derivation built and impurely loaded from: " <> path

365+

366+-- | Determine where the static files of a project are and whether they're plain files or a derivation.

367+-- If they are a derivation, that derivation will be built.

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

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

338findProjectAssets root = do

369findProjectAssets root = do

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

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

340 proc nixExePath

371 proc nixExePath

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

346 ]

377 ]

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

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

348 if isDerivation == "1"

379 if isDerivation == "1"

380+ then do

381+ _ <- buildStaticFilesDerivationAndSymlink

382+ (readProcessAndLogStderr Debug)

383+ root

384+ pure (AssetSource_Derivation, T.pack $ root </> "static.out")

385+ 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

386+ path <- readProcessAndLogStderr Debug $ setCwd (Just root) $

387+ proc nixExePath ["eval", "-f", ".", "passthru.staticFilesImpure", "--raw"]

388+ _ <- readProcessAndLogStderr Debug $ setCwd (Just root) $

389+ proc lnPath ["-s", "-f", T.unpack path, "static.out"]

390+ pure path

391+

392+-- | Get the nix store path to the generated static asset manifest module (e.g., "obelisk-generated-static")

393+getHaskellManifestProjectPath :: MonadObelisk m => FilePath -> m Text

394+getHaskellManifestProjectPath root = fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $

350− proc nixBuildExePath

395+ proc nixBuildExePath

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

396+ [ "--no-out-link"

397+ , "-E"

398+ , "(let a = import ./. {}; in a.passthru.processedStatic.haskellManifest)"

399+ ]

400+

401+-- | Watch the project directory for file changes and check whether those file changes

402+-- cause changes in the static files nix derivation. If so, rebuild it.

403+watchStaticFilesDerivation

404+ :: (MonadIO m, MonadObelisk m)

405+ => FilePath

406+ -> m ()

407+watchStaticFilesDerivation root = do

408+ ob <- getObelisk

409+ drv0 <- showDerivation

410+ liftIO $ runHeadlessApp $ do

411+ pb <- getPostBuild

412+ checkForChanges <- batchOccurrences 0.25 =<< watchDirectoryTree

413+ -- On macOS, use the polling backend due to https://github.com/luite/hfsevents/issues/13

414+ (defaultConfig { confUsePolling = SysInfo.os == "darwin", confPollInterval = 250000 })

415+ (root <$ pb)

416+ ((/="static.out") . takeFileName . eventPath)

417+ drv <- performEvent $ ffor checkForChanges $ \_ ->

418+ liftIO $ runObelisk ob showDerivation

419+ drvs <- foldDyn (\new (_, old, _) -> (old, new, old /= new)) (drv0, drv0, False) drv

420+ void $ throttleBatchWithLag

421+ (\e -> performEvent $ ffor e $ \_ -> liftIO $ runObelisk ob $ do

422+ putLog Notice "Static assets being built..."

423+ buildStaticCatchErrors >>= \case

424+ Nothing -> pure ()

425+ Just _ -> putLog Notice "Static assets built and symlinked to static.out"

426+ )

427+ ((() <$) . ffilter (\x -> isJust (x ^._2) && x ^._3) $ updated drvs)

428+ pure never

429+ where

430+ handleBuildFailure

431+ :: MonadObelisk m

432+ => (ExitCode, String, String)

433+ -> m (Maybe Text)

434+ handleBuildFailure (ex, out, err) = case ex of

435+ ExitSuccess -> pure $ Just $ T.pack out

436+ _ -> do

437+ putLog Error $

438+ ("Static assets build failed: " <>) $

439+ T.unlines $ reverse $ take 10 $ reverse $ T.lines $ T.pack err

440+ pure Nothing

441+ showDerivation :: MonadObelisk m => m (Maybe Text)

442+ showDerivation =

443+ handleBuildFailure <=< readCreateProcessWithExitCode $

444+ setCwd (Just root) $ ProcessSpec

445+ { _processSpec_createProcess = Proc.proc nixExePath

446+ [ "show-derivation"

447+ , "-f", "."

448+ , "passthru.staticFilesImpure"

449+ ]

450+ , _processSpec_overrideEnv = Nothing

451+ }

452+ buildStaticCatchErrors :: MonadObelisk m => m (Maybe Text)

453+ buildStaticCatchErrors = handleBuildFailure =<<

454+ buildStaticFilesDerivationAndSymlink

455+ readCreateProcessWithExitCode

456+ root

457+

458+buildStaticFilesDerivationAndSymlink

459+ :: MonadObelisk m

460+ => (ProcessSpec -> m a)

461+ -> FilePath

462+ -> m a

463+buildStaticFilesDerivationAndSymlink f root = f $

464+ setCwd (Just root) $ ProcessSpec

465+ { _processSpec_createProcess = Proc.proc

466+ nixBuildExePath

467+ [ "-o", "static.out"

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

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

353 ]

469 ]

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

470+ , _processSpec_overrideEnv = Nothing

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

471+ }

lib/command/src/Obelisk/Command/Run.hs+25−10

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

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

63import qualified System.Info

64import qualified System.Info

64import System.IO.Temp (withSystemTempDirectory)

65import System.IO.Temp (withSystemTempDirectory)

65

66

66−import Obelisk.App (MonadObelisk)

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

67import Obelisk.CliApp (

68import Obelisk.CliApp (

68 Severity (..),

69 Severity (..),

69 failWith,

70 failWith,

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

77 withSpinner,

78 withSpinner,

78 )

79 )

79import Obelisk.Command.Nix

80import Obelisk.Command.Nix

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

81+import Obelisk.Command.Project

81import Obelisk.Command.Thunk (attrCacheFileName)

82import Obelisk.Command.Thunk (attrCacheFileName)

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

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

83

84

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

144 , _target_attr = Just "__unstable__.profiledObRun"

145 , _target_attr = Just "__unstable__.profiledObRun"

145 , _target_expr = Nothing

146 , _target_expr = Nothing

146 }

147 }

147− assets <- findProjectAssets root

148+ (assetType, assets) <- findProjectAssets root

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

149+ putLog Debug $ describeImpureAssetSource assetType assets

149 time <- liftIO getCurrentTime

150 time <- liftIO getCurrentTime

150 let profileBaseName = formatTime defaultTimeLocale profileBasePattern time

151 let profileBaseName = formatTime defaultTimeLocale profileBasePattern time

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

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

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

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

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

164run root interpretPaths = do

165run root interpretPaths = do

165 pkgs <- getParsedLocalPkgs root interpretPaths

166 pkgs <- getParsedLocalPkgs root interpretPaths

166− assets <- findProjectAssets root

167+ (assetType, assets) <- findProjectAssets root

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

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

169+ putLog Debug $ describeImpureAssetSource assetType assets

170+ case assetType of

171+ AssetSource_Derivation -> do

172+ ob <- getObelisk

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

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

175+ _ -> pure ()

168− ghciArgs <- getGhciSessionSettings pkgs root True

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

169 freePort <- getFreePort

177 freePort <- getFreePort

170 withGhciScriptArgs pkgs $ \dotGhciArgs -> do

178 withGhciScriptArgs pkgs $ \dotGhciArgs -> do

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

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

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

222 let rootsAndExclusions = calcIntepretFinds "" interpretPaths

230 let rootsAndExclusions = calcIntepretFinds "" interpretPaths

223

231

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

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

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

233+ let allExclusions = obeliskPackageExclusions

234+ <> exclusions

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

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

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

238+ -- fail in its current implementation.

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

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

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

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

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

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

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

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

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

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

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

402 -> m ()

415 -> m ()

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

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

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

404 where

418 where

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

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

406 -- is passed to the ghci session.

420 -- is passed to the ghci session.

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

458

472

459 pure

473 pure

460 $ baseGhciOptions

474 $ baseGhciOptions

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

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

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

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

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

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

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

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

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

75whichPath :: FilePath

76whichPath = $(staticWhich "which")

77

78+lnPath :: FilePath

79+lnPath = $(staticWhich "ln")

80+

78sshKeygenPath :: FilePath

81sshKeygenPath :: FilePath

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

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

80

83

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 #-}

4

3

5module Frontend where

4module Frontend where

6

5

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

40

39

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