Avoid loading prelude from the default path

We now bundle the whole source in the compiler binary anyway, so it's
faster to just use that. Additionally, this should allow us to easily
install the `dex` binary without having to carry the `prelude.dx` file
around. The change is not that simple, because it required an update to
the caching mechanism, which now also uses global XDG directories.

2 files changed, 38 insertions, 25 deletions

diff --git a/src/dex.hs b/src/dex.hs
index 9e6c9435..198099c9 100644
--- a/src/dex.hs
+++ b/src/dex.hs
@@ -13,11 +13,13 @@ import Options.Applicative
 import System.Posix.Terminal (queryTerminal)
 import System.Posix.IO (stdOutput)
 import System.Exit
+import System.Directory
 
 import Syntax
 import PPrint
 import RenderHtml
 import Serialize
+import Resources
 
 import TopLevel
 import Parser  hiding (Parser)
@@ -29,11 +31,14 @@ data EvalMode = ReplMode String
               | WebMode    FilePath
               | WatchMode  FilePath
               | ScriptMode FilePath DocFmt ErrorHandling
-data CmdOpts = CmdOpts EvalMode FilePath EvalConfig Backend
+data CmdOpts = CmdOpts EvalMode (Maybe FilePath) EvalConfig Backend
 
-runMode :: EvalMode -> FilePath -> EvalConfig -> IO ()
+runMode :: EvalMode -> (Maybe FilePath) -> EvalConfig -> IO ()
 runMode evalMode preludeFile opts = do
-  env <- memoizeFileEval "prelude.cache" (evalPrelude opts) preludeFile
+  key <- case preludeFile of
+           Nothing   -> return ""  -- memoizeFileEval already checks compiler version
+           Just path -> show <$> getModificationTime path
+  env <- cached "prelude" key $ evalPrelude opts preludeFile
   let runEnv m = evalStateT m env
   case evalMode of
     ReplMode prompt ->
@@ -46,9 +51,12 @@ runMode evalMode preludeFile opts = do
     WebMode   fname -> runWeb      fname opts env
     WatchMode fname -> runTerminal fname opts env
 
-evalPrelude :: EvalConfig -> FilePath -> IO TopEnv
+evalPrelude :: EvalConfig -> (Maybe FilePath) -> IO TopEnv
 evalPrelude opts fname = flip execStateT mempty $ do
-  result <- evalFile opts fname
+  source <- case fname of
+              Nothing   -> return $ preludeSource
+              Just path -> liftIO $ readFile path
+  result <- evalSource opts source
   void $ liftErrIO $ mapM (\(_, Result _ r) -> r) result
 
 liftErrIO :: MonadIO m => Except a -> m a
@@ -132,9 +140,8 @@ parseEvalOpts = EvalConfig
   <*> pure (error "Backend not initialized")
   <*> pure (error "Logging not initialized")
 
-parsePreludeFile :: Parser FilePath
-parsePreludeFile = (strOption $ long "prelude" <> value "prelude.dx" <> metavar "FILE"
-                                               <> help "Prelude file" <> showDefault)
+parsePreludeFile :: Parser (Maybe FilePath)
+parsePreludeFile = optional $ strOption $ long "prelude" <> metavar "FILE" <> help "Prelude file"
 
 parseBackend :: Parser Backend
 parseBackend =
diff --git a/src/lib/Serialize.hs b/src/lib/Serialize.hs
index 79e90071..b233a344 100644
--- a/src/lib/Serialize.hs
+++ b/src/lib/Serialize.hs
@@ -8,7 +8,7 @@
 
 module Serialize (DBOHeader (..), dumpDataFile, loadDataFile, pprintVal,
                  valToHeatmap, valToScatter,
-                 typeToArrayType, memoizeFileEval) where
+                 typeToArrayType, cached) where
 
 import Prelude hiding (pi, abs)
 import Control.Monad
@@ -18,8 +18,8 @@ import qualified Data.ByteString       as BS
 import qualified Data.ByteString.Char8 as B
 import qualified Data.Vector.Storable as V
 import System.Directory
+import System.FilePath
 import System.IO
-import System.IO.Error
 import System.IO.MMap
 import System.Posix hiding (ReadOnly, version)
 import Text.Megaparsec hiding (State)
@@ -248,22 +248,28 @@ typeToArrayType t = case t of
 curCompilerVersion :: String
 curCompilerVersion = __TIME__
 
-memoizeFileEval :: Store a => FilePath -> (FilePath -> IO a) -> FilePath -> IO a
-memoizeFileEval cacheFile f fname = do
-  cacheFresh <- cacheFile `newerFileThan` fname
-  if cacheFresh
+cached :: (Eq k, Store k, Store a) => String -> k -> IO a -> IO a
+cached cacheName key create = do
+  cacheDir <- getXdgDirectory XdgCache "dex"
+  createDirectoryIfMissing True cacheDir
+  let cacheKeyPath = cacheDir </> (cacheName ++ ".key")
+  let cachePath    = cacheDir </> (cacheName ++ ".cache")
+  cacheExists <- (&&) <$> doesFileExist cacheKeyPath <*> doesFileExist cachePath
+  cacheUpToDate <- case cacheExists of
+                     False -> return False
+                     True -> do
+                       maybeCacheKey <- decode <$> BS.readFile cacheKeyPath
+                       case maybeCacheKey of
+                         Right cacheKey -> return $ cacheKey == (curCompilerVersion, key)
+                         Left  _        -> return False
+  if cacheUpToDate
     then do
-      decoded <- decode <$> BS.readFile cacheFile
+      decoded <- decode <$> BS.readFile cachePath
       case decoded of
-        Right (version, result) | version == curCompilerVersion -> return result
-        _ -> removeFile cacheFile >> memoizeFileEval cacheFile f fname
+        Right result -> return result
+        _            -> removeFile cachePath >> cached cacheName key create
     else do
-      result <- f fname
-      BS.writeFile cacheFile (encode (curCompilerVersion, result))
+      result <- create
+      BS.writeFile cacheKeyPath $ encode (curCompilerVersion, key)
+      BS.writeFile cachePath    $ encode result
       return result
-
-newerFileThan :: FilePath -> FilePath -> IO Bool
-newerFileThan f1 f2 = flip catchIOError (const $ return False) $ do
-  f1Mod <- getModificationTime f1
-  f2Mod <- getModificationTime f2
-  return $ f1Mod > f2Mod