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
(Int -> Package -> ShowS)
-> (Package -> String) -> ([Package] -> ShowS) -> Show Package
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
-> Bool
-> Maybe FilePath
-> Maybe UTCTime
-> Source
-> IO Package
getPackage :: HpackUse
-> Bool -> Maybe String -> Maybe UTCTime -> Source -> IO Package
getPackage HpackUse
optHpack Bool
optSubmodules Maybe String
optHackageDB Maybe UTCTime
optHackageSnapshot =
HpackUse -> Bool -> IO HackageDB -> Source -> IO Package
getPackage' HpackUse
optHpack Bool
optSubmodules (Maybe String -> Maybe UTCTime -> IO HackageDB
loadHackageDB Maybe String
optHackageDB Maybe UTCTime
optHackageSnapshot)
getPackage' :: HpackUse
-> Bool
-> IO DB.HackageDB
-> Source
-> IO Package
getPackage' :: HpackUse -> Bool -> IO HackageDB -> Source -> IO Package
getPackage' HpackUse
optHpack Bool
optSubmodules IO HackageDB
hackageDB Source
source = do
(Maybe DerivationSource
derivSource, Bool
ranHpack, GenericPackageDescription
pkgDesc) <- HpackUse
-> Bool
-> IO HackageDB
-> Source
-> IO (Maybe DerivationSource, Bool, GenericPackageDescription)
fetchOrFromDB HpackUse
optHpack Bool
optSubmodules IO HackageDB
hackageDB Source
source
(\DerivationSource
s -> DerivationSource -> Bool -> GenericPackageDescription -> Package
Package DerivationSource
s Bool
ranHpack GenericPackageDescription
pkgDesc) (DerivationSource -> Package) -> IO DerivationSource -> IO Package
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO DerivationSource
-> (DerivationSource -> IO DerivationSource)
-> Maybe DerivationSource
-> IO DerivationSource
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Hash -> String -> String -> IO DerivationSource
sourceFromHackage (Source -> Hash
sourceHash Source
source) (GenericPackageDescription -> String
showPackageIdentifier GenericPackageDescription
pkgDesc) (String -> IO DerivationSource) -> String -> IO DerivationSource
forall a b. (a -> b) -> a -> b
$ Source -> String
sourceCabalDir Source
source) DerivationSource -> IO DerivationSource
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DerivationSource
derivSource
fetchOrFromDB :: HpackUse
-> Bool
-> IO DB.HackageDB
-> Source
-> IO (Maybe DerivationSource, Bool, Cabal.GenericPackageDescription)
fetchOrFromDB :: HpackUse
-> Bool
-> IO HackageDB
-> Source
-> IO (Maybe DerivationSource, Bool, GenericPackageDescription)
fetchOrFromDB HpackUse
optHpack Bool
optSubmodules IO HackageDB
hackageDB Source
src
| String
"cabal://" String -> String -> Bool
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 (String -> IO (Maybe DerivationSource, GenericPackageDescription))
-> ShowS
-> String
-> IO (Maybe DerivationSource, GenericPackageDescription)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
"cabal://") (String -> IO (Maybe DerivationSource, GenericPackageDescription))
-> String -> IO (Maybe DerivationSource, GenericPackageDescription)
forall a b. (a -> b) -> a -> b
$ Source -> String
sourceUrl Source
src
(Maybe DerivationSource, Bool, GenericPackageDescription)
-> IO (Maybe DerivationSource, Bool, GenericPackageDescription)
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 <- Bool
-> (String -> MaybeT IO (Bool, Bool, GenericPackageDescription))
-> Source
-> IO
(Maybe (DerivationSource, (Bool, Bool, GenericPackageDescription)))
forall a.
Bool
-> (String -> MaybeT IO a)
-> Source
-> IO (Maybe (DerivationSource, a))
fetch Bool
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 -> String
-> IO (Maybe DerivationSource, Bool, GenericPackageDescription)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
-> IO (Maybe DerivationSource, Bool, GenericPackageDescription))
-> String
-> IO (Maybe DerivationSource, Bool, GenericPackageDescription)
forall a b. (a -> b) -> a -> b
$ String
"Failed to fetch source. Does this source exist? " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Source -> String
forall a. Show a => a -> String
show Source
src
Just (DerivationSource
derivSource, (Bool
externalSource, Bool
ranHpack, GenericPackageDescription
pkgDesc)) ->
(Maybe DerivationSource, Bool, GenericPackageDescription)
-> IO (Maybe DerivationSource, Bool, GenericPackageDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return (DerivationSource
derivSource DerivationSource -> Maybe () -> Maybe DerivationSource
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
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 <- IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO String
DB.hackageTarball String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
optHackageDB
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 <- IO VersionData
-> (VersionData -> IO VersionData)
-> Maybe VersionData
-> IO VersionData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO VersionData
forall a. IO a
unknownPackageError VersionData -> IO VersionData
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName -> HackageDB -> Maybe PackageData
forall k a. Ord k => k -> Map k a -> Maybe a
DB.lookup PackageName
name HackageDB
hackageDB Maybe PackageData
-> (PackageData -> Maybe VersionData) -> Maybe VersionData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PackageData -> Maybe VersionData
lookupVersion)
let ds :: Maybe DerivationSource
ds = case VersionData -> Maybe String
DB.tarballSha256 VersionData
vd of
Maybe String
Nothing -> Maybe DerivationSource
forall a. Maybe a
Nothing
Just String
hash -> DerivationSource -> Maybe DerivationSource
forall a. a -> Maybe a
Just (String -> String -> DerivationSource
urlDerivationSource String
url String
hash)
(Maybe DerivationSource, GenericPackageDescription)
-> IO (Maybe DerivationSource, GenericPackageDescription)
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 = PackageIdentifier -> Maybe PackageIdentifier -> PackageIdentifier
forall a. a -> Maybe a -> a
fromMaybe (String -> PackageIdentifier
forall a. HasCallStack => String -> a
error (String
"invalid Haskell package id " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
pkg)) (String -> Maybe PackageIdentifier
forall a. Parsec a => String -> Maybe a
simpleParsec String
pkg)
name :: PackageName
name = PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
Cabal.packageName PackageIdentifier
pkgId
unknownPackageError :: IO a
unknownPackageError = String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String
"No such package " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageIdentifier -> String
forall a. Pretty a => a -> String
prettyShow PackageIdentifier
pkgId String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in the cabal database. Did you run cabal update?"
url :: String
url = String
"mirror://hackage/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageIdentifier -> String
forall a. Pretty a => a -> String
prettyShow PackageIdentifier
pkgId String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".tar.gz"
version :: Version
version :: Version
version = PackageIdentifier -> Version
forall pkg. Package pkg => pkg -> Version
Cabal.packageVersion PackageIdentifier
pkgId
lookupVersion :: DB.Map Version DB.VersionData -> Maybe DB.VersionData
lookupVersion :: PackageData -> Maybe VersionData
lookupVersion PackageData
m | Version
version Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
nullVersion = ((Version, VersionData) -> VersionData)
-> Maybe (Version, VersionData) -> Maybe VersionData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Version, VersionData) -> VersionData
forall a b. (a, b) -> b
snd ([(Version, VersionData)] -> Maybe (Version, VersionData)
forall a. [a] -> Maybe a
listToMaybe (PackageData -> [(Version, VersionData)]
forall k a. Map k a -> [(k, a)]
DB.toDescList PackageData
m))
lookupVersion PackageData
m = Version -> PackageData -> Maybe VersionData
forall k a. Ord k => k -> Map k a -> Maybe a
DB.lookup Version
version PackageData
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 String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
file
else Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
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
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
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 -> Hash -> IO Hash
forall (m :: * -> *) a. Monad m => a -> m a
return (Hash -> IO Hash) -> (String -> Hash) -> String -> IO Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Hash
Certain (String -> IO Hash) -> String -> IO Hash
forall a b. (a -> b) -> a -> b
$ String
h
Guess String
h -> Hash -> IO Hash
forall (m :: * -> *) a. Monad m => a -> m a
return (Hash -> IO Hash) -> (String -> Hash) -> String -> IO Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Hash
Guess (String -> IO Hash) -> String -> IO Hash
forall a b. (a -> b) -> a -> b
$ String
h
Hash
_ -> (Maybe String -> Hash) -> IO (Maybe String) -> IO Hash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Hash -> (String -> Hash) -> Maybe String -> Hash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Hash
UnknownHash String -> Hash
Certain) (IO (Maybe String) -> IO Hash)
-> (String -> IO (Maybe String)) -> String -> IO Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe String)
readFileMay (String -> IO Hash) -> String -> IO Hash
forall a b. (a -> b) -> a -> b
$ String
cacheFile
let url :: String
url = String
"mirror://hackage/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pkgId String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".tar.gz"
case Hash
cachedHash of
Guess String
hash -> DerivationSource -> IO DerivationSource
forall (m :: * -> *) a. Monad m => a -> m a
return (DerivationSource -> IO DerivationSource)
-> DerivationSource -> IO DerivationSource
forall a b. (a -> b) -> a -> b
$ String -> String -> DerivationSource
urlDerivationSource String
url String
hash
Certain String
hash ->
Int -> IO DerivationSource -> IO DerivationSource
seq (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
hash) (IO DerivationSource -> IO DerivationSource)
-> IO DerivationSource -> IO DerivationSource
forall a b. (a -> b) -> a -> b
$
String -> String -> DerivationSource
urlDerivationSource String
url String
hash DerivationSource -> IO () -> IO DerivationSource
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 <- MaybeT IO String -> IO (Maybe String)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (DerivationSource -> String
derivHash (DerivationSource -> String)
-> ((DerivationSource, String) -> DerivationSource)
-> (DerivationSource, String)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DerivationSource, String) -> DerivationSource
forall a b. (a, b) -> a
fst ((DerivationSource, String) -> String)
-> MaybeT IO (DerivationSource, String) -> MaybeT IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool, String, [String])
-> Source -> MaybeT IO (DerivationSource, String)
fetchWith (Bool
False, String
"url", []) (String -> String -> Hash -> String -> Source
Source String
url String
"" Hash
UnknownHash String
cabalDir))
case Maybe String
maybeHash of
Just String
hash ->
Int -> IO DerivationSource -> IO DerivationSource
seq (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
hash) (IO DerivationSource -> IO DerivationSource)
-> IO DerivationSource -> IO DerivationSource
forall a b. (a -> b) -> a -> b
$
String -> String -> DerivationSource
urlDerivationSource String
url String
hash DerivationSource -> IO () -> IO DerivationSource
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 (String -> IO ()) -> String -> IO ()
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."
]
IO DerivationSource
forall a. IO a
exitFailure
showPackageIdentifier :: Cabal.GenericPackageDescription -> String
showPackageIdentifier :: GenericPackageDescription -> String
showPackageIdentifier GenericPackageDescription
pkgDesc = String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Pretty a => a -> String
prettyShow Version
version where
pkgId :: PackageIdentifier
pkgId = PackageDescription -> PackageIdentifier
Cabal.package (PackageDescription -> PackageIdentifier)
-> (GenericPackageDescription -> PackageDescription)
-> GenericPackageDescription
-> PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> PackageDescription
Cabal.packageDescription (GenericPackageDescription -> PackageIdentifier)
-> GenericPackageDescription -> PackageIdentifier
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
pkgDesc
name :: String
name = PackageName -> String
Cabal.unPackageName (PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
Cabal.packageName PackageIdentifier
pkgId)
version :: Version
version = PackageIdentifier -> 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 <- IO Bool -> MaybeT IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> MaybeT IO Bool) -> IO Bool -> MaybeT IO Bool
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
(Bool, Bool, GenericPackageDescription)
-> MaybeT IO (Bool, Bool, GenericPackageDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
d, Bool
ranHpack, GenericPackageDescription
pkg)
else (,,) Bool
d Bool
False (GenericPackageDescription
-> (Bool, Bool, GenericPackageDescription))
-> MaybeT IO GenericPackageDescription
-> MaybeT IO (Bool, Bool, GenericPackageDescription)
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 <- IO Bool -> MaybeT IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> MaybeT IO Bool) -> IO Bool -> MaybeT IO Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist (String
dir String -> ShowS
</> String
"package.yaml")
if Bool
useHpack
then do
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
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 <- IO [String] -> MaybeT IO [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> MaybeT IO [String])
-> IO [String] -> MaybeT IO [String]
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents String
dir IO [String] -> ([String] -> IO [String]) -> IO [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist ([String] -> IO [String])
-> ([String] -> [String]) -> [String] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
dir String -> ShowS
</>) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
".cabal" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`)
case [String]
cabals of
[] -> String -> MaybeT IO (Bool, GenericPackageDescription)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errMsg
[String
cabalFile] -> (,) Bool
False (GenericPackageDescription -> (Bool, GenericPackageDescription))
-> MaybeT IO GenericPackageDescription
-> MaybeT IO (Bool, GenericPackageDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> String -> MaybeT IO GenericPackageDescription
cabalFromFile Bool
True String
cabalFile
[String]
_ -> IO (Bool, GenericPackageDescription)
-> MaybeT IO (Bool, GenericPackageDescription)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, GenericPackageDescription)
-> MaybeT IO (Bool, GenericPackageDescription))
-> IO (Bool, GenericPackageDescription)
-> MaybeT IO (Bool, GenericPackageDescription)
forall a b. (a -> b) -> a -> b
$ String -> IO (Bool, GenericPackageDescription)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"*** found more than one cabal file (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
cabals String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"). Exiting.")
handleIO :: (Exception.IOException -> IO a) -> IO a -> IO a
handleIO :: (IOException -> IO a) -> IO a -> IO a
handleIO = (IOException -> IO a) -> IO a -> IO a
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 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
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 <- IO (Either String DecodeResult)
-> MaybeT IO (Either String DecodeResult)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String DecodeResult)
-> MaybeT IO (Either String DecodeResult))
-> IO (Either String DecodeResult)
-> MaybeT IO (Either String DecodeResult)
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 -> IO (Bool, GenericPackageDescription)
-> MaybeT IO (Bool, GenericPackageDescription)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, GenericPackageDescription)
-> MaybeT IO (Bool, GenericPackageDescription))
-> IO (Bool, GenericPackageDescription)
-> MaybeT IO (Bool, GenericPackageDescription)
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"*** hpack error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Exiting.") IO ()
-> IO (Bool, GenericPackageDescription)
-> IO (Bool, GenericPackageDescription)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Bool, GenericPackageDescription)
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 (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
cabalVersion String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
body
hash :: String
hash = ByteString -> String
printSHA256 (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Algorithm -> ByteString -> ByteString
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 -> IO (Bool, GenericPackageDescription)
-> MaybeT IO (Bool, GenericPackageDescription)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, GenericPackageDescription)
-> MaybeT IO (Bool, GenericPackageDescription))
-> IO (Bool, GenericPackageDescription)
-> MaybeT IO (Bool, GenericPackageDescription)
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
String -> IO (Bool, GenericPackageDescription)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"*** Exiting."
Right GenericPackageDescription
pkg -> IO (Maybe (Bool, GenericPackageDescription))
-> MaybeT IO (Bool, GenericPackageDescription)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (Bool, GenericPackageDescription))
-> MaybeT IO (Bool, GenericPackageDescription))
-> IO (Maybe (Bool, GenericPackageDescription))
-> MaybeT IO (Bool, GenericPackageDescription)
forall a b. (a -> b) -> a -> b
$ Maybe (Bool, GenericPackageDescription)
-> IO (Maybe (Bool, GenericPackageDescription))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Bool, GenericPackageDescription)
-> IO (Maybe (Bool, GenericPackageDescription)))
-> Maybe (Bool, GenericPackageDescription)
-> IO (Maybe (Bool, GenericPackageDescription))
forall a b. (a -> b) -> a -> b
$ (Bool, GenericPackageDescription)
-> Maybe (Bool, GenericPackageDescription)
forall a. a -> Maybe a
Just ((Bool, GenericPackageDescription)
-> Maybe (Bool, GenericPackageDescription))
-> (Bool, GenericPackageDescription)
-> Maybe (Bool, GenericPackageDescription)
forall a b. (a -> b) -> a -> b
$ (,) Bool
True (GenericPackageDescription -> (Bool, GenericPackageDescription))
-> GenericPackageDescription -> (Bool, GenericPackageDescription)
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 =
IO (Maybe GenericPackageDescription)
-> MaybeT IO GenericPackageDescription
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe GenericPackageDescription)
-> MaybeT IO GenericPackageDescription)
-> IO (Maybe GenericPackageDescription)
-> MaybeT IO GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ (IOException -> IO (Maybe GenericPackageDescription))
-> IO (Maybe GenericPackageDescription)
-> IO (Maybe GenericPackageDescription)
forall a. (IOException -> IO a) -> IO a -> IO a
handleIO (\IOException
err -> Maybe GenericPackageDescription
forall a. Maybe a
Nothing Maybe GenericPackageDescription
-> IO () -> IO (Maybe GenericPackageDescription)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"*** parsing cabal file: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IOException -> String
forall a. Show a => a -> String
show IOException
err)) (IO (Maybe GenericPackageDescription)
-> IO (Maybe GenericPackageDescription))
-> IO (Maybe GenericPackageDescription)
-> IO (Maybe GenericPackageDescription)
forall a b. (a -> b) -> a -> b
$ do
ByteString
buf <- String -> IO ByteString
BS.readFile String
file
let hash :: String
hash = ByteString -> String
printSHA256 (Algorithm -> ByteString -> ByteString
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 -> IO (Maybe GenericPackageDescription)
-> IO (Maybe GenericPackageDescription)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GenericPackageDescription)
-> IO (Maybe GenericPackageDescription))
-> IO (Maybe GenericPackageDescription)
-> IO (Maybe GenericPackageDescription)
forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"*** cannot parse " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":"
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
msg
String -> IO (Maybe GenericPackageDescription)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"*** Exiting."
Left String
_ -> Maybe GenericPackageDescription
-> IO (Maybe GenericPackageDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GenericPackageDescription
forall a. Maybe a
Nothing
Right GenericPackageDescription
pkg -> Maybe GenericPackageDescription
-> IO (Maybe GenericPackageDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GenericPackageDescription
-> IO (Maybe GenericPackageDescription))
-> Maybe GenericPackageDescription
-> IO (Maybe GenericPackageDescription)
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> Maybe GenericPackageDescription
forall a. a -> Maybe a
Just (GenericPackageDescription -> Maybe GenericPackageDescription)
-> GenericPackageDescription -> Maybe GenericPackageDescription
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
= ((Maybe Version, NonEmpty PError) -> String)
-> Either
(Maybe Version, NonEmpty PError) GenericPackageDescription
-> Either String GenericPackageDescription
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([String] -> String
unlines ([String] -> String)
-> ((Maybe Version, NonEmpty PError) -> [String])
-> (Maybe Version, NonEmpty PError)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PError -> String) -> [PError] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> PError -> String
showPError String
fpath) ([PError] -> [String])
-> ((Maybe Version, NonEmpty PError) -> [PError])
-> (Maybe Version, NonEmpty PError)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty PError -> [PError]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty PError -> [PError])
-> ((Maybe Version, NonEmpty PError) -> NonEmpty PError)
-> (Maybe Version, NonEmpty PError)
-> [PError]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Version, NonEmpty PError) -> NonEmpty PError
forall a b. (a, b) -> b
snd)
(Either (Maybe Version, NonEmpty PError) GenericPackageDescription
-> Either String GenericPackageDescription)
-> (ByteString
-> Either
(Maybe Version, NonEmpty PError) GenericPackageDescription)
-> ByteString
-> Either String GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
-> Either
(Maybe Version, NonEmpty PError) GenericPackageDescription
forall a b. (a, b) -> b
snd (([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
-> Either
(Maybe Version, NonEmpty PError) GenericPackageDescription)
-> (ByteString
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription))
-> ByteString
-> Either
(Maybe Version, NonEmpty PError) GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseResult GenericPackageDescription
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
runParseResult
(ParseResult GenericPackageDescription
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription))
-> (ByteString -> ParseResult GenericPackageDescription)
-> ByteString
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
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) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: PackageDescription -> [(String, String)]
customFieldsPD (GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
gpd)
}
}