From 41d219a29b03f3114af7a0521c8b2dbbb487c3e1 Mon Sep 17 00:00:00 2001 From: Philip McGrath 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