{-# LANGUAGE NamedFieldPuns #-}
module Distribution.Nixpkgs.Haskell.PackageSourceSpec
( HpackUse(..), Package(..), getPackage, getPackage', loadHackageDB, sourceFromHackage
) where
import qualified Control.Exception as Exception
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe
import Data.Bifunctor
import qualified Data.ByteString.Char8 as BS
import Data.Foldable ( toList )
import Data.List ( isSuffixOf, isPrefixOf )
import qualified Data.Map as DB
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time
import Distribution.Nixpkgs.Fetch
import Distribution.Nixpkgs.Hashes
import qualified Distribution.Nixpkgs.Haskell.Hackage as DB
import Distribution.Nixpkgs.Haskell.OrphanInstances ( )
import qualified Distribution.Package as Cabal
import Distribution.PackageDescription
import qualified Distribution.PackageDescription as Cabal
import Distribution.PackageDescription.Parsec as Cabal
import Distribution.Parsec
import Distribution.Version
import qualified Hpack.Config as Hpack
import qualified Hpack.Render as Hpack
import OpenSSL.Digest ( digest, digestByName )
import System.Directory ( doesDirectoryExist, doesFileExist, createDirectoryIfMissing, getHomeDirectory, getDirectoryContents )
import System.Exit ( exitFailure )
import System.FilePath ( (</>), (<.>) )
import System.IO
import Text.PrettyPrint.HughesPJClass hiding ( first )
data HpackUse
= ForceHpack
| PackageYamlHpack
| NoHpack
data Package = Package
{ Package -> DerivationSource
pkgSource :: DerivationSource
, Package -> Bool
pkgRanHpack :: Bool
, Package -> GenericPackageDescription
pkgCabal :: Cabal.GenericPackageDescription
}
deriving (Int -> Package -> ShowS
[Package] -> ShowS
Package -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Package] -> ShowS
$cshowList :: [Package] -> ShowS
show :: Package -> String
$cshow :: Package -> String
showsPrec :: Int -> Package -> ShowS
$cshowsPrec :: Int -> Package -> ShowS
Show)
getPackage :: HpackUse
-> FetchSubmodules
-> Maybe FilePath
-> Maybe UTCTime
-> Source
-> IO Package
getPackage :: HpackUse
-> FetchSubmodules
-> Maybe String
-> Maybe UTCTime
-> Source
-> IO Package
getPackage HpackUse
optHpack FetchSubmodules
optSubmodules Maybe String
optHackageDB Maybe UTCTime
optHackageSnapshot =
HpackUse -> FetchSubmodules -> IO HackageDB -> Source -> IO Package
getPackage' HpackUse
optHpack FetchSubmodules
optSubmodules (Maybe String -> Maybe UTCTime -> IO HackageDB
loadHackageDB Maybe String
optHackageDB Maybe UTCTime
optHackageSnapshot)
getPackage' :: HpackUse
-> FetchSubmodules
-> IO DB.HackageDB
-> Source
-> IO Package
getPackage' :: HpackUse -> FetchSubmodules -> IO HackageDB -> Source -> IO Package
getPackage' HpackUse
optHpack FetchSubmodules
optSubmodules IO HackageDB
hackageDB Source
source = do
(Maybe DerivationSource
derivSource, Bool
pkgRanHpack, GenericPackageDescription
pkgCabal) <- HpackUse
-> FetchSubmodules
-> IO HackageDB
-> Source
-> IO (Maybe DerivationSource, Bool, GenericPackageDescription)
fetchOrFromDB HpackUse
optHpack FetchSubmodules
optSubmodules IO HackageDB
hackageDB Source
source
DerivationSource
pkgSource <-
case Maybe DerivationSource
derivSource of
Maybe DerivationSource
Nothing ->
Hash -> String -> String -> IO DerivationSource
sourceFromHackage
(Source -> Hash
sourceHash Source
source)
(GenericPackageDescription -> String
showPackageIdentifier GenericPackageDescription
pkgCabal)
(Source -> String
sourceCabalDir Source
source)
Just DerivationSource
derivSource' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DerivationSource
derivSource'
forall (f :: * -> *) a. Applicative f => a -> f a
pure Package {
DerivationSource
pkgSource :: DerivationSource
pkgSource :: DerivationSource
pkgSource,
Bool
pkgRanHpack :: Bool
pkgRanHpack :: Bool
pkgRanHpack,
GenericPackageDescription
pkgCabal :: GenericPackageDescription
pkgCabal :: GenericPackageDescription
pkgCabal
}
fetchOrFromDB :: HpackUse
-> FetchSubmodules
-> IO DB.HackageDB
-> Source
-> IO (Maybe DerivationSource, Bool, Cabal.GenericPackageDescription)
fetchOrFromDB :: HpackUse
-> FetchSubmodules
-> IO HackageDB
-> Source
-> IO (Maybe DerivationSource, Bool, GenericPackageDescription)
fetchOrFromDB HpackUse
optHpack FetchSubmodules
optSubmodules IO HackageDB
hackageDB Source
src
| String
"cabal://" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Source -> String
sourceUrl Source
src = do
(Maybe DerivationSource
msrc, GenericPackageDescription
pkgDesc) <- IO HackageDB
-> String -> IO (Maybe DerivationSource, GenericPackageDescription)
fromDB IO HackageDB
hackageDB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
"cabal://") forall a b. (a -> b) -> a -> b
$ Source -> String
sourceUrl Source
src
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DerivationSource
msrc, Bool
False, GenericPackageDescription
pkgDesc)
| Bool
otherwise = do
Maybe (DerivationSource, (Bool, Bool, GenericPackageDescription))
r <- forall a.
FetchSubmodules
-> (String -> MaybeT IO a)
-> Source
-> IO (Maybe (DerivationSource, a))
fetch FetchSubmodules
optSubmodules (\String
dir -> HpackUse
-> String -> MaybeT IO (Bool, Bool, GenericPackageDescription)
cabalFromPath HpackUse
optHpack (String
dir String -> ShowS
</> Source -> String
sourceCabalDir Source
src)) Source
src
case Maybe (DerivationSource, (Bool, Bool, GenericPackageDescription))
r of
Maybe (DerivationSource, (Bool, Bool, GenericPackageDescription))
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failed to fetch source. Does this source exist? " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Source
src
Just (DerivationSource
derivSource, (Bool
externalSource, Bool
ranHpack, GenericPackageDescription
pkgDesc)) ->
forall (m :: * -> *) a. Monad m => a -> m a
return (DerivationSource
derivSource forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
externalSource, Bool
ranHpack, GenericPackageDescription
pkgDesc)
loadHackageDB :: Maybe FilePath
-> Maybe UTCTime
-> IO DB.HackageDB
loadHackageDB :: Maybe String -> Maybe UTCTime -> IO HackageDB
loadHackageDB Maybe String
optHackageDB Maybe UTCTime
optHackageSnapshot = do
String
dbPath <- case Maybe String
optHackageDB of
Maybe String
Nothing -> IO String
DB.hackageTarball
Just String
hackageDb -> forall (m :: * -> *) a. Monad m => a -> m a
return String
hackageDb
Maybe UTCTime -> String -> IO HackageDB
DB.readTarball Maybe UTCTime
optHackageSnapshot String
dbPath
fromDB :: IO DB.HackageDB
-> String
-> IO (Maybe DerivationSource, Cabal.GenericPackageDescription)
fromDB :: IO HackageDB
-> String -> IO (Maybe DerivationSource, GenericPackageDescription)
fromDB IO HackageDB
hackageDBIO String
pkg = do
HackageDB
hackageDB <- IO HackageDB
hackageDBIO
VersionData
vd <- case forall k a. Ord k => k -> Map k a -> Maybe a
DB.lookup PackageName
name HackageDB
hackageDB forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Map Version VersionData -> Maybe VersionData
lookupVersion of
Maybe VersionData
Nothing -> forall {a}. IO a
unknownPackageError
Just VersionData
versionData -> forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionData
versionData
let ds :: Maybe DerivationSource
ds = case VersionData -> Maybe String
DB.tarballSha256 VersionData
vd of
Maybe String
Nothing -> forall a. Maybe a
Nothing
Just String
hash -> forall a. a -> Maybe a
Just (String -> String -> DerivationSource
urlDerivationSource String
url String
hash)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DerivationSource
ds, String -> GenericPackageDescription -> GenericPackageDescription
setCabalFileHash (VersionData -> String
DB.cabalFileSha256 VersionData
vd) (VersionData -> GenericPackageDescription
DB.cabalFile VersionData
vd))
where
pkgId :: Cabal.PackageIdentifier
pkgId :: PackageIdentifier
pkgId = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error (String
"invalid Haskell package id " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
pkg)) (forall a. Parsec a => String -> Maybe a
simpleParsec String
pkg)
name :: PackageName
name = forall pkg. Package pkg => pkg -> PackageName
Cabal.packageName PackageIdentifier
pkgId
unknownPackageError :: IO a
unknownPackageError = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"No such package " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow PackageIdentifier
pkgId forall a. [a] -> [a] -> [a]
++ String
" in the cabal database. Did you run cabal update?"
url :: String
url = String
"mirror://hackage/" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow PackageIdentifier
pkgId forall a. [a] -> [a] -> [a]
++ String
".tar.gz"
version :: Version
version :: Version
version = forall pkg. Package pkg => pkg -> Version
Cabal.packageVersion PackageIdentifier
pkgId
lookupVersion :: DB.Map Version DB.VersionData -> Maybe DB.VersionData
lookupVersion :: Map Version VersionData -> Maybe VersionData
lookupVersion Map Version VersionData
m | Version
version forall a. Eq a => a -> a -> Bool
== Version
nullVersion = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd (forall a. [a] -> Maybe a
listToMaybe (forall k a. Map k a -> [(k, a)]
DB.toDescList Map Version VersionData
m))
lookupVersion Map Version VersionData
m = forall k a. Ord k => k -> Map k a -> Maybe a
DB.lookup Version
version Map Version VersionData
m
readFileMay :: FilePath -> IO (Maybe String)
readFileMay :: String -> IO (Maybe String)
readFileMay String
file = do
Bool
e <- String -> IO Bool
doesFileExist String
file
if Bool
e
then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
file
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
hashCachePath :: String -> IO String
hashCachePath :: String -> IO String
hashCachePath String
pid = do
String
home <- IO String
getHomeDirectory
let cacheDir :: String
cacheDir = String
home String -> ShowS
</> String
".cache/cabal2nix"
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
cacheDir
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
cacheDir String -> ShowS
</> String
pid String -> ShowS
<.> String
"sha256"
sourceFromHackage :: Hash -> String -> FilePath -> IO DerivationSource
sourceFromHackage :: Hash -> String -> String -> IO DerivationSource
sourceFromHackage Hash
optHash String
pkgId String
cabalDir = do
String
cacheFile <- String -> IO String
hashCachePath String
pkgId
Hash
cachedHash <-
case Hash
optHash of
Certain String
h -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Hash
Certain forall a b. (a -> b) -> a -> b
$ String
h
Guess String
h -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Hash
Guess forall a b. (a -> b) -> a -> b
$ String
h
Hash
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Hash
UnknownHash String -> Hash
Certain) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe String)
readFileMay forall a b. (a -> b) -> a -> b
$ String
cacheFile
let url :: String
url = String
"mirror://hackage/" forall a. [a] -> [a] -> [a]
++ String
pkgId forall a. [a] -> [a] -> [a]
++ String
".tar.gz"
case Hash
cachedHash of
Guess String
hash -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> String -> DerivationSource
urlDerivationSource String
url String
hash
Certain String
hash ->
seq :: forall a b. a -> b -> b
seq (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
hash) forall a b. (a -> b) -> a -> b
$
String -> String -> DerivationSource
urlDerivationSource String
url String
hash forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> String -> IO ()
writeFile String
cacheFile String
hash
Hash
UnknownHash -> do
Maybe String
maybeHash <- forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
forall a b. (a -> b) -> a -> b
$ DerivationSource -> String
derivHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool, DerivKind) -> Source -> MaybeT IO (DerivationSource, String)
fetchWith
(Bool
False, UnpackArchive -> DerivKind
DerivKindUrl UnpackArchive
DontUnpackArchive)
(Source {
sourceUrl :: String
sourceUrl = String
url,
sourceRevision :: String
sourceRevision = String
"",
sourceHash :: Hash
sourceHash = Hash
UnknownHash,
sourceCabalDir :: String
sourceCabalDir = String
cabalDir
})
case Maybe String
maybeHash of
Just String
hash ->
seq :: forall a b. a -> b -> b
seq (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
hash) forall a b. (a -> b) -> a -> b
$
String -> String -> DerivationSource
urlDerivationSource String
url String
hash forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> String -> IO ()
writeFile String
cacheFile String
hash
Maybe String
Nothing -> do
Handle -> String -> IO ()
hPutStr Handle
stderr forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"*** cannot compute hash. (Not a hackage project?)"
, String
" If your project is not on hackage, please supply the path to the root directory of"
, String
" the project, not to the cabal file."
, String
""
, String
" If your project is on hackage but you still want to specify the hash manually, you"
, String
" can use the --sha256 option."
]
forall {a}. IO a
exitFailure
showPackageIdentifier :: Cabal.GenericPackageDescription -> String
showPackageIdentifier :: GenericPackageDescription -> String
showPackageIdentifier GenericPackageDescription
pkgDesc = String
name forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Version
version where
pkgId :: PackageIdentifier
pkgId = PackageDescription -> PackageIdentifier
Cabal.package forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> PackageDescription
Cabal.packageDescription forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
pkgDesc
name :: String
name = PackageName -> String
Cabal.unPackageName (forall pkg. Package pkg => pkg -> PackageName
Cabal.packageName PackageIdentifier
pkgId)
version :: Version
version = forall pkg. Package pkg => pkg -> Version
Cabal.packageVersion PackageIdentifier
pkgId
cabalFromPath :: HpackUse
-> FilePath -> MaybeT IO (Bool, Bool, Cabal.GenericPackageDescription)
cabalFromPath :: HpackUse
-> String -> MaybeT IO (Bool, Bool, GenericPackageDescription)
cabalFromPath HpackUse
optHpack String
path = do
Bool
d <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
path
if Bool
d
then do
(Bool
ranHpack, GenericPackageDescription
pkg) <- HpackUse -> String -> MaybeT IO (Bool, GenericPackageDescription)
cabalFromDirectory HpackUse
optHpack String
path
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
d, Bool
ranHpack, GenericPackageDescription
pkg)
else (,,) Bool
d Bool
False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> String -> MaybeT IO GenericPackageDescription
cabalFromFile Bool
False String
path
cabalFromDirectory :: HpackUse
-> FilePath -> MaybeT IO (Bool, Cabal.GenericPackageDescription)
cabalFromDirectory :: HpackUse -> String -> MaybeT IO (Bool, GenericPackageDescription)
cabalFromDirectory HpackUse
ForceHpack String
dir = String -> MaybeT IO (Bool, GenericPackageDescription)
hpackDirectory String
dir
cabalFromDirectory HpackUse
NoHpack String
dir = String -> String -> MaybeT IO (Bool, GenericPackageDescription)
onlyCabalFromDirectory String
dir String
"*** No .cabal file was found. Exiting."
cabalFromDirectory HpackUse
PackageYamlHpack String
dir = do
Bool
useHpack <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
shouldUseHpack String
dir
if Bool
useHpack
then do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"*** found package.yaml. Using hpack..."
String -> MaybeT IO (Bool, GenericPackageDescription)
hpackDirectory String
dir
else String -> String -> MaybeT IO (Bool, GenericPackageDescription)
onlyCabalFromDirectory String
dir String
"*** Found neither a .cabal file nor package.yaml. Exiting."
onlyCabalFromDirectory :: FilePath -> String -> MaybeT IO (Bool, Cabal.GenericPackageDescription)
onlyCabalFromDirectory :: String -> String -> MaybeT IO (Bool, GenericPackageDescription)
onlyCabalFromDirectory String
dir String
errMsg = do
[String]
cabals <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO [String]
findCabalFiles String
dir
case [String]
cabals of
[] -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errMsg
[String
cabalFile] -> (,) Bool
False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> String -> MaybeT IO GenericPackageDescription
cabalFromFile Bool
True String
cabalFile
[String]
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"*** found more than one cabal file (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
cabals forall a. [a] -> [a] -> [a]
++ String
"). Exiting.")
findCabalFiles :: FilePath -> IO [FilePath]
findCabalFiles :: String -> IO [String]
findCabalFiles String
dir = do
[String]
contents <- String -> IO [String]
getDirectoryContents String
dir
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String
dir String -> ShowS
</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (String
".cabal" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`) forall a b. (a -> b) -> a -> b
$ [String]
contents
shouldUseHpack :: FilePath -> IO Bool
shouldUseHpack :: String -> IO Bool
shouldUseHpack String
dir = do
Bool
hpackExists <- String -> IO Bool
doesFileExist (String
dir String -> ShowS
</> String
"package.yaml")
if Bool
hpackExists
then do
[String]
cabalFiles <- String -> IO [String]
findCabalFiles String
dir
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cabalFiles
else
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
handleIO :: (Exception.IOException -> IO a) -> IO a -> IO a
handleIO :: forall a. (IOException -> IO a) -> IO a -> IO a
handleIO = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Exception.handle
encodeUtf8 :: String -> BS.ByteString
encodeUtf8 :: String -> ByteString
encodeUtf8 = Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
hpackDirectory :: FilePath -> MaybeT IO (Bool, Cabal.GenericPackageDescription)
hpackDirectory :: String -> MaybeT IO (Bool, GenericPackageDescription)
hpackDirectory String
dir = do
Either String DecodeResult
mPackage <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DecodeOptions -> IO (Either String DecodeResult)
Hpack.readPackageConfig DecodeOptions
Hpack.defaultDecodeOptions {
decodeOptionsProgramName :: ProgramName
Hpack.decodeOptionsProgramName = String -> ProgramName
Hpack.ProgramName String
"cabal2nix"
, decodeOptionsTarget :: String
Hpack.decodeOptionsTarget = String
dir String -> ShowS
</> String
Hpack.packageConfig
}
case Either String DecodeResult
mPackage of
Left String
err -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"*** hpack error: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
err forall a. [a] -> [a] -> [a]
++ String
". Exiting.") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {a}. IO a
exitFailure
Right DecodeResult
r -> do
let hpackOutput :: ByteString
hpackOutput =
let body :: String
body = [String] -> Package -> String
Hpack.renderPackage [] (DecodeResult -> Package
Hpack.decodeResultPackage DecodeResult
r)
cabalVersion :: String
cabalVersion = DecodeResult -> String
Hpack.decodeResultCabalVersion DecodeResult
r
in String -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ String
cabalVersion forall a. [a] -> [a] -> [a]
++ String
body
hash :: String
hash = ByteString -> String
printSHA256 forall a b. (a -> b) -> a -> b
$ forall a. Digestable a => Algorithm -> a -> ByteString
digest (String -> Algorithm
digestByName String
"sha256") ByteString
hpackOutput
case String -> ByteString -> Either String GenericPackageDescription
runParseGenericPackageDescription String
"<hpack output>" ByteString
hpackOutput of
Left String
msg -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"*** hpack output:"
Handle -> ByteString -> IO ()
BS.hPutStrLn Handle
stderr ByteString
hpackOutput
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"*** cannot parse hpack output:"
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
msg
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"*** Exiting."
Right GenericPackageDescription
pkg -> forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (,) Bool
True forall a b. (a -> b) -> a -> b
$ String -> GenericPackageDescription -> GenericPackageDescription
setCabalFileHash String
hash GenericPackageDescription
pkg
cabalFromFile :: Bool -> FilePath -> MaybeT IO Cabal.GenericPackageDescription
cabalFromFile :: Bool -> String -> MaybeT IO GenericPackageDescription
cabalFromFile Bool
failHard String
file =
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall a. (IOException -> IO a) -> IO a -> IO a
handleIO (\IOException
err -> forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"*** parsing cabal file: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IOException
err)) forall a b. (a -> b) -> a -> b
$ do
ByteString
buf <- String -> IO ByteString
BS.readFile String
file
let hash :: String
hash = ByteString -> String
printSHA256 (forall a. Digestable a => Algorithm -> a -> ByteString
digest (String -> Algorithm
digestByName String
"sha256") ByteString
buf)
case String -> ByteString -> Either String GenericPackageDescription
runParseGenericPackageDescription String
file ByteString
buf of
Left String
msg | Bool
failHard -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"*** cannot parse " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
file forall a. [a] -> [a] -> [a]
++ String
":"
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
msg
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"*** Exiting."
Left String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Right GenericPackageDescription
pkg -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> GenericPackageDescription -> GenericPackageDescription
setCabalFileHash String
hash GenericPackageDescription
pkg
runParseGenericPackageDescription
:: FilePath
-> BS.ByteString
-> Either String Cabal.GenericPackageDescription
runParseGenericPackageDescription :: String -> ByteString -> Either String GenericPackageDescription
runParseGenericPackageDescription String
fpath
= forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String -> PError -> String
showPError String
fpath) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
runParseResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription
setCabalFileHash :: String -> GenericPackageDescription -> GenericPackageDescription
setCabalFileHash :: String -> GenericPackageDescription -> GenericPackageDescription
setCabalFileHash String
sha256 GenericPackageDescription
gpd = GenericPackageDescription
gpd { packageDescription :: PackageDescription
packageDescription = (GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
gpd) {
customFieldsPD :: [(String, String)]
customFieldsPD = (String
"X-Cabal-File-Hash", String
sha256) forall a. a -> [a] -> [a]
: PackageDescription -> [(String, String)]
customFieldsPD (GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
gpd)
}
}