git.iko.soy/elk
on 3de2023 help sign in
elk/compiler/SourceSyntax/Module.hs
118 lines 3.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module SourceSyntax.Module where
4import Data.Binary
5import qualified Data.Map as Map
6import Control.Applicative ((<$>), (<*>))
7import Text.PrettyPrint as P
9import SourceSyntax.Expression (LExpr)
10import SourceSyntax.Declaration
11import SourceSyntax.Type
12import Data.List (intercalate)
14import qualified Elm.Internal.Version as Version
15import SourceSyntax.PrettyPrint
18data Module def =
19 Module [String] Exports Imports [def]
20 deriving (Show)
22type Exports = [String]
24type Imports = [(String, ImportMethod)]
25data ImportMethod = As String | Importing [String] | Hiding [String]
26 deriving (Eq, Ord, Show)
28instance (Pretty def ) => Pretty (Module def) where
29 pretty (Module modNames exportList importList decs) =
30 let
31 exportPret = case exportList of
32 [] -> P.text " "
33 _ -> P.parens $ commaCat $ map P.text exportList
35 decPret = P.sep $ map pretty decs
36 modName = P.text $ intercalate "." modNames
37 modPret = (P.text "module" <+> modName <+> exportPret <+> P.text "where")
40 importPret = P.vcat $ map prettyImport importList
42 prettyImport (name, method) =
43 case method of
44 As s -> if name == s
45 then P.text $ "import " ++ name
46 else P.text $ "import " ++ name ++ " as " ++ s
47 Importing strs -> (P.text $ "import " ++ name ++ " ") <+> (commaCat $ map P.text strs)
48 Hiding [] -> (P.text $ "import open " ++ name ++ " ")
49 Hiding strs -> (P.text $ "import open " ++ name ++ " ") <+> (commaCat $ map P.text strs)
51 in P.sep [modPret, importPret, decPret]
53instance Binary ImportMethod where
54 put method =
55 let put' n info = putWord8 n >> put info in
56 case method of
57 As s -> put' 0 s
58 Importing ss -> put' 1 ss
59 Hiding ss -> put' 2 ss
61 get = do tag <- getWord8
62 case tag of
63 0 -> As <$> get
64 1 -> Importing <$> get
65 2 -> Hiding <$> get
66 _ -> error "Error reading valid ImportMethod type from serialized string"
68data MetadataModule =
69 MetadataModule
70 { names :: [String]
71 , path :: FilePath
72 , exports :: [String]
73 , imports :: [(String, ImportMethod)]
74 , program :: LExpr
75 , types :: Map.Map String Type
76 , fixities :: [(Assoc, Int, String)]
77 , aliases :: [Alias]
78 , datatypes :: [ADT]
79 , ports :: [String]
80 } deriving Show
82type Interfaces = Map.Map String ModuleInterface
83type ADT = (String, [String], [(String,[Type])])
84type Alias = (String, [String], Type)
86data ModuleInterface =
87 ModuleInterface
88 { iVersion :: Version.Version
89 , iTypes :: Map.Map String Type
90 , iImports :: [(String, ImportMethod)]
91 , iAdts :: [ADT]
92 , iAliases :: [Alias]
93 , iFixities :: [(Assoc, Int, String)]
94 , iPorts :: [String]
95 } deriving Show
97metaToInterface :: MetadataModule -> ModuleInterface
98metaToInterface metaModule =
99 ModuleInterface
100 { iVersion = Version.elmVersion
101 , iTypes = types metaModule
102 , iImports = imports metaModule
103 , iAdts = datatypes metaModule
104 , iAliases = aliases metaModule
105 , iFixities = fixities metaModule
106 , iPorts = ports metaModule
107 }
109instance Binary ModuleInterface where
110 get = ModuleInterface <$> get <*> get <*> get <*> get <*> get <*> get <*> get
111 put modul = do
112 put (iVersion modul)
113 put (iTypes modul)
114 put (iImports modul)
115 put (iAdts modul)
116 put (iAliases modul)
117 put (iFixities modul)
118 put (iPorts modul)