281195a · obelisk · git.iko.soy

git.iko.soy/obelisk

asset-manifest: Use template-haskell to generate asset paths

commit281195a17c67bd19da3e4c4a1833016dc627b448 authorAli Abrar <aliabrar@gmail.com> dateThu 17 Dec 2020, 22:56 (6 years ago) parent7ad33cb

12 files changed+165−51

compare with master

unifiedsplit

ChangeLog.md+7 default.nix+1−1 lib/asset/README.md+2−2 lib/asset/manifest/obelisk-asset-manifest.cabal+11−1 lib/asset/manifest/src-bin/static-th.hs+59 lib/asset/manifest/src/Obelisk/Asset/Cabal.hs+42 lib/asset/manifest/src/Obelisk/Asset/Gather.hs+13−13 lib/asset/manifest/src/Obelisk/Asset/Promoted.hs+8−27 lib/asset/manifest/src/Obelisk/Asset/TH.hs+5 lib/command/src/Obelisk/Command/Project.hs+8 lib/command/src/Obelisk/Command/Run.hs+6−3 skeleton/frontend/src/Frontend.hs+3−4

ChangeLog.md+7

@@ -2,6 +2,13 @@

33This 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.

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

11+

512## v0.9.1.0

613

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

default.nix+1−1

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

7373 set -euo pipefail

7474 touch "$out"

7575 mkdir -p "$symlinked"

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

76+ obelisk-asset-th-generate "$src" "$haskellManifest" ${packageName} ${moduleName} "$symlinked"

7777 '';

7878

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

lib/asset/README.md+2−2

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

66**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.

1010```nix

1111{ 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

1919myAssets = assets.mkAssets ./static;

2020```

2121

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.

2323

