ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gnu: elm-compiler: Update to 0.19.1.

Browse source 
* gnu/packages/patches/elm-compiler-disable-reactor.patch,
gnu/packages/patches/elm-compiler-fix-map-key.patch: Delete files.
* gnu/packages/patches/elm-reactor-static-files.patch: New file.
* gnu/local.mk (dist_patch_DATA): Update accordingly.
* gnu/packages/elm.scm (elm-compiler): Update to 0.19.1.
[origin]<patches>: Remove stale patches. Add new patch.
[arguments]: Use G-expressions. Add #:configure-flags for new patch.
[inputs]: Remove ghc-file-embed. Add ghc-filelock.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Philip McGrath 2022-05-18 14:10:48 -04:00 committed by Ludovic Courtès
parent 014f97544d
commit 4e99510dea
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
5 changed files with 280 additions and 127 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
gnu/local.mk
View file

@ -1024,8 +1024,7 @@ dist_patch_DATA = \
%D%/packages/patches/einstein-build.patch \
%D%/packages/patches/elfutils-tests-ptrace.patch \
%D%/packages/patches/elixir-path-length.patch \
%D%/packages/patches/elm-compiler-disable-reactor.patch \
%D%/packages/patches/elm-compiler-fix-map-key.patch \
%D%/packages/patches/elm-reactor-static-files.patch \
%D%/packages/patches/elogind-revert-polkit-detection.patch \
%D%/packages/patches/emacs-exec-path.patch \
%D%/packages/patches/emacs-ess-fix-obsolete-function-alias.patch \

