{-# LANGUAGE RecordWildCards #-} -- Calls to the hsinspect binary must have some context, which typically must be -- discovered from the file that the user is currently visiting. -- -- This module gathers the definition of the context and the logic to infer it, -- which assumes that .cabal (or package.yaml) and .ghc.flags files are present, -- and that the build tool is either cabal-install or stack. 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 [] -- c.f. haskell-tng--compile-dominating-package 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