From 63751c101bd08b3807596c3b6f4906d970bc34f1 Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Sat, 20 May 2023 15:22:12 -0700 Subject: [PATCH 1/2] Add StanzaInfoMap newtype --- src/Ormolu/Utils/Cabal.hs | 60 +++++++++++++++++++++++++-------------- 1 file changed, 39 insertions(+), 21 deletions(-) diff --git a/src/Ormolu/Utils/Cabal.hs b/src/Ormolu/Utils/Cabal.hs index 9a8793a1..b0206653 100644 --- a/src/Ormolu/Utils/Cabal.hs +++ b/src/Ormolu/Utils/Cabal.hs @@ -60,6 +60,25 @@ data CabalInfo = CabalInfo } deriving (Eq, Show) +-- | Information from the stanza corresponding to a given source file. +data StanzaInfo = StanzaInfo + { -- | Extension and language settings in the form of 'DynOption's + siDynOpts :: ![DynOption], + -- | Direct dependencies + siDependencies :: !(Set PackageName) + } + deriving (Show) + +-- | Map from source files (absolute path without extensions) to the corresponding stanza information. +newtype StanzaInfoMap = StanzaInfoMap (Map FilePath StanzaInfo) + deriving (Show) + +-- | Look up the given source file in the 'StanzaInfoMap'. +lookupStanzaInfo :: FilePath -> StanzaInfoMap -> IO (Maybe StanzaInfo) +lookupStanzaInfo path (StanzaInfoMap m) = do + absPath <- makeAbsolute path + pure $ M.lookup (dropExtensions absPath) m + -- | Locate a @.cabal@ file corresponding to the given Haskell source file -- and obtain 'CabalInfo' from it. getCabalInfoForSourceFile :: @@ -94,9 +113,7 @@ findCabalFile = findClosestFileSatisfying $ \x -> data CachedCabalFile = CachedCabalFile { -- | Parsed generic package description. genericPackageDescription :: GenericPackageDescription, - -- | Map from Haskell source file paths (without any extensions) to the - -- corresponding 'DynOption's and dependencies. - extensionsAndDeps :: Map FilePath ([DynOption], [PackageName]) + stanzaInfoMap :: StanzaInfoMap } deriving (Show) @@ -117,26 +134,24 @@ parseCabalInfo :: m (Bool, CabalInfo) parseCabalInfo cabalFileAsGiven sourceFileAsGiven = liftIO $ do cabalFile <- makeAbsolute cabalFileAsGiven - sourceFileAbs <- makeAbsolute sourceFileAsGiven CachedCabalFile {..} <- withIORefCache cacheRef cabalFile $ do cabalFileBs <- B.readFile cabalFile genericPackageDescription <- whenLeft (snd . runParseResult $ parseGenericPackageDescription cabalFileBs) $ throwIO . OrmoluCabalFileParsingFailed cabalFile . snd - let extensionsAndDeps = - getExtensionAndDepsMap cabalFile genericPackageDescription + let stanzaInfoMap = toStanzaInfoMap cabalFile genericPackageDescription pure CachedCabalFile {..} - let (dynOpts, dependencies, mentioned) = - case M.lookup (dropExtensions sourceFileAbs) extensionsAndDeps of - Nothing -> ([], Set.toList defaultDependencies, False) - Just (dynOpts', dependencies') -> (dynOpts', dependencies', True) - pdesc = packageDescription genericPackageDescription + (dynOpts, dependencies, mentioned) <- + lookupStanzaInfo sourceFileAsGiven stanzaInfoMap >>= \case + Nothing -> pure ([], defaultDependencies, False) + Just StanzaInfo{..} -> pure (siDynOpts, siDependencies, True) + let pdesc = packageDescription genericPackageDescription return ( mentioned, CabalInfo { ciPackageName = pkgName (package pdesc), ciDynOpts = dynOpts, - ciDependencies = Set.fromList dependencies, + ciDependencies = dependencies, ciCabalFilePath = cabalFile } ) @@ -146,14 +161,14 @@ parseCabalInfo cabalFileAsGiven sourceFileAsGiven = liftIO $ do -- | Get a map from Haskell source file paths (without any extensions) to -- the corresponding 'DynOption's and dependencies. -getExtensionAndDepsMap :: +toStanzaInfoMap :: -- | Path to the cabal file FilePath -> -- | Parsed generic package description GenericPackageDescription -> - Map FilePath ([DynOption], [PackageName]) -getExtensionAndDepsMap cabalFile GenericPackageDescription {..} = - M.unions . concat $ + StanzaInfoMap +toStanzaInfoMap cabalFile GenericPackageDescription {..} = + StanzaInfoMap . M.unions . concat $ [ buildMap extractFromLibrary <$> lib ++ sublibs, buildMap extractFromExecutable . snd <$> condExecutables, buildMap extractFromTestSuite . snd <$> condTestSuites, @@ -163,20 +178,23 @@ getExtensionAndDepsMap cabalFile GenericPackageDescription {..} = lib = maybeToList condLibrary sublibs = snd <$> condSubLibraries - buildMap f a = M.fromList ((,extsAndDeps) <$> files) + buildMap f a = M.fromList ((,stanzaInfo) <$> files) where (mergedA, _) = CT.ignoreConditions a - (files, extsAndDeps) = f mergedA + (files, stanzaInfo) = f mergedA - extractFromBuildInfo extraModules BuildInfo {..} = (,(exts, deps)) $ do + extractFromBuildInfo extraModules BuildInfo {..} = (,stanzaInfo) $ do m <- extraModules ++ (ModuleName.toFilePath <$> otherModules) normalise . (takeDirectory cabalFile ) <$> prependSrcDirs (dropExtensions m) where prependSrcDirs f | null hsSourceDirs = [f] | otherwise = ( f) . getSymbolicPath <$> hsSourceDirs - deps = depPkgName <$> targetBuildDepends - exts = maybe [] langExt defaultLanguage ++ fmap extToDynOption defaultExtensions + stanzaInfo = + StanzaInfo + { siDynOpts = maybe [] langExt defaultLanguage ++ fmap extToDynOption defaultExtensions, + siDependencies = Set.fromList $ map depPkgName targetBuildDepends + } langExt = pure . DynOption . ("-X" <>) . \case UnknownLanguage lan -> lan From d5756017f62063695e082ad19c766ecef8f662b0 Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Fri, 2 Jun 2023 08:51:27 -0700 Subject: [PATCH 2/2] Ensure no-cabal-file has equivalent behavior to cabal-file-not-mention --- app/Main.hs | 48 ++++++++-------- src/Ormolu.hs | 44 +++++++------- src/Ormolu/Utils/Cabal.hs | 105 +++++++++++----------------------- tests/Ormolu/CabalInfoSpec.hs | 40 +++++++------ 4 files changed, 105 insertions(+), 132 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index a44765c7..1167f4b0 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -81,25 +81,25 @@ formatOne :: formatOne ConfigFileOpts {..} mode reqSourceType rawConfig mpath = withPrettyOrmoluExceptions (cfgColorMode rawConfig) $ do let getCabalInfoForSourceFile' sourceFile = do - cabalSearchResult <- getCabalInfoForSourceFile sourceFile let debugEnabled = cfgDebug rawConfig - case cabalSearchResult of - CabalNotFound -> do + getCabalInfoForSourceFile sourceFile >>= \case + Nothing -> do when debugEnabled $ hPutStrLn stderr $ "Could not find a .cabal file for " <> sourceFile - return Nothing - CabalDidNotMention cabalInfo -> do - when debugEnabled $ do - relativeCabalFile <- - makeRelativeToCurrentDirectory (ciCabalFilePath cabalInfo) - hPutStrLn stderr $ - "Found .cabal file " - <> relativeCabalFile - <> ", but it did not mention " - <> sourceFile - return (Just cabalInfo) - CabalFound cabalInfo -> return (Just cabalInfo) + return (Nothing, Nothing) + Just CabalInfo {..} -> do + mStanzaInfo <- lookupStanzaInfo sourceFile ciStanzaInfoMap + case mStanzaInfo of + Nothing | debugEnabled -> do + relativeCabalFile <- makeRelativeToCurrentDirectory ciCabalFilePath + hPutStrLn stderr $ + "Found .cabal file " + <> relativeCabalFile + <> ", but it did not mention " + <> sourceFile + _ -> pure () + return (Just ciPackageName, mStanzaInfo) getDotOrmoluForSourceFile' sourceFile = do if optDoNotUseDotOrmolu then return Nothing @@ -107,14 +107,14 @@ formatOne ConfigFileOpts {..} mode reqSourceType rawConfig mpath = case FP.normalise <$> mpath of -- input source = STDIN Nothing -> do - mcabalInfo <- case (optStdinInputFile, optDoNotUseCabal) of - (_, True) -> return Nothing + (mPackageName, mStanzaInfo) <- case (optStdinInputFile, optDoNotUseCabal) of + (_, True) -> return (Nothing, Nothing) (Nothing, False) -> throwIO OrmoluMissingStdinInputFile (Just inputFile, False) -> getCabalInfoForSourceFile' inputFile mdotOrmolu <- case optStdinInputFile of Nothing -> return Nothing Just inputFile -> getDotOrmoluForSourceFile' inputFile - config <- patchConfig Nothing mcabalInfo mdotOrmolu + config <- patchConfig Nothing mPackageName mStanzaInfo mdotOrmolu case mode of Stdout -> do ormoluStdin config >>= TIO.putStr @@ -134,15 +134,16 @@ formatOne ConfigFileOpts {..} mode reqSourceType rawConfig mpath = handleDiff originalInput formattedInput stdinRepr -- input source = a file Just inputFile -> do - mcabalInfo <- + (mPackageName, mStanzaInfo) <- if optDoNotUseCabal - then return Nothing + then return (Nothing, Nothing) else getCabalInfoForSourceFile' inputFile mdotOrmolu <- getDotOrmoluForSourceFile' inputFile config <- patchConfig (Just (detectSourceType inputFile)) - mcabalInfo + mPackageName + mStanzaInfo mdotOrmolu case mode of Stdout -> do @@ -163,7 +164,7 @@ formatOne ConfigFileOpts {..} mode reqSourceType rawConfig mpath = ormolu config inputFile originalInput handleDiff originalInput formattedInput inputFile where - patchConfig mdetectedSourceType mcabalInfo mdotOrmolu = do + patchConfig mdetectedSourceType mPackageName mStanzaInfo mdotOrmolu = do let sourceType = fromMaybe ModuleSource @@ -173,7 +174,8 @@ formatOne ConfigFileOpts {..} mode reqSourceType rawConfig mpath = return $ refineConfig sourceType - mcabalInfo + mPackageName + mStanzaInfo mfixityOverrides mmoduleReexports rawConfig diff --git a/src/Ormolu.hs b/src/Ormolu.hs index 4dd57063..546e8d6a 100644 --- a/src/Ormolu.hs +++ b/src/Ormolu.hs @@ -20,8 +20,11 @@ module Ormolu DynOption (..), -- * Cabal info - CabalUtils.CabalSearchResult (..), CabalUtils.CabalInfo (..), + CabalUtils.StanzaInfo (..), + CabalUtils.defaultStanzaInfo, + CabalUtils.StanzaInfoMap, + CabalUtils.lookupStanzaInfo, CabalUtils.getCabalInfoForSourceFile, -- * Fixity overrides and module re-exports @@ -46,6 +49,7 @@ import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T import Debug.Trace +import Distribution.PackageDescription (PackageName) import GHC.Driver.CmdLine qualified as GHC import GHC.Types.SrcLoc import Ormolu.Config @@ -167,18 +171,20 @@ ormoluStdin :: ormoluStdin cfg = getContentsUtf8 >>= ormolu cfg "" --- | Refine a 'Config' by incorporating given 'SourceType', 'CabalInfo', and --- fixity overrides 'FixityMap'. You can use 'detectSourceType' to deduce --- 'SourceType' based on the file extension, --- 'CabalUtils.getCabalInfoForSourceFile' to obtain 'CabalInfo' and --- 'getFixityOverridesForSourceFile' for 'FixityMap'. +-- | Refine a 'Config' by incorporating the given information. -- --- @since 0.5.3.0 +-- You can use 'detectSourceType' to deduce 'SourceType' based on the file extension, +-- 'CabalUtils.getCabalInfoForSourceFile' to obtain 'PackageName' and +-- 'CabalUtils.StanzaInfo', and 'getFixityOverridesForSourceFile' for 'FixityMap'. +-- +-- @since 0.8.0.0 refineConfig :: -- | Source type to use SourceType -> - -- | Cabal info for the file, if available - Maybe CabalUtils.CabalInfo -> + -- | Name of the package, if available + Maybe PackageName -> + -- | Stanza information for the source file, if available + Maybe CabalUtils.StanzaInfo -> -- | Fixity overrides, if available Maybe FixityOverrides -> -- | Module re-exports, if available @@ -187,7 +193,7 @@ refineConfig :: Config region -> -- | Refined 'Config' Config region -refineConfig sourceType mcabalInfo mfixityOverrides mreexports rawConfig = +refineConfig sourceType mPackageName mStanzaInfo mfixityOverrides mreexports rawConfig = rawConfig { cfgDynOptions = cfgDynOptions rawConfig ++ dynOptsFromCabal, cfgFixityOverrides = @@ -212,16 +218,14 @@ refineConfig sourceType mcabalInfo mfixityOverrides mreexports rawConfig = where fixityOverrides = fromMaybe defaultFixityOverrides mfixityOverrides reexports = fromMaybe defaultModuleReexports mreexports - (dynOptsFromCabal, depsFromCabal) = - case mcabalInfo of - Nothing -> - -- If no cabal info is provided, assume base as a dependency by - -- default. - ([], defaultDependencies) - Just CabalUtils.CabalInfo {..} -> - -- It makes sense to take into account the operator info for the - -- package itself if we know it, as if it were its own dependency. - (ciDynOpts, Set.insert ciPackageName ciDependencies) + CabalUtils.StanzaInfo {..} = fromMaybe CabalUtils.defaultStanzaInfo mStanzaInfo + dynOptsFromCabal = siDynOpts + depsFromCabal = + case mPackageName of + Nothing -> siDependencies + -- It makes sense to take into account the operator info for the + -- package itself if we know it, as if it were its own dependency. + Just package -> Set.insert package siDependencies ---------------------------------------------------------------------------- -- Helpers diff --git a/src/Ormolu/Utils/Cabal.hs b/src/Ormolu/Utils/Cabal.hs index b0206653..59760664 100644 --- a/src/Ormolu/Utils/Cabal.hs +++ b/src/Ormolu/Utils/Cabal.hs @@ -1,9 +1,13 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} module Ormolu.Utils.Cabal - ( CabalSearchResult (..), - CabalInfo (..), + ( CabalInfo (..), + StanzaInfo (..), + defaultStanzaInfo, + StanzaInfoMap, + lookupStanzaInfo, Extension (..), getCabalInfoForSourceFile, findCabalFile, @@ -34,29 +38,14 @@ import System.Directory import System.FilePath import System.IO.Unsafe (unsafePerformIO) --- | The result of searching for a @.cabal@ file. --- --- @since 0.5.3.0 -data CabalSearchResult - = -- | Cabal file could not be found - CabalNotFound - | -- | Cabal file was found, but it did not mention the source file in - -- question - CabalDidNotMention CabalInfo - | -- | Cabal file was found and it mentions the source file in question - CabalFound CabalInfo - deriving (Eq, Show) - -- | Cabal information of interest to Ormolu. data CabalInfo = CabalInfo { -- | Package name ciPackageName :: !PackageName, - -- | Extension and language settings in the form of 'DynOption's - ciDynOpts :: ![DynOption], - -- | Direct dependencies - ciDependencies :: !(Set PackageName), -- | Absolute path to the cabal file - ciCabalFilePath :: !FilePath + ciCabalFilePath :: !FilePath, + -- | Stanza information for all source files mentioned in the cabal file + ciStanzaInfoMap :: !StanzaInfoMap } deriving (Eq, Show) @@ -67,11 +56,18 @@ data StanzaInfo = StanzaInfo -- | Direct dependencies siDependencies :: !(Set PackageName) } - deriving (Show) + deriving (Eq, Show) + +defaultStanzaInfo :: StanzaInfo +defaultStanzaInfo = + StanzaInfo + { siDynOpts = [], + siDependencies = defaultDependencies + } -- | Map from source files (absolute path without extensions) to the corresponding stanza information. newtype StanzaInfoMap = StanzaInfoMap (Map FilePath StanzaInfo) - deriving (Show) + deriving (Eq, Show) -- | Look up the given source file in the 'StanzaInfoMap'. lookupStanzaInfo :: FilePath -> StanzaInfoMap -> IO (Maybe StanzaInfo) @@ -86,17 +82,9 @@ getCabalInfoForSourceFile :: -- | Haskell source file FilePath -> -- | Extracted cabal info, if any - m CabalSearchResult + m (Maybe CabalInfo) getCabalInfoForSourceFile sourceFile = - liftIO (findCabalFile sourceFile) >>= \case - Just cabalFile -> do - (mentioned, cabalInfo) <- parseCabalInfo cabalFile sourceFile - return - ( if mentioned - then CabalFound cabalInfo - else CabalDidNotMention cabalInfo - ) - Nothing -> return CabalNotFound + liftIO (findCabalFile sourceFile) >>= traverse parseCabalInfo -- | Find the path to an appropriate @.cabal@ file for a Haskell source -- file, if available. @@ -109,16 +97,8 @@ findCabalFile :: findCabalFile = findClosestFileSatisfying $ \x -> takeExtension x == ".cabal" --- | Parsed cabal file information to be shared across multiple source files. -data CachedCabalFile = CachedCabalFile - { -- | Parsed generic package description. - genericPackageDescription :: GenericPackageDescription, - stanzaInfoMap :: StanzaInfoMap - } - deriving (Show) - --- | Cache ref that stores 'CachedCabalFile' per Cabal file. -cacheRef :: IORef (Map FilePath CachedCabalFile) +-- | Cache ref that stores 'CabalInfo' per Cabal file path. +cacheRef :: IORef (Map FilePath CabalInfo) cacheRef = unsafePerformIO $ newIORef M.empty {-# NOINLINE cacheRef #-} @@ -127,37 +107,20 @@ parseCabalInfo :: (MonadIO m) => -- | Location of the .cabal file FilePath -> - -- | Location of the source file we are formatting - FilePath -> - -- | Indication if the source file was mentioned in the Cabal file and the - -- extracted 'CabalInfo' - m (Bool, CabalInfo) -parseCabalInfo cabalFileAsGiven sourceFileAsGiven = liftIO $ do + m CabalInfo +parseCabalInfo cabalFileAsGiven = liftIO $ do cabalFile <- makeAbsolute cabalFileAsGiven - CachedCabalFile {..} <- withIORefCache cacheRef cabalFile $ do + withIORefCache cacheRef cabalFile $ do cabalFileBs <- B.readFile cabalFile - genericPackageDescription <- - whenLeft (snd . runParseResult $ parseGenericPackageDescription cabalFileBs) $ - throwIO . OrmoluCabalFileParsingFailed cabalFile . snd - let stanzaInfoMap = toStanzaInfoMap cabalFile genericPackageDescription - pure CachedCabalFile {..} - (dynOpts, dependencies, mentioned) <- - lookupStanzaInfo sourceFileAsGiven stanzaInfoMap >>= \case - Nothing -> pure ([], defaultDependencies, False) - Just StanzaInfo{..} -> pure (siDynOpts, siDependencies, True) - let pdesc = packageDescription genericPackageDescription - return - ( mentioned, - CabalInfo - { ciPackageName = pkgName (package pdesc), - ciDynOpts = dynOpts, - ciDependencies = dependencies, - ciCabalFilePath = cabalFile - } - ) - where - whenLeft :: (Applicative f) => Either e a -> (e -> f a) -> f a - whenLeft eitha ma = either ma pure eitha + case snd . runParseResult . parseGenericPackageDescription $ cabalFileBs of + Right genericPackageDescription -> + pure + CabalInfo + { ciPackageName = pkgName . package . packageDescription $ genericPackageDescription, + ciCabalFilePath = cabalFile, + ciStanzaInfoMap = toStanzaInfoMap cabalFile genericPackageDescription + } + Left (_, e) -> throwIO $ OrmoluCabalFileParsingFailed cabalFile e -- | Get a map from Haskell source file paths (without any extensions) to -- the corresponding 'DynOption's and dependencies. diff --git a/tests/Ormolu/CabalInfoSpec.hs b/tests/Ormolu/CabalInfoSpec.hs index b495c8a1..e505a8ff 100644 --- a/tests/Ormolu/CabalInfoSpec.hs +++ b/tests/Ormolu/CabalInfoSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} module Ormolu.CabalInfoSpec (spec) where @@ -32,35 +33,38 @@ spec = do cabalFile `shouldBe` Nothing describe "parseCabalInfo" $ do it "extracts correct cabal info from ormolu.cabal for src/Ormolu/Config.hs" $ do - (mentioned, CabalInfo {..}) <- parseCabalInfo "ormolu.cabal" "src/Ormolu/Config.hs" - mentioned `shouldBe` True + CabalInfo {..} <- parseCabalInfo "ormolu.cabal" unPackageName ciPackageName `shouldBe` "ormolu" - ciDynOpts `shouldBe` [DynOption "-XGHC2021"] - Set.map unPackageName ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "Diff", "MemoTrie", "ansi-terminal", "array", "base", "binary", "bytestring", "containers", "deepseq", "directory", "file-embed", "filepath", "ghc-lib-parser", "megaparsec", "mtl", "syb", "text"] ciCabalFilePath `shouldSatisfy` isAbsolute makeRelativeToCurrentDirectory ciCabalFilePath `shouldReturn` "ormolu.cabal" + StanzaInfo {..} <- lookupStanzaInfo' "src/Ormolu/Config.hs" ciStanzaInfoMap + siDynOpts `shouldBe` [DynOption "-XGHC2021"] + Set.map unPackageName siDependencies `shouldBe` Set.fromList ["Cabal-syntax", "Diff", "MemoTrie", "ansi-terminal", "array", "base", "binary", "bytestring", "containers", "deepseq", "directory", "file-embed", "filepath", "ghc-lib-parser", "megaparsec", "mtl", "syb", "text"] it "extracts correct cabal info from ormolu.cabal for tests/Ormolu/PrinterSpec.hs" $ do - (mentioned, CabalInfo {..}) <- parseCabalInfo "ormolu.cabal" "tests/Ormolu/PrinterSpec.hs" - mentioned `shouldBe` True + CabalInfo {..} <- parseCabalInfo "ormolu.cabal" unPackageName ciPackageName `shouldBe` "ormolu" - ciDynOpts `shouldBe` [DynOption "-XGHC2021"] - Set.map unPackageName ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "QuickCheck", "base", "containers", "directory", "filepath", "ghc-lib-parser", "hspec", "hspec-megaparsec", "megaparsec", "ormolu", "path", "path-io", "temporary", "text"] ciCabalFilePath `shouldSatisfy` isAbsolute makeRelativeToCurrentDirectory ciCabalFilePath `shouldReturn` "ormolu.cabal" + StanzaInfo {..} <- lookupStanzaInfo' "tests/Ormolu/PrinterSpec.hs" ciStanzaInfoMap + siDynOpts `shouldBe` [DynOption "-XGHC2021"] + Set.map unPackageName siDependencies `shouldBe` Set.fromList ["Cabal-syntax", "QuickCheck", "base", "containers", "directory", "filepath", "ghc-lib-parser", "hspec", "hspec-megaparsec", "megaparsec", "ormolu", "path", "path-io", "temporary", "text"] it "handles correctly files that are not mentioned in ormolu.cabal" $ do - (mentioned, CabalInfo {..}) <- parseCabalInfo "ormolu.cabal" "src/FooBob.hs" - mentioned `shouldBe` False + CabalInfo {..} <- parseCabalInfo "ormolu.cabal" unPackageName ciPackageName `shouldBe` "ormolu" - ciDynOpts `shouldBe` [] - Set.map unPackageName ciDependencies `shouldBe` Set.fromList ["base"] ciCabalFilePath `shouldSatisfy` isAbsolute makeRelativeToCurrentDirectory ciCabalFilePath `shouldReturn` "ormolu.cabal" + mStanzaInfo <- lookupStanzaInfo "src/FooBob.hs" ciStanzaInfoMap + mStanzaInfo `shouldBe` Nothing it "handles `hs-source-dirs: .`" $ do - (_, CabalInfo {..}) <- parseTestCabalInfo "Foo.hs" - ciDynOpts `shouldContain` [DynOption "-XImportQualifiedPost"] + CabalInfo {..} <- parseCabalInfo "data/cabal-tests/test.cabal" + StanzaInfo {..} <- lookupStanzaInfo' "data/cabal-tests/Foo.hs" ciStanzaInfoMap + siDynOpts `shouldContain` [DynOption "-XImportQualifiedPost"] it "handles empty hs-source-dirs" $ do - (_, CabalInfo {..}) <- parseTestCabalInfo "Bar.hs" - ciDynOpts `shouldContain` [DynOption "-XImportQualifiedPost"] + CabalInfo {..} <- parseCabalInfo "data/cabal-tests/test.cabal" + StanzaInfo {..} <- lookupStanzaInfo' "data/cabal-tests/Bar.hs" ciStanzaInfoMap + siDynOpts `shouldContain` [DynOption "-XImportQualifiedPost"] where - parseTestCabalInfo f = - parseCabalInfo "data/cabal-tests/test.cabal" ("data/cabal-tests" f) + lookupStanzaInfo' fp stanzaInfoMap = + lookupStanzaInfo fp stanzaInfoMap >>= \case + Nothing -> error $ "StanzaInfoMap did not contain: " ++ fp + Just info -> pure info