44
gnu/packages/elm.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -24,18 +25,24 @@ (define-module (gnu packages elm)
#:use-module (gnu packages haskell-xyz)
#:use-module (gnu packages haskell-web)
#:use-module (guix build-system haskell)
#:use-module (guix gexp)
#:use-module (guix git-download)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages))
;; The full elm build calls out to itself via Template Haskell to
;; compile the elm reactor web app. elm reactor isn't required to
;; compile elm applications, so we take this part out of this
;; bootstrap package.
;; The `elm` build usually calls out to itself via Template Haskell to compile
;; the `elm reactor` web app (which depends on additional Elm packages) and
;; embeds the static files into itself. The reactor isn't required to compile
;; Elm applications, so we want to skip it for the bootstrap package, but we
;; also want to be able to enable it once we can build it. We patch Elm to
;; instead look for the files on disk relative to the executable and to have
;; `elm reactor` exit with a useful error message if they aren't there.
(define %reactor-root-base
"share/elm/reactor-")
(define-public elm-compiler
(package
(name "elm-compiler")
(version "0.19.0")
(version "0.19.1")
(source
(origin
(method git-fetch)
@ -44,24 +51,29 @@ (define-public elm-compiler
(url "https://github.com/elm/compiler/")
(commit version)))
(sha256
(base32 "0s93z9vr0vp5w894ghc5s34nsq09sg1msf59zfiba87sid5vgjqy"))
(base32 "1rdg3xp3js9xadclk3cdypkscm5wahgsfmm4ldcw3xswzhw6ri8w"))
(patches
(search-patches "elm-compiler-disable-reactor.patch"
"elm-compiler-fix-map-key.patch"))))
(search-patches "elm-reactor-static-files.patch"))))
(build-system haskell-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-before 'configure 'update-constraints
(lambda _
(substitute* "elm.cabal"
(("(ansi-terminal|containers|network|http-client|language-glsl)\\s+[^,]+" all dep)
dep)))))))
(list
#:configure-flags
#~(list (string-append "--ghc-option=-DGUIX_REACTOR_STATIC_REL_ROOT="
"\"../" #$%reactor-root-base
#$(package-version this-package)
"\""))
#:phases
#~(modify-phases %standard-phases
(add-before 'configure 'update-constraints
(lambda _
(substitute* "elm.cabal"
(("(ansi-terminal|containers|network|http-client|language-glsl)\\s+[^,]+" all dep)
dep)))))))
(inputs
(list ghc-ansi-terminal
ghc-ansi-wl-pprint
ghc-edit-distance
ghc-file-embed
ghc-filelock
ghc-http
ghc-http-client
ghc-http-client-tls

71
gnu/packages/patches/elm-compiler-disable-reactor.patch
View file

@ -1,71 +0,0 @@
commit 20d80e2323b565a36751c9455e535d8f73fa32f7
Author: Robert Vollmert <rob@vllmrt.net>
Date: Fri Jun 14 16:05:47 2019 +0200
disable reactor
diff --git a/elm.cabal b/elm.cabal
index c75f9689..ece63c46 100644
--- a/elm.cabal
+++ b/elm.cabal
@@ -45,9 +45,6 @@ Executable elm
builder/src
ui/terminal/src
- other-extensions:
- TemplateHaskell
-
Main-Is:
Main.hs
@@ -56,8 +53,6 @@ Executable elm
Develop
Develop.Generate.Help
Develop.Generate.Index
- Develop.StaticFiles
- Develop.StaticFiles.Build
Diff
Init
Install
diff --git a/ui/terminal/src/Develop.hs b/ui/terminal/src/Develop.hs
index 4b2252e1..7ed7716e 100644
--- a/ui/terminal/src/Develop.hs
+++ b/ui/terminal/src/Develop.hs
@@ -23,7 +23,6 @@ import Snap.Util.FileServe
import qualified Elm.Project as Project
import qualified Develop.Generate.Help as Generate
import qualified Develop.Generate.Index as Index
-import qualified Develop.StaticFiles as StaticFiles
import qualified Generate.Output as Output
import qualified Json.Encode as Encode
import qualified Reporting.Exit as Exit
@@ -219,16 +218,7 @@ compileToHtmlBuilder mode file =
serveAssets :: Snap ()
-serveAssets =
- do file <- getSafePath
- case StaticFiles.lookup file of
- Nothing ->
- pass
-
- Just (content, mimeType) ->
- do modifyResponse (setContentType (mimeType <> ";charset=utf-8"))
- writeBS content
-
+serveAssets = pass
-- MIME TYPES
diff --git a/ui/terminal/src/Main.hs b/terminal/src/Main.hs
index 7000f3ca..2c76965a 100644
--- a/ui/terminal/src/Main.hs
+++ b/ui/terminal/src/Main.hs
@@ -39,7 +39,6 @@ main =
complex intro outro
[ repl
, init
- , reactor
, make
, install
, bump

38
gnu/packages/patches/elm-compiler-fix-map-key.patch
View file

@ -1,38 +0,0 @@
commit e3512d887df41a8162c3e361171c04beca08415b
Author: Tom Stejskal <tom.stejskal@gmail.com>
Date: Mon Nov 19 20:09:43 2018 +0100
Fix Map.!: given key is not an element in the map
diff --git a/compiler/src/Elm/Compiler/Type/Extract.hs b/compiler/src/Elm/Compiler/Type/Extract.hs
index 1aafe1d4..99763392 100644
--- a/compiler/src/Elm/Compiler/Type/Extract.hs
+++ b/compiler/src/Elm/Compiler/Type/Extract.hs
@@ -10,6 +10,7 @@ module Elm.Compiler.Type.Extract
import Data.Map ((!))
+import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
@@ -134,11 +135,15 @@ extractUnion interfaces (Opt.Global home name) =
else
let
pname = toPublicName home name
- unions = I._unions (interfaces ! home)
+ maybeUnions = I._unions <$> Map.lookup home interfaces
in
- case I.toUnionInternals (unions ! name) of
- Can.Union vars ctors _ _ ->
- T.Union pname vars <$> traverse extractCtor ctors
+ case Map.lookup name =<< maybeUnions of
+ Just union ->
+ case I.toUnionInternals union of
+ Can.Union vars ctors _ _ ->
+ T.Union pname vars <$> traverse extractCtor ctors
+ Nothing ->
+ return $ T.Union pname [] []
extractCtor :: Can.Ctor -> Extractor (N.Name, [T.Type])

251
gnu/packages/patches/elm-reactor-static-files.patch Normal file
View file

@ -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