git.iko.soy/elk
on fdcaaed help sign in
elk/src/Transform/AddDefaultImports.hs
92 lines 2.6 kB history raw
1{-# LANGUAGE FlexibleContexts #-}
2module Transform.AddDefaultImports (add) where
4import Prelude hiding (maybe)
5import qualified Data.Map as Map
6import qualified Data.Set as Set
8import qualified AST.Module as Module
9import qualified AST.Variable as Var
12type ImportDict =
13 Map.Map Module.Name ([String], Var.Listing Var.Value)
16-- DESCRIPTION OF DEFAULT IMPORTS
18(==>) :: a -> b -> (a,b)
19(==>) = (,)
22defaultImports :: ImportDict
23defaultImports =
24 Map.fromList
25 [ ["Basics"] ==> ([], Var.openListing)
26 , ["Maybe"] ==> ([], Var.Listing [maybe] False)
27 , ["Result"] ==> ([], Var.Listing [result] False)
28 , ["Signal"] ==> ([], Var.Listing [signal] False)
29 ]
32maybe :: Var.Value
33maybe =
34 Var.ADT "Maybe" Var.openListing
37result :: Var.Value
38result =
39 Var.ADT "Result" Var.openListing
42signal :: Var.Value
43signal =
44 Var.ADT "Signal" (Var.Listing [] False)
47-- ADDING DEFAULT IMPORTS TO A MODULE
49add :: Bool -> Module.Module exs body -> Module.Module exs body
50add needsDefaults (Module.Module moduleName path exports imports decls) =
51 Module.Module moduleName path exports ammendedImports decls
52 where
53 ammendedImports =
54 importDictToList $
55 foldr addImport (if needsDefaults then defaultImports else Map.empty) imports
58importDictToList :: ImportDict -> [(Module.Name, Module.ImportMethod)]
59importDictToList dict =
60 concatMap toImports (Map.toList dict)
61 where
62 toImports (name, (qualifiers, listing@(Var.Listing explicits open))) =
63 map (\qualifier -> (name, Module.As qualifier)) qualifiers
64 ++
65 if open || not (null explicits)
66 then [(name, Module.Open listing)]
67 else []
70addImport :: (Module.Name, Module.ImportMethod) -> ImportDict -> ImportDict
71addImport (name, method) importDict =
72 Map.alter mergeMethods name importDict
73 where
74 mergeMethods :: Maybe ([String], Var.Listing Var.Value)
75 -> Maybe ([String], Var.Listing Var.Value)
76 mergeMethods entry =
77 let (qualifiers, listing) =
78 case entry of
79 Nothing -> ([], Var.Listing [] False)
80 Just v -> v
81 in
82 case method of
83 Module.As qualifier ->
84 Just (qualifier : qualifiers, listing)
86 Module.Open newListing ->
87 Just (qualifiers, mergeListings newListing listing)
89 mergeListings (Var.Listing explicits1 open1) (Var.Listing explicits2 open2) =
90 Var.Listing
91 (Set.toList (Set.fromList (explicits1 ++ explicits2)))
92 (open1 || open2)