git.iko.soy/elk
on 9cda2b2 help sign in
elk/src/AST/Module.hs
169 lines 4.2 kB history raw
1{-# OPTIONS_GHC -W #-}
2module AST.Module where
4import Data.Binary
5import qualified Data.List as List
6import qualified Data.Map as Map
7import Control.Applicative ((<$>),(<*>))
9import qualified AST.Expression.Canonical as Canonical
10import qualified AST.Declaration as Decl
11import qualified AST.Type as Type
12import qualified AST.Variable as Var
13import AST.PrettyPrint
14import qualified Elm.Compiler.Version as Compiler
15import Text.PrettyPrint as P
18-- HELPFUL TYPE ALIASES
20type Interfaces = Map.Map Name Interface
22type Types = Map.Map String Type.CanonicalType
23type Aliases = Map.Map String ([String], Type.CanonicalType)
24type ADTs = Map.Map String (AdtInfo String)
26type AdtInfo v = ( [String], [(v, [Type.CanonicalType])] )
27type CanonicalAdt = (Var.Canonical, AdtInfo Var.Canonical)
30-- MODULES
32type SourceModule =
33 Module (Var.Listing Var.Value) [Decl.SourceDecl]
35type ValidModule =
36 Module (Var.Listing Var.Value) [Decl.ValidDecl]
38type CanonicalModule =
39 Module [Var.Value] CanonicalBody
42data Module exports body = Module
43 { names :: Name
44 , path :: FilePath
45 , exports :: exports
46 , imports :: [(Name, ImportMethod)]
47 , body :: body
48 }
50data CanonicalBody = CanonicalBody
51 { program :: Canonical.Expr
52 , types :: Types
53 , fixities :: [(Decl.Assoc, Int, String)]
54 , aliases :: Aliases
55 , datatypes :: ADTs
56 , ports :: [String]
57 }
60-- HEADERS
62{-| Basic info needed to identify modules and determine dependencies. -}
63data HeaderAndImports = HeaderAndImports
64 { _names :: Name
65 , _exports :: Var.Listing Var.Value
66 , _imports :: [(Name, ImportMethod)]
67 }
69type Name = [String] -- must be non-empty
71nameToString :: Name -> String
72nameToString = List.intercalate "."
74nameIsNative :: Name -> Bool
75nameIsNative name =
76 case name of
77 "Native" : _ -> True
78 _ -> False
82-- INTERFACES
84{-| Key facts about a module, used when reading info from .elmi files. -}
85data Interface = Interface
86 { iVersion :: String
87 , iExports :: [Var.Value]
88 , iTypes :: Types
89 , iImports :: [(Name, ImportMethod)]
90 , iAdts :: ADTs
91 , iAliases :: Aliases
92 , iFixities :: [(Decl.Assoc, Int, String)]
93 , iPorts :: [String]
94 }
96toInterface :: CanonicalModule -> Interface
97toInterface modul =
98 let body' = body modul in
99 Interface
100 { iVersion = Compiler.version
101 , iExports = exports modul
102 , iTypes = types body'
103 , iImports = imports modul
104 , iAdts = datatypes body'
105 , iAliases = aliases body'
106 , iFixities = fixities body'
107 , iPorts = ports body'
108 }
110instance Binary Interface where
111 get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get
112 put modul = do
113 put (iVersion modul)
114 put (iExports modul)
115 put (iTypes modul)
116 put (iImports modul)
117 put (iAdts modul)
118 put (iAliases modul)
119 put (iFixities modul)
120 put (iPorts modul)
123-- IMPORT METHOD
125data ImportMethod
126 = As !String
127 | Open !(Var.Listing Var.Value)
129open :: ImportMethod
130open = Open (Var.openListing)
132importing :: [Var.Value] -> ImportMethod
133importing xs = Open (Var.Listing xs False)
135instance Binary ImportMethod where
136 put method =
137 case method of
138 As alias -> putWord8 0 >> put alias
139 Open listing -> putWord8 1 >> put listing
141 get = do tag <- getWord8
142 case tag of
143 0 -> As <$> get
144 1 -> Open <$> get
145 _ -> error "Error reading valid ImportMethod type from serialized string"
148-- PRETTY PRINTING
150instance (Pretty exs, Pretty body) => Pretty (Module exs body) where
151 pretty (Module names _ exs ims body) =
152 P.vcat [modul, P.text "", prettyImports, P.text "", pretty body]
153 where
154 modul = P.text "module" <+> name <+> pretty exs <+> P.text "where"
155 name = P.text (List.intercalate "." names)
157 prettyImports =
158 P.vcat $ map prettyMethod ims
161prettyMethod :: (Name, ImportMethod) -> Doc
162prettyMethod import' =
163 case import' of
164 ([name], As alias)
165 | name == alias -> P.empty
167 (_, As alias) -> P.text "as" <+> P.text alias
169 (_, Open listing) -> pretty listing