{-# LANGUAGE RecordWildCards #-}
module HsInspect.LSP.Context where
import Control.Monad.IO.Class (liftIO)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Except (ExceptT(..))
import Data.List (isSuffixOf)
import Data.List.Extra (trim)
import HsInspect.LSP.Util
import System.FilePath
data Context = Context
{ hsinspect :: FilePath
, package_dir :: FilePath
, ghcflags :: [String]
, ghcpath :: String
}
findContext :: MonadIO m => DiscoverContext m -> FilePath -> m Context
findContext DiscoverContext{..} src = do
ghcflags' <- discoverGhcflags src
ghcpath' <- discoverGhcpath src
let readWords file = words <$> readFile' file
readFile' = liftIO . readFile
Context <$> discoverHsInspect src <*> discoverPackageDir src <*> readWords ghcflags' <*> readFile' ghcpath'
data DiscoverContext m = DiscoverContext
{ discoverHsInspect :: FilePath -> m FilePath
, discoverPackageDir :: FilePath -> m FilePath
, discoverGhcflags :: FilePath -> m FilePath
, discoverGhcpath :: FilePath -> m FilePath
}
data BuildTool = Cabal | Stack
mkDiscoverContext :: BuildTool -> DiscoverContext (ExceptT String IO)
mkDiscoverContext tool = DiscoverContext {..}
where
discoverHsInspect :: FilePath -> ExceptT String IO FilePath
discoverHsInspect file = do
let dir = takeDirectory file
dir' <- discoverPackageDir dir
case tool of
Cabal -> do
_ <- shell "cabal" ["build", "-v0", ":pkg:hsinspect:exe:hsinspect"] (Just dir') Nothing []
trim <$> shell "cabal" ["exec", "-v0", "which", "--", "hsinspect"] (Just dir') Nothing []
Stack -> do
_ <- shell "stack" ["build", "--silent", "hsinspect"] (Just dir') Nothing []
trim <$> shell "stack" ["exec", "--silent", "which", "--", "hsinspect"] (Just dir') Nothing []
discoverPackageDir :: FilePath -> ExceptT String IO FilePath
discoverPackageDir file = do
let dir = takeDirectory file
isCabal = (".cabal" `isSuffixOf`)
isHpack = ("package.yaml" ==)
locateDominating (\f -> isCabal f || isHpack f) dir
discoverGhcflags :: FilePath -> ExceptT String IO FilePath
discoverGhcflags file = do
let dir = takeDirectory file
(</> ".ghc.flags") <$> locateDominating (".ghc.flags" ==) dir
discoverGhcpath :: FilePath -> ExceptT String IO FilePath
discoverGhcpath file = do
let dir = takeDirectory file
(</> ".ghc.path") <$> locateDominating (".ghc.path" ==) dir