capri (empty) → 0.1
raw patch · 4 files changed
+549/−0 lines, 4 filesdep +Cabaldep +basedep +directorysetup-changed
Dependencies added: Cabal, base, directory, filepath, process
Files
- LICENSE +30/−0
- Main.hs +442/−0
- Setup.hs +2/−0
- capri.cabal +75/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2010, Dmitry Golubovsky++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Dmitry Golubovsky nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Main.hs view
@@ -0,0 +1,442 @@+------------------------------------------------------------------+-- |+-- Module : Main+-- Copyright : (c) Dmitry Golubovsky, 2010+-- License : BSD-style+-- +-- Maintainer : golubovsky@gmail.com+-- Stability : experimental+-- Portability : GHC+-- +--+--+-- Main module of capri, wrapper for cabal-install private mode+------------------------------------------------------------------++module Main where++import qualified Paths_capri+import Data.List+import Data.Maybe+import System.IO+import System.Directory+import System.FilePath+import System.Process+import System.Environment+import System.Exit+import Control.Monad+import Distribution.Text+import Distribution.Simple.Setup+import Distribution.Simple.Utils+import Distribution.Simple.Command++main :: IO ()+main = getArgs >>= mainWorker++-- Toplevel command handler. Any command not recognized in the provided list of+-- commands is forwarded to cabal-install as is, with proper environment set.++mainWorker :: [String] -> IO ()+mainWorker args = topHandler $+ case commandsRun capriGlobalCommand commands args of+ CommandHelp help -> printGlobalHelp help+ CommandList opts -> printOptionsList opts+ CommandErrors errs -> printErrors errs+ CommandReadyToGo (globalflags, commandParse) ->+ case commandParse of+ _ | fromFlag (globalVersion globalflags) -> printVersion+ | fromFlag (globalNumericVersion globalflags) -> printNumericVersion+ CommandHelp help -> printCommandHelp help+ CommandList opts -> printOptionsList opts+ CommandErrors errs -> printErrors errs+ CommandReadyToGo action -> action globalflags+ where+ printCommandHelp help = do+ pname <- getProgName+ putStr (help pname)+ printGlobalHelp help = do+ pname <- getProgName+ putStr (help pname)+ printOptionsList = putStr . unlines+ printErrors errs = die $ concat (intersperse "\n" errs)+ printNumericVersion = putStrLn $ display Paths_capri.version+ printVersion = putStrLn $ "capri version "+ ++ display Paths_capri.version+ ++ "\nusing version "+ ++ display cabalVersion+ ++ " of the Cabal library "+++-- Print global help message++capriGlobalCommand :: CommandUI GlobalFlags+capriGlobalCommand = CommandUI {+ commandName = "",+ commandSynopsis = "",+ commandUsage = \_ ->+ "This program provides a wrapper over cabal-install "+ ++ "to operate in project-private mode.\n",+ commandDescription = Just $ \pname ->+ "For more information about a command use\n"+ ++ " " ++ pname ++ " COMMAND --help\n\n"+ ++ "Typical steps of building Haskell projects with Capri:\n"+ ++ concat [ " " ++ pname ++ " " ++ x ++ "\n"+ | x <- ["bootstrap", "clone", "configure", "build", "install"]],+ commandDefaultFlags = defaultGlobalFlags,+ commandOptions = \_ ->+ [option ['V'] ["version"]+ "Print version information"+ globalVersion (\v flags -> flags { globalVersion = v })+ trueArg+ ,option [] ["numeric-version"]+ "Print just the version number"+ globalNumericVersion (\v flags -> flags { globalNumericVersion = v })+ trueArg+ ]+ }++bootpkgs = ["ffi", "rts", "ghc-prim", "integer-gmp", "base-4*"]++subdir = ".capri"+pkgdir = subdir </> "packages"+instdir = subdir </> "install"++commands = [+ bootstrapCommand `commandAddAction` bootstrapAction+ ,listCommand `commandAddAction` listAction+ ,cloneCommand `commandAddAction` cloneAction+ ,ghcpkgCommand `commandAddAction` ghcpkgAction+ ,cabalCommand `commandAddAction` cabalAction+ ,importCommand `commandAddAction` importAction+ ,xCommand "install" `commandAddAction` xAction (CabalFlags False False False) "install"+ ,xCommand "configure" `commandAddAction` xAction (CabalFlags False False False) "configure"+ ,xCommand "build" `commandAddAction` xAction (CabalFlags True True False) "build"]++-- Import another package into the private packages database. Importing means building+-- within some other package's directory, but with respect to this package's private+-- database and installation path.++importCommand :: CommandUI CabalFlags++importCommand = CommandUI {+ commandName = "import"+ ,commandSynopsis = "Build another package with respect to this package's private " +++ "packages database and installation path"+ ,commandUsage = (++ " import directory -- <cabal or Setup command options>")+ ,commandDescription = Just $ \pname -> + "Use this command to build another package with respect to this package private\n" +++ "packages database. Use double-hyphen (--) before any build program parameters\n" +++ "to avoid interpretation of them by " ++ pname ++ " as its own options.\n" +++ "If only import directory is specified, \"cabal install\" will be executed in\n" ++ + "that directory. If the build program complains about unrecognized options\n" ++ + "`--package-db' or `--prefix' use -D or -P options BEFORE the double hyphen to\n" +++ "omit them. Use -S option to run the package's Setup.{hs|lhs} installation\n" ++ + "program instead of cabal-install.\n\n"+ ,commandDefaultFlags = CabalFlags False False False+ ,commandOptions = const [+ OptionField {+ optionName = "omit-package-db"+ ,optionDescr = [+ ChoiceOpt [+ ("Omit the --package-db option for build programs that do not understand it"+ ,(['D'], ["omit-package-db"])+ ,(\flags -> flags {pkgdb = True})+ ,pkgdb)+ ,("Omit the --prefix option for build programs that do not understand it"+ ,(['P'], ["omit-prefix"])+ ,(\flags -> flags {prefix = True})+ ,prefix)+ ,("Use the Setup.{hs|lhs} installation program instead of Cabal-install"+ ,(['S'], ["setup"])+ ,(\flags -> flags {setup = True})+ ,prefix)]+ ]+ }+ ]+}++importAction (CabalFlags pkgdb prefix setup) s g = do+ when (null s) $ die "at least import directory has to be specified"+ let dir = head s+ cd <- getCurrentDirectory+ doesDirectoryExist dir >>= return . not >>= flip when (die $ "import directory " ++ + dir ++ " does not exist")+ let dbopt = if pkgdb then [] else ["--package-db=" ++ (cd </> pkgdir)]+ pfxopt = if prefix then [] else ["--prefix=" ++ (cd </> instdir)]+ (stp, prog) = if setup then (["Setup"], "runghc") else ([], "cabal")+ cmds = case s of+ [dir] -> ["install"]+ _ -> tail s+ pp <- privateProcessRaw prog (stp ++ cmds ++ dbopt ++ pfxopt)+ (_, _, _, p) <- createProcess pp {cwd = Just dir}+ waitForProcess p+ return ()++-- Shortcut commands to invoke predefined Cabal actions.++xCommand :: String -> CommandUI ()++xCommand cmd = CommandUI {+ commandName = cmd+ ,commandSynopsis = "Short-cut for cabal " ++ cmd ++ " command"+ ,commandUsage = (++ " " ++ cmd)+ ,commandDescription = Just $ \pname -> "This command is equivalent to:\n\n" +++ " " ++ pname ++ " cabal -- " ++ cmd ++ "\n\n" +++ "with package database and install prefix " +++ "set properly.\n\n"+ ,commandDefaultFlags = ()+ ,commandOptions = const []+}++xAction cf cmd f s g = cabalAction cf [cmd] g++-- Invoke cabal to run arbitrary action as a private process.++data CabalFlags = CabalFlags {+ pkgdb :: Bool -- Include the "--package-db" flag+ ,prefix :: Bool -- Include the "--prefix" flag+ ,setup :: Bool -- Use Setup.{hs|lhs} instead of cabal+}++cabalCommand :: CommandUI CabalFlags++cabalCommand = CommandUI {+ commandName = "cabal"+ ,commandSynopsis = "Invoke the cabal-install or Setup.{hs|lhs} program to run arbitrary " +++ "action on private packages"+ ,commandUsage = (++ " cabal -- <cabal or Setup command options>")+ ,commandDescription = Just $ \pname -> + "Use this command to invoke arbitrary action of cabal-install on the privately\n" ++ + "installed packages. Use double-hyphen (--) before any cabal parameters to\n" ++ + "avoid interpretation of them by " ++ pname ++ " as its own options.\n" +++ "If the cabal command complains about unrecognized options `--package-db' or\n" ++ + "`--prefix' use -D or -P options BEFORE the double hyphen to omit them. Use -S\n" +++ "option to run the package's Setup.{hs|lhs} installation program instead of\n" +++ "cabal-install.\n\n"+ ,commandDefaultFlags = CabalFlags False False False+ ,commandOptions = const [+ OptionField {+ optionName = "omit-package-db"+ ,optionDescr = [+ ChoiceOpt [+ ("Omit the --package-db option for cabal commands that do not understand it"+ ,(['D'], ["omit-package-db"])+ ,(\flags -> flags {pkgdb = True})+ ,pkgdb)+ ,("Omit the --prefix option for cabal commands that do not understand it"+ ,(['P'], ["omit-prefix"])+ ,(\flags -> flags {prefix = True})+ ,prefix)+ ,("Use the Setup.{hs|lhs} installation program instead of Cabal-install"+ ,(['S'], ["setup"])+ ,(\flags -> flags {setup = True})+ ,prefix)]+ ]+ }+ ]+}++cabalAction (CabalFlags pkgdb prefix setup) s g = do+ cd <- getCurrentDirectory+ let dbopt = if pkgdb then [] else ["--package-db=" ++ (cd </> pkgdir)]+ pfxopt = if prefix then [] else ["--prefix=" ++ (cd </> instdir)]+ (stp, prog) = if setup then (["Setup"], "runghc") else ([], "cabal")+ (_, _, _, p) <- privateProcessRaw prog (stp ++ s ++ dbopt ++ pfxopt) >>= createProcess+ waitForProcess p+ return ()++-- Invoke ghc-pkg to run arbitrary action as a private process.++ghcpkgCommand :: CommandUI ()++ghcpkgCommand = CommandUI {+ commandName = "ghc-pkg"+ ,commandSynopsis = "Invoke the ghc-pkg program to run arbitrary action on private packages"+ ,commandUsage = (++ " ghc-pkg -- <ghc-pkg command options>")+ ,commandDescription = Just $ \pname -> + "Use this command to invoke arbitrary action of ghc-pkg on the privately installed\n" +++ "packages. Use double-hyphen (--) before any ghc-pkg parameters to avoid\n" +++ "interpretation of them by " ++ pname ++ " as its own options.\n\n"+ ,commandDefaultFlags = ()+ ,commandOptions = const []+}++ghcpkgAction f s g = do+ (_, _, _, p) <- privateProcessRaw "ghc-pkg" s >>= createProcess+ waitForProcess p+ return ()++-- Clone a package installed publicly into the private package database.+-- Exactly this action is performed by the bootstrap command on certain+-- essential packages. Note that --force option will not be passed to+-- ghc-pkg, so if some dependencies are missing, this has to be manually resolved.++cloneCommand :: CommandUI ()++cloneCommand = CommandUI {+ commandName = "clone"+ ,commandSynopsis = "Clone package(s) installed publicly into the private packages database"+ ,commandUsage = (++ " clone <package name> [...<package name>]")+ ,commandDescription = Just $ \pname -> + "Use this command to install previously compiled package(s) from global or user\n" +++ "database into the private database via running ghc-pkg. Package files (libraries,\n" +++ "executables) will not be copied; just the description of the package will be\n" ++ + "transferred.\n" +++ "Note that the --force flag will not be passed to ghc-pkg, so if any package\n" +++ "dependencies are missing, cloning will not be completed. It is a good idea to\n" ++ + "specify package version explicitly.\n\n"+ ,commandDefaultFlags = ()+ ,commandOptions = const []+}++cloneAction f s g = do+ when (null s) $ die "at least one package name to clone should be specified"+ mapM clonePackage s+ return ()++-- List packages installed privately. Equivalent to running ghc-pkg list+-- as a "private" process.++listCommand :: CommandUI ()++listCommand = CommandUI {+ commandName = "list"+ ,commandSynopsis = "List packages installed privately"+ ,commandUsage = (++ " list")+ ,commandDescription = Just $ \pname -> + "Use this command to list packages installed privately for this project.\n" ++ + pname ++ " will run the ghc-pkg utility to perform this action.\n\n"+ ,commandDefaultFlags = ()+ ,commandOptions = const []+}++listAction f s g = do+ (_, _, _, p) <- privateProcess "ghc-pkg list" >>= createProcess+ waitForProcess p+ return ()++-- Bootstrap a private per-project package configuration. Create a subdirectory .capri+-- where packages will be installed. Subdirectory .capri/packages will hold packages+-- cache and descriptions; subdirectory .capri/install will hold compiled libraries and+-- executables.++bootstrapCommand :: CommandUI ()++bootstrapCommand = CommandUI {+ commandName = "bootstrap"+ ,commandSynopsis = "Bootstrap private packages configuration"+ ,commandUsage = (++ " bootstrap")+ ,commandDescription = Just $ \pname -> + "Use this command to create an empty per-project database of packages.\n" ++ + pname ++ " will clone the following packages into the per-project packages directory: \n\n" +++ concat (intersperse " " bootpkgs) ++ ".\n\n"+ ,commandDefaultFlags = ()+ ,commandOptions = const []+}++bootstrapAction f s g = do+ mapM createDirectory [subdir, instdir]+ ex <- runCommand ("ghc-pkg init " ++ pkgdir) >>= waitForProcess+ let exfail (ExitFailure _) = True+ exfail _ = False+ when (exfail ex) $ die "ghc-pkg failed to initialize package configuration:\n"+ mapM clonePackage bootpkgs+ return ()++-- Clone a package. This is same as running ghc-pkg describe as a "public" process,+-- and running ghc-pkg register as a "private" process.++clonePackage :: String -> IO ()++clonePackage pkg = do+ cwd <- getCurrentDirectory+ descr <- publicProcess ("ghc-pkg describe " ++ pkg) cwd+ regst <- privateProcess "ghc-pkg register -"+ (_, _, p) <- runPipe Inherit Inherit [descr, regst]+ mapM waitForProcess p+ return ()++-- Utility: create a process descriptor from given command operating in the project's+-- current directory and having environment variable GHC_PACKAGE_PATH set to+-- the project's private package storage. Standard I/O handles are set to Inherit,+-- but may be adjusted later when actually run the process.++privateProcess :: String -> IO CreateProcess+privateProcess = privateProcess' . ShellCommand++privateProcessRaw :: FilePath -> [String] -> IO CreateProcess+privateProcessRaw prog args = privateProcess' (RawCommand prog args)++privateProcess' cmd = do+ cd <- getCurrentDirectory+ env <- getEnvironment+ let env' = filter ((/= "GHC_PACKAGE_PATH") . fst) env+ return CreateProcess {+ cmdspec = cmd+ ,cwd = Just cd+ ,env = Just (("GHC_PACKAGE_PATH", cd </> pkgdir):env')+ ,std_in = Inherit+ ,std_out = Inherit+ ,std_err = Inherit+ ,close_fds = False+ }++-- Utility: create a process descriptor to run a command without environment+-- adjustments, in given current directory.++publicProcess :: String -> FilePath -> IO CreateProcess++publicProcess cmd dir = return CreateProcess {+ cmdspec = ShellCommand cmd+ ,cwd = Just dir+ ,env = Nothing+ ,std_in = Inherit+ ,std_out = Inherit+ ,std_err = Inherit+ ,close_fds = False+}++-- Utility: pipe processes together. Two StdStream's must be supplied: for pipeline's+-- stdin and stdout. Stderr's of all processes are as set in the process creation+-- descriptors. List of process handles is returned as well as handles for pipe ends.++runPipe :: StdStream -- stdin+ -> StdStream -- stdout+ -> [CreateProcess] -- processes (start at left, end at right)+ -> IO (Maybe Handle -- pipe in+ ,Maybe Handle -- pipe out+ ,[ProcessHandle]) -- same order as in the input list of descriptors++runPipe ins outs [] = return (Nothing, Nothing, [])++runPipe ins outs [p] = do+ let p' = p {std_in = ins, std_out = outs}+ (pin, pout, _, ph) <- createProcess p'+ return (pin, pout, [ph])++runPipe ins outs (pstart:ps) = do+ let pstart' = pstart {std_in = ins}+ prev@(pend:rps) = reverse (pstart':ps)+ pend' = pend {std_out = outs}+ piper (pend':rps) [] Nothing Nothing++piper :: [CreateProcess] + -> [ProcessHandle] + -> Maybe Handle+ -> Maybe Handle+ -> IO (Maybe Handle, Maybe Handle, [ProcessHandle])++piper [] phs pin pend = return (pin, pend, phs)++piper (p:ps) [] Nothing Nothing = do+ let p' = p {std_in = CreatePipe}+ (pin, pend, _, ph) <- createProcess p'+ piper ps [ph] pin pend++piper (p:ps) phs pin pend = do+ let p' = p {std_in = CreatePipe, std_out = UseHandle (fromJust pin)}+ (pin', _, _, ph) <- createProcess p'+ piper ps (ph:phs) pin' pend+++
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ capri.cabal view
@@ -0,0 +1,75 @@+-- capri.cabal auto-generated by cabal init. For additional options,+-- see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name: capri++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version: 0.1++-- A short (one-line) description of the package.+Synopsis: A simple wrapper over cabal-install to operate in project-private mode.++-- A longer description of the package.+Description: Capri (abbreviation of CAbal PRIvate) is a wrapper program on top of + cabal-install to operate it in project-private mode. In this mode, + there is no global or user package databases; only one package + database is defined, private to the project, located under the root + directory of a project. + .+ Capri invokes cabal-install and ghc-pkg in the way that only project's+ private package database is visible. Starting with minimally required+ set of packages, all necessary dependencies will be installed into+ that database, not affecting user or global databases.+ .+ Capri is mainly intended to build executable programs. It depends+ on certain features of GHC, and is not usable with other Haskell+ compilers.+ .+ Further reading: <http://www.haskell.org/haskellwiki/Capri>+++-- The license under which the package is released.+License: BSD3++-- The file containing the license text.+License-file: LICENSE++-- The package author(s).+Author: Dmitry Golubovsky++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer: golubovsky@gmail.com++-- A copyright notice.+-- Copyright: ++Category: Distribution++Build-type: Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files: ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version: >=1.2+++Executable capri+ -- .hs or .lhs file containing the Main module.+ Main-is: Main.hs+ + -- Packages needed in order to build this package.+ Build-depends: base >= 4 && < 5, Cabal >= 1.8, process >= 1.0,+ directory >= 1.0, filepath >= 1.1+ + -- Modules not exported by this package.+ -- Other-modules: + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+ -- Build-tools: +