@@ -1,15 +1,16 @@
11{-# OPTIONS_GHC -W #-}
2+{-# LANGUAGE FlexibleContexts #-}
23module Metadata.Prelude (interfaces, add) where
34
5+import Control.Monad.Error (MonadError, throwError, MonadIO, liftIO)
46import qualified Data.Map as Map
57import qualified Data.Set as Set
6−import qualified Control.Exception as E
7−import System.Exit
8−import System.IO
9−import AST.Module as Module
8+
9+import qualified AST.Module as Module
1010import qualified AST.Variable as Var
11−import qualified Build.Interface as Interface
12−import Build.Utils (getDataFile)
11+import qualified Build.Artifact as Artifact
12+import qualified Build.Utils as Utils
13+import qualified Elm.Compiler.Version as Compiler
1314
1415
1516-- DEFINITION OF THE PRELUDE
@@ -17,8 +18,10 @@ import Build.Utils (getDataFile)
1718type ImportDict =
1819 Map.Map String ([String], Var.Listing Var.Value)
1920
21+
2022prelude :: ImportDict
21−prelude = Map.unions [ string, text, maybe, openImports ]
23+prelude =
24+ Map.unions [ string, text, maybe, openImports ]
2225 where
2326 importing :: String -> [Var.Value] -> ImportDict
2427 importing name values =
@@ -50,26 +53,28 @@ prelude = Map.unions [ string, text, maybe, openImports ]
5053
5154-- ADDING PRELUDE TO A MODULE
5255
53−add :: Bool -> Module exs body -> Module exs body
54−add noPrelude (Module moduleName path exports imports decls) =
55− Module moduleName path exports ammendedImports decls
56+add :: Bool -> Module.Module exs body -> Module.Module exs body
57+add noPrelude (Module.Module moduleName path exports imports decls) =
58+ Module.Module moduleName path exports ammendedImports decls
5659 where
5760 ammendedImports =
5861 importDictToList $
5962 foldr addImport (if noPrelude then Map.empty else prelude) imports
6063
61−importDictToList :: ImportDict -> [(String, ImportMethod)]
64+
65+importDictToList :: ImportDict -> [(String, Module.ImportMethod)]
6266importDictToList dict =
6367 concatMap toImports (Map.toList dict)
6468 where
6569 toImports (name, (qualifiers, listing@(Var.Listing explicits open))) =
66− map (\qualifier -> (name, As qualifier)) qualifiers
70+ map (\qualifier -> (name, Module.As qualifier)) qualifiers
6771 ++
6872 if open || not (null explicits)
69− then [(name, Open listing)]
73+ then [(name, Module.Open listing)]
7074 else []
7175
72−addImport :: (String, ImportMethod) -> ImportDict -> ImportDict
76+
77+addImport :: (String, Module.ImportMethod) -> ImportDict -> ImportDict
7378addImport (name, method) importDict =
7479 Map.alter mergeMethods name importDict
7580 where
@@ -82,8 +87,10 @@ addImport (name, method) importDict =
8287 Just v -> v
8388 in
8489 case method of
85− As qualifier -> Just (qualifier : qualifiers, listing)
86− Open newListing ->
90+ Module.As qualifier ->
91+ Just (qualifier : qualifiers, listing)
92+
93+ Module.Open newListing ->
8794 Just (qualifiers, mergeListings newListing listing)
8895
8996 mergeListings (Var.Listing explicits1 open1) (Var.Listing explicits2 open2) =
@@ -94,33 +101,34 @@ addImport (name, method) importDict =
94101
95102-- EXTRACT INTERFACES FROM STATIC FILE
96103
97−interfaces :: Bool -> IO Interfaces
98−interfaces noPrelude =
99− if noPrelude
100− then return Map.empty
101− else safeReadDocs =<< getDataFile "interfaces.data"
102−
103−safeReadDocs :: FilePath -> IO Interfaces
104−safeReadDocs name =
105− E.catch (readDocs name) $ \err -> do
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
116− interfaces <- Interface.load filePath
117− case mapM (Interface.isValid filePath) (interfaces :: [(String, Module.Interface)]) of
118− Left err -> do
119− hPutStrLn stderr err
120− exitFailure
121−
122− Right [] -> do
123− hPutStrLn stderr "No interfaces found in serialized Prelude!"
124− exitFailure
125−
126− Right ifaces -> return $ Map.fromList ifaces
104+interfaces :: (MonadIO m, MonadError String m) => Bool -> m Module.Interfaces
105+interfaces noPrelude
106+ | noPrelude = return Map.empty
107+ | otherwise =
108+ do filePath <- liftIO (Utils.getDataFile "interfaces.data")
109+ readInterfaces filePath
110+
111+
112+readInterfaces :: (MonadIO m, MonadError String m) => FilePath -> m Module.Interfaces
113+readInterfaces filePath =
114+ do interfaces <- mapM (isValid filePath) =<< Artifact.read filePath
115+ case interfaces of
116+ [] -> throwError "No interfaces found in serialized Prelude!"
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+ ]