git.iko.soy/elk
on d99e412 help sign in
elk/compiler/AST/Module.hs
119 lines 3.4 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 }
27data CanonicalBody = CanonicalBody
28 { program :: Canonical.Expr
29 , types :: Types
30 , fixities :: [(Decl.Assoc, Int, String)]
31 , aliases :: Aliases
32 , datatypes :: ADTs
33 , ports :: [String]
34 }
36type SourceModule = Module (Var.Listing Var.Value) [Decl.SourceDecl]
37type ValidModule = Module (Var.Listing Var.Value) [Decl.ValidDecl]
38type CanonicalModule = Module [Var.Value] CanonicalBody
40type Interfaces = Map.Map String Interface
42type Types = Map.Map String Type.CanonicalType
43type ADTs = Map.Map String ( [String], [(String, [Type.CanonicalType])] )
44type Aliases = Map.Map String ( [String], Type.CanonicalType )
46data Interface = Interface
47 { iVersion :: Version.Version
48 , iTypes :: Types
49 , iImports :: [(String, ImportMethod)]
50 , iAdts :: ADTs
51 , iAliases :: Aliases
52 , iFixities :: [(Decl.Assoc, Int, String)]
53 , iPorts :: [String]
54 }
56toInterface :: CanonicalModule -> Interface
57toInterface modul =
58 let body' = body modul in
59 Interface
60 { iVersion = Version.elmVersion
61 , iTypes = types body'
62 , iImports = imports modul
63 , iAdts = datatypes body'
64 , iAliases = aliases body'
65 , iFixities = fixities body'
66 , iPorts = ports body'
67 }
69instance Binary Interface where
70 get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get
71 put modul = do
72 put (iVersion modul)
73 put (iTypes modul)
74 put (iImports modul)
75 put (iAdts modul)
76 put (iAliases modul)
77 put (iFixities modul)
78 put (iPorts modul)
80data ImportMethod
81 = As !String
82 | Open !(Var.Listing Var.Value)
84open :: ImportMethod
85open = Open (Var.openListing)
87importing :: [String] -> ImportMethod
88importing xs = Open (Var.Listing (map Var.Value xs) False)
90instance Binary ImportMethod where
91 put method =
92 let put' n info = putWord8 n >> put info in
93 case method of
94 As alias -> put' 0 alias
95 Open listing -> put' 1 listing
97 get = do tag <- getWord8
98 case tag of
99 0 -> As <$> get
100 1 -> Open <$> get
101 _ -> error "Error reading valid ImportMethod type from serialized string"
103instance (Pretty exs, Pretty body) => Pretty (Module exs body) where
104 pretty (Module names _ exs ims body) =
105 P.vcat [modul, P.text "", prettyImports, P.text "", pretty body]
106 where
107 modul = P.text "module" <+> name <+> pretty exs <+> P.text "where"
108 name = P.text (List.intercalate "." names)
110 prettyImports = P.vcat $ map prettyMethod ims
112prettyMethod :: (String, ImportMethod) -> Doc
113prettyMethod (name, method) =
114 case method of
115 As alias
116 | name == alias -> P.empty
117 | otherwise -> P.text "as" <+> P.text alias
119 Open listing -> pretty listing