Merge pull request #263 from hellerve/dependencies

Dependency management

app/Main.hs

@@ -23,6 +23,7 @@ defaultProject =
           , projectFiles = []
           , projectAlreadyLoaded = []
           , projectEchoC = False
+          , projectLibDir = ".carp/libs/"
           , projectCarpDir = "./"
           , projectOutDir = "./out/"
           , projectDocsDir = "./docs/"
@@ -81,6 +82,11 @@ main = do args <- SystemEnvironment.getArgs
                        runInputT settings (repl finalContext "")
             Build -> do _ <- executeString True finalContext ":b" "Compiler (Build)"
                         return ()
+            Install thing ->
+              do _ <- executeString True finalContext
+                      ("(load \"" ++ thing ++ "\")")
+                      "Installation"
+                 return ()
             BuildAndRun -> do _ <- executeString True finalContext ":bx" "Compiler (Build & Run)"
                               -- TODO: Handle the return value from executeString and return that one to the shell
                               return ()
@@ -103,6 +109,7 @@ parseArgs args = parseArgsInternal [] Repl [] args
           case arg of
             "-b" -> parseArgsInternal filesToLoad Build otherOptions restArgs
             "-x" -> parseArgsInternal filesToLoad BuildAndRun otherOptions restArgs
+            "-i" -> parseArgsInternal filesToLoad (Install (head restArgs)) otherOptions (tail restArgs)
             "--check" -> parseArgsInternal filesToLoad Check otherOptions restArgs
             "--no-core" -> parseArgsInternal filesToLoad execMode (NoCore : otherOptions) restArgs
             "--log-memory" -> parseArgsInternal filesToLoad execMode (LogMemory : otherOptions) restArgs

src/Eval.hs

@@ -1,14 +1,15 @@
 module Eval where
 
 import qualified Data.Map as Map
