From ed9bf881ffe9c7ab7db42afc6c12b6fde3133cf1 Mon Sep 17 00:00:00 2001 From: fendor Date: Thu, 3 Oct 2019 18:15:39 +0200 Subject: [PATCH] Use cabal-helper 1.0 --- .gitmodules | 9 +- app/MainHie.hs | 2 - haskell-ide-engine.cabal | 3 +- hie-plugin-api/Haskell/Ide/Engine/Cradle.hs | 70 ++- hie-plugin-api/hie-plugin-api.cabal | 1 + src/Haskell/Ide/Engine/Plugin/Build.hs | 538 -------------------- stack-8.2.2.yaml | 3 +- stack-8.4.2.yaml | 3 +- stack-8.4.3.yaml | 3 +- stack-8.4.4.yaml | 3 +- stack-8.6.1.yaml | 3 +- stack-8.6.2.yaml | 3 +- stack-8.6.3.yaml | 3 +- stack-8.6.4.yaml | 4 +- stack.yaml | 3 +- submodules/HaRe | 2 +- submodules/cabal-helper | 2 +- submodules/ghc-mod | 2 +- 18 files changed, 98 insertions(+), 559 deletions(-) diff --git a/.gitmodules b/.gitmodules index c96b580fc..07e4fc692 100644 --- a/.gitmodules +++ b/.gitmodules @@ -12,19 +12,20 @@ [submodule "submodules/HaRe"] path = submodules/HaRe - # url = https://github.com/bubba/HaRe.git - url = https://github.com/wz1000/HaRe.git + url = https://github.com/bubba/HaRe.git + # url = https://github.com/wz1000/HaRe.git [submodule "submodules/cabal-helper"] path = submodules/cabal-helper # url = https://github.com/arbor/cabal-helper.git - url = https://github.com/alanz/cabal-helper.git + # url = https://github.com/alanz/cabal-helper.git # url = https://github.com/DanielG/cabal-helper.git + url = https://github.com/wz1000/cabal-helper.git [submodule "submodules/ghc-mod"] path = submodules/ghc-mod # url = https://github.com/arbor/ghc-mod.git - url = https://github.com/alanz/ghc-mod.git + url = https://github.com/bubba/ghc-mod.git #url = https://github.com/mpickering/ghc-mod.git [submodule "hie-bios"] diff --git a/app/MainHie.hs b/app/MainHie.hs index aaaf4cd0d..f8680085b 100644 --- a/app/MainHie.hs +++ b/app/MainHie.hs @@ -28,7 +28,6 @@ import System.IO import Haskell.Ide.Engine.Plugin.ApplyRefact import Haskell.Ide.Engine.Plugin.Base import Haskell.Ide.Engine.Plugin.Brittany -import Haskell.Ide.Engine.Plugin.Build import Haskell.Ide.Engine.Plugin.Example2 import Haskell.Ide.Engine.Plugin.Bios import Haskell.Ide.Engine.Plugin.HaRe @@ -55,7 +54,6 @@ plugins includeExamples = pluginDescToIdePlugins allPlugins [ applyRefactDescriptor "applyrefact" , baseDescriptor "base" , brittanyDescriptor "brittany" - , buildPluginDescriptor "build" -- , ghcmodDescriptor "ghcmod" , haddockDescriptor "haddock" , hareDescriptor "hare" diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal index 040f704c1..291f7f1af 100644 --- a/haskell-ide-engine.cabal +++ b/haskell-ide-engine.cabal @@ -27,7 +27,6 @@ library Haskell.Ide.Engine.Options Haskell.Ide.Engine.Plugin.ApplyRefact Haskell.Ide.Engine.Plugin.Brittany - Haskell.Ide.Engine.Plugin.Build Haskell.Ide.Engine.Plugin.Example2 Haskell.Ide.Engine.Plugin.Floskell Haskell.Ide.Engine.Plugin.Bios @@ -58,7 +57,7 @@ library , brittany , bytestring , Cabal - , cabal-helper >= 0.8.0.4 + , cabal-helper >= 1.0 && < 1.1 , containers , data-default , directory diff --git a/hie-plugin-api/Haskell/Ide/Engine/Cradle.hs b/hie-plugin-api/Haskell/Ide/Engine/Cradle.hs index 7b8028eb0..5cae61475 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/Cradle.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/Cradle.hs @@ -1,6 +1,23 @@ +{-# LANGUAGE TupleSections #-} module Haskell.Ide.Engine.Cradle (findLocalCradle) where import HIE.Bios as BIOS +import HIE.Bios.Types + +import Haskell.Ide.Engine.MonadFunctions + +import Distribution.Helper +import Distribution.Helper.Discover + +import System.FilePath +import System.Directory + +import qualified Data.Map as M +import Data.Foldable (toList) +import Data.List (inits, sortOn) +import Data.Maybe (listToMaybe) +import Data.Ord +import System.Exit findLocalCradle :: FilePath -> IO Cradle findLocalCradle fp = do @@ -8,4 +25,55 @@ findLocalCradle fp = do cradleConf <- BIOS.findCradle fp case cradleConf of Just yaml -> BIOS.loadCradle yaml - Nothing -> BIOS.loadImplicitCradle fp \ No newline at end of file + Nothing -> cabalHelperCradle fp + +cabalHelperCradle :: FilePath -> IO Cradle +cabalHelperCradle file' = do + -- TODO find cradle + root' <- getCurrentDirectory + root <- canonicalizePath root' + return Cradle + { cradleRootDir = root + , cradleOptsProg = CradleAction + { actionName = "Cabal-Helper" + , runCradle = cabalHelperAction root + } + } + + where + cabalHelperAction :: FilePath -> FilePath -> IO (CradleLoadResult ComponentOptions) + cabalHelperAction root fp = do + file <- canonicalizePath fp + let file_dir = makeRelative root $ takeDirectory file + debugm $ "Cabal Helper dirs: " ++ show [root, file, file_dir] + projs <- findProjects root + case projs of + (Ex proj:_) -> do + let [dist_dir] = findDistDirs proj + env <- mkQueryEnv proj dist_dir + units <- runQuery (allUnits id) env + + case getFlags file_dir $ toList units of + Just fs -> do + debugm $ "Flags for \"" ++ fp ++ "\": " ++ show fs + return $ CradleSuccess + ComponentOptions + { componentOptions = fs ++ [file] + , componentDependencies = [] + } + + Nothing -> return $ CradleFail $ CradleError (ExitFailure 2) ("Could not obtain flags for " ++ fp) + _ -> return $ CradleFail $ CradleError (ExitFailure 1) ("Could not find project from: " ++ fp) + +getFlags :: FilePath -> [UnitInfo] -> Maybe [String] +getFlags dir uis + = listToMaybe + $ map (ciGhcOptions . snd) + $ filter (hasParent dir . fst) + $ sortOn (Down . length . fst) + $ concatMap (\ci -> map (,ci) (ciSourceDirs ci)) + $ concat + $ M.elems . uiComponents <$> uis + +hasParent :: FilePath -> FilePath -> Bool +hasParent child parent = any (equalFilePath parent) (map joinPath $ inits $ splitPath child) \ No newline at end of file diff --git a/hie-plugin-api/hie-plugin-api.cabal b/hie-plugin-api/hie-plugin-api.cabal index 6dcf65260..531d6693b 100644 --- a/hie-plugin-api/hie-plugin-api.cabal +++ b/hie-plugin-api/hie-plugin-api.cabal @@ -51,6 +51,7 @@ library , ghc , hie-bios , ghc-project-types >= 5.9.0.0 + , cabal-helper , haskell-lsp == 0.15.* , hslogger , unliftio diff --git a/src/Haskell/Ide/Engine/Plugin/Build.hs b/src/Haskell/Ide/Engine/Plugin/Build.hs index 724bc7738..e69de29bb 100644 --- a/src/Haskell/Ide/Engine/Plugin/Build.hs +++ b/src/Haskell/Ide/Engine/Plugin/Build.hs @@ -1,538 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PartialTypeSignatures #-} -{-# LANGUAGE RankNTypes #-} -module Haskell.Ide.Engine.Plugin.Build where - -#ifdef MIN_VERSION_Cabal -#undef CH_MIN_VERSION_Cabal -#define CH_MIN_VERSION_Cabal MIN_VERSION_Cabal -#endif - -import qualified Data.Aeson as J -#if __GLASGOW_HASKELL__ < 802 -import qualified Data.Aeson.Types as J -#endif -import Data.Maybe (fromMaybe) -#if __GLASGOW_HASKELL__ < 804 -import Data.Monoid -#endif -import Control.Monad -import Control.Monad.IO.Class -import Control.Monad.Trans.Reader -import qualified Data.ByteString as B -import qualified Data.Text as T -import GHC.Generics (Generic) -import Haskell.Ide.Engine.MonadTypes -import Haskell.Ide.Engine.PluginUtils -import System.Directory (doesFileExist, - getCurrentDirectory, - getDirectoryContents, - makeAbsolute) -import System.FilePath (makeRelative, - normalise, - takeExtension, - takeFileName, ()) -import System.IO (IOMode (..), withFile) -import System.Process (readProcess) - -import Distribution.Helper as CH - -import Distribution.Package (pkgName, unPackageName) -import Distribution.PackageDescription -import Distribution.Simple.Configure (localBuildInfoFile) -import Distribution.Simple.Setup (defaultDistPref) -#if CH_MIN_VERSION_Cabal(2,2,0) -import Distribution.PackageDescription.Parsec (readGenericPackageDescription) -#elif CH_MIN_VERSION_Cabal(2,0,0) -import Distribution.PackageDescription.Parse (readGenericPackageDescription) -#else -import Distribution.PackageDescription.Parse (readPackageDescription) -#endif -import qualified Distribution.Verbosity as Verb - -import Data.Yaml - --- --------------------------------------------------------------------- -{- -buildModeArg = SParamDesc (Proxy :: Proxy "mode") (Proxy :: Proxy "Operation mode: \"stack\" or \"cabal\"") SPtText SRequired -distDirArg = SParamDesc (Proxy :: Proxy "distDir") (Proxy :: Proxy "Directory to search for setup-config file") SPtFile SOptional -toolArgs = SParamDesc (Proxy :: Proxy "cabalExe") (Proxy :: Proxy "Cabal executable") SPtText SOptional - :& SParamDesc (Proxy :: Proxy "stackExe") (Proxy :: Proxy "Stack executable") SPtText SOptional - :& RNil - -pluginCommonArgs = buildModeArg :& distDirArg :& toolArgs - - -buildPluginDescriptor :: TaggedPluginDescriptor _ -buildPluginDescriptor = PluginDescriptor - { - pdUIShortName = "Build plugin" - , pdUIOverview = "A HIE plugin for building cabal/stack packages" - , pdCommands = - buildCommand prepareHelper (Proxy :: Proxy "prepare") - "Prepares helper executable. The project must be configured first" - [] (SCtxNone :& RNil) - ( pluginCommonArgs - <+> RNil) SaveNone --- :& buildCommand isHelperPrepared (Proxy :: Proxy "isPrepared") --- "Checks whether cabal-helper is prepared to work with this project. The project must be configured first" --- [] (SCtxNone :& RNil) --- ( pluginCommonArgs --- <+> RNil) SaveNone - :& buildCommand isConfigured (Proxy :: Proxy "isConfigured") - "Checks if project is configured" - [] (SCtxNone :& RNil) - ( buildModeArg - :& distDirArg - :& RNil) SaveNone - :& buildCommand configure (Proxy :: Proxy "configure") - "Configures the project. For stack project with multiple local packages - build it" - [] (SCtxNone :& RNil) - ( pluginCommonArgs - <+> RNil) SaveNone - :& buildCommand listTargets (Proxy :: Proxy "listTargets") - "Given a directory with stack/cabal project lists all its targets" - [] (SCtxNone :& RNil) - ( pluginCommonArgs - <+> RNil) SaveNone - :& buildCommand listFlags (Proxy :: Proxy "listFlags") - "Lists all flags that can be set when configuring a package" - [] (SCtxNone :& RNil) - ( buildModeArg - :& RNil) SaveNone - :& buildCommand buildDirectory (Proxy :: Proxy "buildDirectory") - "Builds all targets that correspond to the specified directory" - [] (SCtxNone :& RNil) - ( pluginCommonArgs - <+> (SParamDesc (Proxy :: Proxy "directory") (Proxy :: Proxy "Directory to build targets from") SPtFile SOptional :& RNil) - <+> RNil) SaveNone - :& buildCommand buildTarget (Proxy :: Proxy "buildTarget") - "Builds specified cabal or stack component" - [] (SCtxNone :& RNil) - ( pluginCommonArgs - <+> (SParamDesc (Proxy :: Proxy "target") (Proxy :: Proxy "Component to build") SPtText SOptional :& RNil) - <+> (SParamDesc (Proxy :: Proxy "package") (Proxy :: Proxy "Package to search the component in. Only applicable for Stack mode") SPtText SOptional :& RNil) - <+> (SParamDesc (Proxy :: Proxy "type") (Proxy :: Proxy "Type of the component. Only applicable for Stack mode") SPtText SOptional :& RNil) - <+> RNil) SaveNone - :& RNil - , pdExposedServices = [] - , pdUsedServices = [] - } --} - -buildPluginDescriptor :: PluginId -> PluginDescriptor -buildPluginDescriptor plId = PluginDescriptor - { pluginId = plId - , pluginName = "Build plugin" - , pluginDesc = "A HIE plugin for building cabal/stack packages" - , pluginCommands = - [ PluginCommand "prepare" - "Prepares helper executable. The project must be configured first" - prepareHelper - -- , PluginCommand "isPrepared" - -- ("Checks whether cabal-helper is prepared to work with this project. " - -- <> "The project must be configured first") - -- isHelperPrepared - , PluginCommand "isConfigured" - "Checks if project is configured" - isConfigured - , PluginCommand "configure" - ("Configures the project. " - <> "For stack project with multiple local packages - build it") - configure - , PluginCommand "listTargets" - "Given a directory with stack/cabal project lists all its targets" - listTargets - , PluginCommand "listFlags" - "Lists all flags that can be set when configuring a package" - listFlags - , PluginCommand "buildDirectory" - "Builds all targets that correspond to the specified directory" - buildDirectory - , PluginCommand "buildTarget" - "Builds specified cabal or stack component" - buildTarget - ] - , pluginCodeActionProvider = Nothing - , pluginDiagnosticProvider = Nothing - , pluginHoverProvider = Nothing - , pluginSymbolProvider = Nothing - , pluginFormattingProvider = Nothing - } - -data OperationMode = StackMode | CabalMode - -readMode :: T.Text -> Maybe OperationMode -readMode "stack" = Just StackMode -readMode "cabal" = Just CabalMode -readMode _ = Nothing - --- | Used internally by commands, all fields always populated, possibly with --- default values -data CommonArgs = CommonArgs { - caMode :: OperationMode - ,caDistDir :: String - ,caCabal :: String - ,caStack :: String - } - --- | Used to interface with the transport, where the mode is required but rest --- are optional -data CommonParams = CommonParams { - cpMode :: T.Text - ,cpDistDir :: Maybe String - ,cpCabal :: Maybe String - ,cpStack :: Maybe String - ,cpFile :: Uri - } deriving Generic - -instance FromJSON CommonParams where - parseJSON = J.genericParseJSON $ customOptions 2 -instance ToJSON CommonParams where - toJSON = J.genericToJSON $ customOptions 2 - -incorrectParameter :: String -> [String] -> a -> b -incorrectParameter = undefined - -withCommonArgs :: MonadIO m => CommonParams -> ReaderT CommonArgs m a -> m a -withCommonArgs (CommonParams mode0 mDistDir mCabalExe mStackExe _fileUri) a = - case readMode mode0 of - Nothing -> return $ incorrectParameter "mode" ["stack","cabal"] mode0 - Just mode -> do - let cabalExe = fromMaybe "cabal" mCabalExe - stackExe = fromMaybe "stack" mStackExe - distDir' <- maybe (liftIO $ getDistDir mode stackExe) return - mDistDir -- >>= uriToFilePath -- fileUri - runReaderT a $ CommonArgs { - caMode = mode, - caDistDir = distDir', - caCabal = cabalExe, - caStack = stackExe - } -{- -withCommonArgs req a = do - case getParams (IdText "mode" :& RNil) req of - Left err -> return err - Right (ParamText mode0 :& RNil) -> do - case readMode mode0 of - Nothing -> return $ incorrectParameter "mode" ["stack","cabal"] mode0 - Just mode -> do - let cabalExe = maybe "cabal" id $ - Map.lookup "cabalExe" (ideParams req) >>= (\(ParamTextP v) -> return $ T.unpack v) - stackExe = maybe "stack" id $ - Map.lookup "stackExe" (ideParams req) >>= (\(ParamTextP v) -> return $ T.unpack v) - distDir' <- maybe (liftIO $ getDistDir mode stackExe) return $ - Map.lookup "distDir" (ideParams req) >>= - uriToFilePath . (\(ParamFileP v) -> v) - runReaderT a $ CommonArgs { - caMode = mode, - caDistDir = distDir', - caCabal = cabalExe, - caStack = stackExe - } --} - ------------------------------------------------ - --- isHelperPrepared :: CommandFunc Bool --- isHelperPrepared = CmdSync $ \ctx req -> withCommonArgs ctx req $ do --- distDir' <- asks caDistDir --- ret <- liftIO $ isPrepared (defaultQueryEnv "." distDir') --- return $ IdeResultOk ret - ------------------------------------------------ - -prepareHelper :: CommandFunc CommonParams () -prepareHelper = CmdSync $ \req -> withCommonArgs req $ do - ca <- ask - liftIO $ case caMode ca of - StackMode -> do - slp <- getStackLocalPackages "stack.yaml" - mapM_ (prepareHelper' (caDistDir ca) (caCabal ca)) slp - CabalMode -> prepareHelper' (caDistDir ca) (caCabal ca) "." - return $ IdeResultOk () - -prepareHelper' :: MonadIO m => FilePath -> FilePath -> FilePath -> m () -prepareHelper' distDir' cabalExe dir = - prepare $ (mkQueryEnv dir distDir') {qePrograms = defaultPrograms {cabalProgram = cabalExe}} - ------------------------------------------------ - -isConfigured :: CommandFunc CommonParams Bool -isConfigured = CmdSync $ \req -> withCommonArgs req $ do - distDir' <- asks caDistDir - ret <- liftIO $ doesFileExist $ localBuildInfoFile distDir' - return $ IdeResultOk ret - ------------------------------------------------ - -configure :: CommandFunc CommonParams () -configure = CmdSync $ \req -> withCommonArgs req $ do - ca <- ask - _ <- liftIO $ case caMode ca of - StackMode -> configureStack (caStack ca) - CabalMode -> configureCabal (caCabal ca) - return $ IdeResultOk () - -configureStack :: FilePath -> IO String -configureStack stackExe = do - slp <- getStackLocalPackages "stack.yaml" - -- stack can configure only single local package - case slp of - [_singlePackage] -> readProcess stackExe ["build", "--only-configure"] "" - _manyPackages -> readProcess stackExe ["build"] "" - -configureCabal :: FilePath -> IO String -configureCabal cabalExe = readProcess cabalExe ["new-configure"] "" - ------------------------------------------------ - -newtype ListFlagsParams = LF { lfMode :: T.Text } deriving Generic - -instance FromJSON ListFlagsParams where - parseJSON = J.genericParseJSON $ customOptions 2 -instance ToJSON ListFlagsParams where - toJSON = J.genericToJSON $ customOptions 2 - -listFlags :: CommandFunc ListFlagsParams Object -listFlags = CmdSync $ \(LF mode) -> do - cwd <- liftIO getCurrentDirectory - flags0 <- liftIO $ case mode of - "stack" -> listFlagsStack cwd - "cabal" -> fmap (:[]) (listFlagsCabal cwd) - _oops -> return [] - let flags' = flip map flags0 $ \(n,f) -> - object ["packageName" .= n, "flags" .= map flagToJSON f] - (Object ret) = object ["res" .= toJSON flags'] - return $ IdeResultOk ret - -listFlagsStack :: FilePath -> IO [(String,[Flag])] -listFlagsStack d = do - stackPackageDirs <- getStackLocalPackages (d "stack.yaml") - mapM (listFlagsCabal . (d )) stackPackageDirs - -listFlagsCabal :: FilePath -> IO (String,[Flag]) -listFlagsCabal d = do - [cabalFile] <- filter isCabalFile <$> getDirectoryContents d -#if MIN_VERSION_Cabal(2,0,0) - gpd <- readGenericPackageDescription Verb.silent (d cabalFile) -#else - gpd <- readPackageDescription Verb.silent (d cabalFile) -#endif - let name = unPackageName $ pkgName $ package $ packageDescription gpd - flags' = genPackageFlags gpd - return (name, flags') - -flagToJSON :: Flag -> Value -flagToJSON f = object - -- Cabal 2.0 changelog - -- * Backwards incompatible change to 'FlagName' (#4062): - -- 'FlagName' is now opaque; conversion to/from 'String' now works - -- via 'unFlagName' and 'mkFlagName' functions. - - [ "name" .= unFlagName (flagName f) - , "description" .= flagDescription f - , "default" .= flagDefault f] - -#if MIN_VERSION_Cabal(2,0,0) -#else -unFlagName :: FlagName -> String -unFlagName (FlagName s) = s -#endif - ------------------------------------------------ - -data BuildParams = BP { - -- common params. horrible - bpMode :: T.Text - ,bpDistDir :: Maybe String - ,bpCabal :: Maybe String - ,bpStack :: Maybe String - ,bpFile :: Uri - -- specific params - ,bpDirectory :: Maybe Uri - } deriving Generic - -instance FromJSON BuildParams where - parseJSON = J.genericParseJSON $ customOptions 2 -instance ToJSON BuildParams where - toJSON = J.genericToJSON $ customOptions 2 - -buildDirectory :: CommandFunc BuildParams () -buildDirectory = CmdSync $ \(BP m dd c s f mbDir) -> withCommonArgs (CommonParams m dd c s f) $ do - ca <- ask - liftIO $ case caMode ca of - CabalMode -> do - -- for cabal specifying directory have no sense - _ <- readProcess (caCabal ca) ["new-build"] "" - return $ IdeResultOk () - StackMode -> - case mbDir of - Nothing -> do - _ <- readProcess (caStack ca) ["build"] "" - return $ IdeResultOk () - Just dir0 -> pluginGetFile "buildDirectory" dir0 $ \dir -> do - cwd <- getCurrentDirectory - let relDir = makeRelative cwd $ normalise dir - _ <- readProcess (caStack ca) ["build", relDir] "" - return $ IdeResultOk () - ------------------------------------------------ - -data BuildTargetParams = BT { - -- common params. horrible - btMode :: T.Text - ,btDistDir :: Maybe String - ,btCabal :: Maybe String - ,btStack :: Maybe String - ,btFile :: Uri - -- specific params - ,btTarget :: Maybe T.Text - ,btPackage :: Maybe T.Text - ,btType :: T.Text - } deriving Generic - -instance FromJSON BuildTargetParams where - parseJSON = J.genericParseJSON $ customOptions 2 -instance ToJSON BuildTargetParams where - toJSON = J.genericToJSON $ customOptions 2 - -buildTarget :: CommandFunc BuildTargetParams () -buildTarget = CmdSync $ \(BT m dd c s f component package' compType) -> withCommonArgs (CommonParams m dd c s f) $ do - ca <- ask - liftIO $ case caMode ca of - CabalMode -> do - _ <- readProcess (caCabal ca) ["new-build", T.unpack $ fromMaybe "" component] "" - return $ IdeResultOk () - StackMode -> - case (package', component) of - (Just p, Nothing) -> do - _ <- readProcess (caStack ca) ["build", T.unpack $ p `T.append` compType] "" - return $ IdeResultOk () - (Just p, Just c') -> do - _ <- readProcess (caStack ca) ["build", T.unpack $ p `T.append` compType `T.append` (':' `T.cons` c')] "" - return $ IdeResultOk () - (Nothing, Just c') -> do - _ <- readProcess (caStack ca) ["build", T.unpack $ ':' `T.cons` c'] "" - return $ IdeResultOk () - _ -> do - _ <- readProcess (caStack ca) ["build"] "" - return $ IdeResultOk () - ------------------------------------------------ - -data Package = Package { - tPackageName :: String - ,tDirectory :: String - ,tTargets :: [ChComponentName] - } - -listTargets :: CommandFunc CommonParams [Value] -listTargets = CmdSync $ \req -> withCommonArgs req $ do - ca <- ask - targets <- liftIO $ case caMode ca of - CabalMode -> (:[]) <$> listCabalTargets (caDistDir ca) "." - StackMode -> listStackTargets (caDistDir ca) - let ret = flip map targets $ \t -> object - ["name" .= tPackageName t, - "directory" .= tDirectory t, - "targets" .= map compToJSON (tTargets t)] - return $ IdeResultOk ret - -listStackTargets :: FilePath -> IO [Package] -listStackTargets distDir' = do - stackPackageDirs <- getStackLocalPackages "stack.yaml" - mapM (listCabalTargets distDir') stackPackageDirs - -listCabalTargets :: MonadIO m => FilePath -> FilePath -> m Package -listCabalTargets distDir' dir = - runQuery (mkQueryEnv dir distDir') $ do - pkgName' <- fst <$> packageId - cc <- components $ (,) CH.<$> entrypoints - let comps = map (fixupLibraryEntrypoint pkgName' .snd) cc - absDir <- liftIO $ makeAbsolute dir - return $ Package pkgName' absDir comps - where --- # if MIN_VERSION_Cabal(2,0,0) -#if MIN_VERSION_Cabal(1,24,0) - fixupLibraryEntrypoint _n ChLibName = ChLibName -#else - fixupLibraryEntrypoint n (ChLibName "") = ChLibName n -#endif - fixupLibraryEntrypoint _ e = e - --- Example of new way to use cabal helper 'entrypoints' is a ComponentQuery, --- components applies it to all components in the project, the semigroupoids --- apply batches the result per component, and returns the component as the last --- item. -getComponents :: QueryEnv -> IO [(ChEntrypoint,ChComponentName)] -getComponents env = runQuery env $ components $ (,) CH.<$> entrypoints - ------------------------------------------------ - -newtype StackYaml = StackYaml [StackPackage] -data StackPackage = LocalOrHTTPPackage { stackPackageName :: String } - | Repository - -instance FromJSON StackYaml where - parseJSON (Object o) = StackYaml <$> - o .: "packages" - parseJSON _ = mempty - -instance FromJSON StackPackage where - parseJSON (Object _) = pure Repository - parseJSON (String s) = pure $ LocalOrHTTPPackage (T.unpack s) - parseJSON _ = mempty - -isLocal :: StackPackage -> Bool -isLocal (LocalOrHTTPPackage _) = True -isLocal _ = False - -getStackLocalPackages :: FilePath -> IO [String] -getStackLocalPackages stackYamlFile = withBinaryFileContents stackYamlFile $ \contents -> do - let (Just (StackYaml stackYaml)) = decodeThrow contents - stackLocalPackages = map stackPackageName $ filter isLocal stackYaml - return stackLocalPackages - -compToJSON :: ChComponentName -> Value -compToJSON ChSetupHsName = object ["type" .= ("setupHs" :: T.Text)] -#if MIN_VERSION_Cabal(1,24,0) -compToJSON ChLibName = object ["type" .= ("library" :: T.Text)] -compToJSON (ChSubLibName n) = object ["type" .= ("library" :: T.Text), "name" .= n] -compToJSON (ChFLibName n) = object ["type" .= ("library" :: T.Text), "name" .= n] -#else -compToJSON (ChLibName n) = object ["type" .= ("library" :: T.Text), "name" .= n] -#endif -compToJSON (ChExeName n) = object ["type" .= ("executable" :: T.Text), "name" .= n] -compToJSON (ChTestName n) = object ["type" .= ("test" :: T.Text), "name" .= n] -compToJSON (ChBenchName n) = object ["type" .= ("benchmark" :: T.Text), "name" .= n] - ------------------------------------------------ - -getDistDir :: OperationMode -> FilePath -> IO FilePath -getDistDir CabalMode _ = do - cwd <- getCurrentDirectory - return $ cwd defaultDistPref -getDistDir StackMode stackExe = do - cwd <- getCurrentDirectory - dist <- init <$> readProcess stackExe ["path", "--dist-dir"] "" - return $ cwd dist - -isCabalFile :: FilePath -> Bool -isCabalFile f = takeExtension' f == ".cabal" - -takeExtension' :: FilePath -> String -takeExtension' p = - if takeFileName p == takeExtension p - then "" -- just ".cabal" is not a valid cabal file - else takeExtension p - -withBinaryFileContents :: FilePath -> (B.ByteString -> IO c) -> IO c -withBinaryFileContents name act = withFile name ReadMode $ B.hGetContents >=> act - -customOptions :: Int -> J.Options -customOptions n = J.defaultOptions { J.fieldLabelModifier = J.camelTo2 '_' . drop n} diff --git a/stack-8.2.2.yaml b/stack-8.2.2.yaml index 7d3ef1581..36240f3f8 100644 --- a/stack-8.2.2.yaml +++ b/stack-8.2.2.yaml @@ -14,7 +14,7 @@ extra-deps: - brittany-0.12.0.0 - butcher-1.3.1.1 - bytestring-trie-0.2.5.0 -- cabal-plan-0.3.0.0 +- cabal-plan-0.5.0.0 - conduit-parse-0.2.1.0 - constrained-dynamic-0.1.0.0 - czipwith-1.0.1.0 @@ -55,6 +55,7 @@ extra-deps: - unix-2.7.2.2 # - Win32-2.6.2. - time-1.8.0.2 +- pretty-show-1.8.2 flags: haskell-ide-engine: diff --git a/stack-8.4.2.yaml b/stack-8.4.2.yaml index 9e1d3c458..c88d8aa87 100644 --- a/stack-8.4.2.yaml +++ b/stack-8.4.2.yaml @@ -14,7 +14,7 @@ extra-deps: - brittany-0.12.0.0 - base-compat-0.9.3 - bytestring-trie-0.2.5.0 - - cabal-plan-0.3.0.0 + - cabal-plan-0.5.0.0 - constrained-dynamic-0.1.0.0 - floskell-0.10.0 - ghc-exactprint-0.5.8.2 @@ -38,6 +38,7 @@ extra-deps: - unix-time-0.4.7 - windns-0.1.0.0 - yi-rope-0.11 + - pretty-show-1.8.2 # - hie-bios-0.2.1@sha256:5f98a3516ce65e0a3ffd88bf6fb416b04cc084371d0fbf0e1762780de1d652ce,3219 - extra-1.6.18@sha256:5f1fff126f0ae47b701fff5aa8462dc63cb44465d5a724b0afd20a3d731903af diff --git a/stack-8.4.3.yaml b/stack-8.4.3.yaml index 1ab9d645b..382642ab2 100644 --- a/stack-8.4.3.yaml +++ b/stack-8.4.3.yaml @@ -14,7 +14,7 @@ extra-deps: - base-compat-0.9.3 - brittany-0.12.0.0 - bytestring-trie-0.2.5.0 - - cabal-plan-0.3.0.0 + - cabal-plan-0.5.0.0 - constrained-dynamic-0.1.0.0 - floskell-0.10.0 - ghc-exactprint-0.5.8.2 @@ -36,6 +36,7 @@ extra-deps: # To make build work in windows 7 - unix-time-0.4.7 - temporary-1.2.1.1 + - pretty-show-1.8.2 # - hie-bios-0.2.1@sha256:5f98a3516ce65e0a3ffd88bf6fb416b04cc084371d0fbf0e1762780de1d652ce,3219 - extra-1.6.18@sha256:5f1fff126f0ae47b701fff5aa8462dc63cb44465d5a724b0afd20a3d731903af diff --git a/stack-8.4.4.yaml b/stack-8.4.4.yaml index 3787f0054..27aa69643 100644 --- a/stack-8.4.4.yaml +++ b/stack-8.4.4.yaml @@ -13,7 +13,7 @@ extra-deps: - brittany-0.12.0.0 - bytestring-trie-0.2.5.0 - - cabal-plan-0.4.0.0 + - cabal-plan-0.5.0.0 - constrained-dynamic-0.1.0.0 - floskell-0.10.0 - ghc-exactprint-0.5.8.2 @@ -36,6 +36,7 @@ extra-deps: # To make build work in windows 7 - unix-time-0.4.7 - temporary-1.2.1.1 + - pretty-show-1.8.2 #- hie-bios-0.2.1@sha256:5f98a3516ce65e0a3ffd88bf6fb416b04cc084371d0fbf0e1762780de1d652ce,3219 - extra-1.6.18@sha256:5f1fff126f0ae47b701fff5aa8462dc63cb44465d5a724b0afd20a3d731903af diff --git a/stack-8.6.1.yaml b/stack-8.6.1.yaml index 20a3acc05..e088860b0 100644 --- a/stack-8.6.1.yaml +++ b/stack-8.6.1.yaml @@ -16,7 +16,7 @@ extra-deps: - butcher-1.3.2.1 - bytestring-trie-0.2.5.0 - cabal-install-2.4.0.0 - - cabal-plan-0.4.0.0 + - cabal-plan-0.5.0.0 - constrained-dynamic-0.1.0.0 - czipwith-1.0.1.1 - data-tree-print-0.1.0.2 @@ -42,6 +42,7 @@ extra-deps: - temporary-1.2.1.1 # To make build work in windows 7 - unix-time-0.4.7 + - pretty-show-1.8.2 # - hie-bios-0.2.1@sha256:5f98a3516ce65e0a3ffd88bf6fb416b04cc084371d0fbf0e1762780de1d652ce,3219 - extra-1.6.18@sha256:5f1fff126f0ae47b701fff5aa8462dc63cb44465d5a724b0afd20a3d731903af diff --git a/stack-8.6.2.yaml b/stack-8.6.2.yaml index 3524d56fc..c0beabd4c 100644 --- a/stack-8.6.2.yaml +++ b/stack-8.6.2.yaml @@ -14,7 +14,7 @@ extra-deps: - brittany-0.12.0.0 - butcher-1.3.2.1 - bytestring-trie-0.2.5.0 - - cabal-plan-0.4.0.0 + - cabal-plan-0.5.0.0 - constrained-dynamic-0.1.0.0 - floskell-0.10.0 - ghc-lib-parser-8.8.0.20190723 @@ -35,6 +35,7 @@ extra-deps: - temporary-1.2.1.1 # To make build work in windows 7 - unix-time-0.4.7 + - pretty-show-1.8.2 #- hie-bios-0.2.1@sha256:5f98a3516ce65e0a3ffd88bf6fb416b04cc084371d0fbf0e1762780de1d652ce,3219 - extra-1.6.18@sha256:5f1fff126f0ae47b701fff5aa8462dc63cb44465d5a724b0afd20a3d731903af diff --git a/stack-8.6.3.yaml b/stack-8.6.3.yaml index ca34d23ff..833b840aa 100644 --- a/stack-8.6.3.yaml +++ b/stack-8.6.3.yaml @@ -14,7 +14,7 @@ extra-deps: - brittany-0.12.0.0 - bytestring-trie-0.2.5.0 - butcher-1.3.2.1 - - cabal-plan-0.4.0.0 + - cabal-plan-0.5.0.0 - constrained-dynamic-0.1.0.0 - floskell-0.10.0 - ghc-lib-parser-8.8.0.20190723 @@ -36,6 +36,7 @@ extra-deps: - temporary-1.2.1.1 # To make build work in windows 7 - unix-time-0.4.7 + - pretty-show-1.8.2 # - hie-bios-0.2.1@sha256:5f98a3516ce65e0a3ffd88bf6fb416b04cc084371d0fbf0e1762780de1d652ce,3219 - extra-1.6.18@sha256:5f1fff126f0ae47b701fff5aa8462dc63cb44465d5a724b0afd20a3d731903af diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index 9c4193ba6..c507b1a25 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -14,7 +14,7 @@ extra-deps: - brittany-0.12.0.0 - butcher-1.3.2.1 - bytestring-trie-0.2.5.0 - - cabal-plan-0.4.0.0 + - cabal-plan-0.5.0.0 - constrained-dynamic-0.1.0.0 - floskell-0.10.0 - ghc-lib-parser-8.8.0.20190723 @@ -34,6 +34,7 @@ extra-deps: - temporary-1.2.1.1 # To make build work in windows 7 - unix-time-0.4.7 + - pretty-show-1.8.2 # - hie-bios-0.2.1@sha256:5f98a3516ce65e0a3ffd88bf6fb416b04cc084371d0fbf0e1762780de1d652ce,3219 - extra-1.6.18@sha256:5f1fff126f0ae47b701fff5aa8462dc63cb44465d5a724b0afd20a3d731903af @@ -41,6 +42,7 @@ extra-deps: - yaml-0.11.1.2@sha256:cbc4ddb233c564967aad27ee47c1cd8fd6a06b9183353e76fe66c9be7c9dfd76 - unordered-containers-0.2.10.0@sha256:5e9b095a9283d9e2f064fec73a81a6b6ea0b7fda3f219a8175785d2d2a3de204 + flags: haskell-ide-engine: pedantic: true diff --git a/stack.yaml b/stack.yaml index 46f692019..ec9920d0f 100644 --- a/stack.yaml +++ b/stack.yaml @@ -15,7 +15,7 @@ extra-deps: - bytestring-trie-0.2.5.0 - ansi-wl-pprint-0.6.8.2 - brittany-0.12.0.0 -- cabal-plan-0.4.0.0 +- cabal-plan-0.5.0.0 - constrained-dynamic-0.1.0.0 - floskell-0.10.1 - ghc-lib-parser-8.8.0.20190723 @@ -28,6 +28,7 @@ extra-deps: - monad-dijkstra-0.1.1.2@rev:1 - syz-0.2.0.0 - temporary-1.2.1.1 +- pretty-show-1.8.2 # - hie-bios-0.2.1@sha256:5f98a3516ce65e0a3ffd88bf6fb416b04cc084371d0fbf0e1762780de1d652ce,3219 - extra-1.6.18@sha256:5f1fff126f0ae47b701fff5aa8462dc63cb44465d5a724b0afd20a3d731903af - unix-compat-0.5.2@sha256:16763f1fae4a25abf61ac6195eb530ce838474bd04d86c7d353340aee8716bbb diff --git a/submodules/HaRe b/submodules/HaRe index 03de75229..5e870b5b1 160000 --- a/submodules/HaRe +++ b/submodules/HaRe @@ -1 +1 @@ -Subproject commit 03de7522995a3b192c3a2b010539d02e753e3d3d +Subproject commit 5e870b5b13e8fdead0ffd9a47e60528c7490ffd8 diff --git a/submodules/cabal-helper b/submodules/cabal-helper index eafed5e8c..6c4880f7f 160000 --- a/submodules/cabal-helper +++ b/submodules/cabal-helper @@ -1 +1 @@ -Subproject commit eafed5e8c1d82b8daa35775b52361132f2e70261 +Subproject commit 6c4880f7fa6e23a7f9d073bae3721f31b8d89e80 diff --git a/submodules/ghc-mod b/submodules/ghc-mod index 910887b2c..9c56ab080 160000 --- a/submodules/ghc-mod +++ b/submodules/ghc-mod @@ -1 +1 @@ -Subproject commit 910887b2c33237b703417ec07f35ca8bbf35d729 +Subproject commit 9c56ab08087fca74034423dcb6a4560230ca1f76