guix/gnu/packages/patches/elm-reactor-static-files.patch

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