-import Data.List (foldl', null)
-import Data.List.Split (splitWhen)
+import Data.List (foldl', null, isSuffixOf)
+import Data.List.Split (splitOn, splitWhen)
 import Data.Maybe (fromJust, mapMaybe, isJust)
 import Control.Monad.State
 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 (doesPathExist, canonicalizePath)
+import System.Directory (doesFileExist, canonicalizePath, createDirectoryIfMissing, getCurrentDirectory, getHomeDirectory, setCurrentDirectory)
+import System.Process (readProcess, readProcessWithExitCode)
 import Control.Concurrent (forkIO)
 import qualified Data.Map as Map
 import Data.Maybe (fromJust, mapMaybe, isJust)
@@ -447,6 +448,7 @@ catcher ctx exception =
           case contextExecMode ctx of
             Repl -> return ctx
             Build -> exitWith (ExitFailure returnCode)
+            Install _ -> exitWith (ExitFailure returnCode)
             BuildAndRun -> exitWith (ExitFailure returnCode)
             Check -> exitWith ExitSuccess
 
@@ -917,22 +919,23 @@ specialCommandMetaGet path key =
 commandLoad :: CommandCallback
 commandLoad [xobj@(XObj (Str path) _ _)] =
   do ctx <- get
+     home <- liftIO $ getHomeDirectory
      let proj = contextProj ctx
+         libDir = home ++ "/" ++ projectLibDir proj
          carpDir = projectCarpDir proj
          fullSearchPaths =
            path :
            ("./" ++ path) :                                      -- the path from the current directory
            map (++ "/" ++ path) (projectCarpSearchPaths proj) ++ -- user defined search paths
-           [carpDir ++ "/core/" ++ path]
+           [carpDir ++ "/core/" ++ path] ++
+           [libDir ++ "/" ++ path]
             -- putStrLn ("Full search paths = " ++ show fullSearchPaths)
-     existingPaths <- liftIO (filterM doesPathExist fullSearchPaths)
+     existingPaths <- liftIO (filterM doesFileExist fullSearchPaths)
      case existingPaths of
        [] ->
-         return $ Left $ EvalError $ case contextExecMode ctx of
-                                       Check ->
-                                         (machineReadableInfoFromXObj xobj) ++ " Invalid path: '" ++ path ++ "'"
-                                       _ ->
-                                         "Invalid path: '" ++ path ++ "'"
+        if elem '@' path
+          then tryInstall path
+          else return $ invalidPath ctx path
        firstPathFound : _ ->
          do canonicalPath <- liftIO (canonicalizePath firstPathFound)
             let alreadyLoaded = projectAlreadyLoaded proj
@@ -951,6 +954,71 @@ commandLoad [xobj@(XObj (Str path) _ _)] =
                       newCtx <- liftIO $ executeString True (ctx { contextProj = proj' }) contents canonicalPath
                       put newCtx
             return dynamicNil
+  where
+    invalidPath ctx path =
+      Left $ EvalError $
+        (case contextExecMode ctx of
+          Check ->
+            (machineReadableInfoFromXObj xobj) ++ " Invalid path: '" ++ path ++ "'"
+          _ -> "Invalid path: '" ++ path ++ "'") ++
+        "\n\nIf you tried loading an external package, try appending a version string (like `@master`)."
+    invalidPathWith ctx path stderr =
+      Left $ EvalError $
+        (case contextExecMode ctx of
+          Check ->
+            (machineReadableInfoFromXObj xobj) ++ " Invalid path: '" ++ path ++ "'"
+          _ -> "Invalid path: '" ++ path ++ "'") ++
+        "\n\nTried interpreting statement as git import, but got: " ++ stderr
+    tryInstall path =
+      let split = splitOn "@" path
+      in tryInstallWithCheckout (joinWith "@" (init split)) (last split)
+    fromURL url =
+      let split = splitOn "/" url
+          fst = split !! 0
+      in if elem fst ["https:", "http:"]
+        then joinWith "/" (tail split)
+        else
+          if elem '@' fst
+            then joinWith "/" (joinWith "@" (tail (splitOn "@" fst)) : tail split)
+            else url
+    tryInstallWithCheckout path toCheckout = do
+      ctx <- get
+      home <- liftIO $ getHomeDirectory
+      let proj = contextProj ctx
+      let libDir = home ++ "/" ++ projectLibDir proj
+      let fpath = libDir ++ "/" ++ fromURL path ++ "/" ++ toCheckout
+      cur <- liftIO $ getCurrentDirectory
+      _ <- liftIO $ createDirectoryIfMissing True fpath
+      _ <- liftIO $ setCurrentDirectory fpath
+      _ <- liftIO $ readProcessWithExitCode "git" ["init"] ""
+      _ <- liftIO $ readProcessWithExitCode "git" ["remote", "add", "origin", path] ""
+      (x0, _, stderr0) <- liftIO $ readProcessWithExitCode "git" ["fetch"] ""
+      case x0 of
+        ExitFailure _ -> do
+          _ <- liftIO $ setCurrentDirectory cur
+          return $ invalidPathWith ctx path stderr0
+        ExitSuccess -> do
+          (x1, _, stderr1) <- liftIO $ readProcessWithExitCode "git" ["checkout", toCheckout] ""
+          _ <- liftIO $ setCurrentDirectory cur
+          case x1 of
+            ExitSuccess ->
+              let fName = last (splitOn "/" path)
+                  realName' = if isSuffixOf ".git" fName
+                               then take (length fName - 4) fName
+                               else fName
+                  realName = if isSuffixOf ".carp" realName'
+                              then realName'
+                              else realName' ++ ".carp"
+                  fileToLoad = fpath ++ "/" ++ realName
+                  mainToLoad = fpath ++ "/main.carp"
+              in do
+                res <- commandLoad [XObj (Str fileToLoad) Nothing Nothing]
+                case res of
+                  ret@(Right _) -> return ret
+                  Left _ ->  commandLoad [XObj (Str mainToLoad) Nothing Nothing]
+            ExitFailure _ -> do
+                return $ invalidPathWith ctx path stderr1
+
 
 -- | Load several files in order.
 loadFiles :: Context -> [FilePath] -> IO Context

src/Obj.hs

@@ -420,6 +420,7 @@ data Project = Project { projectTitle :: String
                        , projectFiles :: [FilePath]
                        , projectAlreadyLoaded :: [FilePath]
                        , projectEchoC :: Bool
+                       , projectLibDir :: FilePath
                        , projectCarpDir :: FilePath
                        , projectOutDir :: FilePath
                        , projectDocsDir :: FilePath
@@ -444,6 +445,7 @@ instance Show Project where
         srcFiles
         alreadyLoaded
         echoC
+        libDir
         carpDir
         outDir
         docsDir
@@ -467,6 +469,7 @@ instance Show Project where
             , "Can execute: " ++ if canExecute then "true" else "false"
             , "Output directory: " ++ outDir
             , "Docs directory: " ++ docsDir
+            , "Library directory: " ++ libDir
             , "CARP_DIR: " ++ carpDir
             , "Prompt: " ++ prompt
             , "Using Core: " ++ show core
@@ -618,7 +621,7 @@ forceTy :: XObj -> Ty
 forceTy xobj = fromMaybe (error ("No type in " ++ show xobj)) (ty xobj)
 
 -- | How should the compiler be run? Interactively or just build / build & run and then quit?
-data ExecutionMode = Repl | Build | BuildAndRun | Check deriving (Show, Eq)
+data ExecutionMode = Repl | Build | BuildAndRun | Install String | Check deriving (Show, Eq)
 
 -- | Information needed by the REPL
 data Context = Context { contextGlobalEnv :: Env