halive 0.1.0.6 → 0.1.0.7

raw patch · 6 files changed

+86/−50 lines, 6 filesdep +halivedep +processPVP ok

version bump matches the API change (PVP)

Dependencies added: halive, process

API changes (from Hackage documentation)

Files

• exec/FindPackageDBs.hs +59/−0
• exec/Halive.hs +16/−9
• exec/SandboxPath.hs +0/−34
• exec/main.hs +4/−0
• halive.cabal +7/−3
• src/Halive/Utils.hs +0/−4

@@ -0,0 +1,59 @@+{-# LANGUAGE CPP #-}+module FindPackageDBs where+import Data.Maybe++import System.Directory+import System.FilePath+import System.Process+import Data.List+import Data.Char++#if !MIN_VERSION_base(4,8,0)+import Data.Traversable (traverse)+import Control.Applicative ((<$>))+#endif++-- | Extract the sandbox package db directory from the cabal.sandbox.config file.+--   Exception is thrown if the sandbox config file is broken.+extractKey :: String -> String -> Maybe FilePath+extractKey key conf = extractValue <$> parse conf+  where+    keyLen = length key++    parse = listToMaybe . filter (key `isPrefixOf`) . lines+    extractValue = dropWhileEnd isSpace . dropWhile isSpace . drop keyLen+-- From ghc-mod+mightExist :: FilePath -> IO (Maybe FilePath)+mightExist f = do+    exists <- doesFileExist f+    return $ if exists then (Just f) else (Nothing)++------------------------+---------- Cabal Sandbox+------------------------++-- | Get path to sandbox's package DB via the cabal.sandbox.config file+getSandboxDb :: IO (Maybe FilePath)+getSandboxDb = do+    currentDir <- getCurrentDirectory+    config <- traverse readFile =<< mightExist (currentDir </> "cabal.sandbox.config")+    return $ (extractKey "package-db:" =<< config)+++------------------------+---------- Stack project+------------------------++-- | Get path to the project's snapshot and local package DBs via 'stack path'+getStackDb :: IO (Maybe [FilePath])+getStackDb = do+    exists <- doesFileExist "stack.yaml"+    if not exists+        then return Nothing+        else do+            pathInfo <- readProcess "stack" ["path"] ""+            return . Just . catMaybes $ map (flip extractKey pathInfo) ["snapshot-pkg-db:", "local-pkg-db:"]++++

@@ -15,7 +15,7 @@ import System.FSNotify import System.FilePath -import SandboxPath+import FindPackageDBs  directoryWatcher :: IO (Chan Event) directoryWatcher = do@@ -74,11 +74,11 @@   withGHCSession :: FilePath -> [FilePath] -> Ghc () -> IO ()-withGHCSession mainFileName importPaths' action = do+withGHCSession mainFileName extraImportPaths action = do     defaultErrorHandler defaultFatalMessager defaultFlushOut $ runGhc (Just libdir) $ do         -- Add the main file's path to the import path list-        let mainFilePath = dropFileName mainFileName-            importPaths'' = mainFilePath:importPaths'+        let mainFilePath   = dropFileName mainFileName+            allImportPaths = mainFilePath:extraImportPaths          -- Get the default dynFlags         dflags0 <- getSessionDynFlags@@ -90,22 +90,29 @@                 let pkgs = map PkgConfFile [sandboxDB]                 return dflags0 { extraPkgConfs = (pkgs ++) . extraPkgConfs dflags0 } +        -- If this is a stack project, add its package DBs+        dflags2 <- liftIO getStackDb >>= \case+            Nothing -> return dflags1+            Just stackDBs -> do+                let pkgs = map PkgConfFile stackDBs+                return dflags1 { extraPkgConfs = (pkgs ++) . extraPkgConfs dflags1 }+         -- Make sure we're configured for live-reload, and turn off the GHCi sandbox         -- since it breaks OpenGL/GUI usage-        let dflags2 = dflags1 { hscTarget = HscInterpreted+        let dflags3 = dflags2 { hscTarget = HscInterpreted                               , ghcLink   = LinkInMemory                               , ghcMode   = CompManager-                              , importPaths = importPaths''+                              , importPaths = allImportPaths                               } `gopt_unset` Opt_GhciSandbox                  -- We must set dynflags before calling initPackages or any other GHC API-        _ <- setSessionDynFlags dflags2+        _ <- setSessionDynFlags dflags3          -- Initialize the package database-        (dflags3, _) <- liftIO $ initPackages dflags2+        (dflags4, _) <- liftIO $ initPackages dflags3          -- Initialize the dynamic linker-        liftIO $ initDynLinker dflags3 +        liftIO $ initDynLinker dflags4           -- Set the given filename as a compilation target         setTargets =<< sequence [guessTarget mainFileName Nothing]

@@ -1,34 +0,0 @@-module SandboxPath where-import Data.Maybe-import Data.Traversable (traverse)-import Control.Applicative ((<$>))-import System.Directory-import System.FilePath-import Data.List-import Data.Char---- From ghc-mod-mightExist :: FilePath -> IO (Maybe FilePath)-mightExist f = do-    exists <- doesFileExist f-    return $ if exists then (Just f) else (Nothing)---- | Get path to sandbox config file-getSandboxDb :: IO (Maybe FilePath)-getSandboxDb = do-    currentDir <- getCurrentDirectory-    config <- traverse readFile =<< mightExist (currentDir </> "cabal.sandbox.config")-    return $ (extractSandboxDbDir =<< config)---- | Extract the sandbox package db directory from the cabal.sandbox.config file.---   Exception is thrown if the sandbox config file is broken.-extractSandboxDbDir :: String -> Maybe FilePath-extractSandboxDbDir conf = extractValue <$> parse conf-  where-    key = "package-db:"-    keyLen = length key--    parse = listToMaybe . filter (key `isPrefixOf`) . lines-    extractValue = dropWhileEnd isSpace . dropWhile isSpace . drop keyLen---- main = print =<< getSandboxDb

@@ -1,7 +1,11 @@+{-# LANGUAGE CPP #-}+ import Halive import Banner import System.Environment+#if !MIN_VERSION_base(4,8,0) import Control.Applicative+#endif  separateArgs :: [String] -> ([String], [String]) separateArgs args = (haliveArgs, drop 1 targetArgs)

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                halive-version:             0.1.0.6+version:             0.1.0.7 synopsis:            A live recompiler description:            Live recompiler for Haskell@@ -52,7 +52,7 @@   other-modules:            Banner     Halive-    SandboxPath+    FindPackageDBs   -- other-extensions:       build-depends:     base >=4.7 && <4.9,@@ -62,4 +62,8 @@     transformers,     directory,      filepath, -    fsnotify+    fsnotify,+    process,+    halive+-- ^ we don't actually depend on halive, but this seems to work around a bug when running stack install:+-- "Setup.hs: Error: Could not find module: Halive.Utils with any suffix: ["hi"]"

@@ -19,7 +19,3 @@             writeStore (Store storeID) value             return value --- TODO: a version of forkIO that records each threadID so they--- can be killed when the program restarts, probably via--- a 'killOldThreads' function the user calls at the --- start of their program.