git.iko.soy/elk
on master help sign in
Rename Build.Interface => Build.Artifact and shuffle some functions
238629fEvan Czaplicki
Elm.cabal+2−2
compare with master
unifiedsplit
@@ -98,8 +98,8 @@ Library
98 Type.State,
98 Type.State,
99 Type.Type,
99 Type.Type,
100 Type.Unify,
100 Type.Unify,
101+ Build.Artifact,
101 Build.Flags,
102 Build.Flags,
102− Build.Interface,
103 Build.Print,
103 Build.Print,
104 Build.Source,
104 Build.Source,
105 Build.Utils,
105 Build.Utils,
@@ -197,8 +197,8 @@ Executable elm
197 Type.State,
197 Type.State,
198 Type.Type,
198 Type.Type,
199 Type.Unify,
199 Type.Unify,
200+ Build.Artifact,
200 Build.Flags,
201 Build.Flags,
201− Build.Interface,
202 Build.Print,
202 Build.Print,
203 Build.Source,
203 Build.Source,
204 Build.Utils,
204 Build.Utils,
compiler/Build/Artifact.hsnew file+31
@@ -0,0 +1,31 @@
1+{-# OPTIONS_GHC -W #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+module Build.Artifact (read) where
4+
5+import Prelude hiding (read)
6+import Control.Monad.Error (MonadError, throwError, MonadIO, liftIO)
7+import qualified Data.ByteString.Lazy as LBS
8+import qualified Data.Binary as Binary
9+import System.Directory (doesFileExist)
10+
11+
12+read :: (MonadIO m, MonadError String m, Binary.Binary a) => FilePath -> m a
13+read filePath =
14+ do exists <- liftIO (doesFileExist filePath)
15+ if exists then decode else throwError notFound
16+ where
17+ decode =
18+ do bytes <- liftIO (LBS.readFile filePath)
19+ case Binary.decodeOrFail bytes of
20+ Right (_, _, binaryInfo) -> return binaryInfo
21+ Left (_, _, _) -> throwError corrupted
22+
23+ corrupted =
24+ concat
25+ [ "Error reading build artifact ", filePath, "\n"
26+ , " The file was generated by a previous build and may be outdated or corrupt.\n"
27+ , " Please remove the file and try again."
28+ ]
29+
30+ notFound =
31+ "Unable to find file " ++ filePath ++ " for deserialization!"
compiler/Build/Interface.hsdeleted−43
@@ -1,43 +0,0 @@
1−{-# OPTIONS_GHC -W #-}
2−module Build.Interface (load,isValid) where
3−
4−import qualified Data.ByteString.Lazy as L
5−import qualified Data.Binary as Binary
6−
7−import qualified Build.Print as Print
8−import qualified Elm.Compiler.Version as Compiler
9−import System.Directory (doesFileExist)
10−import AST.Module as Module
11−
12−
13−load :: Binary.Binary a => FilePath -> IO a
14−load filePath =
15− do exists <- doesFileExist filePath
16− case exists of
17− False -> Print.failure $ "Unable to find file " ++ filePath ++ " for deserialization!"
18− True -> do
19− bytes <- L.readFile filePath
20− case Binary.decodeOrFail bytes of
21− Right (_, _, binaryInfo) -> return binaryInfo
22− Left (_, offset, err) -> Print.failure $ msg offset err
23−
24− where
25− msg offset err = concat
26− [ "Error reading build artifact: ", filePath, "\n"
27− , " '", err, "' at offset ", show offset, "\n"
28− , " The file was generated by a previous build and may be outdated or corrupt.\n"
29− , " Please remove the file and try again."
30− ]
31−
32−
33−isValid :: FilePath -> (String, Module.Interface) -> Either String (String, Module.Interface)
34−isValid filePath (name, interface) =
35− let version = iVersion interface in
36− if version == Compiler.version
37− then Right (name, interface)
38− else Left $ concat
39− [ "Error reading build artifact: ", filePath, "\n"
40− , " It was generated by version ", version, " of the compiler,\n"
41− , " but you are using version ", Compiler.version, "\n"
42− , " Please remove the file and try again.\n"
43− ]
compiler/Elm/Compiler.hs+1−1
@@ -65,5 +65,5 @@ elmToJs source =
65{-# NOINLINE interfaces #-}
65{-# NOINLINE interfaces #-}
66interfaces :: Module.Interfaces
66interfaces :: Module.Interfaces
67interfaces =
67interfaces =
68− unsafePerformIO $ Prelude.interfaces False
68+ error "unsafePerformIO $ Prelude.interfaces False"
69
69
compiler/Metadata/Prelude.hs+54−46
@@ -1,15 +1,16 @@
1{-# OPTIONS_GHC -W #-}
1{-# OPTIONS_GHC -W #-}
2+{-# LANGUAGE FlexibleContexts #-}
2module Metadata.Prelude (interfaces, add) where
3module Metadata.Prelude (interfaces, add) where
3
4
5+import Control.Monad.Error (MonadError, throwError, MonadIO, liftIO)
4import qualified Data.Map as Map
6import qualified Data.Map as Map
5import qualified Data.Set as Set
7import qualified Data.Set as Set
6−import qualified Control.Exception as E
8+
7−import System.Exit
8−import System.IO
9−import AST.Module as Module
9+import qualified AST.Module as Module
10import qualified AST.Variable as Var
10import qualified AST.Variable as Var
11−import qualified Build.Interface as Interface
11+import qualified Build.Artifact as Artifact
12−import Build.Utils (getDataFile)
12+import qualified Build.Utils as Utils
13+import qualified Elm.Compiler.Version as Compiler
13
14
14
15
15-- DEFINITION OF THE PRELUDE
16-- DEFINITION OF THE PRELUDE
@@ -17,8 +18,10 @@ import Build.Utils (getDataFile)
17type ImportDict =
18type ImportDict =
18 Map.Map String ([String], Var.Listing Var.Value)
19 Map.Map String ([String], Var.Listing Var.Value)
19
20
21+
20prelude :: ImportDict
22prelude :: ImportDict
23+prelude =
21−prelude = Map.unions [ string, text, maybe, openImports ]
24+ Map.unions [ string, text, maybe, openImports ]
22 where
25 where
23 importing :: String -> [Var.Value] -> ImportDict
26 importing :: String -> [Var.Value] -> ImportDict
24 importing name values =
27 importing name values =
@@ -50,26 +53,28 @@ prelude = Map.unions [ string, text, maybe, openImports ]
50
53
51-- ADDING PRELUDE TO A MODULE
54-- ADDING PRELUDE TO A MODULE
52
55
53−add :: Bool -> Module exs body -> Module exs body
56+add :: Bool -> Module.Module exs body -> Module.Module exs body
54−add noPrelude (Module moduleName path exports imports decls) =
57+add noPrelude (Module.Module moduleName path exports imports decls) =
55− Module moduleName path exports ammendedImports decls
58+ Module.Module moduleName path exports ammendedImports decls
56 where
59 where
57 ammendedImports =
60 ammendedImports =
58 importDictToList $
61 importDictToList $
59 foldr addImport (if noPrelude then Map.empty else prelude) imports
62 foldr addImport (if noPrelude then Map.empty else prelude) imports
60
63
64+
61−importDictToList :: ImportDict -> [(String, ImportMethod)]
65+importDictToList :: ImportDict -> [(String, Module.ImportMethod)]
62importDictToList dict =
66importDictToList dict =
63 concatMap toImports (Map.toList dict)
67 concatMap toImports (Map.toList dict)
64 where
68 where
65 toImports (name, (qualifiers, listing@(Var.Listing explicits open))) =
69 toImports (name, (qualifiers, listing@(Var.Listing explicits open))) =
66− map (\qualifier -> (name, As qualifier)) qualifiers
70+ map (\qualifier -> (name, Module.As qualifier)) qualifiers
67 ++
71 ++
68 if open || not (null explicits)
72 if open || not (null explicits)
69− then [(name, Open listing)]
73+ then [(name, Module.Open listing)]
70 else []
74 else []
71
75
76+
72−addImport :: (String, ImportMethod) -> ImportDict -> ImportDict
77+addImport :: (String, Module.ImportMethod) -> ImportDict -> ImportDict
73addImport (name, method) importDict =
78addImport (name, method) importDict =
74 Map.alter mergeMethods name importDict
79 Map.alter mergeMethods name importDict
75 where
80 where
@@ -82,8 +87,10 @@ addImport (name, method) importDict =
82 Just v -> v
87 Just v -> v
83 in
88 in
84 case method of
89 case method of
90+ Module.As qualifier ->
85− As qualifier -> Just (qualifier : qualifiers, listing)
91+ Just (qualifier : qualifiers, listing)
92+
86− Open newListing ->
93+ Module.Open newListing ->
87 Just (qualifiers, mergeListings newListing listing)
94 Just (qualifiers, mergeListings newListing listing)
88
95
89 mergeListings (Var.Listing explicits1 open1) (Var.Listing explicits2 open2) =
96 mergeListings (Var.Listing explicits1 open1) (Var.Listing explicits2 open2) =
@@ -94,33 +101,34 @@ addImport (name, method) importDict =
94
101
95-- EXTRACT INTERFACES FROM STATIC FILE
102-- EXTRACT INTERFACES FROM STATIC FILE
96
103
97−interfaces :: Bool -> IO Interfaces
104+interfaces :: (MonadIO m, MonadError String m) => Bool -> m Module.Interfaces
98−interfaces noPrelude =
105+interfaces noPrelude
99− if noPrelude
100− then return Map.empty
106+ | noPrelude = return Map.empty
107+ | otherwise =
101− else safeReadDocs =<< getDataFile "interfaces.data"
108+ do filePath <- liftIO (Utils.getDataFile "interfaces.data")
102−
109+ readInterfaces filePath
103−safeReadDocs :: FilePath -> IO Interfaces
110+
104−safeReadDocs name =
111+
105− E.catch (readDocs name) $ \err -> do
112+readInterfaces :: (MonadIO m, MonadError String m) => FilePath -> m Module.Interfaces
106− let _ = err :: IOError
107− hPutStrLn stderr $ unlines $
108− [ "Error reading types for standard library from file " ++ name
109− , " If you are using a stable version of Elm, please report an issue at"
110− , " <http://github.com/elm-lang/Elm/issues> specifying version numbers for"
111− , " Elm and your OS." ]
112− exitFailure
113−
114−readDocs :: FilePath -> IO Interfaces
115−readDocs filePath = do
113+readInterfaces filePath =
116− interfaces <- Interface.load filePath
114+ do interfaces <- mapM (isValid filePath) =<< Artifact.read filePath
117− case mapM (Interface.isValid filePath) (interfaces :: [(String, Module.Interface)]) of
115+ case interfaces of
118− Left err -> do
119− hPutStrLn stderr err
120− exitFailure
121−
122− Right [] -> do
123− hPutStrLn stderr "No interfaces found in serialized Prelude!"
116+ [] -> throwError "No interfaces found in serialized Prelude!"
124− exitFailure
125−
126− Right ifaces -> return $ Map.fromList ifaces
117+ _ -> return (Map.fromList interfaces)
118+
119+
120+isValid :: (MonadError String m) => FilePath -> (String, Module.Interface) -> m (String, Module.Interface)
121+isValid filePath (name, interface) =
122+ if version == Compiler.version
123+ then return (name, interface)
124+ else throwError badVersion
125+ where
126+ version = Module.iVersion interface
127+
128+ badVersion =
129+ concat
130+ [ "Error reading build artifact: ", filePath, "\n"
131+ , " It was generated by version ", version, " of the compiler,\n"
132+ , " but you are using version ", Compiler.version, "\n"
133+ , " Please remove the file and try again.\n"
134+ ]