on 0140873 help sign in
elk/src/AST/Module.hs
177 lines 4.2 kB history raw
1module AST.Module
2 ( Interfaces
3 , Types, Aliases, ADTs
4 , AdtInfo, CanonicalAdt
5 , SourceModule, ValidModule, CanonicalModule
6 , Module(..), CanonicalBody(..)
7 , HeaderAndImports(..)
8 , Name, nameToString, nameIsNative
9 , Interface(..), toInterface
10 , ImportMethod(..)
11 ) where
13import Data.Binary
14import qualified Data.List as List
15import qualified Data.Map as Map
16import Control.Applicative ((<$>),(<*>))
18import qualified AST.Expression.Canonical as Canonical
19import qualified AST.Declaration as Decl
20import qualified AST.Type as Type
21import qualified AST.Variable as Var
22import AST.PrettyPrint
23import qualified Elm.Compiler.Version as Compiler
24import Text.PrettyPrint as P
27-- HELPFUL TYPE ALIASES
29type Interfaces = Map.Map Name Interface
31type Types = Map.Map String Type.CanonicalType
32type Aliases = Map.Map String ([String], Type.CanonicalType)
33type ADTs = Map.Map String (AdtInfo String)
35type AdtInfo v = ( [String], [(v, [Type.CanonicalType])] )
36type CanonicalAdt = (Var.Canonical, AdtInfo Var.Canonical)
39-- MODULES
41type SourceModule =
42 Module (Var.Listing Var.Value) [Decl.SourceDecl]
44type ValidModule =
45 Module (Var.Listing Var.Value) [Decl.ValidDecl]
47type CanonicalModule =
48 Module [Var.Value] CanonicalBody
51data Module exports body = Module
52 { names :: Name
53 , path :: FilePath
54 , exports :: exports
55 , imports :: [(Name, ImportMethod)]
56 , body :: body
57 }
59data CanonicalBody = CanonicalBody
60 { program :: Canonical.Expr
61 , types :: Types
62 , fixities :: [(Decl.Assoc, Int, String)]
63 , aliases :: Aliases
64 , datatypes :: ADTs
65 , ports :: [String]
66 }
69-- HEADERS
71{-| Basic info needed to identify modules and determine dependencies. -}
72data HeaderAndImports = HeaderAndImports
73 { _names :: Name
74 , _exports :: Var.Listing Var.Value
75 , _imports :: [(Name, ImportMethod)]
76 }
79type Name = [String] -- must be non-empty
82nameToString :: Name -> String
83nameToString =
84 List.intercalate "."
87nameIsNative :: Name -> Bool
88nameIsNative name =
89 case name of
90 "Native" : _ -> True
91 _ -> False
95-- INTERFACES
97{-| Key facts about a module, used when reading info from .elmi files. -}
98data Interface = Interface
99 { iVersion :: String
100 , iExports :: [Var.Value]
101 , iTypes :: Types
102 , iImports :: [(Name, ImportMethod)]
103 , iAdts :: ADTs
104 , iAliases :: Aliases
105 , iFixities :: [(Decl.Assoc, Int, String)]
106 , iPorts :: [String]
107 }
109toInterface :: CanonicalModule -> Interface
110toInterface modul =
111 let body' = body modul in
112 Interface
113 { iVersion = Compiler.version
114 , iExports = exports modul
115 , iTypes = types body'
116 , iImports = imports modul
117 , iAdts = datatypes body'
118 , iAliases = aliases body'
119 , iFixities = fixities body'
120 , iPorts = ports body'
121 }
123instance Binary Interface where
124 get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get
125 put modul = do
126 put (iVersion modul)
127 put (iExports modul)
128 put (iTypes modul)
129 put (iImports modul)
130 put (iAdts modul)
131 put (iAliases modul)
132 put (iFixities modul)
133 put (iPorts modul)
136-- IMPORT METHOD
138data ImportMethod = ImportMethod
139 { alias :: Maybe String
140 , exposedVars :: !(Var.Listing Var.Value)
141 }
144instance Binary ImportMethod where
145 put (ImportMethod alias exposedVars) =
146 do put alias
147 put exposedVars
149 get =
150 ImportMethod <$> get <*> get
153-- PRETTY PRINTING
155instance (Pretty exs, Pretty body) => Pretty (Module exs body) where
156 pretty (Module names _ exs ims body) =
157 P.vcat [modul, P.text "", prettyImports, P.text "", pretty body]
158 where
159 modul =
160 P.text "module" <+> name <+> pretty exs <+> P.text "where"
162 name =
163 P.text (nameToString names)
165 prettyImports =
166 P.vcat $ map prettyMethod ims
169prettyMethod :: (Name, ImportMethod) -> Doc
170prettyMethod (name, ImportMethod maybeAlias exposedVars) =
171 let prettyAlias =
172 case maybeAlias of
173 Nothing -> P.empty
174 Just alias ->
175 P.text "as" <+> P.text alias
176 in
177 prettyAlias <+> P.text "exposing" <+> pretty exposedVars