summaryrefslogtreecommitdiff
path: root/gnu/packages/patches/elm-reactor-static-files.patch
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/packages/patches/elm-reactor-static-files.patch')
-rw-r--r--gnu/packages/patches/elm-reactor-static-files.patch251
1 files changed, 251 insertions, 0 deletions
diff --git a/gnu/packages/patches/elm-reactor-static-files.patch b/gnu/packages/patches/elm-reactor-static-files.patch
new file mode 100644
index 0000000000..94c4aa0cd1
--- /dev/null
+++ b/gnu/packages/patches/elm-reactor-static-files.patch
@@ -0,0 +1,251 @@
+From 41d219a29b03f3114af7a0521c8b2dbbb487c3e1 Mon Sep 17 00:00:00 2001
+From: Philip McGrath <philip@philipmcgrath.com>
+Date: Wed, 13 Apr 2022 18:45:58 -0400
+Subject: [PATCH] reactor: look for static files relative to executable
+
+Must built with `-DGUIX_REACTOR_STATIC_REL_ROOT="../path/to/reactor"`.
+
+This lets us build a version of Elm without the `elm reactor` for
+bootstrapping, then simply put the files in place in the final package.
+---
+ elm.cabal | 2 +-
+ terminal/src/Develop.hs | 32 +++++++++++----
+ terminal/src/Develop/StaticFiles.hs | 37 ++++++++++-------
+ terminal/src/Develop/StaticFiles/Build.hs | 50 ++++++++++++++---------
+ 4 files changed, 79 insertions(+), 42 deletions(-)
+
+diff --git a/elm.cabal b/elm.cabal
+index bf1cfcf0..93161072 100644
+--- a/elm.cabal
++++ b/elm.cabal
+@@ -50,6 +50,7 @@ Executable elm
+
+ other-extensions:
+ TemplateHaskell
++ CPP
+
+ Main-Is:
+ Main.hs
+@@ -211,7 +212,6 @@ Executable elm
+ containers >= 0.5.8.2 && < 0.6,
+ directory >= 1.2.3.0 && < 2.0,
+ edit-distance >= 0.2 && < 0.3,
+- file-embed,
+ filelock,
+ filepath >= 1 && < 2.0,
+ ghc-prim >= 0.5.2,
+diff --git a/terminal/src/Develop.hs b/terminal/src/Develop.hs
+index 00339364..6855b03e 100644
+--- a/terminal/src/Develop.hs
++++ b/terminal/src/Develop.hs
+@@ -33,6 +33,7 @@ import qualified Reporting.Exit as Exit
+ import qualified Reporting.Task as Task
+ import qualified Stuff
+
++import System.Exit as SysExit
+
+
+ -- RUN THE DEV SERVER
+@@ -45,13 +46,29 @@ data Flags =
+
+
+ run :: () -> Flags -> IO ()
+-run () (Flags maybePort) =
++run () flags = do
++ frontEnd <- StaticFiles.prepare
++ case frontEnd of
++ Right lookup ->
++ reallyRun lookup flags
++ Left missing ->
++ SysExit.die $ unlines
++ [ "The `reactor` command is not available."
++ , ""
++ , "On Guix, these files are needed for `elm reactor` to work,"
++ , "but they are missing:"
++ , ""
++ , unlines (map (\pth -> " " ++ (show pth)) missing)
++ ]
++
++reallyRun :: StaticFiles.Lookup -> Flags -> IO ()
++reallyRun lookup (Flags maybePort) =
+ do let port = maybe 8000 id maybePort
+ putStrLn $ "Go to http://localhost:" ++ show port ++ " to see your project dashboard."
+ httpServe (config port) $
+ serveFiles
+ <|> serveDirectoryWith directoryConfig "."
+- <|> serveAssets
++ <|> serveAssets lookup
+ <|> error404
+
+
+@@ -169,16 +186,15 @@ compile path =
+ -- SERVE STATIC ASSETS
+
+
+-serveAssets :: Snap ()
+-serveAssets =
++serveAssets :: StaticFiles.Lookup -> Snap ()
++serveAssets lookup =
+ do path <- getSafePath
+- case StaticFiles.lookup path of
++ case lookup path of
+ Nothing ->
+ pass
+
+- Just (content, mimeType) ->
+- do modifyResponse (setContentType (mimeType <> ";charset=utf-8"))
+- writeBS content
++ Just (fsPath, mimeType) ->
++ serveFileAs (mimeType <> ";charset=utf-8") fsPath
+
+
+
+diff --git a/terminal/src/Develop/StaticFiles.hs b/terminal/src/Develop/StaticFiles.hs
+index 94ee72dc..3227d617 100644
+--- a/terminal/src/Develop/StaticFiles.hs
++++ b/terminal/src/Develop/StaticFiles.hs
+@@ -2,7 +2,8 @@
+ {-# LANGUAGE OverloadedStrings #-}
+ {-# LANGUAGE TemplateHaskell #-}
+ module Develop.StaticFiles
+- ( lookup
++ ( prepare
++ , Lookup
+ , cssPath
+ , elmPath
+ , waitingPath
+@@ -11,9 +12,7 @@ module Develop.StaticFiles
+
+ import Prelude hiding (lookup)
+ import qualified Data.ByteString as BS
+-import Data.FileEmbed (bsToExp)
+ import qualified Data.HashMap.Strict as HM
+-import Language.Haskell.TH (runIO)
+ import System.FilePath ((</>))
+
+ import qualified Develop.StaticFiles.Build as Build
+@@ -26,20 +25,29 @@ import qualified Develop.StaticFiles.Build as Build
+ type MimeType =
+ BS.ByteString
+
++type Lookup = FilePath -> Maybe (FilePath, MimeType)
+
+-lookup :: FilePath -> Maybe (BS.ByteString, MimeType)
+-lookup path =
++prepare :: IO (Either [FilePath] Lookup)
++prepare = do
++ found <- Build.findReactorFrontEnd expectedFiles
++ return $ case found of
++ Left missing ->
++ Left missing
++ Right resolved ->
++ Right (mkLookup (HM.fromList resolved))
++
++mkLookup :: HM.HashMap FilePath (FilePath, MimeType) -> Lookup
++mkLookup dict path =
+ HM.lookup path dict
+
+
+-dict :: HM.HashMap FilePath (BS.ByteString, MimeType)
+-dict =
+- HM.fromList
+- [ faviconPath ==> (favicon , "image/x-icon")
+- , elmPath ==> (elm , "application/javascript")
+- , cssPath ==> (css , "text/css")
+- , codeFontPath ==> (codeFont, "font/ttf")
+- , sansFontPath ==> (sansFont, "font/ttf")
++expectedFiles :: [(FilePath, MimeType)]
++expectedFiles =
++ [ faviconPath ==> "image/x-icon"
++ , elmPath ==> "application/javascript"
++ , cssPath ==> "text/css"
++ , codeFontPath ==> "font/ttf"
++ , sansFontPath ==> "font/ttf"
+ ]
+
+
+@@ -82,7 +90,7 @@ sansFontPath =
+ "_elm" </> "source-sans-pro.ttf"
+
+
+-
++{-
+ -- ELM
+
+
+@@ -121,3 +129,4 @@ sansFont =
+ favicon :: BS.ByteString
+ favicon =
+ $(bsToExp =<< runIO (Build.readAsset "favicon.ico"))
++-}
+diff --git a/terminal/src/Develop/StaticFiles/Build.hs b/terminal/src/Develop/StaticFiles/Build.hs
+index c61fae57..c39b08b0 100644
+--- a/terminal/src/Develop/StaticFiles/Build.hs
++++ b/terminal/src/Develop/StaticFiles/Build.hs
+@@ -1,28 +1,39 @@
+ {-# LANGUAGE OverloadedStrings #-}
++{-# LANGUAGE CPP #-}
+ module Develop.StaticFiles.Build
+- ( readAsset
+- , buildReactorFrontEnd
++ ( findReactorFrontEnd
+ )
+ where
+
+-
+-import qualified Data.ByteString as BS
+-import qualified Data.ByteString.Builder as B
+-import qualified Data.ByteString.Lazy as LBS
+-import qualified Data.NonEmptyList as NE
+ import qualified System.Directory as Dir
+-import System.FilePath ((</>))
+-
+-import qualified BackgroundWriter as BW
+-import qualified Build
+-import qualified Elm.Details as Details
+-import qualified Generate
+-import qualified Reporting
+-import qualified Reporting.Exit as Exit
+-import qualified Reporting.Task as Task
+-
+-
+-
++import System.FilePath ((</>), takeDirectory)
++import System.Environment (getExecutablePath)
++import Data.Either as Either
++
++reactorStaticRelRoot :: FilePath
++reactorStaticRelRoot = GUIX_REACTOR_STATIC_REL_ROOT
++
++type Resolved a = (FilePath, (FilePath, a))
++
++findReactorFrontEnd :: [(FilePath, a)] -> IO (Either [FilePath] [Resolved a])
++findReactorFrontEnd specs = do
++ exe <- getExecutablePath
++ let dir = takeDirectory exe </> reactorStaticRelRoot
++ dirExists <- Dir.doesDirectoryExist dir
++ files <- sequence (map (findFile dir) specs)
++ return $ case Either.lefts files of
++ [] ->
++ Right (Either.rights files)
++ missing ->
++ Left $ if dirExists then missing else [dir]
++
++findFile :: FilePath -> (FilePath, a) -> IO (Either FilePath (Resolved a))
++findFile dir (rel, rhs) = do
++ let abs = dir </> rel
++ exists <- Dir.doesFileExist abs
++ return $ if not exists then Left abs else Right (rel, (abs, rhs))
++
++{-
+ -- ASSETS
+
+
+@@ -71,3 +82,4 @@ runTaskUnsafe task =
+ \\nCompile with `elm make` directly to figure it out faster\
+ \\n--------------------------------------------------------\
+ \\n"
++-}
+--
+2.32.0
+
generated by cgit v1.2.3 (git 2.47.1) at 2025-01-22 04:37:02 +0000