git.iko.soy/elk
on 2a930fd help sign in
elk/src/Metadata/Prelude.hs
95 lines 3.0 kB history raw
1{-# OPTIONS_GHC -W #-}
2{-# LANGUAGE FlexibleContexts #-}
3module Metadata.Prelude (add) where
5import qualified Data.Map as Map
6import qualified Data.Set as Set
8import qualified AST.Module as Module
9import qualified AST.Variable as Var
12-- DEFINITION OF THE PRELUDE
14type ImportDict =
15 Map.Map Module.Name ([String], Var.Listing Var.Value)
18prelude :: ImportDict
19prelude =
20 Map.unions [ string, text, maybe, openImports ]
21 where
22 importing :: Module.Name -> [Var.Value] -> ImportDict
23 importing name values =
24 Map.singleton name ([], Var.Listing values False)
26 openImports :: ImportDict
27 openImports =
28 Map.fromList $ map (\name -> (name, ([], Var.openListing))) $
29 [ ["Basics"], ["Signal"], ["List"], ["Time"], ["Color"]
30 , ["Graphics","Element"], ["Graphics","Collage"]
31 , ["Native","Ports"], ["Native","Json"]
32 ]
34 maybe :: ImportDict
35 maybe = importing ["Maybe"] [ Var.ADT "Maybe" Var.openListing ]
37 string :: ImportDict
38 string = importing ["String"] [Var.Value "show"]
40 text :: ImportDict
41 text = importing ["Text"] (Var.ADT "Text" (Var.Listing [] False) : values)
42 where
43 values =
44 map Var.Value
45 [ "toText", "leftAligned", "rightAligned", "centered", "justified"
46 , "plainText", "asText", "typeface", "monospace", "bold", "italic"
47 ]
50-- ADDING PRELUDE TO A MODULE
52add :: Bool -> Module.Module exs body -> Module.Module exs body
53add noPrelude (Module.Module moduleName path exports imports decls) =
54 Module.Module moduleName path exports ammendedImports decls
55 where
56 ammendedImports =
57 importDictToList $
58 foldr addImport (if noPrelude then Map.empty else prelude) imports
61importDictToList :: ImportDict -> [(Module.Name, Module.ImportMethod)]
62importDictToList dict =
63 concatMap toImports (Map.toList dict)
64 where
65 toImports (name, (qualifiers, listing@(Var.Listing explicits open))) =
66 map (\qualifier -> (name, Module.As qualifier)) qualifiers
67 ++
68 if open || not (null explicits)
69 then [(name, Module.Open listing)]
70 else []
73addImport :: (Module.Name, Module.ImportMethod) -> ImportDict -> ImportDict
74addImport (name, method) importDict =
75 Map.alter mergeMethods name importDict
76 where
77 mergeMethods :: Maybe ([String], Var.Listing Var.Value)
78 -> Maybe ([String], Var.Listing Var.Value)
79 mergeMethods entry =
80 let (qualifiers, listing) =
81 case entry of
82 Nothing -> ([], Var.Listing [] False)
83 Just v -> v
84 in
85 case method of
86 Module.As qualifier ->
87 Just (qualifier : qualifiers, listing)
89 Module.Open newListing ->
90 Just (qualifiers, mergeListings newListing listing)
92 mergeListings (Var.Listing explicits1 open1) (Var.Listing explicits2 open2) =
93 Var.Listing
94 (Set.toList (Set.fromList (explicits1 ++ explicits2)))
95 (open1 || open2)