pantry 0.7.1 → 0.8.0

raw patch · 10 files changed

+100/−52 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• pantry.cabal +1/−1
• src/Pantry.hs +67/−45
• src/Pantry/Archive.hs +1/−1
• src/Pantry/Casa.hs +1/−1
• src/Pantry/Hackage.hs +2/−1
• src/Pantry/Repo.hs +1/−1
• src/Pantry/Tree.hs +1/−1
• src/Pantry/Types.hs +18/−0
• test/Pantry/FileSpec.hs +1/−1

@@ -1,5 +1,12 @@ # Changelog for pantry
 
+## v0.8.0
+
+* `findOrGenerateCabalFile`, `loadCabalFilePath`, `loadCabalFile` and
+  `loadCabalFileRaw` no longer assume that the program name used by Hpack (the
+  library) is "stack", and take a new initial argument of type `Maybe Text` to
+  specify the desired program name. The default is "hpack".
+
 ## v0.7.1
 
 * To support the Haskell Foundation's

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack
 
 name:           pantry
-version:        0.7.1
+version:        0.8.0
 synopsis:       Content addressable Haskell package management
 description:    Please see the README on GitHub at <https://github.com/commercialhaskell/pantry#readme>
 category:       Development

@@ -217,6 +217,7 @@ import RIO.PrettyPrint
 import RIO.PrettyPrint.StylesUpdate
 import RIO.Process
+import RIO.Text (unpack)
 import RIO.Directory (getAppUserDataDirectory)
 import qualified Data.Yaml as Yaml
 import Pantry.Internal.AesonExtended (WithJSONWarnings (..), Value)
@@ -595,54 +596,58 @@           x <- inner
           atomicModifyIORef' ref $ \m -> (Map.insert loc x m, x)
 
--- | Same as 'loadCabalFileRawImmutable', but takes a
--- 'RawPackageLocation'. Never prints warnings, see 'loadCabalFilePath'
--- for that.
+-- | Same as 'loadCabalFileRawImmutable', but takes a 'RawPackageLocation'.
+-- Never prints warnings, see 'loadCabalFilePath' for that.
 --
--- @since 0.1.0.0
+-- @since 0.8.0
 loadCabalFileRaw
   :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
-  => RawPackageLocation
+  => Maybe Text -- ^ The program name used by Hpack (the library), defaults to
+                -- \"hpack\".
+  -> RawPackageLocation
   -> RIO env GenericPackageDescription
-loadCabalFileRaw (RPLImmutable loc) = loadCabalFileRawImmutable loc
-loadCabalFileRaw (RPLMutable rfp) = do
-  (gpdio, _, _) <- loadCabalFilePath (resolvedAbsolute rfp)
+loadCabalFileRaw _ (RPLImmutable loc) = loadCabalFileRawImmutable loc
+loadCabalFileRaw progName (RPLMutable rfp) = do
+  (gpdio, _, _) <- loadCabalFilePath progName (resolvedAbsolute rfp)
   liftIO $ gpdio NoPrintWarnings
 
--- | Same as 'loadCabalFileImmutable', but takes a
--- 'PackageLocation'. Never prints warnings, see 'loadCabalFilePath'
--- for that.
+-- | Same as 'loadCabalFileImmutable', but takes a 'PackageLocation'. Never
+-- prints warnings, see 'loadCabalFilePath' for that.
 --
--- @since 0.1.0.0
+-- @since 0.8.0
 loadCabalFile
   :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
-  => PackageLocation
+  => Maybe Text -- ^ The program name used by Hpack (the library), defaults to
+                -- \"hpack\".
+  -> PackageLocation
   -> RIO env GenericPackageDescription
-loadCabalFile (PLImmutable loc) = loadCabalFileImmutable loc
-loadCabalFile (PLMutable rfp) = do
-  (gpdio, _, _) <- loadCabalFilePath (resolvedAbsolute rfp)
+loadCabalFile _ (PLImmutable loc) = loadCabalFileImmutable loc
+loadCabalFile progName (PLMutable rfp) = do
+  (gpdio, _, _) <- loadCabalFilePath progName (resolvedAbsolute rfp)
   liftIO $ gpdio NoPrintWarnings
 
--- | Parse the cabal file for the package inside the given
--- directory. Performs various sanity checks, such as the file name
--- being correct and having only a single cabal file.
+-- | Parse the Cabal file for the package inside the given directory. Performs
+-- various sanity checks, such as the file name being correct and having only a
+-- single Cabal file.
 --
--- @since 0.1.0.0
+-- @since 0.8.0
 loadCabalFilePath
   :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
