generating "autogen/" if not exist (#326).
This commit is contained in:
parent
7382e1bf1d
commit
e3e95adeb6
@ -147,6 +147,8 @@ Executable ghc-modi
|
|||||||
Misc
|
Misc
|
||||||
Utils
|
Utils
|
||||||
GHC-Options: -Wall -threaded
|
GHC-Options: -Wall -threaded
|
||||||
|
if os(windows)
|
||||||
|
Cpp-Options: -DWINDOWS
|
||||||
Default-Extensions: ConstraintKinds, FlexibleContexts
|
Default-Extensions: ConstraintKinds, FlexibleContexts
|
||||||
HS-Source-Dirs: src
|
HS-Source-Dirs: src
|
||||||
Build-Depends: base >= 4.0 && < 5
|
Build-Depends: base >= 4.0 && < 5
|
||||||
@ -154,6 +156,7 @@ Executable ghc-modi
|
|||||||
, containers
|
, containers
|
||||||
, directory
|
, directory
|
||||||
, filepath
|
, filepath
|
||||||
|
, process
|
||||||
, split
|
, split
|
||||||
, time
|
, time
|
||||||
, ghc
|
, ghc
|
||||||
|
@ -87,6 +87,7 @@ run opt ref = flip E.catches handlers $ do
|
|||||||
let rootdir = cradleRootDir cradle0
|
let rootdir = cradleRootDir cradle0
|
||||||
-- c = cradle0 { cradleCurrentDir = rootdir } TODO: ?????
|
-- c = cradle0 { cradleCurrentDir = rootdir } TODO: ?????
|
||||||
setCurrentDirectory rootdir
|
setCurrentDirectory rootdir
|
||||||
|
prepareAutogen
|
||||||
-- Asynchronous db loading starts here.
|
-- Asynchronous db loading starts here.
|
||||||
symdbreq <- newSymDbReq opt
|
symdbreq <- newSymDbReq opt
|
||||||
(res, _) <- runGhcModT opt $ getCurrentWorld >>= loop symdbreq ref
|
(res, _) <- runGhcModT opt $ getCurrentWorld >>= loop symdbreq ref
|
||||||
@ -128,6 +129,7 @@ loop symdbreq ref world = do
|
|||||||
when changed $ do
|
when changed $ do
|
||||||
liftIO $ ungetCommand ref cmdArg
|
liftIO $ ungetCommand ref cmdArg
|
||||||
E.throw Restart
|
E.throw Restart
|
||||||
|
liftIO $ prepareAutogen
|
||||||
let (cmd,arg') = break (== ' ') cmdArg
|
let (cmd,arg') = break (== ' ') cmdArg
|
||||||
arg = dropWhile (== ' ') arg'
|
arg = dropWhile (== ' ') arg'
|
||||||
(ret,ok) <- case cmd of
|
(ret,ok) <- case cmd of
|
||||||
|
67
src/Misc.hs
67
src/Misc.hs
@ -1,4 +1,4 @@
|
|||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
{-# LANGUAGE DeriveDataTypeable, CPP #-}
|
||||||
|
|
||||||
module Misc (
|
module Misc (
|
||||||
GHCModiError(..)
|
GHCModiError(..)
|
||||||
@ -14,18 +14,25 @@ module Misc (
|
|||||||
, newSymDbReq
|
, newSymDbReq
|
||||||
, getDb
|
, getDb
|
||||||
, checkDb
|
, checkDb
|
||||||
|
, prepareAutogen
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
|
import Control.Concurrent (threadDelay)
|
||||||
import Control.Concurrent.Async (Async, async, wait)
|
import Control.Concurrent.Async (Async, async, wait)
|
||||||
import Control.Exception (Exception)
|
import Control.Exception (Exception)
|
||||||
|
import Control.Monad (unless)
|
||||||
import CoreMonad (liftIO)
|
import CoreMonad (liftIO)
|
||||||
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
||||||
|
import Data.List (isPrefixOf)
|
||||||
import Data.Time (UTCTime)
|
import Data.Time (UTCTime)
|
||||||
import Data.Typeable (Typeable)
|
import Data.Typeable (Typeable)
|
||||||
|
import System.Directory (getModificationTime, doesDirectoryExist, getDirectoryContents)
|
||||||
|
import System.Process
|
||||||
|
import System.IO (openBinaryFile, IOMode(..))
|
||||||
|
|
||||||
import Language.Haskell.GhcMod
|
import Language.Haskell.GhcMod
|
||||||
import Language.Haskell.GhcMod.Internal
|
import Language.Haskell.GhcMod.Internal
|
||||||
import System.Directory (getModificationTime)
|
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
@ -107,3 +114,59 @@ checkDb (SymDbReq ref act) db = do
|
|||||||
hoistGhcModT =<< liftIO (wait req)
|
hoistGhcModT =<< liftIO (wait req)
|
||||||
else
|
else
|
||||||
return db
|
return db
|
||||||
|
|
||||||
|
----------------------------------------------------------------
|
||||||
|
|
||||||
|
build :: IO ProcessHandle
|
||||||
|
build = do
|
||||||
|
#ifdef WINDOWS
|
||||||
|
nul <- openBinaryFile "NUL" AppendMode
|
||||||
|
#else
|
||||||
|
nul <- openBinaryFile "/dev/null" AppendMode
|
||||||
|
#endif
|
||||||
|
(_, _, _, hdl) <- createProcess $ pro nul
|
||||||
|
return hdl
|
||||||
|
where
|
||||||
|
pro nul = CreateProcess {
|
||||||
|
cmdspec = RawCommand "cabal" ["build"]
|
||||||
|
, cwd = Nothing
|
||||||
|
, env = Nothing
|
||||||
|
, std_in = Inherit
|
||||||
|
, std_out = UseHandle nul
|
||||||
|
, std_err = UseHandle nul
|
||||||
|
, close_fds = False
|
||||||
|
, create_group = True
|
||||||
|
, delegate_ctlc = False
|
||||||
|
}
|
||||||
|
|
||||||
|
autogen :: String
|
||||||
|
autogen = "dist/build/autogen"
|
||||||
|
|
||||||
|
isAutogenPrepared :: IO Bool
|
||||||
|
isAutogenPrepared = do
|
||||||
|
exist <- doesDirectoryExist autogen
|
||||||
|
if exist then do
|
||||||
|
files <- filter ("." `isPrefixOf`) <$> getDirectoryContents autogen
|
||||||
|
if length files >= 2 then
|
||||||
|
return True
|
||||||
|
else
|
||||||
|
return False
|
||||||
|
else
|
||||||
|
return False
|
||||||
|
|
||||||
|
watch :: Int -> ProcessHandle -> IO ()
|
||||||
|
watch 0 _ = return ()
|
||||||
|
watch n hdl = do
|
||||||
|
prepared <- isAutogenPrepared
|
||||||
|
if prepared then
|
||||||
|
interruptProcessGroupOf hdl
|
||||||
|
else do
|
||||||
|
threadDelay 100000
|
||||||
|
watch (n - 1) hdl
|
||||||
|
|
||||||
|
prepareAutogen :: IO ()
|
||||||
|
prepareAutogen = do
|
||||||
|
prepared <- isAutogenPrepared
|
||||||
|
unless prepared $ do
|
||||||
|
hdl <- build
|
||||||
|
watch 30 hdl
|
||||||
|
Loading…
Reference in New Issue
Block a user