diff --git a/builder/src/Generate.hs b/builder/src/Generate.hs index a0623a6b..332814d8 100644 --- a/builder/src/Generate.hs +++ b/builder/src/Generate.hs @@ -37,7 +37,7 @@ import Prelude hiding (cycle, print) type Task a = Task.Task Exit.Generate a -debug :: FilePath -> Details.Details -> Build.Artifacts -> Task B.Builder +debug :: FilePath -> Details.Details -> Build.Artifacts -> Task JS.GeneratedResult debug root details (Build.Artifacts pkg ifaces roots modules) = do loading <- loadObjects root details modules @@ -46,20 +46,18 @@ debug root details (Build.Artifacts pkg ifaces roots modules) = let mode = Mode.Dev (Just types) let graph = objectsToGlobalGraph objects let mains = gatherMains pkg objects roots - let (JS.GeneratedResult state) = JS.generate mode graph mains - return state + return $ JS.generate mode graph mains -dev :: FilePath -> Details.Details -> Build.Artifacts -> Task B.Builder +dev :: FilePath -> Details.Details -> Build.Artifacts -> Task JS.GeneratedResult dev root details (Build.Artifacts pkg _ roots modules) = do objects <- finalizeObjects =<< loadObjects root details modules let mode = Mode.Dev Nothing let graph = objectsToGlobalGraph objects let mains = gatherMains pkg objects roots - let (JS.GeneratedResult state) = JS.generate mode graph mains - return state + return $ JS.generate mode graph mains -prod :: FilePath -> Details.Details -> Build.Artifacts -> Task B.Builder +prod :: FilePath -> Details.Details -> Build.Artifacts -> Task JS.GeneratedResult prod root details (Build.Artifacts pkg _ roots modules) = do objects <- finalizeObjects =<< loadObjects root details modules @@ -67,8 +65,7 @@ prod root details (Build.Artifacts pkg _ roots modules) = let graph = objectsToGlobalGraph objects let mode = Mode.Prod (Mode.shortenFieldNames graph) let mains = gatherMains pkg objects roots - let (JS.GeneratedResult state) = JS.generate mode graph mains - return state + return $ JS.generate mode graph mains repl :: FilePath -> Details.Details -> Bool -> Build.ReplArtifacts -> N.Name -> Task B.Builder repl root details ansi (Build.ReplArtifacts home modules localizer annotations) name = diff --git a/compiler/src/Generate/JavaScript.hs b/compiler/src/Generate/JavaScript.hs index 984682f9..f05126e1 100644 --- a/compiler/src/Generate/JavaScript.hs +++ b/compiler/src/Generate/JavaScript.hs @@ -23,6 +23,7 @@ import Generate.JavaScript.Expression qualified as Expr import Generate.JavaScript.Functions qualified as Functions import Generate.JavaScript.Name qualified as JsName import Generate.Mode qualified as Mode +import Generate.SourceMap qualified as SourceMap import Gren.Kernel qualified as K import Gren.ModuleName qualified as ModuleName import Reporting.Doc qualified as D @@ -36,8 +37,10 @@ type Graph = Map.Map Opt.Global Opt.Node type Mains = Map.Map ModuleName.Canonical Opt.Main -newtype GeneratedResult = GeneratedResult - {_source :: B.Builder} +data GeneratedResult = GeneratedResult + { _source :: B.Builder, + _sourceMap :: SourceMap.SourceMap + } prelude :: B.Builder prelude = @@ -56,7 +59,11 @@ generate mode (Opt.GlobalGraph graph _) mains = <> stateToBuilder state <> toMainExports mode mains <> "}(this.module ? this.module.exports : this));" - in GeneratedResult {_source = builder} + sourceMap = SourceMap.generate $ stateToMappings state + in GeneratedResult + { _source = builder, + _sourceMap = sourceMap + } addMain :: Mode.Mode -> Graph -> ModuleName.Canonical -> Opt.Main -> State -> State addMain mode graph home _ state = @@ -114,6 +121,10 @@ stateToBuilder :: State -> B.Builder stateToBuilder (State _ builder) = JS._code builder +stateToMappings :: State -> [JS.Mapping] +stateToMappings (State _ builder) = + JS._mappings builder + -- ADD DEPENDENCIES addGlobal :: Mode.Mode -> Graph -> State -> Opt.Global -> State diff --git a/compiler/src/Generate/JavaScript/Builder.hs b/compiler/src/Generate/JavaScript/Builder.hs index c183b3c0..227b1e9e 100644 --- a/compiler/src/Generate/JavaScript/Builder.hs +++ b/compiler/src/Generate/JavaScript/Builder.hs @@ -3,6 +3,7 @@ module Generate.JavaScript.Builder ( Builder (..), + Mapping (..), emptyBuilder, stmtToBuilder, exprToBuilder, diff --git a/compiler/src/Generate/SourceMap.hs b/compiler/src/Generate/SourceMap.hs new file mode 100644 index 00000000..55d4fd3b --- /dev/null +++ b/compiler/src/Generate/SourceMap.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Generate.SourceMap (SourceMap, generate, sandwhich, toBytes) where + +import Data.ByteString.Builder qualified as B +import Generate.JavaScript.Builder qualified as JS + +newtype SourceMap = SourceMap B.Builder + +generate :: [JS.Mapping] -> SourceMap +generate _ = SourceMap $ B.char7 '\0' + +sandwhich :: SourceMap -> B.Builder -> B.Builder +sandwhich (SourceMap mapBytes) sourceBytes = + sourceBytes + <> "\n" + <> "//# sourceMappingURL=data:application/json;base64," + <> mapBytes + +toBytes :: SourceMap -> B.Builder +toBytes (SourceMap bytes) = + bytes diff --git a/gren.cabal b/gren.cabal index a165101f..04187d81 100644 --- a/gren.cabal +++ b/gren.cabal @@ -152,6 +152,7 @@ Common gren-common Generate.JavaScript.Functions Generate.JavaScript.Name Generate.Mode + Generate.SourceMap Nitpick.Debug Nitpick.PatternMatches Optimize.Case diff --git a/terminal/src/Make.hs b/terminal/src/Make.hs index 29c2c325..a7020eb6 100644 --- a/terminal/src/Make.hs +++ b/terminal/src/Make.hs @@ -20,7 +20,9 @@ import Directories qualified as Dirs import File qualified import Generate qualified import Generate.Html qualified as Html +import Generate.JavaScript qualified as JS import Generate.Node qualified as Node +import Generate.SourceMap qualified as SourceMap import Gren.Details qualified as Details import Gren.ModuleName qualified as ModuleName import Gren.Platform qualified as Platform @@ -64,7 +66,7 @@ run paths flags@(Flags _ _ maybeOutput report) = Reporting.attemptWithStyle style Exit.makeToReport $ case maybeRoot of Just root -> runHelp root paths style flags - Nothing -> return $ Left $ Exit.MakeNoOutline + Nothing -> return $ Left Exit.MakeNoOutline runHelp :: FilePath -> [FilePath] -> Reporting.Style -> Flags -> IO (Either Exit.Make ()) runHelp root paths style (Flags debug optimize maybeOutput _) = @@ -100,47 +102,47 @@ runHelp root paths style (Flags debug optimize maybeOutput _) = return () (Platform.Browser, [name]) -> do - builder <- toBuilder root details desiredMode artifacts - generate style "index.html" (Html.sandwich name builder) (NE.List name []) + (JS.GeneratedResult source sourceMap) <- generate root details desiredMode artifacts + writeToDisk style "index.html" (Html.sandwich name (SourceMap.sandwhich sourceMap source)) (NE.List name []) (Platform.Node, [name]) -> do - builder <- toBuilder root details desiredMode artifacts - generate style "app" (Node.sandwich name builder) (NE.List name []) + (JS.GeneratedResult source sourceMap) <- generate root details desiredMode artifacts + writeToDisk style "app" (SourceMap.sandwhich sourceMap (Node.sandwich name source)) (NE.List name []) (_, name : names) -> do - builder <- toBuilder root details desiredMode artifacts - generate style "index.js" builder (NE.List name names) + (JS.GeneratedResult source sourceMap) <- generate root details desiredMode artifacts + writeToDisk style "index.js" (SourceMap.sandwhich sourceMap source) (NE.List name names) Just DevStdOut -> case getMains artifacts of [] -> return () _ -> do - builder <- toBuilder root details desiredMode artifacts - Task.io $ B.hPutBuilder IO.stdout builder + (JS.GeneratedResult source sourceMap) <- generate root details desiredMode artifacts + Task.io $ B.hPutBuilder IO.stdout (SourceMap.sandwhich sourceMap source) Just DevNull -> return () Just (Exe target) -> case platform of Platform.Node -> do name <- hasOneMain artifacts - builder <- toBuilder root details desiredMode artifacts - generate style target (Node.sandwich name builder) (NE.List name []) + (JS.GeneratedResult source sourceMap) <- generate root details desiredMode artifacts + writeToDisk style target (SourceMap.sandwhich sourceMap (Node.sandwich name source)) (NE.List name []) _ -> do Task.throw Exit.MakeExeOnlyForNodePlatform Just (JS target) -> case getNoMains artifacts of [] -> do - builder <- toBuilder root details desiredMode artifacts - generate style target builder (Build.getRootNames artifacts) + (JS.GeneratedResult source sourceMap) <- generate root details desiredMode artifacts + writeToDisk style target (SourceMap.sandwhich sourceMap source) (Build.getRootNames artifacts) name : names -> Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names) Just (Html target) -> case platform of Platform.Browser -> do name <- hasOneMain artifacts - builder <- toBuilder root details desiredMode artifacts - generate style target (Html.sandwich name builder) (NE.List name []) + (JS.GeneratedResult source sourceMap) <- generate root details desiredMode artifacts + writeToDisk style target (Html.sandwich name (SourceMap.sandwhich sourceMap source)) (NE.List name []) _ -> do Task.throw Exit.MakeHtmlOnlyForBrowserPlatform @@ -251,22 +253,22 @@ getNoMain modules root = Just _ -> Nothing Nothing -> Just name --- GENERATE +-- WRITE TO DISK -generate :: Reporting.Style -> FilePath -> B.Builder -> NE.List ModuleName.Raw -> Task () -generate style target builder names = +writeToDisk :: Reporting.Style -> FilePath -> B.Builder -> NE.List ModuleName.Raw -> Task () +writeToDisk style target builder names = Task.io $ do Dir.createDirectoryIfMissing True (FP.takeDirectory target) File.writeBuilder target builder Reporting.reportGenerate style names target --- TO BUILDER +-- GENERATE data DesiredMode = Debug | Dev | Prod -toBuilder :: FilePath -> Details.Details -> DesiredMode -> Build.Artifacts -> Task B.Builder -toBuilder root details desiredMode artifacts = +generate :: FilePath -> Details.Details -> DesiredMode -> Build.Artifacts -> Task JS.GeneratedResult +generate root details desiredMode artifacts = Task.mapError Exit.MakeBadGenerate $ case desiredMode of Debug -> Generate.debug root details artifacts