-  => Path Abs Dir -- ^ project directory, with a cabal file or hpack file
+  => Maybe Text -- ^ The program name used by Hpack (the library), defaults to
+                -- \"hpack\".
+  -> Path Abs Dir -- ^ project directory, with a cabal file or hpack file
   -> RIO env
        ( PrintWarnings -> IO GenericPackageDescription
        , PackageName
        , Path Abs File
        )
-loadCabalFilePath dir = do
+loadCabalFilePath progName dir = do
   ref <- view $ pantryConfigL.to pcParsedCabalFilesMutable
   mcached <- Map.lookup dir <$> readIORef ref
   case mcached of
     Just triple -> pure triple
     Nothing -> do
-      (name, cabalfp) <- findOrGenerateCabalFile dir
+      (name, cabalfp) <- findOrGenerateCabalFile progName dir
       gpdRef <- newIORef Nothing
       run <- askRunInIO
       let gpdio = run . getGPD cabalfp gpdRef
@@ -683,21 +688,24 @@         when (expected /= toFilePath (filename cabalfp))
             $ throwM $ MismatchedCabalName cabalfp name
 
--- | Get the filename for the cabal file in the given directory.
+-- | Get the file name for the Cabal file in the given directory.
 --
--- If no .cabal file is present, or more than one is present, an exception is
+-- If no Cabal file is present, or more than one is present, an exception is
 -- thrown via 'throwM'.
 --
--- If the directory contains a file named package.yaml, hpack is used to
--- generate a .cabal file from it.
+-- If the directory contains a file named package.yaml, Hpack is used to
+-- generate a Cabal file from it.
 --
--- @since 0.1.0.0
+-- @since 0.8.0
 findOrGenerateCabalFile
     :: forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
-    => Path Abs Dir -- ^ package directory
+    => Maybe Text -- ^ The program name used by Hpack (the library), defaults to
+                  -- \"hpack\".
+    -> Path Abs Dir -- ^ package directory
     -> RIO env (PackageName, Path Abs File)
-findOrGenerateCabalFile pkgDir = do
-    hpack pkgDir
+findOrGenerateCabalFile progName pkgDir = do
+    let hpackProgName = fromString . unpack <$> progName
+    hpack hpackProgName pkgDir
     files <- filter (flip hasExtension "cabal" . toFilePath) . snd
          <$> listDir pkgDir
     -- If there are multiple files, ignore files that start with
@@ -717,42 +725,56 @@         _:_ -> throwIO $ MultipleCabalFilesFound pkgDir files
       where hasExtension fp x = FilePath.takeExtension fp == "." ++ x
 
--- | Generate .cabal file from package.yaml, if necessary.
+-- | Generate Cabal file from package.yaml, if necessary.
 hpack
   :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
-  => Path Abs Dir
+  => Maybe Hpack.ProgramName -- ^ The program name used by Hpack (the library).
+  -> Path Abs Dir
   -> RIO env ()
-hpack pkgDir = do
+hpack progName pkgDir = do
     packageConfigRelFile <- parseRelFile Hpack.packageConfig
     let hpackFile = pkgDir </> packageConfigRelFile
+        mHpackProgName = maybe id Hpack.setProgramName progName
     exists <- liftIO $ doesFileExist hpackFile
     when exists $ do
-        logDebug $ "Running hpack on " <> fromString (toFilePath hpackFile)
+        logDebug $ "Running Hpack on " <> fromString (toFilePath hpackFile)
 
         he <- view $ pantryConfigL.to pcHpackExecutable
         case he of
             HpackBundled -> do
-                r <- liftIO $ Hpack.hpackResult $ Hpack.setProgramName "stack" $ Hpack.setTarget (toFilePath hpackFile) Hpack.defaultOptions
+                r <- catchAny
+                       ( liftIO
+                           $ Hpack.hpackResult
+                           $ mHpackProgName
+                           $ Hpack.setTarget
+                               (toFilePath hpackFile) Hpack.defaultOptions
+                       )
+                       ( throwIO . HpackLibraryException hpackFile )
                 forM_ (Hpack.resultWarnings r) (logWarn . fromString)
                 let cabalFile = fromString . Hpack.resultCabalFile $ r
                 case Hpack.resultStatus r of
-                    Hpack.Generated -> logDebug $ "hpack generated a modified version of " <> cabalFile
-                    Hpack.OutputUnchanged -> logDebug $ "hpack output unchanged in " <> cabalFile
+                    Hpack.Generated ->
+                      logDebug $ "Hpack generated a modified version of "
+                                 <> cabalFile
+                    Hpack.OutputUnchanged ->
+                      logDebug $ "Hpack output unchanged in " <> cabalFile
                     Hpack.AlreadyGeneratedByNewerHpack -> logWarn $
                         cabalFile <>
