@@ -2,6 +2,7 @@
22module Metadata.Prelude (interfaces, add) where
33
44import qualified Data.Map as Map
5+import qualified Data.Set as Set
56import qualified Control.Exception as E
67import System.Exit
78import System.IO
@@ -10,37 +11,88 @@ import qualified AST.Variable as Var
1011import qualified Build.Interface as Interface
1112import Build.Utils (getDataFile)
1213
13−add :: Bool -> Module exs body -> Module exs body
14−add noPrelude (Module name path exs ims decls) =
15− Module name path exs (customIms ++ ims) decls
16− where
17− customIms = if noPrelude then [] else concatMap addModule prelude
18−
19− addModule (n, method) = case lookup n ims of
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
14+
15+-- DEFINITION OF THE PRELUDE
16+
17+type ImportDict =
18+ Map.Map String ([String], Var.Listing Var.Value)
19+
20+prelude :: ImportDict
21+prelude = Map.unions [ string, text, maybe, openImports ]
2622 where
27− modules = [ "Basics", "Signal", "List", "Time", "Color"
28− , "Graphics.Element", "Graphics.Collage"
29− , "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"
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))) $
30+ [ "Basics", "Signal", "List", "Time", "Color"
31+ , "Graphics.Element", "Graphics.Collage"
32+ , "Native.Ports", "Native.Json"
3933 ]
4034
41− maybe =
42− let imports = [ Var.ADT "Maybe" (Var.Listing ["Just", "Nothing"] False) ]
43− in ("Maybe", Module.importing imports)
35+ maybe :: ImportDict
36+ maybe = importing "Maybe" [ Var.ADT "Maybe" Var.openListing ]
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
4496
4597interfaces :: Bool -> IO Interfaces
4698interfaces noPrelude =