2424```bash

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

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

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

2727 , unix-compat

2828 , vector

2929 exposed-modules:

30+ Obelisk.Asset.Cabal

3031 Obelisk.Asset.Gather

3132 Obelisk.Asset.Promoted

3233 Obelisk.Asset.Symlink

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

3536 other-extensions: TemplateHaskell

3637 ghc-options:

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

3940

4041executable obelisk-asset-manifest-generate

4142 hs-source-dirs: src-bin

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

4445 base

4546 , obelisk-asset-manifest

4647 , 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+59

@@ -0,0 +1,59 @@

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+ , "filepath"

19+ , "obelisk-asset-manifest"

20+ , "template-haskell"

21+ ]

22+ , _simplePkg_moduleContents = T.pack $ unlines

23+ [ "{-# Language BangPatterns #-}"

24+ , "{-# Language CPP #-}"

25+ , "{-# Language OverloadedStrings #-}"

26+ , "{-|"

27+ , " Description:"

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

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

30+ , "-}"

31+ , "module " <> moduleName <> " ( static ) where"

32+ , ""

33+ , "import Obelisk.Asset.Gather"

34+ , "import Language.Haskell.TH"

35+ , "import Language.Haskell.TH.Syntax"

36+ , "import System.FilePath"

37+ , ""

38+ , "-- | Produces a string literal with the hashed path of the file"

39+ , "assetPath :: FilePath -> FilePath -> Q Exp"

40+ , "assetPath root relativePath = do"

41+ , " qAddDependentFile $ root </> relativePath"

42+ , " LitE . StringL . (prefix</>) <$> runIO (toHashedPath root relativePath)"

43+ , ""

44+ , "-- | Produces a string literal with the raw (i.e., unhashed) path of the file"

45+ , "assetPathRaw :: FilePath -> Q Exp"

46+ , "assetPathRaw fp = returnQ $ LitE $ StringL $ prefix </> fp"

47+ , ""

48+ , "prefix :: FilePath"

49+ , "prefix = \"/static\""

50+ , ""

51+ , "static :: FilePath -> Q Exp"

52+ , "#ifdef PASSTHRU"

53+ , "static = assetPathRaw"

54+ , "#else"

55+ , "static = assetPath " <> show root

56+ , "#endif"

57+ ]

58+ }

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

66 , toHashedPath

77 ) where

9−import Control.DeepSeq

9+import Control.DeepSeq (force)

1010import Control.Monad (forM)

11−import Data.Bits

12−import qualified Data.ByteString.Lazy as LBS

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

14−import Data.Char

15−import Data.Digest.Pure.SHA

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

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

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

14+import Data.Char (ord)

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

1616import Data.Map (Map)

17−import qualified Data.Map as Map

18−import qualified Data.Text as T

19−import Data.Text.Encoding

20−import qualified Data.Vector.Unboxed as UV

21−import Data.Word

22−import System.FilePath.Posix

23−import System.Directory

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

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

19+import Data.Text.Encoding (decodeUtf8)

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

21+import Data.Word (Word8)

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

23+import System.Directory (listDirectory, doesFileExist)

2424

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

2626gatherHashedPaths

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

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

1010import Obelisk.Asset.Gather

1111

1212import Data.Foldable

13−import qualified Data.List as L

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

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

1615import GHC.TypeLits

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

1817import qualified Data.Sequence as Seq

1918import Control.Monad.Trans.Writer

2019import System.FilePath

21−import System.Directory

2220import Data.Text (Text)

2321import qualified Data.Text as T

24−import qualified Data.Text.IO as T

2522import Data.Map (Map)

2623import qualified Data.Map as Map

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

2725

2826data StaticConfig = StaticConfig

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

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

3230

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

3432writeStaticProject paths target cfg = do

35− createDirectoryIfMissing True target

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

3733 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

4234 modContents <- staticModuleFile modName paths

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

44−

45−staticCabalFile :: StaticConfig -> Text

46−staticCabalFile cfg = T.unlines

47− [ "name: " <> _staticConfig_packageName cfg

48− , "version: 0"

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

35+ writeCabalProject target $ SimplePkg

36+ { _simplePkg_name = _staticConfig_packageName cfg

37+ , _simplePkg_moduleName = _staticConfig_moduleName cfg

38+ , _simplePkg_moduleContents = modContents

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

40+ }

6041

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

6243staticModuleFile moduleName paths = do

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

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

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

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

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

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

7354 , ""

7455 , "import qualified GHC.Types"

7556 , "import Data.Text (Text)"

lib/asset/manifest/src/Obelisk/Asset/TH.hs+5

@@ -1,9 +1,14 @@

1+{-|

2+Description:

3+ Template Haskell for generating asset paths.

4+-}

15module Obelisk.Asset.TH

26 ( assetPath

37 ) where

59import Obelisk.Asset.Gather

610

11+import Language.Haskell.TH

712import Language.Haskell.TH.Syntax

813import System.FilePath.Posix

914

lib/command/src/Obelisk/Command/Project.hs+8

@@ -16,6 +16,7 @@ module Obelisk.Command.Project

1616 , toObeliskDir

1717 , withProjectRoot

1818 , bashEscape

19+ , getHaskellManifestProjectPath

1920 ) where

2021

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

@@ -353,3 +354,10 @@ findProjectAssets root = do

353354 ]

354355 else readProcessAndLogStderr Debug $ setCwd (Just root) $

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

357+

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

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

360+ proc nixBuildExePath

361+ [ "-E"

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

363+ ]

lib/command/src/Obelisk/Command/Run.hs+6−3

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

7777 withSpinner,

7878 )

7979import Obelisk.Command.Nix

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

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

8181import Obelisk.Command.Thunk (attrCacheFileName)

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

8383

@@ -164,8 +164,9 @@ run :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

164164run root interpretPaths = do

165165 pkgs <- getParsedLocalPkgs root interpretPaths

166166 assets <- findProjectAssets root

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

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

168− ghciArgs <- getGhciSessionSettings pkgs root True

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

169170 freePort <- getFreePort

170171 withGhciScriptArgs pkgs $ \dotGhciArgs -> do

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

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

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

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

402403 -> m ()

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

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

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

404406 where

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

406408 -- is passed to the ghci session.

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

458460

459461 pure

460462 $ baseGhciOptions

463+ <> ["-DPASSTHRU"] -- For passthrough static assets

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

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

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

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

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

1−{-# LANGUAGE DataKinds #-}

21{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE TypeApplications #-}

2+{-# LANGUAGE TemplateHaskell #-}

54module Frontend where

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

2726frontend = Frontend

2827 { _frontend_head = do

2928 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

3130 , _frontend_body = do

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

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

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

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

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

4039

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

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

4241 el "div" $ do

4342 exampleConfig <- getConfig "common/example"

4443 case exampleConfig of