From c845e586edd07ed95ea419299077ca80b931a70c Mon Sep 17 00:00:00 2001 From: Justin Leitgeb Date: Wed, 30 Oct 2013 17:44:47 -0500 Subject: [PATCH] Give more helpful error messages when deserializing elmi files Provides an error message indicating incorrect compiler version or corrupt file. Exit status will be 1 in either failure case and error message is printed to stderr. Uses the same checks against interfaces.data as well as standard .elmi files since both are susceptible to breaking in the same way. The following will be displayed when an elmi file has a different compiler version than the elm compiler that tries to load it: justin ~/Code/elm-lang.org/public/examples/Intermediate $ ~/Code/elm/dist/build/elm/elm Pong.elm Found build artifacts created by a different Elm compiler version. Please rebuilt cache/Pong.elmi and try again. The following will be displayed when a file that cannot be deserialized is encountered: justin ~/Code/elm-lang.org/public/examples/Intermediate $ ~/Code/elm/dist/build/elm/elm Pong.elm Got an error, 'demandInput: not enough bytes' at offset 10303 of cache/Pong.elmi. This error may be due to an outdated or corrupt artifact from a previous build. Please rebuild cache/Pong.elmi and try again. --- Elm.cabal | 12 ++++--- compiler/Compiler.hs | 54 +++++++++++++++++------------- compiler/Initialize.hs | 2 +- compiler/InterfaceSerialization.hs | 50 +++++++++++++++++++++++++++ compiler/Metadata/Prelude.hs | 37 ++++++++++++++------ compiler/SourceSyntax/Module.hs | 9 +++-- compiler/Transform/Canonicalize.hs | 5 ++- 7 files changed, 125 insertions(+), 44 deletions(-) create mode 100644 compiler/InterfaceSerialization.hs diff --git a/Elm.cabal b/Elm.cabal index fcce33d..1ef8460 100644 --- a/Elm.cabal +++ b/Elm.cabal @@ -53,6 +53,7 @@ Library Transform.Optimize, Metadata.Prelude, Initialize, + InterfaceSerialization, Parse.Binop, Parse.Declaration, Parse.Expression, @@ -79,13 +80,14 @@ Library Paths_Elm Build-depends: base >=4.2 && <5, - binary, + binary >= 0.6.4.0, blaze-html == 0.5.* || == 0.6.*, - blaze-markup == 0.5.1.*, + blaze-markup, bytestring, cmdargs, containers >= 0.3, directory, + either-unwrap, filepath, indents, language-ecmascript < 1, @@ -122,6 +124,7 @@ Executable elm Transform.Optimize, Metadata.Prelude, Initialize, + InterfaceSerialization, Parse.Binop, Parse.Declaration, Parse.Expression, @@ -148,7 +151,7 @@ Executable elm Paths_Elm Build-depends: base >=4.2 && <5, - binary, + binary >= 0.6.4.0, blaze-html == 0.5.* || == 0.6.*, blaze-markup == 0.5.1.*, bytestring, @@ -156,6 +159,7 @@ Executable elm containers >= 0.3, directory, filepath, + either-unwrap, indents, language-ecmascript < 1, mtl >= 2, @@ -191,7 +195,7 @@ Executable elm-doc Build-depends: aeson, aeson-pretty, base >=4.2 && <5, - binary, + binary >= 0.6.4.0, bytestring, cmdargs, containers >= 0.3, diff --git a/compiler/Compiler.hs b/compiler/Compiler.hs index b55605b..5b37c65 100644 --- a/compiler/Compiler.hs +++ b/compiler/Compiler.hs @@ -24,6 +24,7 @@ import Parse.Module (getModuleName) import Initialize (buildFromSource, getSortedDependencies) import Generate.JavaScript (jsModule) import Generate.Html (createHtml, JSSource(..)) +import qualified InterfaceSerialization as IS import Paths_Elm import SourceSyntax.PrettyPrint (pretty, variable) @@ -39,9 +40,9 @@ data Flags = , print_types :: Bool , scripts :: [FilePath] , no_prelude :: Bool - , cache_dir :: FilePath - , build_dir :: FilePath - , src_dir :: [FilePath] + , cache_dir :: FilePath + , build_dir :: FilePath + , src_dir :: [FilePath] } deriving (Data,Typeable,Show,Eq) @@ -93,27 +94,30 @@ elmo flags filePath = cachePath flags filePath "elmo" elmi :: Flags -> FilePath -> FilePath elmi flags filePath = cachePath flags filePath "elmi" +buildFile :: Flags -> Int -> Int -> Interfaces -> FilePath -> IO (String, ModuleInterface) +buildFile flags moduleNum numModules interfaces filePath = do + compiled <- alreadyCompiled + if compiled then do + bytes <- IS.loadInterface (elmi flags filePath) + case bytes >>= IS.interfaceDecode (elmi flags filePath) >>= + IS.validVersion filePath of -buildFile :: Flags -> Int -> Int -> Interfaces -> FilePath -> IO (String,ModuleInterface) -buildFile flags moduleNum numModules interfaces filePath = - do compiled <- alreadyCompiled - case compiled of - False -> compile - True -> do - handle <- openBinaryFile (elmi flags filePath) ReadMode - bits <- L.hGetContents handle - let info :: (String, ModuleInterface) - info = Binary.decode bits - modInterface = snd info + Left err -> do + hPutStrLn stderr err + exitFailure - when (print_types flags) - (printTypes interfaces - (iTypes modInterface) - (iAliases modInterface) - (iImports modInterface)) + Right (name, interface) -> do + when (print_types flags) + (printTypes interfaces + (iTypes interface) + (iAliases interface) + (iImports interface)) + + return (name, interface) + + else + compile - L.length bits `seq` hClose handle - return info where alreadyCompiled :: IO Bool alreadyCompiled = do @@ -140,6 +144,7 @@ buildFile flags moduleNum numModules interfaces filePath = createDirectoryIfMissing True (cache_dir flags) createDirectoryIfMissing True (build_dir flags) + metaModule <- case buildFromSource (no_prelude flags) interfaces source of Left errors -> do @@ -152,6 +157,7 @@ buildFile flags moduleNum numModules interfaces filePath = (types metaModule) (aliases metaModule) (imports metaModule)) let interface = Canonical.interface name $ ModuleInterface { + iVersion = showVersion version, iTypes = types metaModule, iImports = imports metaModule, iAdts = datatypes metaModule, @@ -206,12 +212,12 @@ build flags rootFile = do where appendToOutput :: BS.ByteString -> FilePath -> IO BS.ByteString appendToOutput js filePath = - do src <- BS.readFile (elmo flags filePath) - return (BS.append src js) + do + src <- BS.readFile (elmo flags filePath) + return (BS.append src js) sources js = map Link (scripts flags) ++ [ Source js ] - buildFiles :: Flags -> Int -> Interfaces -> String -> [FilePath] -> IO (String, Interfaces) buildFiles _ _ interfaces moduleName [] = return (moduleName, interfaces) buildFiles flags numModules interfaces _ (filePath:rest) = do diff --git a/compiler/Initialize.hs b/compiler/Initialize.hs index 53c7762..c6ca97c 100644 --- a/compiler/Initialize.hs +++ b/compiler/Initialize.hs @@ -92,7 +92,7 @@ readDeps srcDirs noPrelude root = evalStateT (go root) Set.empty case Parse.dependencies txt of Left err -> liftIO (putStrLn msg >> print err >> exitFailure) where msg = "Error resolving dependencies in " ++ root' ++ ":" - + Right (name,deps) -> do seen <- get let realDeps = Set.difference (Set.fromList deps) builtIns diff --git a/compiler/InterfaceSerialization.hs b/compiler/InterfaceSerialization.hs new file mode 100644 index 0000000..47dad46 --- /dev/null +++ b/compiler/InterfaceSerialization.hs @@ -0,0 +1,50 @@ +module InterfaceSerialization ( loadInterface + , interfaceDecode + , validVersion + ) where + +import qualified Data.ByteString.Lazy as L +import qualified Data.Binary as Binary + +import Paths_Elm (version) +import Data.Version (showVersion) +import System.Directory (doesFileExist) +import System.IO (hPutStrLn, stderr) +import System.Exit (exitFailure) + +import SourceSyntax.Module + +loadInterface :: FilePath -> IO (Either String L.ByteString) +loadInterface filePath = do + exists <- doesFileExist filePath + if exists + then do + byteString <- L.readFile filePath + return $ Right byteString + + else + return $ Left $ "Unable to find file " ++ filePath ++ + " for deserialization!" + +interfaceDecode :: Binary.Binary a => FilePath -> L.ByteString -> + Either String a +interfaceDecode filePath bytes = do + case Binary.decodeOrFail bytes of + Left (_, offset, err) -> do + Left $ "Got an error, '" ++ err ++ "' at offset " ++ + show offset ++ " of " ++ filePath ++ ".\n\n" ++ + "This error may be due to an outdated or corrupt " ++ + "artifact from a previous build. Please rebuild " ++ + filePath ++ " and try again." + + Right (_, _, binaryInfo) -> Right binaryInfo + +validVersion :: FilePath -> (String, ModuleInterface) -> + Either String (String, ModuleInterface) +validVersion filePath (name, interface) = + if (iVersion interface) == showVersion version then + Right (name, interface) + else + Left $ "Found build artifacts created by a different " ++ + "Elm compiler version. Please rebuild " ++ + filePath ++ " and try again." diff --git a/compiler/Metadata/Prelude.hs b/compiler/Metadata/Prelude.hs index 72eae07..a58917b 100644 --- a/compiler/Metadata/Prelude.hs +++ b/compiler/Metadata/Prelude.hs @@ -11,7 +11,9 @@ import System.IO.Unsafe (unsafePerformIO) import SourceSyntax.Module import qualified Data.Binary as Binary import qualified Data.ByteString.Lazy as BS +import Data.Either.Unwrap (fromRight) +import qualified InterfaceSerialization as IS add :: Module t v -> Module t v add (Module name exs ims stmts) = Module name exs (customIms ++ ims) stmts @@ -46,14 +48,29 @@ safeReadDocs name = , " and specify your versions of Elm and your OS" ] exitFailure +firstModuleInterface :: Interfaces -> Either String (String, ModuleInterface) +firstModuleInterface interfaces = + if Map.null interfaces then + Left "No interfaces found in serialized Prelude!" + else + Right $ head $ Map.toList interfaces + readDocs :: FilePath -> IO Interfaces -readDocs name = do - exists <- doesFileExist name - case exists of - False -> ioError . userError $ "File Not Found" - True -> do - handle <- openBinaryFile name ReadMode - bits <- BS.hGetContents handle - let ifaces = Map.fromList (Binary.decode bits) - BS.length bits `seq` hClose handle - return ifaces \ No newline at end of file +readDocs filePath = do + bytes <- IS.loadInterface filePath + let interfaces = bytes >>= IS.interfaceDecode filePath + + -- Although every ModuleInterface that is deserialized in this collection + -- contains the compiler version, we only check the first ModuleInterface + -- since it doesn't make sense that different modules in Prelude would have + -- been compiled by different compiler versions. + case interfaces >>= firstModuleInterface >>= IS.validVersion filePath of + Left err -> do + hPutStrLn stderr err + exitFailure + + -- Unwrapping the Right value here is safe since the whole above chain + -- returns a Right value. The toList/fromList is necessary because of a + -- problem with looking up keys in the Map after deserialization. Example + -- at https://gist.github.com/jsl/7294493. + Right _ -> return $ Map.fromList $ Map.toList $ fromRight interfaces diff --git a/compiler/SourceSyntax/Module.hs b/compiler/SourceSyntax/Module.hs index b503964..dfd2556 100644 --- a/compiler/SourceSyntax/Module.hs +++ b/compiler/SourceSyntax/Module.hs @@ -14,6 +14,9 @@ import SourceSyntax.Type import System.FilePath (joinPath) import Control.Monad (liftM) +import Paths_Elm (version) +import Data.Version (showVersion) + data Module tipe var = Module [String] Exports Imports [Declaration tipe var] deriving (Show) @@ -52,12 +55,13 @@ data MetadataModule t v = MetadataModule { datatypes :: [ (String, [String], [(String,[Type])]) ], foreignImports :: [(String, LExpr t v, String, Type)], foreignExports :: [(String, String, Type)] -} +} deriving Show type Interfaces = Map.Map String ModuleInterface type ADT = (String, [String], [(String,[Type])]) data ModuleInterface = ModuleInterface { + iVersion :: String, iTypes :: Map.Map String Type, iImports :: [(String, ImportMethod)], iAdts :: [ADT], @@ -67,8 +71,9 @@ data ModuleInterface = ModuleInterface { instance Binary ModuleInterface where - get = ModuleInterface <$> get <*> get <*> get <*> get <*> get + get = ModuleInterface <$> get <*> get <*> get <*> get <*> get <*> get put modul = do + put (iVersion modul) put (iTypes modul) put (iImports modul) put (iAdts modul) diff --git a/compiler/Transform/Canonicalize.hs b/compiler/Transform/Canonicalize.hs index 57310b1..9cf6e59 100644 --- a/compiler/Transform/Canonicalize.hs +++ b/compiler/Transform/Canonicalize.hs @@ -15,11 +15,11 @@ import qualified SourceSyntax.Type as Type import qualified Transform.SortDefinitions as SD import Text.PrettyPrint as P - interface :: String -> ModuleInterface -> ModuleInterface interface moduleName iface = ModuleInterface - { iTypes = Map.mapKeys prefix (Map.map renameType' (iTypes iface)) + { iVersion = iVersion iface + , iTypes = Map.mapKeys prefix (Map.map renameType' (iTypes iface)) , iImports = iImports iface , iAdts = map (both prefix renameCtors) (iAdts iface) , iAliases = map (both prefix renameType') (iAliases iface) @@ -95,7 +95,6 @@ metadataModule ifaces modul = realImports = filter (not . List.isPrefixOf "Native." . fst) (imports modul) initialEnv = Map.fromList (concatMap canon realImports ++ localEnv ++ globalEnv) - type Env = Map.Map String String extend :: Env -> Pattern -> Env