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

   1 From 41d219a29b03f3114af7a0521c8b2dbbb487c3e1 Mon Sep 17 00:00:00 2001
   2 From: Philip McGrath <philip@philipmcgrath.com>
   3 Date: Wed, 13 Apr 2022 18:45:58 -0400
   4 Subject: [PATCH] reactor: look for static files relative to executable
   5
   6 Must built with `-DGUIX_REACTOR_STATIC_REL_ROOT="../path/to/reactor"`.
   7
   8 This lets us build a version of Elm without the `elm reactor` for
   9 bootstrapping, then simply put the files in place in the final package.
  10 ---
  11  elm.cabal                                 |  2 +-
  12  terminal/src/Develop.hs                   | 32 +++++++++++----
  13  terminal/src/Develop/StaticFiles.hs       | 37 ++++++++++-------
  14  terminal/src/Develop/StaticFiles/Build.hs | 50 ++++++++++++++---------
  15  4 files changed, 79 insertions(+), 42 deletions(-)
  16
  17 diff --git a/elm.cabal b/elm.cabal
  18 index bf1cfcf0..93161072 100644
  19 --- a/elm.cabal
  20 +++ b/elm.cabal
  21 @@ -50,6 +50,7 @@ Executable elm
  22
  23      other-extensions:
  24          TemplateHaskell
  25 +        CPP
  26
  27      Main-Is:
  28          Main.hs
  29 @@ -211,7 +212,6 @@ Executable elm
  30          containers >= 0.5.8.2 && < 0.6,
  31          directory >= 1.2.3.0 && < 2.0,
  32          edit-distance >= 0.2 && < 0.3,
  33 -        file-embed,
  34          filelock,
  35          filepath >= 1 && < 2.0,
  36          ghc-prim >= 0.5.2,
  37 diff --git a/terminal/src/Develop.hs b/terminal/src/Develop.hs
  38 index 00339364..6855b03e 100644
  39 --- a/terminal/src/Develop.hs
  40 +++ b/terminal/src/Develop.hs
  41 @@ -33,6 +33,7 @@ import qualified Reporting.Exit as Exit
  42  import qualified Reporting.Task as Task
  43  import qualified Stuff
  44
  45 +import System.Exit as SysExit
  46
  47
  48  -- RUN THE DEV SERVER
  49 @@ -45,13 +46,29 @@ data Flags =
  50
  51
  52  run :: () -> Flags -> IO ()
  53 -run () (Flags maybePort) =
  54 +run () flags = do
  55 +  frontEnd <- StaticFiles.prepare
  56 +  case frontEnd of
  57 +    Right lookup ->
  58 +      reallyRun lookup flags
  59 +    Left missing ->
  60 +      SysExit.die $ unlines
  61 +      [ "The `reactor` command is not available."
  62 +      , ""
  63 +      , "On Guix, these files are needed for `elm reactor` to work,"
  64 +      , "but they are missing:"
  65 +      , ""
  66 +      , unlines (map (\pth -> "    " ++ (show pth)) missing)
  67 +      ]
  68 +
  69 +reallyRun :: StaticFiles.Lookup -> Flags -> IO ()
  70 +reallyRun lookup (Flags maybePort) =
  71    do  let port = maybe 8000 id maybePort
  72        putStrLn $ "Go to http://localhost:" ++ show port ++ " to see your project dashboard."
  73        httpServe (config port) $
  74          serveFiles
  75          <|> serveDirectoryWith directoryConfig "."
  76 -        <|> serveAssets
  77 +        <|> serveAssets lookup
  78          <|> error404
  79
  80
  81 @@ -169,16 +186,15 @@ compile path =
  82  -- SERVE STATIC ASSETS
  83
  84
  85 -serveAssets :: Snap ()
  86 -serveAssets =
  87 +serveAssets :: StaticFiles.Lookup -> Snap ()
  88 +serveAssets lookup =
  89    do  path <- getSafePath
  90 -      case StaticFiles.lookup path of
  91 +      case lookup path of
  92          Nothing ->
  93            pass
  94
  95 -        Just (content, mimeType) ->
  96 -          do  modifyResponse (setContentType (mimeType <> ";charset=utf-8"))
  97 -              writeBS content
  98 +        Just (fsPath, mimeType) ->
  99 +          serveFileAs (mimeType <> ";charset=utf-8") fsPath
 100
 101
 102
 103 diff --git a/terminal/src/Develop/StaticFiles.hs b/terminal/src/Develop/StaticFiles.hs
 104 index 94ee72dc..3227d617 100644
 105 --- a/terminal/src/Develop/StaticFiles.hs
 106 +++ b/terminal/src/Develop/StaticFiles.hs
 107 @@ -2,7 +2,8 @@
 108  {-# LANGUAGE OverloadedStrings #-}
 109  {-# LANGUAGE TemplateHaskell #-}
 110  module Develop.StaticFiles
 111 -  ( lookup
 112 +  ( prepare
 113 +  , Lookup
 114    , cssPath
 115    , elmPath
 116    , waitingPath
 117 @@ -11,9 +12,7 @@ module Develop.StaticFiles
 118
 119  import Prelude hiding (lookup)
 120  import qualified Data.ByteString as BS
 121 -import Data.FileEmbed (bsToExp)
 122  import qualified Data.HashMap.Strict as HM
 123 -import Language.Haskell.TH (runIO)
 124  import System.FilePath ((</>))
 125
 126  import qualified Develop.StaticFiles.Build as Build
 127 @@ -26,20 +25,29 @@ import qualified Develop.StaticFiles.Build as Build
 128  type MimeType =
 129    BS.ByteString
 130
 131 +type Lookup = FilePath -> Maybe (FilePath, MimeType)
 132
 133 -lookup :: FilePath -> Maybe (BS.ByteString, MimeType)
 134 -lookup path =
 135 +prepare :: IO (Either [FilePath] Lookup)
 136 +prepare = do
 137 +  found <- Build.findReactorFrontEnd expectedFiles
 138 +  return $ case found of
 139 +    Left missing ->
 140 +      Left missing
 141 +    Right resolved ->
 142 +      Right (mkLookup (HM.fromList resolved))
 143 +
 144 +mkLookup :: HM.HashMap FilePath (FilePath, MimeType) -> Lookup
 145 +mkLookup dict path =
 146    HM.lookup path dict
 147
 148
 149 -dict :: HM.HashMap FilePath (BS.ByteString, MimeType)
 150 -dict =
 151 -  HM.fromList
 152 -    [ faviconPath  ==> (favicon , "image/x-icon")
 153 -    , elmPath      ==> (elm     , "application/javascript")
 154 -    , cssPath      ==> (css     , "text/css")
 155 -    , codeFontPath ==> (codeFont, "font/ttf")
 156 -    , sansFontPath ==> (sansFont, "font/ttf")
 157 +expectedFiles :: [(FilePath, MimeType)]
 158 +expectedFiles =
 159 +    [ faviconPath  ==> "image/x-icon"
 160 +    , elmPath      ==> "application/javascript"
 161 +    , cssPath      ==> "text/css"
 162 +    , codeFontPath ==> "font/ttf"
 163 +    , sansFontPath ==> "font/ttf"
 164      ]
 165
 166
 167 @@ -82,7 +90,7 @@ sansFontPath =
 168    "_elm" </> "source-sans-pro.ttf"
 169
 170
 171 -
 172 +{-
 173  -- ELM
 174
 175
 176 @@ -121,3 +129,4 @@ sansFont =
 177  favicon :: BS.ByteString
 178  favicon =
 179    $(bsToExp =<< runIO (Build.readAsset "favicon.ico"))
 180 +-}
 181 diff --git a/terminal/src/Develop/StaticFiles/Build.hs b/terminal/src/Develop/StaticFiles/Build.hs
 182 index c61fae57..c39b08b0 100644
 183 --- a/terminal/src/Develop/StaticFiles/Build.hs
 184 +++ b/terminal/src/Develop/StaticFiles/Build.hs
 185 @@ -1,28 +1,39 @@
 186  {-# LANGUAGE OverloadedStrings #-}
 187 +{-# LANGUAGE CPP #-}
 188  module Develop.StaticFiles.Build
 189 -  ( readAsset
 190 -  , buildReactorFrontEnd
 191 +  ( findReactorFrontEnd
 192    )
 193    where
 194
 195 -
 196 -import qualified Data.ByteString as BS
 197 -import qualified Data.ByteString.Builder as B
 198 -import qualified Data.ByteString.Lazy as LBS
 199 -import qualified Data.NonEmptyList as NE
 200  import qualified System.Directory as Dir
 201 -import System.FilePath ((</>))
 202 -
 203 -import qualified BackgroundWriter as BW
 204 -import qualified Build
 205 -import qualified Elm.Details as Details
 206 -import qualified Generate
 207 -import qualified Reporting
 208 -import qualified Reporting.Exit as Exit
 209 -import qualified Reporting.Task as Task
 210 -
 211 -
 212 -
 213 +import System.FilePath ((</>), takeDirectory)
 214 +import System.Environment (getExecutablePath)
 215 +import Data.Either as Either
 216 +
 217 +reactorStaticRelRoot :: FilePath
 218 +reactorStaticRelRoot = GUIX_REACTOR_STATIC_REL_ROOT
 219 +
 220 +type Resolved a = (FilePath, (FilePath, a))
 221 +
 222 +findReactorFrontEnd :: [(FilePath, a)] -> IO (Either [FilePath] [Resolved a])
 223 +findReactorFrontEnd specs = do
 224 +  exe <- getExecutablePath
 225 +  let dir = takeDirectory exe </> reactorStaticRelRoot
 226 +  dirExists <- Dir.doesDirectoryExist dir
 227 +  files <- sequence (map (findFile dir) specs)
 228 +  return $ case Either.lefts files of
 229 +           [] ->
 230 +             Right (Either.rights files)
 231 +           missing ->
 232 +             Left $ if dirExists then missing else [dir]
 233 +
 234 +findFile :: FilePath -> (FilePath, a) -> IO (Either FilePath (Resolved a))
 235 +findFile dir (rel, rhs) = do
 236 +  let abs = dir </> rel
 237 +  exists <- Dir.doesFileExist abs
 238 +  return $ if not exists then Left abs else Right (rel, (abs, rhs))
 239 +
 240 +{-
 241  -- ASSETS
 242
 243
 244 @@ -71,3 +82,4 @@ runTaskUnsafe task =
 245                  \\nCompile with `elm make` directly to figure it out faster\
 246                  \\n--------------------------------------------------------\
 247                  \\n"
 248 +-}
 249 --
 250 2.32.0
 251