on master help sign in
Fix #734 regarding overlapping open imports
489e5ccEvan Czaplicki
compiler/Metadata/Prelude.hs+80−28
@@ -2,6 +2,7 @@
2module Metadata.Prelude (interfaces, add) where
2module Metadata.Prelude (interfaces, add) where
3
3
4import qualified Data.Map as Map
4import qualified Data.Map as Map
5+import qualified Data.Set as Set
5import qualified Control.Exception as E
6import qualified Control.Exception as E
6import System.Exit
7import System.Exit
7import System.IO
8import System.IO
@@ -10,37 +11,88 @@ import qualified AST.Variable as Var
10import qualified Build.Interface as Interface
11import qualified Build.Interface as Interface
11import Build.Utils (getDataFile)
12import Build.Utils (getDataFile)
12
13
13−add :: Bool -> Module exs body -> Module exs body
14+
14−add noPrelude (Module name path exs ims decls) =
15+-- DEFINITION OF THE PRELUDE
15− Module name path exs (customIms ++ ims) decls
16+
16− where
17+type ImportDict =
17− customIms = if noPrelude then [] else concatMap addModule prelude
18+ Map.Map String ([String], Var.Listing Var.Value)
18−
19+
19− addModule (n, method) = case lookup n ims of
20+prelude :: ImportDict
20− Nothing -> [(n, method)]
21− Just (As _) -> [(n, method)]
22− Just _ -> []
23−
24−prelude :: [(String, ImportMethod)]
25−prelude = string : text : maybe : map (\n -> (n, Module.open)) modules
21+prelude = Map.unions [ string, text, maybe, openImports ]
26 where
22 where
23+ importing :: String -> [Var.Value] -> ImportDict
24+ importing name values =
25+ Map.singleton name ([], Var.Listing values False)
26+
27+ openImports :: ImportDict
28+ openImports =
29+ Map.fromList $ map (\name -> (name, ([], Var.openListing))) $
27− modules = [ "Basics", "Signal", "List", "Time", "Color"
30+ [ "Basics", "Signal", "List", "Time", "Color"
28− , "Graphics.Element", "Graphics.Collage"
31+ , "Graphics.Element", "Graphics.Collage"
29− , "Native.Ports", "Native.Json"
32+ , "Native.Ports", "Native.Json"
30− ]
31−
32− string = ("String", Module.importing [Var.Value "show"])
33−
34− text = ("Text", Module.importing textImports)
35− textImports =
36− Var.ADT "Text" (Var.Listing [] False) : map Var.Value
37− [ "toText", "leftAligned", "rightAligned", "centered", "justified"
38− , "plainText", "asText", "typeface", "monospace", "bold", "italic"
39 ]
33 ]
40
34
41− maybe =
35+ maybe :: ImportDict
42− let imports = [ Var.ADT "Maybe" (Var.Listing ["Just", "Nothing"] False) ]
36+ maybe = importing "Maybe" [ Var.ADT "Maybe" Var.openListing ]
43− in ("Maybe", Module.importing imports)
37+
38+ string :: ImportDict
39+ string = importing "String" [Var.Value "show"]
40+
41+ text :: ImportDict
42+ text = importing "Text" (Var.ADT "Text" (Var.Listing [] False) : values)
43+ where
44+ values =
45+ map Var.Value
46+ [ "toText", "leftAligned", "rightAligned", "centered", "justified"
47+ , "plainText", "asText", "typeface", "monospace", "bold", "italic"
48+ ]
49+
50+
51+-- ADDING PRELUDE TO A MODULE
52+
53+add :: Bool -> Module exs body -> Module exs body
54+add noPrelude (Module moduleName path exports imports decls) =
55+ Module moduleName path exports ammendedImports decls
56+ where
57+ ammendedImports =
58+ importDictToList $
59+ foldr addImport (if noPrelude then Map.empty else prelude) imports
60+
61+importDictToList :: ImportDict -> [(String, ImportMethod)]
62+importDictToList dict =
63+ concatMap toImports (Map.toList dict)
64+ where
65+ toImports (name, (qualifiers, listing@(Var.Listing explicits open))) =
66+ map (\qualifier -> (name, As qualifier)) qualifiers
67+ ++
68+ if open || not (null explicits)
69+ then [(name, Open listing)]
70+ else []
71+
72+addImport :: (String, ImportMethod) -> ImportDict -> ImportDict
73+addImport (name, method) importDict =
74+ Map.alter mergeMethods name importDict
75+ where
76+ mergeMethods :: Maybe ([String], Var.Listing Var.Value)
77+ -> Maybe ([String], Var.Listing Var.Value)
78+ mergeMethods entry =
79+ let (qualifiers, listing) =
80+ case entry of
81+ Nothing -> ([], Var.Listing [] False)
82+ Just v -> v
83+ in
84+ case method of
85+ As qualifier -> Just (qualifier : qualifiers, listing)
86+ Open newListing ->
87+ Just (qualifiers, mergeListings newListing listing)
88+
89+ mergeListings (Var.Listing explicits1 open1) (Var.Listing explicits2 open2) =
90+ Var.Listing
91+ (Set.toList (Set.fromList (explicits1 ++ explicits2)))
92+ (open1 || open2)
93+
94+
95+-- EXTRACT INTERFACES FROM STATIC FILE
44
96
45interfaces :: Bool -> IO Interfaces
97interfaces :: Bool -> IO Interfaces
46interfaces noPrelude =
98interfaces noPrelude =
tests/compiler/test-files/good/OverlappingImports.elmnew file+5
@@ -0,0 +1,5 @@
1+import Text
2+import Text (..)
3+import Text (leftAligned)
4+
5+main = leftAligned (toText "hello")