From 5ad6e94579fd583a5b6e333f79fe6811873cba23 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Erik=20Sved=C3=A4ng?= Date: Fri, 22 Mar 2019 20:33:06 +0100 Subject: [PATCH] The '(load)' command will work relative to the file containing it, if put into a file. --- examples/vector.carp | 4 +-- src/Eval.hs | 59 +++++++++++++++++++++++++++++--------------- test/filepath.carp | 2 +- test/statistics.carp | 2 +- test/tuples.carp | 2 +- 5 files changed, 44 insertions(+), 25 deletions(-) diff --git a/examples/vector.carp b/examples/vector.carp index 9904e93c..6c744e62 100644 --- a/examples/vector.carp +++ b/examples/vector.carp @@ -1,5 +1,5 @@ -(load "Vector.carp") -(load "Geometry.carp") +(load "core/Vector.carp") ;; specified path to avoid loading itself on case insensitive file systems +(load "core/Geometry.carp") (use-all IO Vector2 Geometry) diff --git a/src/Eval.hs b/src/Eval.hs index 33d0e3a7..4638df5a 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -9,6 +9,7 @@ import Control.Monad.State.Lazy (StateT(..), runStateT, liftIO, modify, get, put import System.Exit (exitSuccess, exitFailure, exitWith, ExitCode(..)) import qualified System.IO as SysIO import System.Directory (doesFileExist, canonicalizePath, createDirectoryIfMissing, getCurrentDirectory, getHomeDirectory, setCurrentDirectory) +import System.FilePath (takeDirectory) import System.Process (readProcess, readProcessWithExitCode) import Control.Concurrent (forkIO) import qualified Data.Map as Map @@ -1008,20 +1009,27 @@ specialCommandMetaGet path key = -- | Command for loading a Carp file. commandLoad :: CommandCallback -commandLoad [xobj@(XObj (Str path) _ _)] = +commandLoad [xobj@(XObj (Str path) i _)] = do ctx <- get home <- liftIO $ getHomeDirectory - let proj = contextProj ctx + let relativeTo = case i of + Just ii -> + case infoFile ii of + "REPL" -> "." + file -> takeDirectory file + Nothing -> "." + proj = contextProj ctx libDir = home ++ "/" ++ projectLibDir proj carpDir = projectCarpDir proj fullSearchPaths = path : - ("./" ++ path) : -- the path from the current directory + (relativeTo ++ "/" ++ path) : -- the path from the file that contains the '(load)', or the current directory if not loading from a file (e.g. the repl) map (++ "/" ++ path) (projectCarpSearchPaths proj) ++ -- user defined search paths [carpDir ++ "/core/" ++ path] ++ [libDir ++ "/" ++ path] - -- putStrLn ("Full search paths = " ++ show fullSearchPaths) + --liftIO $ putStrLn ("Full search paths = " ++ joinWithComma fullSearchPaths) existingPaths <- liftIO (filterM doesFileExist fullSearchPaths) + --liftIO $ putStrLn ("Existing paths = " ++ joinWithComma existingPaths) case existingPaths of [] -> if elem '@' path @@ -1029,22 +1037,27 @@ commandLoad [xobj@(XObj (Str path) _ _)] = else return $ invalidPath ctx path firstPathFound : _ -> do canonicalPath <- liftIO (canonicalizePath firstPathFound) - let alreadyLoaded = projectAlreadyLoaded proj - if canonicalPath `elem` alreadyLoaded - then do --liftIO (putStrLn ("Ignoring 'load' command for already loaded file '" ++ canonicalPath ++ "'")) - return () - else do contents <- liftIO $ do --putStrLn ("Will load '" ++ canonicalPath ++ "'") - handle <- SysIO.openFile canonicalPath SysIO.ReadMode - SysIO.hSetEncoding handle SysIO.utf8 - SysIO.hGetContents handle - let files = projectFiles proj - files' = if canonicalPath `elem` files - then files - else files ++ [canonicalPath] - proj' = proj { projectFiles = files', projectAlreadyLoaded = canonicalPath : alreadyLoaded } - newCtx <- liftIO $ executeString True (ctx { contextProj = proj' }) contents canonicalPath - put newCtx - return dynamicNil + fileThatLoads <- liftIO (canonicalizePath (case i of + Just ii -> infoFile ii + Nothing -> "")) + if (canonicalPath == fileThatLoads) + then return $ cantLoadSelf ctx path + else do let alreadyLoaded = projectAlreadyLoaded proj + if canonicalPath `elem` alreadyLoaded + then do --liftIO (putStrLn ("Ignoring 'load' command for already loaded file '" ++ canonicalPath ++ "'")) + return () + else do contents <- liftIO $ do --putStrLn ("Will load '" ++ canonicalPath ++ "'") + handle <- SysIO.openFile canonicalPath SysIO.ReadMode + SysIO.hSetEncoding handle SysIO.utf8 + SysIO.hGetContents handle + let files = projectFiles proj + files' = if canonicalPath `elem` files + then files + else files ++ [canonicalPath] + proj' = proj { projectFiles = files', projectAlreadyLoaded = canonicalPath : alreadyLoaded } + newCtx <- liftIO $ executeString True (ctx { contextProj = proj' }) contents canonicalPath + put newCtx + return dynamicNil where fppl ctx = projectFilePathPrintLength (contextProj ctx) @@ -1062,6 +1075,12 @@ commandLoad [xobj@(XObj (Str path) _ _)] = (machineReadableInfoFromXObj (fppl ctx) xobj) ++ " I can't find a file named: '" ++ path ++ "'" _ -> "I can't find a file named: '" ++ path ++ "'") ++ "\n\nI tried interpreting the statement as a git import, but got: " ++ stderr) (info xobj) + cantLoadSelf ctx path = + case contextExecMode ctx of + Check -> + Left (EvalError (machineReadableInfoFromXObj (fppl ctx) xobj ++ " A file can't load itself: '" ++ path ++ "'") Nothing) + _ -> + Left (EvalError ("A file can't load itself: '" ++ path ++ "'") (info xobj)) tryInstall path = let split = splitOn "@" path in tryInstallWithCheckout (joinWith "@" (init split)) (last split) diff --git a/test/filepath.carp b/test/filepath.carp index 4da9101a..57704488 100644 --- a/test/filepath.carp +++ b/test/filepath.carp @@ -1,4 +1,4 @@ -(load "Filepath.carp") +(load "core/Filepath.carp") ;; specified path to avoid loading itself on case insensitive file systems (load "Test.carp") (use-all Test Filepath) diff --git a/test/statistics.carp b/test/statistics.carp index 105106ab..2542e6a3 100644 --- a/test/statistics.carp +++ b/test/statistics.carp @@ -1,5 +1,5 @@ (load "Test.carp") -(load "Statistics.carp") +(load "core/Statistics.carp") ;; specified path to avoid loading itself on case insensitive file systems (use-all Double Test Statistics) diff --git a/test/tuples.carp b/test/tuples.carp index 72f33d6d..8c48e257 100644 --- a/test/tuples.carp +++ b/test/tuples.carp @@ -1,4 +1,4 @@ -(load "Tuples.carp") +(load "core/Tuples.carp") ;; specified path to avoid loading itself on case insensitive file systems (load "Test.carp") (use Test)