git.iko.soy/elk
on d42941c help sign in
elk/src/AST/Module.hs
168 lines 4.2 kB history raw
1module AST.Module where
3import Data.Binary
4import qualified Data.List as List
5import qualified Data.Map as Map
6import Control.Applicative ((<$>),(<*>))
8import qualified AST.Expression.Canonical as Canonical
9import qualified AST.Declaration as Decl
10import qualified AST.Type as Type
11import qualified AST.Variable as Var
12import AST.PrettyPrint
13import qualified Elm.Compiler.Version as Compiler
14import Text.PrettyPrint as P
17-- HELPFUL TYPE ALIASES
19type Interfaces = Map.Map Name Interface
21type Types = Map.Map String Type.CanonicalType
22type Aliases = Map.Map String ([String], Type.CanonicalType)
23type ADTs = Map.Map String (AdtInfo String)
25type AdtInfo v = ( [String], [(v, [Type.CanonicalType])] )
26type CanonicalAdt = (Var.Canonical, AdtInfo Var.Canonical)
29-- MODULES
31type SourceModule =
32 Module (Var.Listing Var.Value) [Decl.SourceDecl]
34type ValidModule =
35 Module (Var.Listing Var.Value) [Decl.ValidDecl]
37type CanonicalModule =
38 Module [Var.Value] CanonicalBody
41data Module exports body = Module
42 { names :: Name
43 , path :: FilePath
44 , exports :: exports
45 , imports :: [(Name, ImportMethod)]
46 , body :: body
47 }
49data CanonicalBody = CanonicalBody
50 { program :: Canonical.Expr
51 , types :: Types
52 , fixities :: [(Decl.Assoc, Int, String)]
53 , aliases :: Aliases
54 , datatypes :: ADTs
55 , ports :: [String]
56 }
59-- HEADERS
61{-| Basic info needed to identify modules and determine dependencies. -}
62data HeaderAndImports = HeaderAndImports
63 { _names :: Name
64 , _exports :: Var.Listing Var.Value
65 , _imports :: [(Name, ImportMethod)]
66 }
68type Name = [String] -- must be non-empty
70nameToString :: Name -> String
71nameToString = List.intercalate "."
73nameIsNative :: Name -> Bool
74nameIsNative name =
75 case name of
76 "Native" : _ -> True
77 _ -> False
81-- INTERFACES
83{-| Key facts about a module, used when reading info from .elmi files. -}
84data Interface = Interface
85 { iVersion :: String
86 , iExports :: [Var.Value]
87 , iTypes :: Types
88 , iImports :: [(Name, ImportMethod)]
89 , iAdts :: ADTs
90 , iAliases :: Aliases
91 , iFixities :: [(Decl.Assoc, Int, String)]
92 , iPorts :: [String]
93 }
95toInterface :: CanonicalModule -> Interface
96toInterface modul =
97 let body' = body modul in
98 Interface
99 { iVersion = Compiler.version
100 , iExports = exports modul
101 , iTypes = types body'
102 , iImports = imports modul
103 , iAdts = datatypes body'
104 , iAliases = aliases body'
105 , iFixities = fixities body'
106 , iPorts = ports body'
107 }
109instance Binary Interface where
110 get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get
111 put modul = do
112 put (iVersion modul)
113 put (iExports modul)
114 put (iTypes modul)
115 put (iImports modul)
116 put (iAdts modul)
117 put (iAliases modul)
118 put (iFixities modul)
119 put (iPorts modul)
122-- IMPORT METHOD
124data ImportMethod
125 = As !String
126 | Open !(Var.Listing Var.Value)
128open :: ImportMethod
129open = Open (Var.openListing)
131importing :: [Var.Value] -> ImportMethod
132importing xs = Open (Var.Listing xs False)
134instance Binary ImportMethod where
135 put method =
136 case method of
137 As alias -> putWord8 0 >> put alias
138 Open listing -> putWord8 1 >> put listing
140 get = do tag <- getWord8
141 case tag of
142 0 -> As <$> get
143 1 -> Open <$> get
144 _ -> error "Error reading valid ImportMethod type from serialized string"
147-- PRETTY PRINTING
149instance (Pretty exs, Pretty body) => Pretty (Module exs body) where
150 pretty (Module names _ exs ims body) =
151 P.vcat [modul, P.text "", prettyImports, P.text "", pretty body]
152 where
153 modul = P.text "module" <+> name <+> pretty exs <+> P.text "where"
154 name = P.text (List.intercalate "." names)
156 prettyImports =
157 P.vcat $ map prettyMethod ims
160prettyMethod :: (Name, ImportMethod) -> Doc
161prettyMethod import' =
162 case import' of
163 ([name], As alias)
164 | name == alias -> P.empty
166 (_, As alias) -> P.text "as" <+> P.text alias
168 (_, Open listing) -> pretty listing