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

@@ -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,

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

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

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."

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
+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

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)

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