-                        " was generated with a newer version of hpack,\n" <>
+                        " was generated with a newer version of Hpack,\n" <>
                         "please upgrade and try again."
                     Hpack.ExistingCabalFileWasModifiedManually -> logWarn $
                         cabalFile <>
                         " was modified manually. Ignoring " <>
                         fromString (toFilePath hpackFile) <>
-                        " in favor of the cabal file.\nIf you want to use the " <>
+                        " in favor of the Cabal file.\nIf you want to use the " <>
                         fromString (toFilePath (filename hpackFile)) <>
-                        " file instead of the cabal file,\n" <>
-                        "then please delete the cabal file."
-            HpackCommand command ->
-                withWorkingDir (toFilePath pkgDir) $
-                proc command [] runProcess_
+                        " file instead of the Cabal file,\n" <>
+                        "then please delete the Cabal file."
+            HpackCommand command -> catchAny
+                ( withWorkingDir (toFilePath pkgDir) $
+                  proc command [] runProcess_
+                )
+                ( throwIO . HpackExeException command pkgDir)
 
 -- | Get the 'PackageIdentifier' from a 'GenericPackageDescription'.
 --

@@ -14,7 +14,7 @@ 
 import RIO
 import qualified Pantry.SHA256 as SHA256
-import Pantry.Storage hiding (Tree, TreeEntry)
+import Pantry.Storage hiding (Tree, TreeEntry, findOrGenerateCabalFile)
 import Pantry.Tree
 import Pantry.Types
 import RIO.Process

@@ -10,7 +10,7 @@ import           Conduit
 import qualified Data.HashMap.Strict as HM
 import qualified Pantry.SHA256 as SHA256
-import           Pantry.Storage
+import           Pantry.Storage hiding (findOrGenerateCabalFile)
 import           Pantry.Types as P
 import           RIO
 import qualified RIO.ByteString as B

@@ -33,7 +33,8 @@ import qualified RIO.ByteString.Lazy as BL
 import Pantry.Archive
 import Pantry.Types hiding (FileType (..))
-import Pantry.Storage hiding (TreeEntry, PackageName, Version)
+import Pantry.Storage
+         hiding (TreeEntry, PackageName, Version, findOrGenerateCabalFile)
 import Pantry.Tree
 import qualified Pantry.SHA256 as SHA256
 import Network.URI (parseURI)

@@ -17,7 +17,7 @@ 
 import Pantry.Types
 import Pantry.Archive
-import Pantry.Storage
+import Pantry.Storage hiding (findOrGenerateCabalFile)
 import RIO
 import Path.IO (resolveFile')
 import RIO.FilePath ((</>))

@@ -10,7 +10,7 @@ import qualified RIO.Map as Map
 import qualified RIO.Text as T
 import qualified RIO.ByteString as B
-import Pantry.Storage hiding (Tree, TreeEntry)
+import Pantry.Storage hiding (Tree, TreeEntry, findOrGenerateCabalFile)
 import Pantry.Types
 import RIO.FilePath ((</>), takeDirectory)
 import RIO.Directory (createDirectoryIfMissing, setPermissions, getPermissions, setOwnerExecutable)

@@ -970,6 +970,8 @@   | MigrationFailure !Text !(Path Abs File) !SomeException
   | InvalidTreeFromCasa !BlobKey !ByteString
   | ParseSnapNameException !Text
+  | HpackLibraryException !(Path Abs File) !SomeException
+  | HpackExeException !FilePath !(Path Abs Dir) !SomeException
 
   deriving Typeable
 instance Exception PantryException where
@@ -1276,6 +1278,22 @@     "Error: [S-994]\n"
      <> "Invalid snapshot name: "
      <> display t
+  display (HpackLibraryException file e) =
+    "Error: [S-305]\n"
+    <> "Failed to generate a Cabal file using the Hpack library on file:\n"
+    <> fromString (toFilePath file)
+    <> "\n\n"
+    <> "The exception encountered was:\n\n"
+    <> fromString (show e)
+  display (HpackExeException fp dir e) =
+    "Error: [S-720]\n"
+    <> "Failed to generate a Cabal file using the Hpack executable:\n"
+    <> fromString fp
+    <> "in directory: "
+    <> fromString (toFilePath dir)
+    <> "\n\n"
+    <> "The exception encountered was:\n\n"
+    <> fromString (show e)
 
 data FuzzyResults
   = FRNameNotFound ![PackageName]

@@ -10,7 +10,7 @@ spec = describe "loadCabalFilePath" $ do
   it "sanity" $ do
     abs' <- resolveDir' "."
-    (f, name, cabalfp) <- runPantryApp $ loadCabalFilePath abs'
+    (f, name, cabalfp) <- runPantryApp $ loadCabalFilePath Nothing abs'
     suffix <- parseRelFile "pantry.cabal"
     cabalfp `shouldBe` abs' </> suffix
     name' <- parsePackageNameThrowing "pantry"