git.iko.soy/elk
on 458bf2b help sign in
elk/compiler/SourceSyntax/Module.hs
119 lines 3.6 kB history raw
1{-# OPTIONS_GHC -W #-}
2module SourceSyntax.Module where
4import Data.Binary
5import qualified Data.List as List
6import qualified Data.Map as Map
7import Control.Applicative ((<$>), (<*>))
8import Text.PrettyPrint as P
10import SourceSyntax.Expression (LExpr)
11import SourceSyntax.Declaration
12import SourceSyntax.PrettyPrint
13import SourceSyntax.Type
15import qualified Elm.Internal.Version as Version
17data Module def =
18 Module [String] Exports Imports [def]
19 deriving (Show)
21type Exports = [String]
23type Imports = [(String, ImportMethod)]
24data ImportMethod = As String | Importing [String] | Hiding [String]
25 deriving (Eq, Ord, Show)
27instance (Pretty def) => Pretty (Module def) where
28 pretty (Module modNames exports imports decls) =
29 P.vcat [modul, P.text "", prettyImports, P.text "", prettyDecls]
30 where
31 prettyDecls = P.sep $ map pretty decls
33 modul = P.text "module" <+> moduleName <+> where'
34 moduleName = P.text $ List.intercalate "." modNames
35 where' =
36 case exports of
37 [] -> P.text "where"
38 _ -> P.parens (commaCat $ map P.text exports) <+> P.text "where"
40 prettyImports = P.vcat $ map prettyImport imports
42 prettyImport (name, method) =
43 P.text "import" <+>
44 case method of
45 As alias ->
46 P.text $ name ++ (if name == alias then "" else " as " ++ alias)
48 Importing values ->
49 P.text name <+> P.parens (commaCat (map P.text values))
51 Hiding [] -> P.text ("open " ++ name)
52 Hiding _ -> error "invalid import declaration"
54instance Binary ImportMethod where
55 put method =
56 let put' n info = putWord8 n >> put info in
57 case method of
58 As s -> put' 0 s
59 Importing ss -> put' 1 ss
60 Hiding ss -> put' 2 ss
62 get = do tag <- getWord8
63 case tag of
64 0 -> As <$> get
65 1 -> Importing <$> get
66 2 -> Hiding <$> get
67 _ -> error "Error reading valid ImportMethod type from serialized string"
69data MetadataModule =
70 MetadataModule
71 { names :: [String]
72 , path :: FilePath
73 , exports :: [String]
74 , imports :: [(String, ImportMethod)]
75 , program :: LExpr
76 , types :: Map.Map String Type
77 , fixities :: [(Assoc, Int, String)]
78 , aliases :: [Alias]
79 , datatypes :: [ADT]
80 , ports :: [String]
81 } deriving Show
83type Interfaces = Map.Map String ModuleInterface
84type ADT = (String, [String], [(String,[Type])])
85type Alias = (String, [String], Type)
87data ModuleInterface =
88 ModuleInterface
89 { iVersion :: Version.Version
90 , iTypes :: Map.Map String Type
91 , iImports :: [(String, ImportMethod)]
92 , iAdts :: [ADT]
93 , iAliases :: [Alias]
94 , iFixities :: [(Assoc, Int, String)]
95 , iPorts :: [String]
96 } deriving Show
98metaToInterface :: MetadataModule -> ModuleInterface
99metaToInterface metaModule =
100 ModuleInterface
101 { iVersion = Version.elmVersion
102 , iTypes = types metaModule
103 , iImports = imports metaModule
104 , iAdts = datatypes metaModule
105 , iAliases = aliases metaModule
106 , iFixities = fixities metaModule
107 , iPorts = ports metaModule
108 }
110instance Binary ModuleInterface where
111 get = ModuleInterface <$> get <*> get <*> get <*> get <*> get <*> get <*> get
112 put modul = do
113 put (iVersion 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)