Skip to content

GitLab

Commit 40a921a4 authored by bjorn@bringert.net's avatar bjorn@bringert.net
Browse files

Get rid of OutputGen.

parent e2601c7c
Hide whitespace changes
Inline Side-by-side
cabal-install/src/Network/Hackage/CabalInstall/Config.hs
View file @ 40a921a4
......@@ -16,7 +16,7 @@ module Network.Hackage.CabalInstall.Config
, packageFile
, packageDir
, getKnownPackages
, message
, pkgURL
, defaultConfigFile
, loadConfig
......@@ -26,6 +26,7 @@ module Network.Hackage.CabalInstall.Config
import Prelude hiding (catch)
import Control.Exception (catch, Exception(IOException),evaluate)
import Control.Monad (when)
import Control.Monad.Error (mplus, filterM) -- Using Control.Monad.Error to get the Error instance for IO.
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.ByteString.Lazy.Char8 (ByteString)
......@@ -56,34 +57,10 @@ import System.FilePath ((</>), takeExtension, (<.>))
import System.Directory
import Network.Hackage.CabalInstall.Tar (readTarArchive, tarFileName)
import Network.Hackage.CabalInstall.Types (ConfigFlags (..), OutputGen(..), PkgInfo (..), Repo(..))
import Network.Hackage.CabalInstall.Types (ConfigFlags (..), PkgInfo (..), Repo(..))
import Network.Hackage.CabalInstall.Utils
-- FIXME: remove imports below, only for defaultOutputGen
import Control.Monad (guard, mplus, when)
import Network.Hackage.CabalInstall.Types (ConfigFlags (..), OutputGen (..)
, ResolvedPackage (..))
import qualified Distribution.Simple.Configure as Configure (configCompiler)
import Distribution.Simple.Program
import Distribution.ParseUtils (showDependency)
import Distribution.Package (showPackageId)
import Distribution.Version (VersionRange(..))
import Distribution.Verbosity
import System.FilePath ((</>))
import Text.Printf (printf)
import System.IO (openFile, IOMode (..))
import System.Directory (doesFileExist, getHomeDirectory, getAppUserDataDirectory)
import Data.Maybe (fromMaybe)
-- |Name of the packages directory.
packagesDirectoryName :: FilePath
packagesDirectoryName = "packages"
......@@ -139,57 +116,8 @@ parseRepoIndex repo s =
_ -> error $ "Couldn't read cabal file " ++ show (tarFileName hdr)
else fail "Not a .cabal file"
{-|
Structure with default responses to various events.
-}
defaultOutputGen :: Verbosity -> IO OutputGen
defaultOutputGen verbosity
= do (outch,errch) <- do guard (verbosity <= normal)
nullOut <- openFile ("/"</>"dev"</>"null") AppendMode
nullErr <- openFile ("/"</>"dev"</>"null") AppendMode
return (Just nullOut, Just nullErr)
`mplus` return (Nothing,Nothing)
return OutputGen
{ prepareInstall = \_pkgs -> return ()
, pkgIsPresent = printf "'%s' is present.\n" . showPackageId
, downloadingPkg = printf "Downloading '%s'...\n" . showPackageId
, executingCmd = \cmd args
-> when (verbosity > silent) $ printf "Executing: '%s %s'\n" cmd (unwords args)
, cmdFailed = \cmd args errno
-> error (printf "Command failed: '%s %s'. Errno: %d\n" cmd (unwords args) errno)
, buildingPkg = printf "Building '%s'\n" . showPackageId
, stepConfigPkg = const (printf " Configuring...\n")
, stepBuildPkg = const (printf " Building...\n")
, stepInstallPkg = const (printf " Installing...\n")
, stepFinishedPkg= const (printf " Done.\n")
, noSetupScript = const (error "Couldn't find a setup script in the tarball.")
, noCabalFile = const (error "Couldn't find a .cabal file in the tarball")
, gettingPkgList = \serv ->
when (verbosity > silent) (printf "Downloading package list from server '%s'\n" serv)
, showPackageInfo = showPkgInfo
, showOtherPackageInfo = showOtherPkg
, cmdStdout = outch
, cmdStderr = errch
, message = \v s -> when (verbosity >= v) (putStrLn s)
}
where showOtherPkg mbPkg dep
= do printf " Package: '%s'\n" (show $ showDependency dep)
case mbPkg of
Nothing -> printf " Not available!\n\n"
Just pkg -> do printf " Using: %s\n" (showPackageId pkg)
printf " Installed: Yes\n\n"
showPkgInfo mbPath installed ops dep (pkg,repo,deps)
= do printf " Package: '%s'\n" (show $ showDependency dep)
printf " Using: %s\n" (showPackageId pkg)
printf " Installed: %s\n" (if installed then "Yes" else "No")
printf " Depends: %s\n" (showDeps deps)
printf " Options: %s\n" (unwords ops)
printf " Location: %s\n" (pkgURL pkg repo)
printf " Local: %s\n\n" (fromMaybe "*Not downloaded" mbPath)
showDeps = show . map showDep
showDep dep = show (showDependency (fulfilling dep))
message :: ConfigFlags -> Verbosity -> String -> IO ()
message cfg v s = when (configVerbose cfg >= v) (putStrLn s)
-- | Generate the URL of the tarball for a given package.
pkgURL :: PackageIdentifier -> Repo -> String
......@@ -234,13 +162,11 @@ defaultConfigFlags :: IO ConfigFlags
defaultConfigFlags =
do installDirs <- defaultInstallDirs defaultCompiler True
cacheDir <- defaultCacheDir
outputGen <- defaultOutputGen normal -- FIXME: get rid of OutputGen
return $ ConfigFlags
{ configCompiler = defaultCompiler
, configInstallDirs = installDirs
, configCacheDir = cacheDir
, configRepos = [Repo "hackage.haskell.org" "http://hackage.haskell.org/packages/archive"]
, configOutputGen = outputGen
, configVerbose = normal
, configUserInstall = True
}
......
cabal-install/src/Network/Hackage/CabalInstall/Fetch.hs
View file @ 40a921a4
......@@ -34,8 +34,8 @@ import Data.Version
import Text.Printf (printf)
import System.Directory (doesFileExist, createDirectoryIfMissing)
import Network.Hackage.CabalInstall.Types (ConfigFlags (..), OutputGen (..), UnresolvedDependency (..), Repo(..))
import Network.Hackage.CabalInstall.Config (packagesDirectory, repoCacheDir, packageFile, packageDir, pkgURL)
import Network.Hackage.CabalInstall.Types (ConfigFlags (..), UnresolvedDependency (..), Repo(..))
import Network.Hackage.CabalInstall.Config (packagesDirectory, repoCacheDir, packageFile, packageDir, pkgURL, message)
import Network.Hackage.CabalInstall.Dependency (filterFetchables, resolveDependencies)
import Distribution.Package (PackageIdentifier(..), showPackageId)
......@@ -92,7 +92,7 @@ downloadPackage cfg pkg repo
= do let url = pkgURL pkg repo
dir = packageDir cfg pkg repo
path = packageFile cfg pkg repo
message (configOutputGen cfg) verbose $ "GET " ++ show url
message cfg verbose $ "GET " ++ show url
createDirectoryIfMissing True dir
mbError <- downloadFile path url
case mbError of
......@@ -121,9 +121,9 @@ fetchPackage :: ConfigFlags -> PackageIdentifier -> Repo -> IO String
fetchPackage cfg pkg repo
= do fetched <- isFetched cfg pkg repo
if fetched
then do pkgIsPresent (configOutputGen cfg) pkg
then do printf "'%s' is present.\n" (showPackageId pkg)
return (packageFile cfg pkg repo)
else do downloadingPkg (configOutputGen cfg) pkg
else do printf "Downloading '%s'...\n" (showPackageId pkg)
downloadPackage cfg pkg repo
-- |Fetch a list of packages and their dependencies.
......@@ -141,9 +141,8 @@ fetch cfg pkgs
, depOptions = [] }
isNotFetched (pkg,repo)
= do fetched <- isFetched cfg pkg repo
pkgIsPresent output pkg
printf "'%s' is present.\n" (showPackageId pkg)
return (not fetched)
output = configOutputGen cfg
withBinaryFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile name mode = bracket (openBinaryFile name mode) hClose
cabal-install/src/Network/Hackage/CabalInstall/Info.hs
View file @ 40a921a4
......@@ -12,15 +12,18 @@
-----------------------------------------------------------------------------
module Network.Hackage.CabalInstall.Info where
import Network.Hackage.CabalInstall.Config (pkgURL)
import Network.Hackage.CabalInstall.Dependency
(resolveDependencies, fulfillDependency, listInstalledPackages)
import Network.Hackage.CabalInstall.Fetch (isFetched, packageFile)
import Network.Hackage.CabalInstall.Types (ConfigFlags(..), ResolvedPackage(..)
,UnresolvedDependency(..), OutputGen(..))
,UnresolvedDependency(..))
import Distribution.Package (PackageIdentifier)
import Distribution.Package (PackageIdentifier, showPackageId)
import Distribution.ParseUtils (showDependency)
import Data.Maybe (listToMaybe)
import Data.Maybe (listToMaybe, fromMaybe)
import Text.Printf (printf)
info :: ConfigFlags -> [String] -> [UnresolvedDependency] -> IO ()
info cfg globalArgs deps
......@@ -36,14 +39,31 @@ info cfg globalArgs deps
infoPkg :: ConfigFlags -> [PackageIdentifier] -> [String] -> ResolvedPackage -> IO ()
infoPkg cfg ipkgs _ (ResolvedPackage { fulfilling = dep
, resolvedData = Nothing })
= showOtherPackageInfo output installedPkg dep
= showOtherPkg installedPkg dep
where installedPkg = listToMaybe (filter (fulfillDependency dep) ipkgs)
output = configOutputGen cfg
infoPkg cfg ipkgs globalArgs (ResolvedPackage { fulfilling = dep
, pkgOptions = ops
, resolvedData = (Just (pkg,repo,deps)) })
= do fetched <- isFetched cfg pkg repo
let pkgFile = if fetched then Just (packageFile cfg pkg repo) else Nothing
showPackageInfo output pkgFile isInstalled (globalArgs ++ ops) dep (pkg,repo,deps)
where output = configOutputGen cfg
isInstalled = pkg `elem` ipkgs
showPkgInfo pkgFile isInstalled (globalArgs ++ ops) dep (pkg,repo,deps)
where isInstalled = pkg `elem` ipkgs
showPkgInfo mbPath installed ops dep (pkg,repo,deps)
= do printf " Package: '%s'\n" (show $ showDependency dep)
printf " Using: %s\n" (showPackageId pkg)
printf " Installed: %s\n" (if installed then "Yes" else "No")
printf " Depends: %s\n" (showDeps deps)
printf " Options: %s\n" (unwords ops)
printf " Location: %s\n" (pkgURL pkg repo)
printf " Local: %s\n\n" (fromMaybe "*Not downloaded" mbPath)
where
showDeps = show . map showDep
showDep dep = show (showDependency (fulfilling dep))
showOtherPkg mbPkg dep
= do printf " Package: '%s'\n" (show $ showDependency dep)
case mbPkg of
Nothing -> printf " Not available!\n\n"
Just pkg -> do printf " Using: %s\n" (showPackageId pkg)
printf " Installed: Yes\n\n"
cabal-install/src/Network/Hackage/CabalInstall/Install.hs
View file @ 40a921a4
......@@ -21,13 +21,13 @@ import Data.Maybe (fromJust)
import Debug.Trace
import Control.Exception (bracket_)
import Network.Hackage.CabalInstall.Config (programConfiguration, findCompiler)
import Network.Hackage.CabalInstall.Config (programConfiguration, findCompiler, message)
import Network.Hackage.CabalInstall.Dependency (getPackages, resolveDependencies
, listInstalledPackages)
import Network.Hackage.CabalInstall.Fetch (isFetched, packageFile, fetchPackage)
import Network.Hackage.CabalInstall.Tar (extractTarGzFile)
import Network.Hackage.CabalInstall.Types (ConfigFlags(..), UnresolvedDependency(..)
,OutputGen(..), Repo(..))
, Repo(..))
import Distribution.Simple.Compiler (Compiler(..))
import Distribution.Simple.InstallDirs (InstallDirs(..), absoluteInstallDirs)
......@@ -62,7 +62,7 @@ downloadPkg :: ConfigFlags -> PackageIdentifier -> Repo -> IO FilePath
downloadPkg cfg pkg repo
= do fetched <- isFetched cfg pkg repo
if fetched
then do pkgIsPresent (configOutputGen cfg) pkg
then do printf "'%s' is present.\n" (showPackageId pkg)
return (packageFile cfg pkg repo)
else fetchPackage cfg pkg repo
......@@ -132,27 +132,25 @@ installPkg cfg comp globalArgs (pkg,ops,repo)
setup cmd
= do let cmdOps = mkPkgOps cfg comp pkg cmd (globalArgs++ops)
path = tmpDirPath </> showPackageId pkg
message output deafening $
message cfg deafening $
unwords ["setupWrapper", show (cmd:cmdOps), show path]
setupWrapper (cmd:cmdOps) (Just path)
bracket_ (createDirectoryIfMissing True tmpDirPath)
(removeDirectoryRecursive tmpDirPath)
(do message output deafening (printf "Extracting %s..." pkgPath)
(do message cfg deafening (printf "Extracting %s..." pkgPath)
extractTarGzFile (Just tmpDirPath) pkgPath
installUnpackedPkg cfg pkg setup
return ())
where output = configOutputGen cfg
installUnpackedPkg :: ConfigFlags -> PackageIdentifier
-> (String -> IO ()) -> IO ()
installUnpackedPkg cfg pkgId setup
= do buildingPkg output pkgId
stepConfigPkg output pkgId
= do printf "Building '%s'\n" (showPackageId pkgId)
printf " Configuring...\n"
setup "configure"
stepBuildPkg output pkgId
printf " Building...\n"
setup "build"
stepInstallPkg output pkgId
printf " Installing...\n"
setup "install"
stepFinishedPkg output pkgId
printf " Done.\n"
return ()
where output = configOutputGen cfg
cabal-install/src/Network/Hackage/CabalInstall/List.hs
View file @ 40a921a4
......@@ -23,8 +23,7 @@ import Distribution.Package
import Distribution.PackageDescription
import Network.Hackage.CabalInstall.Config (getKnownPackages)
import Network.Hackage.CabalInstall.Dependency (finalizePackage, listInstalledPackages)
import Network.Hackage.CabalInstall.Types (PkgInfo(..), ConfigFlags(..), UnresolvedDependency(..)
,OutputGen(..))
import Network.Hackage.CabalInstall.Types (PkgInfo(..), ConfigFlags(..), UnresolvedDependency(..))
-- |Show information about packages
list :: ConfigFlags -> [String] -> IO ()
......
cabal-install/src/Network/Hackage/CabalInstall/Types.hs
View file @ 40a921a4
......@@ -63,7 +63,6 @@ data ConfigFlags = ConfigFlags {
configInstallDirs :: InstallDirTemplates,
configCacheDir :: FilePath,
configRepos :: [Repo], -- ^Available Hackage servers.
configOutputGen :: OutputGen,
configVerbose :: Verbosity,
configUserInstall :: Bool -- ^--user-install flag
}
......@@ -74,39 +73,6 @@ data Repo = Repo {
}
deriving (Show,Eq)
data OutputGen
= OutputGen
{ prepareInstall :: [(PackageIdentifier,[String],String)] -> IO ()
, pkgIsPresent :: PackageIdentifier -> IO ()
, downloadingPkg :: PackageIdentifier -> IO ()
, executingCmd :: String -> [String] -> IO ()
, cmdFailed :: String -> [String] -> Int -> IO () -- cmd, flags and errno.
, buildingPkg :: PackageIdentifier -> IO () -- Package is fetched and unpacked. Starting installation.
, stepConfigPkg :: PackageIdentifier -> IO ()
, stepBuildPkg :: PackageIdentifier -> IO ()
, stepInstallPkg :: PackageIdentifier -> IO ()
, stepFinishedPkg:: PackageIdentifier -> IO ()
, noSetupScript :: PackageIdentifier -> IO ()
, noCabalFile :: PackageIdentifier -> IO ()
, gettingPkgList :: String -> IO () -- Server.
, showPackageInfo :: Maybe FilePath -- pkg file if fetched.
-> Bool -- is installed
-> [String] -- Options
-> Dependency -- Which dependency is this package supposed to fill
-> (PackageIdentifier,Repo,[ResolvedPackage])
-> IO ()
, showOtherPackageInfo :: Maybe PackageIdentifier -- package if installed.
-> Dependency
-> IO () -- Show package which isn't available from any server.
, cmdStdout :: Maybe Handle
, cmdStderr :: Maybe Handle
, -- | Output a message.
message :: Verbosity -- ^ minimum verbosity needed to output this message
-> String -> IO ()
}
data ResolvedPackage
= ResolvedPackage
{ fulfilling :: Dependency
......
cabal-install/src/Network/Hackage/CabalInstall/Update.hs
View file @ 40a921a4
......@@ -14,7 +14,7 @@ module Network.Hackage.CabalInstall.Update
( update
) where
import Network.Hackage.CabalInstall.Types (ConfigFlags (..), OutputGen(..), PkgInfo(..), Repo(..))
import Network.Hackage.CabalInstall.Types (ConfigFlags (..), PkgInfo(..), Repo(..))
import Network.Hackage.CabalInstall.Utils (isVerbose)
import Network.Hackage.CabalInstall.Fetch (downloadIndex, packagesDirectory)
......@@ -39,6 +39,6 @@ updateRepo :: ConfigFlags
-> Repo
-> IO ()
updateRepo cfg repo =
do gettingPkgList (configOutputGen cfg) (repoURL repo)
do printf "Downloading package list from server '%s'\n" (repoURL repo)
indexPath <- downloadIndex cfg repo
BS.readFile indexPath >>= BS.writeFile (dropExtension indexPath) . decompress
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment