diff --git a/cabal.project b/cabal.project index e6fdbadb4..0021c31c7 100644 --- a/cabal.project +++ b/cabal.project @@ -1 +1,6 @@ packages: . + +source-repository-package + type: git + location: https://github.com/Avi-D-coder/implicit-hie.git + tag: 58d729310b9eb627e7e1dfcc3e42862cf1606e44 diff --git a/hie-bios.cabal b/hie-bios.cabal index 4d65a4c34..2935f326e 100644 --- a/hie-bios.cabal +++ b/hie-bios.cabal @@ -137,7 +137,8 @@ Library hslogger >= 1.2 && < 1.4, file-embed >= 0.0.11 && < 1, conduit >= 1.3 && < 2, - conduit-extra >= 1.3 && < 2 + conduit-extra >= 1.3 && < 2, + implicit-hie Executable hie-bios diff --git a/src/HIE/Bios/Cradle.hs b/src/HIE/Bios/Cradle.hs index 3e96c0085..2973afd60 100644 --- a/src/HIE/Bios/Cradle.hs +++ b/src/HIE/Bios/Cradle.hs @@ -37,6 +37,7 @@ import Control.Applicative ((<|>)) import System.IO.Temp import System.IO.Error (isPermissionError) import Data.List +import Data.Maybe import Data.Ord (Down(..)) import System.PosixCompat.Files @@ -49,8 +50,12 @@ import qualified Data.Conduit.Combinators as C import qualified Data.Conduit as C import qualified Data.Conduit.Text as C import qualified Data.Text as T -import Data.Maybe (fromMaybe) +import qualified Data.Text.IO as T import GHC.Fingerprint (fingerprintString) + +import Hie.Cabal.Parser +import Hie.Yaml +import Hie.Locate ---------------------------------------------------------------- -- | Given root\/foo\/bar.hs, return root\/hie.yaml, or wherever the yaml file was found. @@ -88,13 +93,13 @@ getCradle :: (b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a getCradle buildCustomCradle (cc, wdir) = addCradleDeps cradleDeps $ case cradleType cc of Cabal mc -> cabalCradle wdir mc CabalMulti ms -> - getCradle buildCustomCradle $ + getCradle buildCustomCradle (CradleConfig cradleDeps (Multi [(p, CradleConfig [] (Cabal (Just c))) | (p, c) <- ms]) , wdir) Stack mc -> stackCradle wdir mc StackMulti ms -> - getCradle buildCustomCradle $ + getCradle buildCustomCradle (CradleConfig cradleDeps (Multi [(p, CradleConfig [] (Stack (Just c))) | (p, c) <- ms]) , wdir) @@ -128,9 +133,23 @@ implicitConfig' fp = (\wdir -> (Bios (wdir ".hie-bios") Nothing, wdir)) <$> biosWorkDir fp -- <|> (Obelisk,) <$> obeliskWorkDir fp -- <|> (Bazel,) <$> rulesHaskellWorkDir fp - <|> (stackExecutable >> (Stack Nothing,) <$> stackWorkDir fp) - <|> ((Cabal Nothing,) <$> cabalWorkDir fp) - + <|> (cabalExecutable >> cabalProjectDir fp >> cabalDistDir fp >>= cabal) + <|> (stackExecutable >> stackYamlDir fp >> stackWorkDir fp >>= stack) + <|> (cabalExecutable >> cabalProjectDir fp >>= cabal) + <|> (stackExecutable >> stackYamlDir fp >>= stack) + <|> (cabalExecutable >> cabalFile fp >>= cabal) + where + readPkgs f gp p = do + cfs <- gp p + pkgs <- liftIO $ catMaybes <$> mapM (nestedPkg p) cfs + pure $ concatMap (components f) pkgs + build cn cc gp p = do + c <- cn <$> readPkgs cc gp p + pure (c, p) + cabal :: FilePath -> MaybeT IO (CradleType a, FilePath) + cabal = build CabalMulti cabalComponent cabalPkgs + stack = build StackMulti stackComponent stackYamlPkgs + components f (Package n cs) = map (f n) cs yamlConfig :: FilePath -> MaybeT IO FilePath yamlConfig fp = do @@ -456,12 +475,25 @@ removeRTS [] = [] removeVerbosityOpts :: [String] -> [String] removeVerbosityOpts = filter ((&&) <$> (/= "-v0") <*> (/= "-w")) +cabalExecutable :: MaybeT IO FilePath +cabalExecutable = MaybeT $ findExecutable "cabal" + +cabalDistDir :: FilePath -> MaybeT IO FilePath +cabalDistDir = findFileUpwards isCabal + where + -- TODO do old style dist builds work? + isCabal name = name == "dist-newstyle" || name == "dist" -cabalWorkDir :: FilePath -> MaybeT IO FilePath -cabalWorkDir = findFileUpwards isCabal +cabalProjectDir :: FilePath -> MaybeT IO FilePath +cabalProjectDir = findFileUpwards isCabal where isCabal name = name == "cabal.project" +cabalFile :: FilePath -> MaybeT IO FilePath +cabalFile = findFileUpwards isCabal + where + isCabal = (".cabal" ==) . takeExtension + ------------------------------------------------------------------------ -- Stack Cradle -- Works for by invoking `stack repl` with a wrapper script @@ -515,6 +547,11 @@ stackExecutable = MaybeT $ findExecutable "stack" stackWorkDir :: FilePath -> MaybeT IO FilePath stackWorkDir = findFileUpwards isStack + where + isStack name = name == ".stack-work" + +stackYamlDir :: FilePath -> MaybeT IO FilePath +stackYamlDir = findFileUpwards isStack where isStack name = name == "stack.yaml"