...
 
Commits (8)
......@@ -21,19 +21,13 @@ jobs:
name: Bootstrap on Linux
runs-on: ubuntu-18.04
steps:
- name: Set PATH
run: |
echo "::add-path::/opt/ghc/8.6.5/bin"
- uses: actions/checkout@v2
- name: bootstrap.sh
env:
EXTRA_CONFIGURE_OPTS: ""
- name: bootstrap.py
run: |
cd cabal-install
sh ./bootstrap.sh --no-doc
python3 bootstrap/bootstrap.py -w /opt/ghc/8.6.5/bin/ghc -d bootstrap/linux-8.6.5.json
- name: Smoke test
run: |
$HOME/.cabal/bin/cabal --version
packages/tmp/bin/cabal --version
boostrap-macos:
name: Bootstrap on macOS
......@@ -47,17 +41,13 @@ jobs:
cd ghc-*
./configure --prefix=/opt/ghc/8.6.5
sudo make install
- name: Set PATH
run: |
echo "::add-path::/opt/ghc/8.6.5/bin"
echo "::add-path::$HOME/.cabal/bin"
- uses: actions/checkout@v2
- name: bootstrap.sh
env:
EXTRA_CONFIGURE_OPTS: ""
# We use linux dependencies
- name: bootstrap.py
run: |
cd cabal-install
sh ./bootstrap.sh --no-doc
python3 bootstrap/bootstrap.py -w /opt/ghc/8.6.5/bin/ghc -d bootstrap/linux-8.6.5.json
- name: Smoke test
run: |
$HOME/.cabal/bin/cabal --version
packages/tmp/bin/cabal --version
......@@ -603,6 +603,7 @@ library
Distribution.Lex
Distribution.Utils.String
Distribution.Simple.Build.Macros.Z
Distribution.Simple.Build.PathsModule.Z
Distribution.Simple.GHC.EnvironmentParser
Distribution.Simple.GHC.Internal
Distribution.Simple.GHC.ImplInfo
......
This diff is collapsed.
......@@ -50,12 +50,16 @@ $(SPDX_EXCEPTION_HS) : templates/SPDX.LicenseExceptionId.template.hs cabal-dev-s
# source generation: templates
TEMPLATE_MACROS:=Cabal/src/Distribution/Simple/Build/Macros/Z.hs
TEMPLATE_PATHS:=Cabal/src/Distribution/Simple/Build/PathsModule/Z.hs
templates : phony $(TEMPLATE_MACROS)
templates : phony $(TEMPLATE_MACROS) $(TEMPLATE_PATHS)
$(TEMPLATE_MACROS) : templates/cabal_macros.template.h cabal-dev-scripts/src/GenCabalMacros.hs
cabal v2-run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-cabal-macros -- $< $@
$(TEMPLATE_PATHS) : templates/Paths_pkg.template.hs cabal-dev-scripts/src/GenPathsModule.hs
cabal v2-run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-paths-module -- $< $@
# generated docs
buildinfo-fields-reference : phony
......@@ -221,6 +225,25 @@ weeder :
tags :
hasktags -b Cabal/src Cabal/Cabal-described/src cabal-install/src cabal-testsuite/src
# boostrapping
##############################################################################
bootstrap-plans-linux: phony
@if [ $$(uname) != "Linux" ]; then echo "Not Linux"; false; fi
cabal v2-build --project=cabal.project.release --with-compiler ghc-8.6.5 --dry-run cabal-install:exe:cabal
cp dist-newstyle/cache/plan.json bootstrap/linux-8.6.5.plan.json
cabal v2-build --project=cabal.project.release --with-compiler ghc-8.8.3 --dry-run cabal-install:exe:cabal
cp dist-newstyle/cache/plan.json bootstrap/linux-8.8.3.plan.json
cabal v2-build --project=cabal.project.release --with-compiler ghc-8.10.1 --dry-run cabal-install:exe:cabal
cp dist-newstyle/cache/plan.json bootstrap/linux-8.10.1.plan.json
bootstrap-jsons-linux: phony
@if [ $$(uname) != "Linux" ]; then echo "Not Linux"; false; fi
cabal v2-build --builddir=dist-newstyle-bootstrap --project=cabal.project.bootstrap cabal-bootstrap-gen
cabal v2-run -vnormal+stderr --builddir=dist-newstyle-bootstrap --project=cabal.project.bootstrap cabal-bootstrap-gen -- bootstrap/linux-8.6.5.plan.json | python -m json.tool | tee bootstrap/linux-8.6.5.json
cabal v2-run -vnormal+stderr --builddir=dist-newstyle-bootstrap --project=cabal.project.bootstrap cabal-bootstrap-gen -- bootstrap/linux-8.8.3.plan.json | python -m json.tool | tee bootstrap/linux-8.8.3.json
cabal v2-run -vnormal+stderr --builddir=dist-newstyle-bootstrap --project=cabal.project.bootstrap cabal-bootstrap-gen -- bootstrap/linux-8.10.1.plan.json | python -m json.tool | tee bootstrap/linux-8.10.1.json
# documentation
##############################################################################
......@@ -238,5 +261,3 @@ $(USERGUIDE_STAMP) : doc/*.rst
.python-sphinx-virtualenv:
python3 -m venv .python-sphinx-virtualenv
(. ./.python-sphinx-virtualenv/bin/activate)
# Bootstrapping cabal-install
This utility is only intended for use in building cabal-install
on a new platform. If you already have a functional (if dated) cabal-install
please rather run `cabal v2-install`.
The typical usage is porting to a new linux architecture,
then the `linux-ghcvec.json` file is available in `bootstrap/` folder:
On a (linux) system you are boostrapping, run
bootstrap.py -d linux-ghcver.json -w /path/to-ghc
To generate the `platform-ghcver` files for other platforms, do:
1. On a system with functional cabal-install, install the same GHC version
as you will use to bootstrap on the host system.
2. Build a dependency description file (`platform-ghcver.json`, e.g. `linux-8.8.3.json`) by running:
```sh
cabal v2-build --with-compiler=/path/to/ghc --dry-run cabal-install:exe:cabal
cp dist-newstyle/cache/plan.json bootstrap/platform-ghcver.plan.json
cabal v2-build --builddir=dist-newstyle-bootstrap --project=cabal.project.bootstrap cabal-bootstrap-gen
cabal v2-run -vnormal+stderr --builddir=dist-newstyle-bootstrap --project=cabal.project.bootstrap cabal-bootstrap-gen -- bootstrap/platform-ghcver.plan.json | tee bootstrap/platform-ghcver.json
```
3. You may need to tweak `bootstrap/platform-ghcver.json` file manually,
for example toggle flags.
There are rules in top-level `Makefile` for generation of these files.
#!/usr/bin/env python3
# -*- coding: utf-8 -*-
"""
bootstrap.py - bootstrapping utility for cabal-install.
See bootstrap/README.md for usage instructions.
"""
USAGE = """
This utility is only intended for use in building cabal-install
on a new platform. If you already have a functional (if dated) cabal-install
please rather run `cabal v2-install .`.
"""
from enum import Enum
import hashlib
import logging
import json
from pathlib import Path
import shutil
import subprocess
from textwrap import dedent
from typing import Set, Optional, Dict, List, Tuple, \
NewType, BinaryIO, NamedTuple, TypeVar
#logging.basicConfig(level=logging.INFO)
PACKAGES = Path('packages')
PKG_DB = PACKAGES / 'packages.conf'
PackageName = NewType('PackageName', str)
Version = NewType('Version', str)
SHA256Hash = NewType('SHA256Hash', str)
class PackageSource(Enum):
HACKAGE = 'hackage'
LOCAL = 'local'
BuiltinDep = NamedTuple('BuiltinDep', [
('package', PackageName),
('version', Version),
])
BootstrapDep = NamedTuple('BootstrapDep', [
('package', PackageName),
('version', Version),
('source', PackageSource),
# source tarball SHA256
('src_sha256', Optional[SHA256Hash]),
# `revision` is only valid when source == HACKAGE.
('revision', Optional[int]),
('cabal_sha256', Optional[SHA256Hash]),
('flags', List[str]),
])
BootstrapInfo = NamedTuple('BootstrapInfo', [
('builtin', List[BuiltinDep]),
('dependencies', List[BootstrapDep]),
])
class Compiler:
def __init__(self, ghc_path: Path):
if not ghc_path.is_file():
raise TypeError(f'GHC {ghc_path} is not a file')
self.ghc_path = ghc_path.resolve()
info = self._get_ghc_info()
self.version = info['Project version']
#self.lib_dir = Path(info['LibDir'])
#self.ghc_pkg_path = (self.lib_dir / 'bin' / 'ghc-pkg').resolve()
self.ghc_pkg_path = (self.ghc_path.parent / 'ghc-pkg').resolve()
if not self.ghc_pkg_path.is_file():
raise TypeError(f'ghc-pkg {self.ghc_pkg_path} is not a file')
self.hsc2hs_path = (self.ghc_path.parent / 'hsc2hs').resolve()
if not self.hsc2hs_path.is_file():
raise TypeError(f'hsc2hs {self.hsc2hs_path} is not a file')
def _get_ghc_info(self) -> Dict[str,str]:
from ast import literal_eval
p = subprocess_run([self.ghc_path, '--info'], stdout=subprocess.PIPE, check=True, encoding='UTF-8')
out = p.stdout.replace('\n', '').strip()
return dict(literal_eval(out))
PackageSpec = Tuple[PackageName, Version]
class BadTarball(Exception):
def __init__(self, path: Path, expected_sha256: SHA256Hash, found_sha256: SHA256Hash):
self.path = path
self.expected_sha256 = expected_sha256
self.found_sha256 = found_sha256
def __str__(self):
return '\n'.join([
f'Bad tarball hash: {str(self.path)}',
f' expected: {self.expected_sha256}',
f' found: {self.found_sha256}',
])
def package_url(package: PackageName, version: Version) -> str:
return f'https://hackage.haskell.org/package/{package}-{version}/{package}-{version}.tar.gz'
def package_cabal_url(package: PackageName, version: Version, revision: int) -> str:
return f'https://hackage.haskell.org/package/{package}-{version}/revision/{revision}.cabal'
def verify_sha256(expected_hash: SHA256Hash, f: Path):
h = hash_file(hashlib.sha256(), f.open('rb'))
if h != expected_hash:
raise BadTarball(f, expected_hash, h)
def fetch_package(package: PackageName,
version: Version,
src_sha256: SHA256Hash,
revision: Optional[int],
cabal_sha256: Optional[SHA256Hash],
) -> Path:
import urllib.request
# Download source distribution
out = PACKAGES / (f'{package}-{version}.tar.gz')
if not out.exists():
print(f'Fetching {package}-{version}...')
out.parent.mkdir(parents=True, exist_ok=True)
url = package_url(package, version)
with urllib.request.urlopen(url) as resp:
shutil.copyfileobj(resp, out.open('wb'))
# Download revised cabal file
cabal_file = PACKAGES / f'{package}.cabal'
if revision is not None and not cabal_file.exists():
assert cabal_sha256 is not None
url = package_cabal_url(package, version, revision)
with urllib.request.urlopen(url) as resp:
shutil.copyfileobj(resp, cabal_file.open('wb'))
verify_sha256(cabal_sha256, cabal_file)
verify_sha256(src_sha256, out)
return out
def read_bootstrap_info(path: Path) -> BootstrapInfo:
obj = json.load(path.open())
def bi_from_json(o: dict) -> BuiltinDep:
return BuiltinDep(**o)
def dep_from_json(o: dict) -> BootstrapDep:
o['source'] = PackageSource(o['source'])
return BootstrapDep(**o)
builtin = [bi_from_json(dep) for dep in obj['builtin'] ]
deps = [dep_from_json(dep) for dep in obj['dependencies'] ]
return BootstrapInfo(dependencies=deps, builtin=builtin)
def check_builtin(dep: BuiltinDep, ghc: Compiler) -> None:
subprocess_run([str(ghc.ghc_pkg_path), 'describe', f'{dep.package}-{dep.version}'],
check=True, stdout=subprocess.DEVNULL)
print(f'Using {dep.package}-{dep.version} from GHC...')
return
def install_dep(dep: BootstrapDep, ghc: Compiler) -> None:
if dep.source == PackageSource.HACKAGE:
assert dep.src_sha256 is not None
tarball = fetch_package(dep.package, dep.version, dep.src_sha256,
dep.revision, dep.cabal_sha256)
subprocess_run(['tar', 'zxf', tarball.resolve()],
cwd=PACKAGES, check=True)
sdist_dir = PACKAGES / f'{dep.package}-{dep.version}'
# Update cabal file with revision
if dep.revision is not None:
shutil.copyfile(PACKAGES / f'{dep.package}.cabal',
sdist_dir / f'{dep.package}.cabal')
elif dep.source == PackageSource.LOCAL:
if dep.package == 'Cabal':
sdist_dir = Path('Cabal').resolve()
elif dep.package == 'cabal-install':
sdist_dir = Path('cabal-install').resolve()
else:
raise ValueError(f'Unknown local package {dep.package}')
install_sdist(sdist_dir, ghc, dep.flags)
def install_sdist(sdist_dir: Path, ghc: Compiler, flags: List[str]):
prefix = (PACKAGES / 'tmp').resolve()
flags_option = ' '.join(flags)
configure_args = [
f'--package-db={PKG_DB.resolve()}',
f'--prefix={prefix}',
f'--with-compiler={ghc.ghc_path}',
f'--with-hc-pkg={ghc.ghc_pkg_path}',
f'--with-hsc2hs={ghc.hsc2hs_path}',
f'--flags={flags_option}'
]
def check_call(args: List[str]) -> None:
subprocess_run(args, cwd=sdist_dir, check=True)
check_call([str(ghc.ghc_path), '--make', '-package-env', '-', 'Setup'])
check_call(['./Setup', 'configure'] + configure_args)
check_call(['./Setup', 'build'])
check_call(['./Setup', 'install'])
def hash_file(h, f: BinaryIO) -> SHA256Hash:
while True:
d = f.read(1024)
if len(d) == 0:
return SHA256Hash(h.hexdigest())
h.update(d)
# Cabal plan.json representation
UnitId = NewType('UnitId', str)
PlanUnit = NewType('PlanUnit', dict)
def read_plan(project_dir: Path) -> Dict[UnitId, PlanUnit]:
path = project_dir / 'dist-newstyle' / 'cache' / 'plan.json'
plan = json.load(path.open('rb'))
return {
UnitId(c['id']): PlanUnit(c)
for c in plan['install-plan']
}
def bootstrap(info: BootstrapInfo, ghc: Compiler) -> None:
if not PKG_DB.exists():
print(f'Creating package database {PKG_DB}')
PKG_DB.parent.mkdir(parents=True, exist_ok=True)
subprocess_run([ghc.ghc_pkg_path, 'init', PKG_DB])
for dep in info.builtin:
check_builtin(dep, ghc)
for dep in info.dependencies:
install_dep(dep, ghc)
def main() -> None:
import argparse
parser = argparse.ArgumentParser(
description="bootstrapping utility for cabal-install.",
epilog = USAGE,
formatter_class = argparse.RawDescriptionHelpFormatter)
parser.add_argument('-d', '--deps', type=Path, default='bootstrap-deps.json',
help='bootstrap dependency file')
parser.add_argument('-w', '--with-compiler', type=Path,
help='path to GHC')
args = parser.parse_args()
# Find compiler
if args.with_compiler is None:
path = shutil.which('ghc')
if path is None:
raise ValueError("Couldn't find ghc in PATH")
ghc = Compiler(Path(path))
else:
ghc = Compiler(args.with_compiler)
print(f'Bootstrapping cabal-install with GHC {ghc.version} at {ghc.ghc_path}...')
print(dedent("""
DO NOT use this script if you have another recent cabal-install available.
This script is intended only for bootstrapping cabal-install on new
architectures.
"""))
info = read_bootstrap_info(args.deps)
bootstrap(info, ghc)
cabal_path = (PACKAGES / 'tmp' / 'bin' / 'cabal').resolve()
print(dedent(f'''
Bootstrapping finished!
The resulting cabal-install executable can be found at
{cabal_path}
You now should use this to build a full cabal-install distribution
using v2-build.
'''))
def subprocess_run(args, **kwargs):
"Like subprocess.run, but also print what we run"
args_str = ' '.join(map(str, args))
extras = ''
if 'cwd' in kwargs:
extras += f' cwd={kwargs["cwd"]}'
print(f'bootstrap: running{extras} {args_str}')
return subprocess.run(args, **kwargs)
if __name__ == '__main__':
main()
cabal-version: 2.2
name: cabal-bootstrap-gen
version: 0
executable cabal-bootstrap-gen
default-language: Haskell2010
hs-source-dirs: src
ghc-options: -Wall
main-is: Main.hs
build-depends:
, aeson ^>=1.5.2.0
, base ^>=4.12.0.0 || ^>=4.13.0.0 || ^>=4.14.0.0
, bytestring ^>=0.10.8.2
, Cabal ^>=3.2.0.0
, cabal-install-parsers ^>=0.3.0.1
, cabal-plan ^>=0.7.0.0
, containers ^>=0.6.0.1
, text ^>=1.2.3.0
, topograph ^>=1.0.0.1
, transformers ^>=0.5.6.2
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
module Main (main) where
import Control.Monad (when)
import Data.Either (partitionEithers)
import Data.Foldable (for_, traverse_)
import Data.Maybe (listToMaybe)
import Data.String (fromString)
import Data.Traversable (for)
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)
import qualified Data.Text as T
import qualified Cabal.Index as I
import qualified Cabal.Plan as P
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Distribution.Types.PackageName as C
import qualified Distribution.Types.Version as C
import qualified Topograph as TG
-------------------------------------------------------------------------------
-- Main
-------------------------------------------------------------------------------
main :: IO ()
main = do
args <- getArgs
case args of
[fp] -> main1 fp
_ -> die "Usage: cabal-bootstrap-gen plan.json"
main1 :: FilePath -> IO ()
main1 planPath = do
meta <- I.cachedHackageMetadata
plan <- P.decodePlanJson planPath
main2 meta plan
main2 :: Map.Map C.PackageName I.PackageInfo -> P.PlanJson -> IO ()
main2 meta plan = do
info $ show $ Map.keys $ P.pjUnits plan
-- find cabal-install:exe:cabal unit
(cabalUid, cabalUnit) <- case findCabalExe plan of
Just x -> return x
Nothing -> die "Cannot find cabal-install:exe:cabal unit"
info $ "cabal-install:exe:cabal unit " ++ show cabalUid
-- BFS from cabal unit, getting all dependencies
units <- bfs plan cabalUnit
info $ "Unit order:"
for_ units $ \unit -> do
info $ " - " ++ show (P.uId unit)
(builtin, deps) <- fmap partitionEithers $ for units $ \unit -> do
let P.PkgId pkgname@(P.PkgName tpkgname) ver@(P.Ver verdigits) = P.uPId unit
let uid = P.uId unit
let cpkgname :: C.PackageName
cpkgname = C.mkPackageName (T.unpack tpkgname)
let cversion :: C.Version
cversion = C.mkVersion verdigits
case P.uType unit of
P.UnitTypeBuiltin ->
return $ Left Builtin
{ builtinPackageName = pkgname
, builtinVersion = ver
}
_ -> do
(src, rev, revhash) <- case P.uSha256 unit of
Just _ -> do
pkgInfo <- maybe (die $ "Cannot find " ++ show uid ++ " package metadata") return $
Map.lookup cpkgname meta
relInfo <- maybe (die $ "Cannot find " ++ show uid ++ " version metadata") return $
Map.lookup cversion $ I.piVersions pkgInfo
return
( Hackage
, Just $ fromIntegral (I.riRevision relInfo)
, P.sha256FromByteString $ I.getSHA256 $ I.riCabal relInfo
)
Nothing -> case P.uType unit of
P.UnitTypeLocal -> return (Local, Nothing, Nothing)
t -> die $ "Unit of wrong type " ++ show uid ++ " " ++ show t
return $ Right Dep
{ depPackageName = pkgname
, depVersion = ver
, depSource = src
, depSrcHash = P.uSha256 unit
, depRevision = rev
, depRevHash = revhash
, depFlags =
[ (if fval then "+" else "-") ++ T.unpack fname
| (P.FlagName fname, fval) <- Map.toList (P.uFlags unit)
]
}
LBS.putStr $ A.encode Result
{ resBuiltin = builtin
, resDependencies = deps
}
bfs :: P.PlanJson -> P.Unit -> IO [P.Unit]
bfs plan unit0 = do
uids <- either (\loop -> die $ "Loop in install-plan " ++ show loop) id $ TG.runG am $ \g -> do
v <- maybe (die "Cannot find cabal-install unit in topograph") return $
TG.gToVertex g $ P.uId unit0
let t = TG.dfs g v
return $ map (TG.gFromVertex g) $
-- nub and sort
reverse $ Set.toList $ Set.fromList $ concat t
for uids $ \uid -> do
unit <- lookupUnit units uid
case Map.toList (P.uComps unit) of
[(_, compinfo)] -> checkExeDeps uid (P.pjUnits plan) (P.ciExeDeps compinfo)
_ -> die $ "Unit with multiple components " ++ show uid
return unit
where
am :: Map.Map P.UnitId (Set.Set P.UnitId)
am = fmap (foldMap P.ciLibDeps . P.uComps) units
units = P.pjUnits plan
checkExeDeps :: P.UnitId -> Map.Map P.UnitId P.Unit -> Set.Set P.UnitId -> IO ()
checkExeDeps pkgUid units = traverse_ check . Set.toList where
check uid = do
unit <- lookupUnit units uid
let P.PkgId pkgname _ = P.uPId unit
when (pkgname /= P.PkgName (fromString "hsc2hs")) $ do
die $ "unit " ++ show pkgUid ++ " depends on executable " ++ show uid
lookupUnit :: Map.Map P.UnitId P.Unit -> P.UnitId -> IO P.Unit
lookupUnit units uid
= maybe (die $ "Cannot find unit " ++ show uid) return
$ Map.lookup uid units
-------------------------------------------------------------------------------
-- Data
-------------------------------------------------------------------------------
data Result = Result
{ resBuiltin :: [Builtin]
, resDependencies :: [Dep]
}
deriving (Show)
data Builtin = Builtin
{ builtinPackageName :: P.PkgName
, builtinVersion :: P.Ver
}
deriving (Show)
data Dep = Dep
{ depPackageName :: P.PkgName
, depVersion :: P.Ver
, depSource :: SrcType
, depSrcHash :: Maybe P.Sha256
, depRevision :: Maybe Int
, depRevHash :: Maybe P.Sha256
, depFlags :: [String]
}
deriving (Show)
data SrcType
= Hackage
| Local
deriving (Show)
instance A.ToJSON Result where
toJSON res = A.object
[ fromString "builtin" A..= resBuiltin res
, fromString "dependencies" A..= resDependencies res
]
instance A.ToJSON Builtin where
toJSON b = A.object
[ fromString "package" A..= builtinPackageName b
, fromString "version" A..= builtinVersion b
]
instance A.ToJSON Dep where
toJSON dep = A.object
[ fromString "package" A..= depPackageName dep
, fromString "version" A..= depVersion dep
, fromString "source" A..= depSource dep
, fromString "src_sha256" A..= depSrcHash dep
, fromString "revision" A..= depRevision dep
, fromString "cabal_sha256" A..= depRevHash dep
, fromString "flags" A..= depFlags dep
]
instance A.ToJSON SrcType where
toJSON Hackage = fromString "hackage"
toJSON Local = fromString "local"
-------------------------------------------------------------------------------
-- Utilities
-------------------------------------------------------------------------------
info :: String -> IO ()
info msg = hPutStrLn stderr $ "INFO: " ++ msg
die :: String -> IO a
die msg = do
hPutStrLn stderr msg
exitFailure
-------------------------------------------------------------------------------
-- Pure bits
-------------------------------------------------------------------------------
findCabalExe :: P.PlanJson -> Maybe (P.UnitId, P.Unit)
findCabalExe plan = listToMaybe
[ (uid, unit)
| (uid, unit) <- Map.toList (P.pjUnits plan)
, let P.PkgId pkgname _ = P.uPId unit
, pkgname == P.PkgName (fromString "cabal-install")
, Map.keys (P.uComps unit) == [P.CompNameExe (fromString "cabal")]
]
......@@ -93,6 +93,20 @@ executable gen-cabal-macros
, template-haskell
, zinza ^>=0.2
executable gen-paths-module
default-language: Haskell2010
main-is: GenPathsModule.hs
other-modules: Capture
hs-source-dirs: src
ghc-options: -Wall
build-depends:
, base
, bytestring
, Cabal
, syb ^>=0.7.1
, template-haskell
, zinza ^>=0.2
executable gen-cabal-install-cabal
default-language: Haskell2010
main-is: GenCabalInstallCabal.hs
......
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Main (main) where
import Control.Exception (SomeException (..), catch, displayException)
import Distribution.Types.PackageName (PackageName)
import Distribution.Types.Version (Version)
import GHC.Generics (Generic)
import System.Environment (getArgs)
import System.Exit (exitFailure)
import Zinza
(ModuleConfig (..), Ty (..), Zinza (..), genericFromValueSFP, genericToTypeSFP,
genericToValueSFP, parseAndCompileModuleIO)
import Capture
-------------------------------------------------------------------------------
-- Inputs
-------------------------------------------------------------------------------
$(capture "decls" [d|
data Z = Z
{ zPackageName :: PackageName
, zVersionDigits :: String
, zSupportsCpp :: Bool
, zSupportsNoRebindableSyntax :: Bool
, zAbsolute :: Bool
, zRelocatable :: Bool
, zIsWindows :: Bool
, zIsI386 :: Bool
, zIsX8664 :: Bool
, zPrefix :: FilePath
, zBindir :: FilePath
, zLibdir :: FilePath
, zDynlibdir :: FilePath
, zDatadir :: FilePath
, zLibexecdir :: FilePath
, zSysconfdir :: FilePath
, zNot :: Bool -> Bool
, zManglePkgName :: PackageName -> String
}
deriving (Generic)
|])
-------------------------------------------------------------------------------
-- Main
-------------------------------------------------------------------------------
withIO :: (FilePath -> FilePath -> IO a) -> IO a
withIO k = do
args <- getArgs
case args of
[src,tgt] -> k src tgt `catch` \(SomeException e) -> do
putStrLn $ "Exception: " ++ displayException e
exitFailure
_ -> do
putStrLn "Usage cabal v2-run ... source.temeplate.ext target.ext"
exitFailure
main :: IO ()
main = withIO $ \src tgt -> do
mdl <- parseAndCompileModuleIO config src
writeFile tgt mdl
config :: ModuleConfig Z
config = ModuleConfig
{ mcRender = "render"
, mcHeader =
[ "{-# LANGUAGE DeriveGeneric #-}"
, "module Distribution.Simple.Build.PathsModule.Z (render, Z(..)) where"
, "import Distribution.ZinzaPrelude"
, decls
, "render :: Z -> String"
]
}
-------------------------------------------------------------------------------
-- Zinza instances
-------------------------------------------------------------------------------
instance Zinza Z where
toType = genericToTypeSFP
toValue = genericToValueSFP
fromValue = genericFromValueSFP
-------------------------------------------------------------------------------
-- Orphans
-------------------------------------------------------------------------------
instance Zinza PackageName where
toType _ = TyString (Just "prettyShow")
toValue _ = error "not needed"
fromValue _ = error "not needed"
instance Zinza Version where
toType _ = TyString (Just "prettyShow")
toValue _ = error "not needed"
fromValue _ = error "not needed"
This diff is collapsed.
packages: bootstrap/
optimization: False
{% if supportsCpp %}
{-# LANGUAGE CPP #-}
{% endif %}
{% if supportsNoRebindableSyntax %}
{-# LANGUAGE NoRebindableSyntax #-}
{% endif %}
{% if not absolute %}
{-# LANGUAGE ForeignFunctionInterface #-}
{% endif %}
{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}
module Paths_{{ manglePkgName packageName }} (
version,
getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,
getDataFileName, getSysconfDir
) where
{% if not absolute %}
import Foreign
import Foreign.C
{% endif %}
import qualified Control.Exception as Exception
import Data.Version (Version(..))
import System.Environment (getEnv)
import Prelude
{% if relocatable %}
import System.Environment (getExecutablePath)
{% endif %}
{% if supportsCpp %}
#if defined(VERSION_base)
#if MIN_VERSION_base(4,0,0)
catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
#else
catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a
#endif
#else
catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
#endif
catchIO = Exception.catch
{% else %}
catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
catchIO = Exception.catch
{% endif %}
version :: Version
version = Version {{ versionDigits }} []
getDataFileName :: FilePath -> IO FilePath
getDataFileName name = do
dir <- getDataDir
return (dir `joinFileName` name)
getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath
{# body #}
{# ######################################################################### #}
{% if relocatable %}
getPrefixDirReloc :: FilePath -> IO FilePath
getPrefixDirReloc dirRel = do
exePath <- getExecutablePath
let (dir,_) = splitFileName exePath
return ((dir `minusFileName` {{ bindir }}) `joinFileName` dirRel)
getBinDir = catchIO (getEnv "{{ manglePkgName packageName }}_bindir") (\_ -> getPrefixDirReloc $ {{ bindir }})
getLibDir = catchIO (getEnv "{{ manglePkgName packageName }}_libdir") (\_ -> getPrefixDirReloc $ {{ libdir }})
getDynLibDir = catchIO (getEnv "{{ manglePkgName packageName }}_dynlibdir") (\_ -> getPrefixDirReloc $ {{ dynlibdir }})
getDataDir = catchIO (getEnv "{{ manglePkgName packageName }}_datadir") (\_ -> getPrefixDirReloc $ {{ datadir }})
getLibexecDir = catchIO (getEnv "{{ manglePkgName packageName }}_libexecdir") (\_ -> getPrefixDirReloc $ {{ libexecdir }})
getSysconfDir = catchIO (getEnv "{{ manglePkgName packageName }}_sysconfdir") (\_ -> getPrefixDirReloc $ {{ sysconfdir }})
{% elif absolute %}
bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath
bindir = {{ bindir }}
libdir = {{ libdir }}
dynlibdir = {{ dynlibdir }}
datadir = {{ datadir }}
libexecdir = {{ libexecdir }}
sysconfdir = {{ sysconfdir }}
getBinDir = catchIO (getEnv "{{ manglePkgName packageName }}_bindir") (\_ -> return bindir)
getLibDir = catchIO (getEnv "{{ manglePkgName packageName }}_libdir") (\_ -> return libdir)
getDynLibDir = catchIO (getEnv "{{ manglePkgName packageName }}_dynlibdir") (\_ -> return dynlibdir)
getDataDir = catchIO (getEnv "{{ manglePkgName packageName }}_datadir") (\_ -> return datadir)
getLibexecDir = catchIO (getEnv "{{ manglePkgName packageName }}_libexecdir") (\_ -> return libexecdir)
getSysconfDir = catchIO (getEnv "{{ manglePkgName packageName }}_sysconfdir") (\_ -> return sysconfdir)
{% elif isWindows %}
prefix :: FilePath
prefix = {{ prefix }}
getBinDir = getPrefixDirRel $ {{ bindir }}
getLibDir = {{ libdir }}
getDynLibDir = {{ dynlibdir }}
getDataDir = catchIO (getEnv "{{ manglePkgName packageName }}_datadir") (\_ -> {{ datadir }})
getLibexecDir = {{ libexecdir }}
getSysconfDir = {{ sysconfdir }}
getPrefixDirRel :: FilePath -> IO FilePath
getPrefixDirRel dirRel = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
where
try_size size = allocaArray (fromIntegral size) $ \buf -> do
ret <- c_GetModuleFileName nullPtr buf size
case ret of
0 -> return (prefix `joinFileName` dirRel)
_ | ret < size -> do
exePath <- peekCWString buf
let (bindir,_) = splitFileName exePath
return ((bindir `minusFileName` {{ bindir}}) `joinFileName` dirRel)
| otherwise -> try_size (size * 2)
{% if isI386 %}
foreign import stdcall unsafe "windows.h GetModuleFileNameW"
c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32
{% elif isX8664 %}
foreign import ccall unsafe "windows.h GetModuleFileNameW"
c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32
{% else %}
-- win32 supported only with I386, X86_64
c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32
c_GetModuleFileName = _
{% endif %}
{% else %}
notRelocAbsoluteOrWindows :: ()
notRelocAbsoluteOrWindows = _
{% endif %}
{# filename stuff #}
{# ######################################################################### #}
{% if not absolute %}
minusFileName :: FilePath -> String -> FilePath
minusFileName dir "" = dir
minusFileName dir "." = dir
minusFileName dir suffix =
minusFileName (fst (splitFileName dir)) (fst (splitFileName suffix))
splitFileName :: FilePath -> (String, String)
splitFileName p = (reverse (path2++drive), reverse fname)
where
(path,drive) = case p of
(c:':':p') -> (reverse p',[':',c])
_ -> (reverse p ,"")
(fname,path1) = break isPathSeparator path
path2 = case path1 of
[] -> "."
[_] -> path1 -- don't remove the trailing slash if
-- there is only one character
(c:path') | isPathSeparator c -> path'
_ -> path1
{% endif %}
joinFileName :: String -> String -> FilePath
joinFileName "" fname = fname
joinFileName "." fname = fname
joinFileName dir "" = dir
joinFileName dir fname
| isPathSeparator (last dir) = dir ++ fname
| otherwise = dir ++ pathSeparator : fname
pathSeparator :: Char
{% if isWindows %}
pathSeparator = '\\'
{% else %}
pathSeparator = '/'
{% endif %}
isPathSeparator :: Char -> Bool
{% if isWindows %}
isPathSeparator c = c == '/' || c == '\\'
{% else %}
isPathSeparator c = c == '/'
{% endif %}
......@@ -21,19 +21,13 @@ jobs:
name: Bootstrap on Linux
runs-on: ubuntu-18.04
steps:
- name: Set PATH
run: |
echo "::add-path::/opt/ghc/8.6.5/bin"
- uses: actions/checkout@v2
- name: bootstrap.sh
env:
EXTRA_CONFIGURE_OPTS: ""
- name: bootstrap.py
run: |
cd cabal-install
sh ./bootstrap.sh --no-doc
python3 bootstrap/bootstrap.py -w /opt/ghc/8.6.5/bin/ghc -d bootstrap/linux-8.6.5.json
- name: Smoke test
run: |
$HOME/.cabal/bin/cabal --version
packages/tmp/bin/cabal --version
boostrap-macos:
name: Bootstrap on macOS
......@@ -47,17 +41,13 @@ jobs:
cd ghc-*
./configure --prefix=/opt/ghc/8.6.5
sudo make install
- name: Set PATH
run: |
echo "::add-path::/opt/ghc/8.6.5/bin"
echo "::add-path::$HOME/.cabal/bin"
- uses: actions/checkout@v2
- name: bootstrap.sh
env:
EXTRA_CONFIGURE_OPTS: ""
# We use linux dependencies
- name: bootstrap.py
run: |
cd cabal-install
sh ./bootstrap.sh --no-doc
python3 bootstrap/bootstrap.py -w /opt/ghc/8.6.5/bin/ghc -d bootstrap/linux-8.6.5.json
- name: Smoke test
run: |
$HOME/.cabal/bin/cabal --version
packages/tmp/bin/cabal --version