git.iko.soy/elk
on fcd5d23 help sign in
elk/compiler/AST/Module.hs
123 lines 3.5 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
14import AST.PrettyPrint
15import Text.PrettyPrint as P
17import qualified Elm.Internal.Version as Version
19data Module exs body = Module
20 { names :: [String]
21 , path :: FilePath
22 , exports :: exs
23 , imports :: [(String, ImportMethod)]
24 , body :: body
25 }
27getName :: Module exs body -> String
28getName modul =
29 List.intercalate "." (names modul)
31data CanonicalBody = CanonicalBody
32 { program :: Canonical.Expr
33 , types :: Types
34 , fixities :: [(Decl.Assoc, Int, String)]
35 , aliases :: Aliases
36 , datatypes :: ADTs
37 , ports :: [String]
38 }
40type SourceModule = Module (Var.Listing Var.Value) [Decl.SourceDecl]
41type ValidModule = Module (Var.Listing Var.Value) [Decl.ValidDecl]
42type CanonicalModule = Module [Var.Value] CanonicalBody
44type Interfaces = Map.Map String Interface
46type Types = Map.Map String Type.CanonicalType
47type ADTs = Map.Map String ( [String], [(String, [Type.CanonicalType])] )
48type Aliases = Map.Map String ( [String], Type.CanonicalType )
50data Interface = Interface
51 { iVersion :: Version.Version
52 , iTypes :: Types
53 , iImports :: [(String, ImportMethod)]
54 , iAdts :: ADTs
55 , iAliases :: Aliases
56 , iFixities :: [(Decl.Assoc, Int, String)]
57 , iPorts :: [String]
58 }
60toInterface :: CanonicalModule -> Interface
61toInterface modul =
62 let body' = body modul in
63 Interface
64 { iVersion = Version.elmVersion
65 , iTypes = types body'
66 , iImports = imports modul
67 , iAdts = datatypes body'
68 , iAliases = aliases body'
69 , iFixities = fixities body'
70 , iPorts = ports body'
71 }
73instance Binary Interface where
74 get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get
75 put modul = do
76 put (iVersion modul)
77 put (iTypes modul)
78 put (iImports modul)
79 put (iAdts modul)
80 put (iAliases modul)
81 put (iFixities modul)
82 put (iPorts modul)
84data ImportMethod
85 = As !String
86 | Open !(Var.Listing Var.Value)
88open :: ImportMethod
89open = Open (Var.openListing)
91importing :: [String] -> ImportMethod
92importing xs = Open (Var.Listing (map Var.Value xs) False)
94instance Binary ImportMethod where
95 put method =
96 let put' n info = putWord8 n >> put info in
97 case method of
98 As alias -> put' 0 alias
99 Open listing -> put' 1 listing
101 get = do tag <- getWord8
102 case tag of
103 0 -> As <$> get
104 1 -> Open <$> get
105 _ -> error "Error reading valid ImportMethod type from serialized string"
107instance (Pretty exs, Pretty body) => Pretty (Module exs body) where
108 pretty (Module names _ exs ims body) =
109 P.vcat [modul, P.text "", prettyImports, P.text "", pretty body]
110 where
111 modul = P.text "module" <+> name <+> pretty exs <+> P.text "where"
112 name = P.text (List.intercalate "." names)
114 prettyImports = P.vcat $ map prettyMethod ims
116prettyMethod :: (String, ImportMethod) -> Doc
117prettyMethod (name, method) =
118 case method of
119 As alias
120 | name == alias -> P.empty
121 | otherwise -> P.text "as" <+> P.text alias
123 Open listing -> pretty listing