mirror of
https://github.com/gren-lang/compiler.git
synced 2024-09-11 08:45:42 +03:00
Insert project sources into source map.
This commit is contained in:
Robin Heggelund Hansen
parent
75ddba194d
commit
f6853ededa
@ -9,7 +9,6 @@ import Data.Function ((&))
|
||||
import Data.List as List
|
||||
import Data.Map.Strict qualified as Map
|
||||
import Data.Maybe qualified as Maybe
|
||||
import Data.Name qualified as Name
|
||||
import Generate.JavaScript.Builder qualified as JS
|
||||
import Generate.JavaScript.Name qualified as JsName
|
||||
import Gren.ModuleName qualified as ModuleName
|
||||
@ -21,19 +20,19 @@ newtype SourceMap = SourceMap [JS.Mapping]
|
||||
wrap :: [JS.Mapping] -> SourceMap
|
||||
wrap = SourceMap
|
||||
|
||||
generateOnto :: Int -> SourceMap -> B.Builder -> B.Builder
|
||||
generateOnto leadingLines (SourceMap mappings) sourceBytes =
|
||||
generateOnto :: Int -> Map.Map ModuleName.Raw String -> SourceMap -> B.Builder -> B.Builder
|
||||
generateOnto leadingLines moduleSources (SourceMap mappings) sourceBytes =
|
||||
sourceBytes
|
||||
<> "\n"
|
||||
<> "//# sourceMappingURL=data:application/json;base64,"
|
||||
<> generate leadingLines mappings
|
||||
<> generate leadingLines moduleSources mappings
|
||||
|
||||
generate :: Int -> [JS.Mapping] -> B.Builder
|
||||
generate leadingLines mappings =
|
||||
generate :: Int -> Map.Map ModuleName.Raw String -> [JS.Mapping] -> B.Builder
|
||||
generate leadingLines moduleSources mappings =
|
||||
mappings
|
||||
& map (\mapping -> mapping {JS._m_gen_line = JS._m_gen_line mapping + fromIntegral leadingLines})
|
||||
& parseMappings
|
||||
& mappingsToJson
|
||||
& mappingsToJson moduleSources
|
||||
& Json.encode
|
||||
& B.toLazyByteString
|
||||
& BLazy.toStrict
|
||||
@ -41,26 +40,27 @@ generate leadingLines mappings =
|
||||
& B.byteString
|
||||
|
||||
data Mappings = Mappings
|
||||
{ _m_sources :: OrderedListBuilder Name.Name,
|
||||
{ _m_sources :: OrderedListBuilder ModuleName.Canonical,
|
||||
_m_names :: OrderedListBuilder JsName.Name,
|
||||
_m_vlqs :: [Json.Value]
|
||||
}
|
||||
|
||||
parseMappings :: [JS.Mapping] -> Mappings
|
||||
parseMappings mappings =
|
||||
parseMappingsHelp (List.sortBy (\a b -> JS._m_gen_line b `compare` JS._m_gen_line a) mappings) $
|
||||
Mappings
|
||||
{ _m_sources = emptyOrderedListBuilder,
|
||||
_m_names = emptyOrderedListBuilder,
|
||||
_m_vlqs = []
|
||||
}
|
||||
let sortedMappings = List.sortBy (\a b -> JS._m_gen_line b `compare` JS._m_gen_line a) mappings
|
||||
in parseMappingsHelp sortedMappings $
|
||||
Mappings
|
||||
{ _m_sources = emptyOrderedListBuilder,
|
||||
_m_names = emptyOrderedListBuilder,
|
||||
_m_vlqs = []
|
||||
}
|
||||
|
||||
parseMappingsHelp :: [JS.Mapping] -> Mappings -> Mappings
|
||||
parseMappingsHelp mappings acc@(Mappings srcs nms vlqs) =
|
||||
case mappings of
|
||||
[] -> acc
|
||||
first : rest ->
|
||||
let newSources = insertIntoOrderedListBuilder (ModuleName._module $ JS._m_src_module first) srcs
|
||||
let newSources = insertIntoOrderedListBuilder (JS._m_src_module first) srcs
|
||||
newNames = insertIntoOrderedListBuilder (JS._m_src_name first) nms
|
||||
in parseMappingsHelp rest $
|
||||
Mappings newSources newNames $
|
||||
@ -68,7 +68,7 @@ parseMappingsHelp mappings acc@(Mappings srcs nms vlqs) =
|
||||
[ (JStr.fromChars "src_line", Json.int $ fromIntegral $ JS._m_src_line first),
|
||||
(JStr.fromChars "src_col", Json.int $ fromIntegral $ JS._m_src_col first),
|
||||
(JStr.fromChars "src_module", ModuleName.encode $ ModuleName._module $ JS._m_src_module first),
|
||||
(JStr.fromChars "src_module_idx", Json.int $ Maybe.fromMaybe 0 $ lookupIndexOrderedListBuilder (ModuleName._module $ JS._m_src_module first) newSources),
|
||||
(JStr.fromChars "src_module_idx", Json.int $ Maybe.fromMaybe 0 $ lookupIndexOrderedListBuilder (JS._m_src_module first) newSources),
|
||||
(JStr.fromChars "src_name", Json.String $ JsName.toBuilder $ JS._m_src_name first),
|
||||
(JStr.fromChars "src_name_idx", Json.int $ Maybe.fromMaybe 0 $ lookupIndexOrderedListBuilder (JS._m_src_name first) newNames),
|
||||
(JStr.fromChars "gen_line", Json.int $ fromIntegral $ JS._m_gen_line first),
|
||||
@ -105,20 +105,21 @@ lookupIndexOrderedListBuilder :: Ord a => a -> OrderedListBuilder a -> Maybe Int
|
||||
lookupIndexOrderedListBuilder value (OrderedListBuilder _ values) =
|
||||
Map.lookup value values
|
||||
|
||||
arrayBuilderToList :: OrderedListBuilder a -> [a]
|
||||
arrayBuilderToList (OrderedListBuilder _ values) =
|
||||
orderedListBuilderToList :: OrderedListBuilder a -> [a]
|
||||
orderedListBuilderToList (OrderedListBuilder _ values) =
|
||||
values
|
||||
& Map.toList
|
||||
& map (\(val, idx) -> (idx, val))
|
||||
& Map.fromList
|
||||
& Map.elems
|
||||
|
||||
mappingsToJson :: Mappings -> Json.Value
|
||||
mappingsToJson (Mappings sources names vlqs) =
|
||||
Json.object
|
||||
[ (JStr.fromChars "version", Json.int 3),
|
||||
(JStr.fromChars "sources", Json.array $ map ModuleName.encode $ arrayBuilderToList sources),
|
||||
(JStr.fromChars "sourcesContent", Json.array []),
|
||||
(JStr.fromChars "names", Json.array $ map (Json.String . JsName.toBuilder) $ arrayBuilderToList names),
|
||||
(JStr.fromChars "mappings", Json.array vlqs)
|
||||
]
|
||||
mappingsToJson :: Map.Map ModuleName.Raw String -> Mappings -> Json.Value
|
||||
mappingsToJson moduleSources (Mappings sources names vlqs) =
|
||||
let moduleNames = orderedListBuilderToList sources
|
||||
in Json.object
|
||||
[ (JStr.fromChars "version", Json.int 3),
|
||||
(JStr.fromChars "sources", Json.array $ map (ModuleName.encode . ModuleName._module) moduleNames),
|
||||
(JStr.fromChars "sourcesContent", Json.array $ map (\moduleName -> Maybe.maybe Json.null Json.chars $ Map.lookup (ModuleName._module moduleName) moduleSources) moduleNames),
|
||||
(JStr.fromChars "names", Json.array $ map (Json.String . JsName.toBuilder) $ orderedListBuilderToList names),
|
||||
(JStr.fromChars "mappings", Json.array vlqs)
|
||||
]
|
||||
|
||||
@ -14,6 +14,7 @@ import AST.Optimized qualified as Opt
|
||||
import BackgroundWriter qualified as BW
|
||||
import Build qualified
|
||||
import Data.ByteString.Builder qualified as B
|
||||
import Data.Map (Map)
|
||||
import Data.Maybe qualified as Maybe
|
||||
import Data.NonEmptyList qualified as NE
|
||||
import Directories qualified as Dirs
|
||||
@ -76,6 +77,7 @@ runHelp root paths style (Flags debug optimize maybeOutput _) =
|
||||
do
|
||||
desiredMode <- getMode debug optimize
|
||||
details <- Task.eio Exit.MakeBadDetails (Details.load style scope root)
|
||||
moduleSources <- rereadSources details
|
||||
let platform = getPlatform details
|
||||
let projectType = getProjectType details
|
||||
case (projectType, maybeOutput) of
|
||||
@ -103,15 +105,15 @@ runHelp root paths style (Flags debug optimize maybeOutput _) =
|
||||
(Platform.Browser, [name]) ->
|
||||
do
|
||||
(JS.GeneratedResult source sourceMap) <- generate root details desiredMode artifacts
|
||||
writeToDisk style "index.html" (Html.sandwich name (SourceMap.generateOnto Html.leadingLines sourceMap source)) (NE.List name [])
|
||||
writeToDisk style "index.html" (Html.sandwich name (SourceMap.generateOnto Html.leadingLines moduleSources sourceMap source)) (NE.List name [])
|
||||
(Platform.Node, [name]) ->
|
||||
do
|
||||
(JS.GeneratedResult source sourceMap) <- generate root details desiredMode artifacts
|
||||
writeToDisk style "app" (SourceMap.generateOnto Node.leadingLines sourceMap (Node.sandwich name source)) (NE.List name [])
|
||||
writeToDisk style "app" (SourceMap.generateOnto Node.leadingLines moduleSources sourceMap (Node.sandwich name source)) (NE.List name [])
|
||||
(_, name : names) ->
|
||||
do
|
||||
(JS.GeneratedResult source sourceMap) <- generate root details desiredMode artifacts
|
||||
writeToDisk style "index.js" (SourceMap.generateOnto 0 sourceMap source) (NE.List name names)
|
||||
writeToDisk style "index.js" (SourceMap.generateOnto 0 moduleSources sourceMap source) (NE.List name names)
|
||||
Just DevStdOut ->
|
||||
case getMains artifacts of
|
||||
[] ->
|
||||
@ -119,7 +121,7 @@ runHelp root paths style (Flags debug optimize maybeOutput _) =
|
||||
_ ->
|
||||
do
|
||||
(JS.GeneratedResult source sourceMap) <- generate root details desiredMode artifacts
|
||||
Task.io $ B.hPutBuilder IO.stdout (SourceMap.generateOnto 0 sourceMap source)
|
||||
Task.io $ B.hPutBuilder IO.stdout (SourceMap.generateOnto 0 moduleSources sourceMap source)
|
||||
Just DevNull ->
|
||||
return ()
|
||||
Just (Exe target) ->
|
||||
@ -127,14 +129,14 @@ runHelp root paths style (Flags debug optimize maybeOutput _) =
|
||||
Platform.Node -> do
|
||||
name <- hasOneMain artifacts
|
||||
(JS.GeneratedResult source sourceMap) <- generate root details desiredMode artifacts
|
||||
writeToDisk style target (SourceMap.generateOnto Node.leadingLines sourceMap (Node.sandwich name source)) (NE.List name [])
|
||||
writeToDisk style target (SourceMap.generateOnto Node.leadingLines moduleSources sourceMap (Node.sandwich name source)) (NE.List name [])
|
||||
_ -> do
|
||||
Task.throw Exit.MakeExeOnlyForNodePlatform
|
||||
Just (JS target) ->
|
||||
case getNoMains artifacts of
|
||||
[] -> do
|
||||
(JS.GeneratedResult source sourceMap) <- generate root details desiredMode artifacts
|
||||
writeToDisk style target (SourceMap.generateOnto 0 sourceMap source) (Build.getRootNames artifacts)
|
||||
writeToDisk style target (SourceMap.generateOnto 0 moduleSources sourceMap source) (Build.getRootNames artifacts)
|
||||
name : names ->
|
||||
Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names)
|
||||
Just (Html target) ->
|
||||
@ -142,7 +144,7 @@ runHelp root paths style (Flags debug optimize maybeOutput _) =
|
||||
Platform.Browser -> do
|
||||
name <- hasOneMain artifacts
|
||||
(JS.GeneratedResult source sourceMap) <- generate root details desiredMode artifacts
|
||||
writeToDisk style target (Html.sandwich name (SourceMap.generateOnto Html.leadingLines sourceMap source)) (NE.List name [])
|
||||
writeToDisk style target (Html.sandwich name (SourceMap.generateOnto Html.leadingLines moduleSources sourceMap source)) (NE.List name [])
|
||||
_ -> do
|
||||
Task.throw Exit.MakeHtmlOnlyForBrowserPlatform
|
||||
|
||||
@ -163,6 +165,11 @@ getMode debug optimize =
|
||||
(False, False) -> return Dev
|
||||
(False, True) -> return Prod
|
||||
|
||||
rereadSources :: Details.Details -> Task (Map ModuleName.Raw String)
|
||||
rereadSources details =
|
||||
let locals = Details._locals details
|
||||
in Task.io $ traverse (readFile . Details._path) locals
|
||||
|
||||
getExposed :: Details.Details -> Task (NE.List ModuleName.Raw)
|
||||
getExposed (Details.Details _ validOutline _ _ _ _) =
|
||||
case validOutline of
|
||||
|
||||
Loading…
Reference in New Issue
Block a user