@@ -2,6 +2,7 @@
2module Metadata.Prelude (interfaces, add) where
2module Metadata.Prelude (interfaces, add) where
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)
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)
19− addModule (n, method) = case lookup n ims of
20+prelude :: ImportDict
20− Nothing -> [(n, method)]
21− Just (As _) -> [(n, method)]
24−prelude :: [(String, ImportMethod)]
25−prelude = string : text : maybe : map (\n -> (n, Module.open)) modules
21+prelude = Map.unions [ string, text, maybe, openImports ]
23+ importing :: String -> [Var.Value] -> ImportDict
24+ importing name values =
25+ Map.singleton name ([], Var.Listing values False)
27+ openImports :: ImportDict
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"
32− string = ("String", Module.importing [Var.Value "show"])
34− text = ("Text", Module.importing textImports)
36− Var.ADT "Text" (Var.Listing [] False) : map Var.Value
37− [ "toText", "leftAligned", "rightAligned", "centered", "justified"
38− , "plainText", "asText", "typeface", "monospace", "bold", "italic"
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+
39+ string = importing "String" [Var.Value "show"]
42+ text = importing "Text" (Var.ADT "Text" (Var.Listing [] False) : values)
46+ [ "toText", "leftAligned", "rightAligned", "centered", "justified"
47+ , "plainText", "asText", "typeface", "monospace", "bold", "italic"
51+-- ADDING PRELUDE TO A MODULE
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
59+ foldr addImport (if noPrelude then Map.empty else prelude) imports
61+importDictToList :: ImportDict -> [(String, ImportMethod)]
62+importDictToList dict =
63+ concatMap toImports (Map.toList dict)
65+ toImports (name, (qualifiers, listing@(Var.Listing explicits open))) =
66+ map (\qualifier -> (name, As qualifier)) qualifiers
68+ if open || not (null explicits)
69+ then [(name, Open listing)]
72+addImport :: (String, ImportMethod) -> ImportDict -> ImportDict
73+addImport (name, method) importDict =
74+ Map.alter mergeMethods name importDict
76+ mergeMethods :: Maybe ([String], Var.Listing Var.Value)
77+ -> Maybe ([String], Var.Listing Var.Value)
79+ let (qualifiers, listing) =
81+ Nothing -> ([], Var.Listing [] False)
85+ As qualifier -> Just (qualifier : qualifiers, listing)
87+ Just (qualifiers, mergeListings newListing listing)
89+ mergeListings (Var.Listing explicits1 open1) (Var.Listing explicits2 open2) =
91+ (Set.toList (Set.fromList (explicits1 ++ explicits2)))
95+-- EXTRACT INTERFACES FROM STATIC FILE
45interfaces :: Bool -> IO Interfaces
97interfaces :: Bool -> IO Interfaces
46interfaces noPrelude =
98interfaces noPrelude =