{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module Stack.Ide
(ide, getPackageOptsAndTargetFiles)
where
import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.List
import Data.Maybe
import Data.Monoid
import qualified Data.Set as S
import Data.Text (Text)
import Distribution.System
import Network.HTTP.Client.Conduit
import Path
import Path.IO
import Stack.Constants
import Stack.Ghci (GhciPkgInfo(..), ghciSetup)
import Stack.Package
import Stack.Types
import Stack.Types.Internal
import System.Environment (lookupEnv)
import System.Process.Run
ide
:: (HasConfig r, HasBuildConfig r, HasTerminal r, HasLogLevel r, MonadMask m, HasEnvConfig r, MonadReader r m, MonadIO m, MonadThrow m, MonadLogger m, MonadCatch m, MonadBaseControl IO m, HasHttpManager r)
=> [Text]
-> [String]
-> m ()
ide targets useropts = do
(_realTargets,_,pkgs) <- ghciSetup Nothing targets
pwd <- getWorkingDir
(pkgopts,_srcfiles) <-
liftM mconcat $ forM pkgs $ getPackageOptsAndTargetFiles pwd
localdb <- packageDatabaseLocal
depsdb <- packageDatabaseDeps
mpath <- liftIO $ lookupEnv "PATH"
bindirs <- extraBinDirs `ap` return True
let pkgdbs =
["--package-db=" <> toFilePath depsdb <> ":" <> toFilePath localdb]
paths =
[ "--ide-backend-tools-path=" <>
intercalate ":" (map toFilePath bindirs) <>
(maybe "" (':' :) mpath)]
args =
["--verbose"] <> ["--include=" <> includeDirs pkgopts] <>
["--local-work-dir=" ++ toFilePath pwd] <>
map ("--ghc-option=" ++) useropts <>
paths <>
pkgopts <>
pkgdbs
menv <- getMinimalEnvOverride
Platform _ os <- asks getPlatform
when
(os == OSX)
(catch (callProcess (Just pwd) menv "stty" ["cbreak", "-imaxbel"])
(\(_ :: ProcessExitedUnsuccessfully) -> undefined))
callProcess (Just pwd) menv "stack-ide" args
where
includeDirs pkgopts =
intercalate
":"
(mapMaybe
(stripPrefix "--ghc-option=-i")
pkgopts)
getPackageOptsAndTargetFiles
:: (MonadThrow m, MonadIO m, MonadReader env m, HasEnvConfig env)
=> Path Abs Dir -> GhciPkgInfo -> m ([FilePath], [FilePath])
getPackageOptsAndTargetFiles pwd pkg = do
dist <- distDirFromDir (ghciPkgDir pkg)
autogen <- return (autogenDir dist)
paths_foo <-
liftM
(autogen </>)
(parseRelFile
("Paths_" ++ packageNameString (ghciPkgName pkg) ++ ".hs"))
paths_foo_exists <- fileExists paths_foo
return
( ["--dist-dir=" <> toFilePath dist] ++
map ("--ghc-option=" ++) (ghciPkgOpts pkg)
, mapMaybe
(fmap toFilePath . stripDir pwd)
(S.toList (ghciPkgCFiles pkg) <> S.toList (ghciPkgModFiles pkg) <>
if paths_foo_exists
then [paths_foo]
else []))