Refactor extraction and caching of CabalInfo

app/Main.hs

@@ -81,40 +81,40 @@ 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
             else Just <$> getDotOrmoluForSourceFile sourceFile
     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

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 "<stdin>"
 
--- | 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

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,50 +38,53 @@ 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)
+
+-- | 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 (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 (Eq, 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 ::
   (MonadIO m) =>
   -- | 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.
@@ -90,18 +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,
-    -- | Map from Haskell source file paths (without any extensions) to the
-    -- corresponding 'DynOption's and dependencies.
-    extensionsAndDeps :: Map FilePath ([DynOption], [PackageName])
-  }
-  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 #-}
 
@@ -110,50 +107,31 @@ 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
-  sourceFileAbs <- makeAbsolute sourceFileAsGiven
-  CachedCabalFile {..} <- withIORefCache cacheRef cabalFile $ do
+  withIORefCache cacheRef cabalFile $ do
     cabalFileBs <- B.readFile cabalFile
-    genericPackageDescription <-
-      whenLeft (snd . runParseResult $ parseGenericPackageDescription cabalFileBs) $
-        throwIO . OrmoluCabalFileParsingFailed cabalFile . snd
-    let extensionsAndDeps =
-          getExtensionAndDepsMap 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
-  return
-    ( mentioned,
-      CabalInfo
-        { ciPackageName = pkgName (package pdesc),
-          ciDynOpts = dynOpts,
-          ciDependencies = Set.fromList 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.
-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 +141,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