git.iko.soy/elk
on master help sign in
Start building a .elmi file that contains the types of all top-level functions
1a4732aEvan Czaplicki
compiler/Compiler.hs+27−13
compare with master
unifiedsplit
@@ -1,19 +1,17 @@
1{-# LANGUAGE DeriveDataTypeable #-}
1{-# LANGUAGE DeriveDataTypeable #-}
2module Main where
2module Main where
3
3
4−import Control.Monad (foldM, when)
4+import Control.Monad
5import qualified Data.Map as Map
5import qualified Data.Map as Map
6−import Data.Either (lefts, rights)
6+import qualified Data.List as List
7−import Data.List (intersect, intercalate, lookup)
8−import Data.Maybe (fromMaybe)
9import Data.Version (showVersion)
7import Data.Version (showVersion)
10import System.Console.CmdArgs
8import System.Console.CmdArgs
11import System.Directory
9import System.Directory
12import System.Exit
10import System.Exit
13import System.FilePath
11import System.FilePath
12+
14import qualified Text.Blaze.Html.Renderer.Pretty as Pretty
13import qualified Text.Blaze.Html.Renderer.Pretty as Pretty
15import qualified Text.Blaze.Html.Renderer.String as Normal
14import qualified Text.Blaze.Html.Renderer.String as Normal
16−
17import qualified Text.Jasmine as JS
15import qualified Text.Jasmine as JS
18import qualified Data.ByteString.Lazy.Char8 as BS
16import qualified Data.ByteString.Lazy.Char8 as BS
19
17
@@ -21,9 +19,12 @@ import SourceSyntax.Module
21import Initialize (buildFromSource, getSortedModuleNames)
19import Initialize (buildFromSource, getSortedModuleNames)
22import Generate.JavaScript (jsModule)
20import Generate.JavaScript (jsModule)
23import Generate.Html (createHtml, JSStyle(..), JSSource(..))
21import Generate.Html (createHtml, JSStyle(..), JSSource(..))
24−import qualified Metadata.Libraries as Libraries
25import Paths_Elm
22import Paths_Elm
26
23
24+import Text.PrettyPrint as P
25+import qualified Type.Type as Type
26+
27+
27data Flags =
28data Flags =
28 Flags { make :: Bool
29 Flags { make :: Bool
29 , files :: [FilePath]
30 , files :: [FilePath]
@@ -72,6 +73,7 @@ file flags filePath ext = output_directory flags </> replaceExtension filePath e
72
73
73elmo :: Flags -> FilePath -> FilePath
74elmo :: Flags -> FilePath -> FilePath
74elmo flags filePath = file flags filePath "elmo"
75elmo flags filePath = file flags filePath "elmo"
76+elmi flags filePath = file flags filePath "elmi"
75
77
76
78
77buildFile :: Flags -> Int -> Int -> FilePath -> IO Interface
79buildFile :: Flags -> Int -> Int -> FilePath -> IO Interface
@@ -92,20 +94,32 @@ buildFile flags moduleNum numModules filePath =
92 number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
94 number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
93
95
94 name :: String
96 name :: String
95− name = intercalate "." (splitDirectories (dropExtensions filePath))
97+ name = List.intercalate "." (splitDirectories (dropExtensions filePath))
96
98
97 compile :: IO Interface
99 compile :: IO Interface
98 compile = do
100 compile = do
99 putStrLn (number ++ " Compiling " ++ name)
101 putStrLn (number ++ " Compiling " ++ name)
100 source <- readFile filePath
102 source <- readFile filePath
101− obj <-
103+ (js, maybeModule) <-
102− if takeExtension filePath == ".js" then return source else
104+ if takeExtension filePath == ".js" then return (source, Nothing) else
103 case buildFromSource (no_prelude flags) source of
105 case buildFromSource (no_prelude flags) source of
104 Left err -> mapM print err >> exitFailure
106 Left err -> mapM print err >> exitFailure
105− Right modul -> return . jsModule $ (modul :: MetadataModule () ())
107+ Right modul -> return (jsModule modul, Just modul)
106 createDirectoryIfMissing True (output_directory flags)
108 createDirectoryIfMissing True (output_directory flags)
107− writeFile (elmo flags filePath) obj
109+ writeFile (elmo flags filePath) js
110+ writeTypes maybeModule
108− return obj
111+ return js
112+
113+ writeTypes :: Maybe (MetadataModule () ()) -> IO ()
114+ writeTypes maybeModule =
115+ case maybeModule of
116+ Nothing -> return ()
117+ Just metaModule -> do
118+ tipes <- forM (Map.toList (types metaModule)) $ \(n,t) -> do
119+ pt <- Type.extraPretty t
120+ return $ P.text n <+> P.text ":" <+> pt
121+ writeFile (elmi flags filePath) (P.render $ P.vcat tipes)
122+
109
123
110
124
111getRuntime :: Flags -> IO FilePath
125getRuntime :: Flags -> IO FilePath
@@ -147,6 +161,6 @@ buildFiles :: Flags -> Int -> Map.Map String Interface -> [FilePath] -> IO ()
147buildFiles _ _ _ [] = return ()
161buildFiles _ _ _ [] = return ()
148buildFiles flags numModules interfaces (filePath:rest) = do
162buildFiles flags numModules interfaces (filePath:rest) = do
149 interface <- buildFile flags (numModules - length rest) numModules filePath
163 interface <- buildFile flags (numModules - length rest) numModules filePath
150− let moduleName = intercalate "." (splitDirectories (dropExtensions filePath))
164+ let moduleName = List.intercalate "." (splitDirectories (dropExtensions filePath))
151 interfaces' = Map.insert moduleName interface interfaces
165 interfaces' = Map.insert moduleName interface interfaces
152 buildFiles flags numModules interfaces' rest
166 buildFiles flags numModules interfaces' rest