git.iko.soy/lynxjs-elm/compiler
on master help sign in
Dev command: raw rspack bundler with miso-lynx runtime pattern

- Switch from rspeedy/ReactLynx to raw rspack + LynxEncodePlugin/LynxTemplatePlugin - Entry: stubs.js + elm.js + init.js concatenated into all.js - Runtime stubs: runWorklet, renderPage (creates page), processData, etc. - Dev server: rspack build + npx serve (static file server) - Prints LynxJS Explorer URL with local IP

commite7fa0a84c727c409ea57f0d12d73cdfb5584d000 authoriko <mail@iko.soy> dateWed 18 Mar 2026, 04:53 (7 months ago) parent43aef00
8 files changed+652−8
compare with master
unifiedsplit
compiler/src/Generate/Html.hs+175−1 compiler/src/Generate/JavaScript.hs+1−1 lynxjs-elm.cabal+1 stack.yaml+4 terminal/src/Dev.hs+287 terminal/src/Develop.hs+48−1 terminal/src/Main.hs+29 terminal/src/Make.hs+107−5
compiler/src/Generate/Html.hs+175−1
@@ -2,6 +2,7 @@
22{-# LANGUAGE QuasiQuotes #-}
33module Generate.Html
44 ( sandwich
5+ , sandwichReactor
56 )
67 where
78
@@ -18,6 +19,179 @@ import Text.RawString.QQ (r)
1819sandwich :: Name.Name -> B.Builder -> B.Builder
1920sandwich moduleName javascript =
2021 let name = Name.toBuilder moduleName in
21− javascript <> [r|
22+ [r|<!DOCTYPE html>
23+<html>
24+<head>
25+<meta charset="UTF-8">
26+<meta name="viewport" content="width=device-width, initial-scale=1">
27+<title>LynxJS-Elm</title>
28+<style>
29+*, *::before, *::after { box-sizing: border-box; margin: 0; padding: 0; }
30+body { font-family: -apple-system, BlinkMacSystemFont, "Segoe UI", Roboto, sans-serif; }
31+</style>
32+</head>
33+<body>
34+<script>
35+|] <> polyfill <> [r|
36+</script>
37+<script>
38+|] <> javascript <> [r|
2239var app = Elm.|] <> name <> [r|.init({});
40+</script>
41+</body>
42+</html>
43+|]
44+
45+
46+
47+-- REACTOR SANDWICH (with live reload)
48+
49+
50+sandwichReactor :: Name.Name -> B.Builder -> B.Builder
51+sandwichReactor moduleName javascript =
52+ let name = Name.toBuilder moduleName in
53+ [r|<!DOCTYPE html>
54+<html>
55+<head>
56+<meta charset="UTF-8">
57+<meta name="viewport" content="width=device-width, initial-scale=1">
58+<title>LynxJS-Elm</title>
59+<style>
60+*, *::before, *::after { box-sizing: border-box; margin: 0; padding: 0; }
61+body { font-family: -apple-system, BlinkMacSystemFont, "Segoe UI", Roboto, sans-serif; }
62+</style>
63+</head>
64+<body>
65+<script>
66+|] <> polyfill <> [r|
67+</script>
68+<script>
69+|] <> javascript <> [r|
70+var app = Elm.|] <> name <> [r|.init({});
71+</script>
72+<script>
73+|] <> reloadScript <> [r|
74+</script>
75+</body>
76+</html>
77+|]
78+
79+
80+
81+-- LIVE RELOAD SCRIPT
82+
83+
84+reloadScript :: B.Builder
85+reloadScript = [r|
86+(function() {
87+ var lastMtime = null;
88+ function poll() {
89+ fetch('/_elm/watch')
90+ .then(function(r) { return r.text(); })
91+ .then(function(mtime) {
92+ if (lastMtime === null) { lastMtime = mtime; }
93+ else if (mtime !== lastMtime) { location.reload(); }
94+ setTimeout(poll, 500);
95+ })
96+ .catch(function() { setTimeout(poll, 2000); });
97+ }
98+ poll();
99+})();
100+|]
101+
102+
103+
104+-- PAPI POLYFILL
105+
106+
107+polyfill :: B.Builder
108+polyfill = [r|
109+// LynxJS PAPI-to-DOM polyfill for browser preview
110+(function() {
111+ var tagMap = {
112+ 'view': 'div',
113+ 'text': 'span',
114+ 'image': 'img',
115+ 'scroll-view': 'div',
116+ 'input': 'input',
117+ 'textarea': 'textarea',
118+ 'list': 'div'
119+ };
120+
121+ var eventMap = {
122+ 'tap': 'click',
123+ 'longpress': 'contextmenu',
124+ 'touchstart': 'touchstart',
125+ 'touchmove': 'touchmove',
126+ 'touchend': 'touchend',
127+ 'touchcancel': 'touchcancel',
128+ 'input': 'input'
129+ };
130+
131+ var g = typeof globalThis !== 'undefined' ? globalThis : window;
132+
133+ g.__CreatePage = function() {
134+ var page = document.createElement('div');
135+ page.id = 'lynx-page';
136+ document.body.appendChild(page);
137+ return page;
138+ };
139+
140+ g.__CreateElement = function(tag) {
141+ var domTag = tagMap[tag] || 'div';
142+ var el = document.createElement(domTag);
143+ if (tag === 'scroll-view') { el.style.overflow = 'auto'; }
144+ el.setAttribute('data-lynx-tag', tag);
145+ return el;
146+ };
147+
148+ g.__AppendElement = function(parent, child) {
149+ parent.appendChild(child);
150+ };
151+
152+ g.__RemoveElement = function(parent, child) {
153+ parent.removeChild(child);
154+ };
155+
156+ g.__ReplaceElement = function(parent, newEl, oldEl) {
157+ parent.replaceChild(newEl, oldEl);
158+ };
159+
160+ g.__InsertElementBefore = function(parent, child, ref) {
161+ parent.insertBefore(child, ref);
162+ };
163+
164+ g.__SetAttribute = function(el, key, value) {
165+ if (key === 'content' && el.getAttribute('data-lynx-tag') === 'text') {
166+ el.textContent = value;
167+ } else if (key === 'src' && el.tagName === 'IMG') {
168+ el.src = value;
169+ } else {
170+ el.setAttribute(key, value);
171+ }
172+ };
173+
174+ g.__AddEvent = function(el, bindingName, eventName, callback) {
175+ var domEvent = eventMap[eventName] || eventName;
176+ el.addEventListener(domEvent, function(e) {
177+ callback(e);
178+ });
179+ };
180+
181+ g.__SetInlineStyles = function(el, styles) {
182+ Object.assign(el.style, styles);
183+ };
184+
185+ g.__AddInlineStyle = function(el, key, value) {
186+ el.style[key] = value;
187+ };
188+
189+ g.__GetChildren = function(el) {
190+ return Array.from(el.children);
191+ };
192+
193+ g.__GetParent = function(el) {
194+ return el.parentNode;
195+ };
196+})();
23197|]
compiler/src/Generate/JavaScript.hs+1−1
@@ -49,7 +49,7 @@ generate mode (Opt.GlobalGraph graph _) mains =
4949 <> perfNote mode
5050 <> stateToBuilder state
5151 <> toMainExports mode mains
52− <> "}(this));"
52+ <> "}(globalThis));"
5353
5454
5555addMain :: Mode.Mode -> Graph -> ModuleName.Canonical -> Opt.Main -> State -> State
lynxjs-elm.cabal+1
@@ -53,6 +53,7 @@ Executable lynxjs-elm
5353
5454 other-modules:
5555 Bump
56+ Dev
5657 Develop
5758 Diff
5859 Init
stack.yaml+4
@@ -71,3 +71,7 @@ extra-deps:
7171#
7272# Allow a newer minor version of GHC than the snapshot specifies
7373# compiler-check: newer-minor
74+
75+ghc-options:
76+ "$everything": -O2
77+ "$locals": ""
terminal/src/Dev.hsnew file+287
@@ -0,0 +1,287 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Dev
3+ ( Flags(..)
4+ , run
5+ )
6+ where
7+
8+
9+import Control.Concurrent (threadDelay)
10+import Control.Exception (finally)
11+import Control.Monad (when)
12+import qualified Data.List as List
13+import qualified Data.NonEmptyList as NE
14+import qualified Data.Time.Clock.POSIX as Time
15+import qualified System.Directory as Dir
16+import qualified System.Exit as SysExit
17+import System.FilePath ((</>), takeExtension, takeFileName)
18+import qualified System.Process as Process
19+
20+import qualified BackgroundWriter as BW
21+import qualified Build
22+import qualified Elm.Details as Details
23+import qualified File
24+import qualified Generate
25+import qualified Reporting
26+import qualified Reporting.Exit as Exit
27+import qualified Reporting.Task as Task
28+import qualified Stuff
29+
30+
31+
32+-- FLAGS
33+
34+
35+data Flags =
36+ Flags
37+ { _port :: Maybe Int
38+ }
39+
40+
41+
42+-- RUN
43+
44+
45+run :: FilePath -> Flags -> IO ()
46+run path (Flags maybePort) =
47+ do maybeRoot <- Stuff.findRoot
48+ case maybeRoot of
49+ Nothing ->
50+ putStrLn "I cannot find an elm.json file. Run `lynxjs-elm init` first."
51+
52+ Just root ->
53+ do home <- Stuff.getElmHome
54+ let bundlerDir = home </> "bundler"
55+ let srcDir = bundlerDir </> "src"
56+ let elmOutput = srcDir </> "elm.js"
57+ let nodeModules = bundlerDir </> "node_modules"
58+
59+ -- Set up bundler project
60+ let port = maybe 3000 id maybePort
61+ Dir.createDirectoryIfMissing True srcDir
62+ setupBundlerProject bundlerDir port
63+
64+ -- Initial compile
65+ putStrLn "Compiling..."
66+ ok <- compileAndWrite root path elmOutput
67+ when ok $
68+ do -- Install deps if needed
69+ let rspackDir = nodeModules </> "@rspack" </> "cli"
70+ hasCorrectDeps <- Dir.doesDirectoryExist rspackDir
71+ when (not hasCorrectDeps) $
72+ do putStrLn "Installing bundler dependencies..."
73+ callIn bundlerDir "npm" ["install"]
74+
75+ -- Assemble all.js and build bundle
76+ putStrLn "Bundling..."
77+ assembleAndBuild bundlerDir
78+
79+ -- Start static file server in background
80+ let distDir = bundlerDir </> "dist"
81+ let serveProc = (Process.proc "npx" ["serve", "-l", show port, "-n", distDir])
82+ { Process.cwd = Just bundlerDir }
83+ (_, _, _, serveHandle) <- Process.createProcess serveProc
84+
85+ -- Print bundle URL
86+ ip <- getLocalIp
87+ putStrLn ""
88+ putStrLn $ " LynxJS Explorer URL:"
89+ putStrLn $ " http://" ++ ip ++ ":" ++ show port ++ "/main.lynx.bundle"
90+ putStrLn ""
91+
92+ -- Watch for changes, recompile, and rebuild
93+ let cleanup = do Process.terminateProcess serveHandle
94+ _ <- Process.waitForProcess serveHandle
95+ return ()
96+ finally
97+ (watchAndRebuild root path elmOutput bundlerDir)
98+ cleanup
99+
100+
101+
102+-- COMPILE
103+
104+
105+compileAndWrite :: FilePath -> FilePath -> FilePath -> IO Bool
106+compileAndWrite root path elmOutput =
107+ BW.withScope $ \scope -> Stuff.withRootLock root $
108+ do result <- Task.run $
109+ do details <- Task.eio Exit.MakeBadDetails (Details.load Reporting.silent scope root)
110+ artifacts <- Task.eio Exit.MakeCannotBuild (Build.fromPaths Reporting.silent root details (NE.List path []))
111+ Task.mapError Exit.MakeBadGenerate (Generate.dev root details artifacts)
112+ case result of
113+ Left e ->
114+ do _ <- Reporting.attemptWithStyle Reporting.silent Exit.makeToReport (return (Left e))
115+ return False
116+
117+ Right javascript ->
118+ do File.writeBuilder elmOutput javascript
119+ putStrLn " Compiled successfully."
120+ return True
121+
122+
123+
124+-- WATCH
125+
126+
127+assembleAndBuild :: FilePath -> IO ()
128+assembleAndBuild bundlerDir =
129+ do let srcDir = bundlerDir </> "src"
130+ stubs <- readFile (srcDir </> "stubs.js")
131+ elm <- readFile (srcDir </> "elm.js")
132+ initCode <- readFile (srcDir </> "init.js")
133+ writeFile (srcDir </> "all.js") (stubs ++ elm ++ initCode)
134+ callIn bundlerDir "npx" ["rspack", "build"]
135+
136+
137+watchAndRebuild :: FilePath -> FilePath -> FilePath -> FilePath -> IO ()
138+watchAndRebuild root path elmOutput bundlerDir =
139+ do mtime <- getMaxMtime root
140+ loop mtime
141+ where
142+ loop lastMtime =
143+ do threadDelay 500000 -- 500ms
144+ mtime <- getMaxMtime root
145+ when (mtime /= lastMtime) $
146+ do putStrLn "\nRecompiling..."
147+ ok <- compileAndWrite root path elmOutput
148+ when ok $
149+ do putStrLn "Bundling..."
150+ assembleAndBuild bundlerDir
151+ loop mtime
152+
153+
154+getMaxMtime :: FilePath -> IO Double
155+getMaxMtime root =
156+ do files <- findElmFiles root
157+ case files of
158+ [] -> return 0
159+ _ ->
160+ do times <- mapM Dir.getModificationTime files
161+ return $ maximum $ map (realToFrac . Time.utcTimeToPOSIXSeconds) times
162+
163+
164+findElmFiles :: FilePath -> IO [FilePath]
165+findElmFiles dir =
166+ do entries <- Dir.listDirectory dir
167+ let paths = map (dir </>) entries
168+ files <- mapM classify paths
169+ return (concat files)
170+ where
171+ classify fp =
172+ do isDir <- Dir.doesDirectoryExist fp
173+ case (isDir, isHidden fp) of
174+ (True, False) -> findElmFiles fp
175+ (True, True) -> return []
176+ _ -> return [fp | takeExtension fp == ".elm"]
177+
178+ isHidden fp =
179+ case takeFileName fp of
180+ '.':_ -> True
181+ _ -> List.isPrefixOf "elm-stuff" (takeFileName fp)
182+
183+
184+
185+-- BUNDLER PROJECT
186+
187+
188+setupBundlerProject :: FilePath -> Int -> IO ()
189+setupBundlerProject dir _port =
190+ do let pkgFile = dir </> "package.json"
191+ let cfgFile = dir </> "rspack.config.js"
192+ let stubsFile = dir </> "src" </> "stubs.js"
193+ let initFile = dir </> "src" </> "init.js"
194+ writeFile pkgFile packageJson
195+ writeFile cfgFile rspackConfig
196+ writeFile stubsFile stubsJs
197+ writeFile initFile initJs
198+
199+
200+getLocalIp :: IO String
201+getLocalIp =
202+ do let proc = Process.proc "ipconfig" ["getifaddr", "en0"]
203+ result <- Process.readCreateProcess proc ""
204+ case lines result of
205+ (ip:_) -> return ip
206+ _ -> return "localhost"
207+
208+
209+callIn :: FilePath -> String -> [String] -> IO ()
210+callIn dir cmd cmdArgs =
211+ do let proc = (Process.proc cmd cmdArgs) { Process.cwd = Just dir }
212+ (_, _, _, ph) <- Process.createProcess proc
213+ exitCode <- Process.waitForProcess ph
214+ case exitCode of
215+ SysExit.ExitSuccess -> return ()
216+ SysExit.ExitFailure code ->
217+ error $ cmd ++ " failed with exit code " ++ show code
218+
219+
220+packageJson :: String
221+packageJson = unlines
222+ [ "{"
223+ , " \"name\": \"lynxjs-elm-bundler\","
224+ , " \"private\": true,"
225+ , " \"type\": \"module\","
226+ , " \"dependencies\": {"
227+ , " \"@lynx-js/template-webpack-plugin\": \"0.6.4\","
228+ , " \"@rspack/cli\": \"^1.7.0\","
229+ , " \"@rspack/core\": \"^1.7.0\""
230+ , " }"
231+ , "}"
232+ ]
233+
234+
235+rspackConfig :: String
236+rspackConfig = unlines
237+ [ "import { LynxEncodePlugin, LynxTemplatePlugin } from '@lynx-js/template-webpack-plugin';"
238+ , "import { defineConfig } from '@rspack/cli';"
239+ , ""
240+ , "export default defineConfig({"
241+ , " entry: { main: './src/all.js' },"
242+ , " plugins: ["
243+ , " new LynxEncodePlugin(),"
244+ , " new LynxTemplatePlugin({ filename: 'main.lynx.bundle', intermediate: 'main' }),"
245+ , " (compiler) => {"
246+ , " compiler.hooks.thisCompilation.tap('MarkMainThread', (compilation) => {"
247+ , " compilation.hooks.processAssets.tap('MarkMainThread', () => {"
248+ , " const asset = compilation.getAsset('main.js');"
249+ , " compilation.updateAsset(asset.name, asset.source, { ...asset.info, 'lynx:main-thread': true });"
250+ , " });"
251+ , " });"
252+ , " },"
253+ , " ]"
254+ , "});"
255+ ]
256+
257+
258+stubsJs :: String
259+stubsJs = unlines
260+ [ "globalThis['requestAnimationFrame'] = lynx['requestAnimationFrame'];"
261+ , "globalThis['cancelAnimationFrame'] = lynx['cancelAnimationFrame'];"
262+ , "globalThis['runWorklet'] = function(worklet, params) { return worklet(params); };"
263+ , "globalThis['native'] = {};"
264+ , "globalThis['processData'] = function() {};"
265+ , "globalThis['updatePage'] = function() {};"
266+ , "globalThis['updateGlobalProps'] = function() {};"
267+ ]
268+
269+
270+initJs :: String
271+initJs = unlines
272+ [ "globalThis['renderPage'] = function() {"
273+ , " var page = __CreatePage('0', 0);"
274+ , " var pageId = __GetElementUniqueID(page);"
275+ , " globalThis['native']['currentPageId'] = pageId;"
276+ , " globalThis['page'] = page;"
277+ , " var mods = globalThis.Elm;"
278+ , " if (mods) {"
279+ , " for (var k in mods) {"
280+ , " if (mods[k] && mods[k].init) {"
281+ , " mods[k].init({});"
282+ , " break;"
283+ , " }"
284+ , " }"
285+ , " }"
286+ , "};"
287+ ]
terminal/src/Develop.hs+48−1
@@ -11,8 +11,11 @@ import Control.Monad (guard)
1111import Control.Monad.Trans (MonadIO(liftIO))
1212import qualified Data.ByteString.Builder as B
1313import qualified Data.ByteString as BS
14+import qualified Data.ByteString.Char8 as BSC
1415import qualified Data.HashMap.Strict as HashMap
16+import qualified Data.List as List
1517import qualified Data.NonEmptyList as NE
18+import qualified Data.Time.Clock.POSIX as Time
1619import qualified System.Directory as Dir
1720import System.FilePath as FP
1821import Snap.Core hiding (path)
@@ -51,6 +54,7 @@ run () (Flags maybePort) =
5154 serveFiles
5255 <|> serveDirectoryWith directoryConfig "."
5356 <|> serveAssets
57+ <|> serveWatch
5458 <|> error404
5559
5660
@@ -161,7 +165,7 @@ compile path =
161165 artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromPaths Reporting.silent root details (NE.List path [])
162166 javascript <- Task.mapError Exit.ReactorBadGenerate $ Generate.dev root details artifacts
163167 let (NE.List name _) = Build.getRootNames artifacts
164− return $ Html.sandwich name javascript
168+ return $ Html.sandwichReactor name javascript
165169
166170
167171
@@ -181,6 +185,49 @@ serveAssets =
181185
182186
183187
188+-- WATCH ENDPOINT
189+
190+
191+serveWatch :: Snap ()
192+serveWatch =
193+ do rqPath <- BSC.unpack . rqPathInfo <$> getRequest
194+ guard (rqPath == "_elm/watch")
195+ mtime <- liftIO getMaxMtime
196+ modifyResponse (setContentType "text/plain")
197+ writeBS (BSC.pack (show mtime))
198+
199+
200+getMaxMtime :: IO Double
201+getMaxMtime =
202+ do files <- findElmFiles "."
203+ case files of
204+ [] -> return 0
205+ _ ->
206+ do times <- mapM Dir.getModificationTime files
207+ return $ maximum $ map (realToFrac . Time.utcTimeToPOSIXSeconds) times
208+
209+
210+findElmFiles :: FilePath -> IO [FilePath]
211+findElmFiles root =
212+ do entries <- Dir.listDirectory root
213+ let paths = map (root </>) entries
214+ files <- mapM classify paths
215+ return (concat files)
216+ where
217+ classify path =
218+ do isDir <- Dir.doesDirectoryExist path
219+ case (isDir, isHidden path) of
220+ (True, False) -> findElmFiles path
221+ (True, True) -> return []
222+ _ -> return [path | takeExtension path == ".elm"]
223+
224+ isHidden p =
225+ case takeFileName p of
226+ '.':_ -> True
227+ _ -> List.isPrefixOf "elm-stuff" (takeFileName p)
228+
229+
230+
184231-- MIME TYPES
185232
186233
terminal/src/Main.hs+29
@@ -15,6 +15,7 @@ import Terminal
1515import Terminal.Helpers
1616
1717import qualified Bump
18+import qualified Dev
1819import qualified Develop
1920import qualified Diff
2021import qualified Init
@@ -34,6 +35,7 @@ main =
3435 [ repl
3536 , init
3637 , reactor
38+ , dev
3739 , make
3840 , install
3941 , bump
@@ -168,6 +170,33 @@ port_ =
168170
169171
170172
173+-- DEV
174+
175+
176+dev :: Terminal.Command
177+dev =
178+ let
179+ summary =
180+ "Start a LynxJS dev server with live reloading. It compiles your Elm code,\
181+ \ bundles it with Rspeedy, and watches for changes."
182+
183+ details =
184+ "The `dev` command starts an Rspeedy dev server for LynxJS:"
185+
186+ example =
187+ reflow
188+ "After running that command, you will see a URL and QR code that you can\
189+ \ use to open the app in LynxJS Explorer. When you save an Elm file, it\
190+ \ recompiles and the app updates automatically."
191+
192+ devFlags =
193+ flags Dev.Flags
194+ |-- flag "port" port_ "The port of the dev server (default: 3000)"
195+ in
196+ Terminal.Command "dev" (Common summary) details example (required elmFile) devFlags Dev.run
197+
198+
199+
171200-- MAKE
172201
173202
terminal/src/Make.hs+107−5
@@ -16,10 +16,14 @@ import qualified Data.Maybe as Maybe
1616import qualified Data.NonEmptyList as NE
1717import qualified System.Directory as Dir
1818import qualified System.FilePath as FP
19+import System.FilePath ((</>))
20+import qualified System.Exit as SysExit
21+import qualified System.Process as Process
1922
2023import qualified AST.Optimized as Opt
2124import qualified BackgroundWriter as BW
2225import qualified Build
26+import qualified Data.Name as Name
2327import qualified Elm.Details as Details
2428import qualified Elm.ModuleName as ModuleName
2529import qualified File
@@ -49,6 +53,7 @@ data Flags =
4953data Output
5054 = JS FilePath
5155 | Html FilePath
56+ | Bundle FilePath
5257 | DevNull
5358
5459
@@ -117,6 +122,12 @@ runHelp root paths style (Flags debug optimize maybeOutput _ maybeDocs) =
117122 builder <- toBuilder root details desiredMode artifacts
118123 generate style target (Html.sandwich name builder) (NE.List name [])
119124
125+ Just (Bundle target) ->
126+ do name <- hasOneMain artifacts
127+ builder <- toBuilder root details desiredMode artifacts
128+ let js = builder <> "\nvar app = Elm." <> Name.toBuilder name <> ".init({});\n"
129+ Task.io $ bundle style target js name
130+
120131
121132
122133-- GET INFORMATION
@@ -286,16 +297,17 @@ output =
286297 , _plural = "output files"
287298 , _parser = parseOutput
288299 , _suggest = \_ -> return []
289− , _examples = \_ -> return [ "elm.js", "index.html", "/dev/null" ]
300+ , _examples = \_ -> return [ "elm.js", "index.html", "main.lynx.bundle", "/dev/null" ]
290301 }
291302
292303
293304parseOutput :: String -> Maybe Output
294305parseOutput name
295− | isDevNull name = Just DevNull
296− | hasExt ".html" name = Just (Html name)
297− | hasExt ".js" name = Just (JS name)
298− | otherwise = Nothing
306+ | isDevNull name = Just DevNull
307+ | hasSuffix ".lynx.bundle" name = Just (Bundle name)
308+ | hasExt ".html" name = Just (Html name)
309+ | hasExt ".js" name = Just (JS name)
310+ | otherwise = Nothing
299311
300312
301313docsFile :: Parser FilePath
@@ -314,6 +326,96 @@ hasExt ext path =
314326 FP.takeExtension path == ext && length path > length ext
315327
316328
329+hasSuffix :: String -> String -> Bool
330+hasSuffix suffix path =
331+ drop (length path - length suffix) path == suffix && length path > length suffix
332+
333+
317334isDevNull :: String -> Bool
318335isDevNull name =
319336 name == "/dev/null" || name == "NUL" || name == "$null"
337+
338+
339+
340+-- BUNDLE
341+
342+
343+bundle :: Reporting.Style -> FilePath -> B.Builder -> Name.Name -> IO ()
344+bundle style target js name =
345+ do home <- Stuff.getElmHome
346+ let bundlerDir = home </> "bundler"
347+ let srcDir = bundlerDir </> "src"
348+ let entryFile = srcDir </> "index.js"
349+ let nodeModules = bundlerDir </> "node_modules"
350+
351+ -- Set up bundler project (first time)
352+ Dir.createDirectoryIfMissing True srcDir
353+ setupBundlerProject bundlerDir
354+
355+ -- Write generated JS as entry point
356+ File.writeBuilder entryFile js
357+
358+ -- Install deps if needed
359+ hasNodeModules <- Dir.doesDirectoryExist nodeModules
360+ if hasNodeModules
361+ then return ()
362+ else
363+ do putStrLn "Installing bundler dependencies (first time)..."
364+ callIn bundlerDir "npm" ["install"]
365+
366+ -- Run rspeedy build
367+ putStrLn "Bundling..."
368+ callIn bundlerDir "bun" ["run", "rspeedy", "build", "--config", "lynx.config.mjs"]
369+
370+ -- Find and copy the output bundle
371+ let distBundle = bundlerDir </> "dist" </> "main.lynx.bundle"
372+ Dir.createDirectoryIfMissing True (FP.takeDirectory target)
373+ Dir.copyFile distBundle target
374+ Reporting.reportGenerate style (NE.List name []) target
375+
376+
377+setupBundlerProject :: FilePath -> IO ()
378+setupBundlerProject dir =
379+ do let pkgFile = dir </> "package.json"
380+ let cfgFile = dir </> "lynx.config.mjs"
381+ hasPkg <- Dir.doesFileExist pkgFile
382+ if hasPkg then return () else writeFile pkgFile packageJson
383+ writeFile cfgFile rspeedyConfig
384+
385+
386+callIn :: FilePath -> String -> [String] -> IO ()
387+callIn dir cmd args =
388+ do let proc = (Process.proc cmd args) { Process.cwd = Just dir }
389+ (_, _, _, ph) <- Process.createProcess proc
390+ exitCode <- Process.waitForProcess ph
391+ case exitCode of
392+ SysExit.ExitSuccess -> return ()
393+ SysExit.ExitFailure code ->
394+ error $ cmd ++ " failed with exit code " ++ show code
395+
396+
397+packageJson :: String
398+packageJson = unlines
399+ [ "{"
400+ , " \"name\": \"lynxjs-elm-bundler\","
401+ , " \"private\": true,"
402+ , " \"devDependencies\": {"
403+ , " \"@lynx-js/rspeedy\": \"latest\","
404+ , " \"@lynx-js/react-rsbuild-plugin\": \"latest\""
405+ , " }"
406+ , "}"
407+ ]
408+
409+
410+rspeedyConfig :: String
411+rspeedyConfig = unlines
412+ [ "import { defineConfig } from '@lynx-js/rspeedy';"
413+ , "import { pluginReactLynx } from '@lynx-js/react-rsbuild-plugin';"
414+ , ""
415+ , "export default defineConfig({"
416+ , " source: {"
417+ , " entry: './src/index.js',"
418+ , " },"
419+ , " plugins: [pluginReactLynx()],"
420+ , "});"
421+ ]