@@ -1,4 +1,4 @@
1−{-# LANGUAGE OverloadedStrings #-}
1+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
22module Dev
33 ( Flags(..)
44 , run
@@ -7,15 +7,16 @@ module Dev
77
88
99import Control.Concurrent (threadDelay)
10−import Control.Exception (finally)
11−import Control.Monad (when)
10+import Control.Exception (finally, catch, IOException)
11+import Control.Monad (when, unless)
1212import qualified Data.List as List
1313import qualified Data.NonEmptyList as NE
1414import qualified Data.Time.Clock.POSIX as Time
1515import qualified System.Directory as Dir
1616import qualified System.Exit as SysExit
1717import System.FilePath ((</>), takeExtension, takeFileName)
18−import System.IO (hSetBuffering, stdout, BufferMode(..))
18+import qualified System.Info as Info
19+import System.IO (hSetBuffering, stdout, BufferMode(..), hFlush, hPutStr, hGetContents)
1920import qualified System.Process as Process
2021
2122import qualified BackgroundWriter as BW
@@ -36,6 +37,7 @@ import qualified Stuff
3637data Flags =
3738 Flags
3839 { _port :: Maybe Int
40+ , _verbose :: Bool
3941 }
4042
4143
@@ -44,7 +46,7 @@ data Flags =
4446
4547
4648run :: FilePath -> Flags -> IO ()
47−run path (Flags maybePort) =
49+run path (Flags maybePort verbose) =
4850 do hSetBuffering stdout LineBuffering
4951 maybeRoot <- Stuff.findRoot
5052 case maybeRoot of
@@ -65,18 +67,23 @@ run path (Flags maybePort) =
6567
6668 -- Initial compile
6769 putStrLn "Compiling..."
70+ startTime <- Time.getPOSIXTime
6871 ok <- compileAndWrite root path elmOutput
6972 when ok $
70− do -- Install deps if needed
73+ do endTime <- Time.getPOSIXTime
74+ let elapsed = realToFrac (endTime - startTime) :: Double
75+ putStrFlush $ " (" ++ showTime elapsed ++ ")\n"
76+
77+ -- Install deps if needed
7178 let rspackDir = nodeModules </> "@rspack" </> "cli"
7279 hasCorrectDeps <- Dir.doesDirectoryExist rspackDir
73− when (not hasCorrectDeps) $
80+ unless hasCorrectDeps $
7481 do putStrLn "Installing bundler dependencies..."
75− callIn bundlerDir "npm" ["install"]
82+ callIn bundlerDir "npm" ["install"] verbose
7683
7784 -- Assemble all.js and build bundle
7885 putStrLn "Bundling..."
79− assembleAndBuild bundlerDir
86+ assembleAndBuild bundlerDir verbose
8087
8188 -- Start static file server in background
8289 let distDir = bundlerDir </> "dist"
@@ -89,17 +96,29 @@ run path (Flags maybePort) =
8996
9097 -- Print bundle URL
9198 ip <- getLocalIp
99+ let url = "http://" ++ ip ++ ":" ++ show port ++ "/main.lynx.bundle"
92100 putStrLn ""
93101 putStrLn $ " LynxJS Explorer URL:"
94− putStrLn $ " http://" ++ ip ++ ":" ++ show port ++ "/main.lynx.bundle"
102+ putStrLn $ " " ++ url
95103 putStrLn ""
96104
105+ -- Print QR code
106+ printQrCode bundlerDir url
107+
108+ -- Report bundle size
109+ let bundlePath = distDir </> "main.lynx.bundle"
110+ bundleExists <- Dir.doesFileExist bundlePath
111+ when bundleExists $
112+ do size <- Dir.getFileSize bundlePath
113+ putStrLn $ " Bundle size: " ++ formatSize size
114+ putStrLn ""
115+
97116 -- Watch for changes, recompile, and rebuild
98117 let cleanup = do Process.terminateProcess serveHandle
99118 _ <- Process.waitForProcess serveHandle
100119 return ()
101120 finally
102− (watchAndRebuild root path elmOutput bundlerDir)
121+ (watchAndRebuild root path elmOutput bundlerDir verbose)
103122 cleanup
104123
105124
@@ -129,18 +148,18 @@ compileAndWrite root path elmOutput =
129148-- WATCH
130149
131150
132−assembleAndBuild :: FilePath -> IO ()
133−assembleAndBuild bundlerDir =
151+assembleAndBuild :: FilePath -> Bool -> IO ()
152+assembleAndBuild bundlerDir verbose =
134153 do let srcDir = bundlerDir </> "src"
135154 stubs <- readFile (srcDir </> "stubs.js")
136155 elm <- readFile (srcDir </> "elm.js")
137156 initCode <- readFile (srcDir </> "init.js")
138157 writeFile (srcDir </> "all.js") (stubs ++ elm ++ initCode)
139− callIn bundlerDir "npx" ["rspack", "build"]
158+ callIn bundlerDir "npx" ["rspack", "build"] verbose
140159
141160
142−watchAndRebuild :: FilePath -> FilePath -> FilePath -> FilePath -> IO ()
143−watchAndRebuild root path elmOutput bundlerDir =
161+watchAndRebuild :: FilePath -> FilePath -> FilePath -> FilePath -> Bool -> IO ()
162+watchAndRebuild root path elmOutput bundlerDir verbose =
144163 do mtime <- getMaxMtime root
145164 loop mtime
146165 where
@@ -149,10 +168,21 @@ watchAndRebuild root path elmOutput bundlerDir =
149168 mtime <- getMaxMtime root
150169 when (mtime /= lastMtime) $
151170 do putStrLn "\nRecompiling..."
171+ startTime <- Time.getPOSIXTime
152172 ok <- compileAndWrite root path elmOutput
153173 when ok $
154− do putStrLn "Bundling..."
155− assembleAndBuild bundlerDir
174+ do endTime <- Time.getPOSIXTime
175+ let elapsed = realToFrac (endTime - startTime) :: Double
176+ putStrFlush $ " (" ++ showTime elapsed ++ ")\n"
177+ putStrLn "Bundling..."
178+ assembleAndBuild bundlerDir verbose
179+
180+ -- Report bundle size
181+ let bundlePath = bundlerDir </> "dist" </> "main.lynx.bundle"
182+ bundleExists <- Dir.doesFileExist bundlePath
183+ when bundleExists $
184+ do size <- Dir.getFileSize bundlePath
185+ putStrLn $ " Bundle size: " ++ formatSize size
156186 loop mtime
157187
158188
@@ -204,22 +234,104 @@ setupBundlerProject dir _port =
204234
205235getLocalIp :: IO String
206236getLocalIp =
207− do let proc = Process.proc "ipconfig" ["getifaddr", "en0"]
208− result <- Process.readCreateProcess proc ""
209− case lines result of
210− (ip:_) -> return ip
211− _ -> return "localhost"
237+ tryGetIp `catch` (\(_ :: IOException) -> return "localhost")
238+ where
239+ tryGetIp =
240+ case Info.os of
241+ "darwin" ->
242+ do let proc = Process.proc "ipconfig" ["getifaddr", "en0"]
243+ result <- Process.readCreateProcess proc ""
244+ case words result of
245+ (ip:_) -> return ip
246+ _ -> return "localhost"
247+
248+ "linux" ->
249+ do let proc = Process.proc "hostname" ["-I"]
250+ result <- Process.readCreateProcess proc ""
251+ case words result of
252+ (ip:_) -> return ip
253+ _ -> return "localhost"
254+
255+ _ ->
256+ return "localhost"
257+
258+
259+callIn :: FilePath -> String -> [String] -> Bool -> IO ()
260+callIn dir cmd cmdArgs verbose =
261+ do let outStream = if verbose then Process.Inherit else Process.NoStream
262+ let proc = (Process.proc cmd cmdArgs)
263+ { Process.cwd = Just dir
264+ , Process.std_out = outStream
265+ , Process.std_err = Process.CreatePipe
266+ }
267+ (_, _, mStderr, ph) <- Process.createProcess proc
268+ exitCode <- Process.waitForProcess ph
269+ case exitCode of
270+ SysExit.ExitSuccess -> return ()
271+ SysExit.ExitFailure code ->
272+ do case mStderr of
273+ Just h ->
274+ do errOutput <- readAll h
275+ unless (null errOutput) $
276+ do putStrLn $ "\n-- " ++ cmd ++ " ERROR " ++ replicate 60 '-'
277+ putStrLn errOutput
278+ Nothing -> return ()
279+ error $ cmd ++ " failed with exit code " ++ show code
280+ where
281+ readAll h =
282+ do content <- hGetContents h
283+ length content `seq` return content
284+
285+
286+-- QR CODE
212287
213288
214−callIn :: FilePath -> String -> [String] -> IO ()
215−callIn dir cmd cmdArgs =
216− do let proc = (Process.proc cmd cmdArgs) { Process.cwd = Just dir }
289+printQrCode :: FilePath -> String -> IO ()
290+printQrCode bundlerDir url =
291+ do let proc = (Process.proc "npx" ["qrcode-terminal", url])
292+ { Process.cwd = Just bundlerDir
293+ , Process.std_err = Process.NoStream
294+ }
217295 (_, _, _, ph) <- Process.createProcess proc
218296 exitCode <- Process.waitForProcess ph
219297 case exitCode of
220298 SysExit.ExitSuccess -> return ()
221− SysExit.ExitFailure code ->
222− error $ cmd ++ " failed with exit code " ++ show code
299+ SysExit.ExitFailure _ -> return () -- silently skip if not available
300+
301+
302+
303+-- HELPERS
304+
305+
306+showTime :: Double -> String
307+showTime seconds
308+ | seconds < 1.0 = show (round (seconds * 1000) :: Int) ++ "ms"
309+ | otherwise = showFFloat 2 seconds ++ "s"
310+ where
311+ showFFloat n x =
312+ let whole = floor x :: Int
313+ frac = round ((x - fromIntegral whole) * (10 ^ n)) :: Int
314+ fracStr = show frac
315+ padded = replicate (n - length fracStr) '0' ++ fracStr
316+ in show whole ++ "." ++ padded
317+
318+
319+formatSize :: Integer -> String
320+formatSize bytes
321+ | bytes < 1024 = show bytes ++ " B"
322+ | bytes < 1048576 = showF (fromIntegral bytes / 1024) ++ " KB"
323+ | otherwise = showF (fromIntegral bytes / 1048576) ++ " MB"
324+ where
325+ showF :: Double -> String
326+ showF x =
327+ let whole = floor x :: Int
328+ frac = round ((x - fromIntegral whole) * 10) :: Int
329+ in if frac == 0 then show whole else show whole ++ "." ++ show frac
330+
331+
332+putStrFlush :: String -> IO ()
333+putStrFlush str =
334+ hPutStr stdout str >> hFlush stdout
223335
224336
225337packageJson :: String
@@ -231,7 +343,8 @@ packageJson = unlines
231343 , " \"dependencies\": {"
232344 , " \"@lynx-js/template-webpack-plugin\": \"0.6.4\","
233345 , " \"@rspack/cli\": \"^1.7.0\","
234− , " \"@rspack/core\": \"^1.7.0\""
346+ , " \"@rspack/core\": \"^1.7.0\","
347+ , " \"qrcode-terminal\": \"^0.12.0\""
235348 , " }"
236349 , "}"
237350 ]