252 lines
7.1 KiB
Diff
252 lines
7.1 KiB
Diff
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
|
|
|