├── .ghci ├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── Setup.hs ├── default-override.nix ├── default.nix ├── driver └── tinc.hs ├── get-tinc.sh ├── package.nix ├── package.yaml ├── plugins ├── tinc-ghci ├── tinc-install ├── tinc-pkg ├── tinc-sensei ├── tinc-shell ├── tinc-test └── tinc-update ├── shell.nix ├── src ├── Run.hs ├── Tinc │ ├── Cabal.hs │ ├── Cache.hs │ ├── Config.hs │ ├── Facts.hs │ ├── Fail.hs │ ├── Freeze.hs │ ├── GhcInfo.hs │ ├── GhcPkg.hs │ ├── Hpack.hs │ ├── Install.hs │ ├── Nix.hs │ ├── Package.hs │ ├── PackageGraph.hs │ ├── Process.hs │ ├── RecentCheck.hs │ ├── Sandbox.hs │ ├── SourceDependency.hs │ └── Types.hs └── Util.hs ├── test ├── All.hs ├── Helper.hs ├── MockedEnv.hs ├── MockedProcess.hs ├── RunSpec.hs ├── Spec.hs ├── Test │ └── Mockery │ │ ├── Action.hs │ │ └── ActionSpec.hs ├── Tinc │ ├── CacheSpec.hs │ ├── ConfigSpec.hs │ ├── FactsSpec.hs │ ├── FreezeSpec.hs │ ├── GhcInfoSpec.hs │ ├── GhcPkgSpec.hs │ ├── InstallSpec.hs │ ├── NixSpec.hs │ ├── PackageGraphSpec.hs │ ├── PackageSpec.hs │ ├── RecentCheckSpec.hs │ ├── SandboxSpec.hs │ └── SourceDependencySpec.hs ├── UtilSpec.hs └── resources │ ├── cabal-1.22.4.0-dry-run-all-already-installed.txt │ └── cabal-1.22.4.0-dry-run.txt ├── tinc.cabal ├── tinc.freeze └── tinc.nix /.ghci: -------------------------------------------------------------------------------- 1 | :set -isrc -itest -idist/build/tinc/autogen -DTEST 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /dist/ 2 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: false 2 | 3 | language: c 4 | 5 | addons: 6 | apt: 7 | sources: 8 | - hvr-ghc 9 | packages: 10 | - ghc-8.4.3 11 | - cabal-install-2.2 12 | 13 | before_install: 14 | - export PATH=$HOME/.tinc/bin:/opt/ghc/8.4.3/bin:/opt/cabal/2.2/bin:$PATH 15 | - curl -sSL https://github.com/sol/tinc/raw/master/get-tinc.sh | bash 16 | - tinc --version 17 | - ghc --version 18 | - cabal --version 19 | - travis_retry cabal update 20 | - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config 21 | 22 | install: 23 | - tinc 24 | 25 | script: 26 | - cabal configure --enable-tests --ghc-options=-Werror && cabal build && cabal test --show-details=direct 27 | 28 | before_deploy: 29 | - cp dist/build/tinc/tinc . 30 | - gzip tinc 31 | - mv tinc.gz tinc-${TRAVIS_OS_NAME}.gz 32 | 33 | deploy: 34 | provider: releases 35 | api_key: 36 | secure: ccgjywa/XIYrwiTnrOpiBuTFrBENAvZ4jOkZ7aNekTVpOo7ahq++G5Ke2n/a725FEO2Xldx1rUXVAiNnbEEHBwzd4bxig/mJUahEKJLkZWduEmzNrv/kcKtuOYV6OJrheF6hv6Jt8ACls6ezUuOrsyLz/4A3eS2Ca8JcLE2RHLcVm4OA5G9It1h8o6kM2okZNjkwggwK1HHMyRf7yfkikG2w/+3sF+6eVDJWVGEVmyvGPfeY323jpiFLrBdl9Q5/wIOrav+wn3NOIXJP4/iYOSHnxWt8AwlV0Hl97ClN1ifM02YwnEEwF0nFNOf0mEOa169sZX4cN8IouNUNEtprv7QO+ZTYui12R654qp6CFauWUQTJueAgrcXVshIQcZ9Xx03bjy/qnGIQIlQzzMbrBxhtSjVwmTYX/4sYHFyz10EzlFouylFM6gi5NEMHadIkEmuWo78nSjkddAPaFTFHzxUuvtm5Z+MAW+MarHNgES3qX/kReOx0XD0WXz0DBKSUyXoNbIvEZKAVqH6SJap+eodzUW8G1JjJqjQ0tO3IhDm0IHWc9riMyYxM11gApPezVlKAvnk/T+/trHot5+YVvdQ0MmcqJWpFfHbBStAXGA7X22nzX4SrwfvaoUJF6rtNRS5D9W/Ior996GNDD9OwmWBgmc2dsOn7S99lKOFhejI= 37 | file_glob: true 38 | file: tinc-*.gz 39 | skip_cleanup: true 40 | on: 41 | repo: sol/tinc 42 | tags: true 43 | 44 | cache: 45 | directories: 46 | - $HOME/.tinc/cache 47 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015 Sönke Hahn 2 | Copyright (c) 2015-2017 Simon Hengel 3 | 4 | Permission is hereby granted, free of charge, to any person obtaining a copy 5 | of this software and associated documentation files (the "Software"), to deal 6 | in the Software without restriction, including without limitation the rights 7 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 8 | copies of the Software, and to permit persons to whom the Software is 9 | furnished to do so, subject to the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included in 12 | all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 17 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 18 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 19 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 20 | THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # tinc: A dependency manager for Haskell 2 | 3 | `tinc` installs dependencies for a project that you work on into a sandbox. 4 | While doing so it caches installed packages (in `~/.tinc/cache`). When a 5 | package with the same transitive dependencies is already in the cache, it 6 | reuses that cached package instead of building it again. 7 | 8 | `tinc` uses an exact algorithm for determining reusability. This guarantees 9 | 100% cache reuse. A package with the same transitive dependencies is never 10 | built twice. 11 | 12 | `tinc` does not take any cached packages into account when resolving 13 | dependencies. Running 14 | 15 | $ tinc 16 | 17 | gives you the exact same result as 18 | 19 | $ cabal sandbox delete 20 | $ cabal sandbox init 21 | $ cabal install --only-dependencies --enable-tests 22 | 23 | `tinc` is idempotent. It's safe to run `tinc` multiple times. Running `tinc` 24 | after changing the `.cabal`-file of a project or after running `cabal update` 25 | results in a new updated sandbox. 26 | 27 | If `tinc` fails / terminates for some reason, it does not modify anything 28 | (neither the cache nor any existing sandboxes). Interrupting a running `tinc` 29 | build is always safe. 30 | 31 | ## Optionally use Nix for package caching 32 | By default, `tinc` maintains its own package cache under `~/.tinc/cache`. 33 | 34 | However, it can optionally use nixpkgs for package caching. 35 | If `tinc` is installed somewhere under `/nix`, this is the default. 36 | 37 | To change the default, you can set the environment variable 38 | `TINC_USE_NIX` to either `yes` or `no`, specifically: 39 | ```bash 40 | export TINC_USE_NIX=yes # use nix, even if not installed under /nix 41 | export TINC_USE_NIX=no # do not use nix, even if installed under /nix 42 | ``` 43 | 44 | If you want to install `tinc` with `nix-env` you can do so by running 45 | ``` 46 | nix-env -i -f default.nix 47 | ``` 48 | inside this repository. 49 | 50 | ## Enabling plug-ins 51 | `tinc` comes with a number of useful plug-ins. To enable them symlink `plugins` to `~/.tinc/plugins`: 52 | 53 | ``` 54 | mkdir -p ~/.tinc/ && ln -s `pwd`/plugins/ ~/.tinc/ 55 | ``` 56 | 57 | # Additional dependencies and dependencies from GitHub 58 | 59 | You can specify additional dependencies in a file named `tinc.yaml`. These 60 | dependencies may be from a variety of sources: 61 | 62 | ```yaml 63 | dependencies: 64 | # additional dependency from Hackage 65 | - foo 66 | 67 | # override version constraint in package.yaml 68 | - foo == 0.1.0 69 | 70 | # dependency from GitHub 71 | - name: foo 72 | github: owner/repo 73 | ref: master 74 | subdir: some-dir # optional subdirectory 75 | 76 | # dependency from arbitrary Git repositories 77 | - name: foo 78 | git: http://... 79 | ref: master 80 | 81 | # local dependency (will use cabal sdist) 82 | - name: foo 83 | path: ../foo/ 84 | ``` 85 | 86 | (Note: The accepted syntax for dependencies is the same as what is accepted in 87 | `package.yaml`.) 88 | 89 | Dependencies from `tinc.yaml` will be added to your sandbox or can override 90 | existing dependencies from `package.yaml`. 91 | 92 | You can also use `tinc.yaml` without any `package.yaml` file (or `.cabal` file) 93 | to create a sandbox with dependencies. 94 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | import Distribution.Simple 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /default-override.nix: -------------------------------------------------------------------------------- 1 | { nixpkgs ? import {} }: 2 | let 3 | tinc = import ./tinc.nix { inherit nixpkgs; }; 4 | resolver = tinc.resolver; 5 | oldDrv = resolver.callPackage ./package.nix {}; 6 | makeWrapper = nixpkgs.makeWrapper; 7 | compiler = tinc.compiler; 8 | ghc = compiler.ghc; 9 | cabal2nix = compiler.cabal2nix; 10 | cabal-install = compiler.cabal-install; 11 | in nixpkgs.lib.overrideDerivation oldDrv (oldAttrs: { 12 | doCheck = false; 13 | configureFlags = [ "--disable-tests" ]; 14 | postInstall = '' 15 | source ${makeWrapper}/nix-support/setup-hook 16 | wrapProgram $out/bin/tinc \ 17 | --prefix PATH : '${ghc}/bin' \ 18 | --prefix PATH : '${cabal2nix}/bin' \ 19 | --prefix PATH : '${cabal-install}/bin' 20 | ''; 21 | }) 22 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | let 2 | default = { nixpkgs ? import {} }: 3 | (import ./tinc.nix { inherit nixpkgs; }).resolver.callPackage ./package.nix {}; 4 | overrideFile = ./default-override.nix; 5 | expr = if builtins.pathExists overrideFile then import overrideFile else default; 6 | in expr 7 | -------------------------------------------------------------------------------- /driver/tinc.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import System.Environment 4 | 5 | import Run 6 | 7 | main :: IO () 8 | main = getArgs >>= tinc 9 | -------------------------------------------------------------------------------- /get-tinc.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -o nounset 3 | set -o errexit 4 | 5 | dst="$HOME/.tinc/bin" 6 | tinc="$dst/tinc" 7 | 8 | mkdir -p "$dst" 9 | 10 | os="${1:-${TRAVIS_OS_NAME:-linux}}" 11 | url=$(curl --fail --silent --show-error https://api.github.com/repos/sol/tinc/releases/latest | jq -r ".assets[] | select(.name | test(\"$os\")) | .browser_download_url") 12 | 13 | echo "Downloading $url" 14 | 15 | curl --fail --silent --show-error --location "$url" | gunzip > "$tinc.tmp" 16 | chmod +x "$tinc.tmp" 17 | mv "$tinc.tmp" "$tinc" 18 | 19 | echo "Installed tinc to $tinc" 20 | -------------------------------------------------------------------------------- /package.nix: -------------------------------------------------------------------------------- 1 | { mkDerivation, aeson, base, bytestring, Cabal, call-stack 2 | , containers, directory, exceptions, filelock, filepath, gitrev 3 | , graph-wrapper, hpack, hspec, HUnit, language-dot, mockery, parsec 4 | , process, QuickCheck, safe, stdenv, store, temporary, time 5 | , transformers, unix, unix-compat, yaml 6 | }: 7 | mkDerivation { 8 | pname = "tinc"; 9 | version = "0.1.0"; 10 | src = ./.; 11 | isLibrary = false; 12 | isExecutable = true; 13 | executableHaskellDepends = [ 14 | aeson base bytestring Cabal call-stack containers directory 15 | exceptions filelock filepath gitrev graph-wrapper hpack 16 | language-dot parsec process store temporary time transformers 17 | unix-compat yaml 18 | ]; 19 | testHaskellDepends = [ 20 | aeson base bytestring Cabal call-stack containers directory 21 | exceptions filelock filepath gitrev graph-wrapper hpack hspec HUnit 22 | language-dot mockery parsec process QuickCheck safe store temporary 23 | time transformers unix unix-compat yaml 24 | ]; 25 | homepage = "https://github.com/sol/tinc#readme"; 26 | license = stdenv.lib.licenses.mit; 27 | } 28 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: tinc 2 | version: 0.2.0 3 | category: Development 4 | license: MIT 5 | copyright: 6 | - (c) 2015 Sönke Hahn 7 | - (c) 2015-2017 Simon Hengel 8 | author: Simon Hengel 9 | maintainer: Simon Hengel 10 | 11 | github: sol/tinc 12 | 13 | extra-source-files: 14 | - test/resources/* 15 | 16 | ghc-options: -Wall -fwarn-redundant-constraints 17 | 18 | dependencies: 19 | - base >= 4.11 20 | - graph-wrapper >= 0.2.5 21 | - language-dot 22 | - containers 23 | - directory 24 | - filepath 25 | - filelock 26 | - process >= 1.2 27 | - parsec 28 | - temporary 29 | - exceptions 30 | - transformers 31 | - hpack >= 0.34.2 32 | - aeson >= 0.11.0 33 | - bytestring 34 | - yaml 35 | - Cabal >= 2.0.0.2 36 | - unix-compat 37 | - call-stack 38 | - time 39 | - store 40 | 41 | source-dirs: src 42 | 43 | executables: 44 | tinc: 45 | main: tinc.hs 46 | source-dirs: driver 47 | 48 | tests: 49 | spec: 50 | main: Spec.hs 51 | source-dirs: test 52 | dependencies: 53 | - hspec 54 | - mockery >= 0.3.3 55 | - HUnit >= 1.4 56 | - safe 57 | - unix 58 | - QuickCheck 59 | cpp-options: -DTEST 60 | -------------------------------------------------------------------------------- /plugins/tinc-ghci: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | set -o nounset 3 | set -o errexit 4 | 5 | tinc --fast 6 | exec tinc exec ghci "$@" 7 | -------------------------------------------------------------------------------- /plugins/tinc-install: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | set -o nounset 3 | set -o errexit 4 | 5 | SANDBOX=$(mktemp -d "${TMPDIR:-/tmp}"/tinc-XXXX) 6 | trap "rm -rf $SANDBOX" EXIT 7 | 8 | if [ $# -eq 0 ]; then 9 | tarball=$(cabal v1-sdist | grep -o "\S*\.tar\.gz") 10 | cp $tarball $SANDBOX 11 | cd $SANDBOX 12 | tar xvf *.tar.gz 13 | elif [ $# -eq 1 ]; then 14 | cd $SANDBOX 15 | cabal unpack $1 16 | else 17 | >&2 echo "usage: tinc install [PACKAGE]" 18 | exit 1 19 | fi 20 | 21 | cd * 22 | tinc 23 | 24 | 25 | # NOTE: This is technically not necessary as we already ensure in Tinc.Facts 26 | # that TINC_USE_NIX is always set. We default TINC_USE_NIX to "no" here anyway 27 | # to give a smoother upgrade path, but it can and should be removed eventually. 28 | TINC_USE_NIX=${TINC_USE_NIX:-no} 29 | 30 | 31 | if [ "$TINC_USE_NIX" = "yes" ]; then 32 | find . -exec touch -d "1970-01-01 00:00:00 UTC" {} \; 33 | NAME=`sed -rn '/pname/ s/.*"(.*)";/\1/p' package.nix` 34 | nix-env -i "$NAME" -f default.nix 35 | else 36 | cabal v1-install --prefix ~/.tinc ${1:-} # we pass $1 here, as a workaround for https://github.com/haskell/cabal/issues/4593 37 | fi 38 | -------------------------------------------------------------------------------- /plugins/tinc-pkg: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | set -o nounset 3 | set -o errexit 4 | 5 | exec tinc exec ghc-pkg "$@" 6 | -------------------------------------------------------------------------------- /plugins/tinc-sensei: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | set -o nounset 3 | set -o errexit 4 | 5 | tinc --fast 6 | exec tinc exec sensei "$@" 7 | -------------------------------------------------------------------------------- /plugins/tinc-shell: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | set -o nounset 3 | set -o errexit 4 | 5 | tinc --fast 6 | 7 | if [ "$TINC_USE_NIX" != "yes" ]; then 8 | if [ ! -z "$1" ]; then 9 | exec tinc exec "$@" 10 | else 11 | exec tinc exec $SHELL 12 | fi 13 | else 14 | EXPR=$(cat <<'EOF' 15 | { nixpkgs ? import { } }: 16 | with nixpkgs; 17 | let 18 | oldDefault = import ./default.nix { inherit nixpkgs; }; 19 | oldShell = import ./shell.nix { inherit nixpkgs; }; 20 | in { 21 | default = lib.overrideDerivation oldDefault (oldAttrs: { 22 | phases = [ "installPhase" ]; 23 | name = "${oldAttrs.name}-default-toolchain"; 24 | installPhase = '' 25 | mkdir -p $out 26 | 27 | echo "$PATH " >> $out/paths 28 | echo "$LOCALE_ARCHIVE " >> $out/paths 29 | echo "$setupCompilerEnvironmentPhase " >> $out/paths 30 | echo "$stdenv " >> $out/paths 31 | echo "$nativeBuildInputs " >> $out/paths 32 | ''; 33 | }); 34 | 35 | shell = lib.overrideDerivation oldShell (oldAttrs: { 36 | phases = [ "installPhase" ]; 37 | name = "${oldAttrs.name}-shell-toolchain"; 38 | installPhase = '' 39 | mkdir -p $out 40 | 41 | echo "$LOCALE_ARCHIVE " >> $out/paths 42 | echo "$stdenv " >> $out/paths 43 | echo "$nativeBuildInputs " >> $out/paths 44 | ''; 45 | }); 46 | } 47 | EOF 48 | ) 49 | 50 | nix-build -o result-shell -E "$EXPR" 51 | 52 | if [ ! -z "$*" ]; then 53 | exec nix-shell --run "$*" 54 | else 55 | exec nix-shell 56 | fi 57 | fi 58 | -------------------------------------------------------------------------------- /plugins/tinc-test: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | set -o nounset 3 | set -o errexit 4 | 5 | tinc --fast 6 | cabal v1-exec -- cabal test --show-details=direct 7 | -------------------------------------------------------------------------------- /plugins/tinc-update: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | set -o nounset 3 | set -o errexit 4 | 5 | cabal v1-update 6 | rm -f tinc.freeze 7 | exec tinc 8 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | { nixpkgs ? import {} }: 2 | (import ./default.nix { inherit nixpkgs; }).env 3 | -------------------------------------------------------------------------------- /src/Run.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | module Run where 4 | 5 | import Control.Exception 6 | import Control.Monad 7 | import System.Environment 8 | import System.FileLock 9 | import System.FilePath 10 | import System.Process 11 | import Data.Version (showVersion) 12 | 13 | import Paths_tinc (version) 14 | 15 | import Tinc.Install 16 | import Tinc.Facts 17 | import Tinc.Types 18 | import Tinc.Nix 19 | import Tinc.RecentCheck 20 | 21 | unsetEnvVars :: IO () 22 | unsetEnvVars = do 23 | unsetEnv "CABAL_SANDBOX_CONFIG" 24 | unsetEnv "CABAL_SANDBOX_PACKAGE_PATH" 25 | unsetEnv "GHC_PACKAGE_PATH" 26 | 27 | tinc :: [String] -> IO () 28 | tinc args = do 29 | unsetEnvVars 30 | facts@Facts{..} <- getExecutablePath >>= discoverFacts 31 | case args of 32 | [] -> do 33 | withCacheLock factsCache $ do 34 | installDependencies False facts 35 | ["--fast"] -> do 36 | recent <- tincEnvCreationTime facts >>= isRecent 37 | unless recent $ do 38 | withCacheLock factsCache $ do 39 | installDependencies False facts 40 | ["--dry-run"] -> withCacheLock factsCache $ 41 | installDependencies True facts 42 | ["--version"] -> putStrLn $ showVersion version 43 | "exec" : name : rest -> callExec facts name rest 44 | name : rest | Just plugin <- lookup name factsPlugins -> callPlugin plugin rest 45 | _ -> throwIO (ErrorCall $ "unrecognized arguments: " ++ show args) 46 | 47 | callExec :: Facts -> String -> [String] -> IO () 48 | callExec Facts{..} name args = do 49 | let 50 | cmd 51 | | factsUseNix = nixShell name args 52 | | otherwise = ("cabal", "v1-exec" : "--" : name : args) 53 | uncurry rawSystemExit cmd 54 | 55 | callPlugin :: String -> [String] -> IO () 56 | callPlugin = rawSystemExit 57 | 58 | rawSystemExit :: FilePath -> [String] -> IO () 59 | rawSystemExit path args = rawSystem path args >>= throwIO 60 | 61 | withCacheLock :: Path CacheDir -> IO a -> IO a 62 | withCacheLock cache action = do 63 | putStrLn $ "Acquiring " ++ lock 64 | withFileLock lock Exclusive $ \ _ -> action 65 | where 66 | lock = path cache "tinc.lock" 67 | -------------------------------------------------------------------------------- /src/Tinc/Cabal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards #-} 2 | module Tinc.Cabal where 3 | 4 | import qualified Tinc.Nix as Nix 5 | import Tinc.Facts 6 | 7 | cabal :: Facts -> [String] -> (String, [String]) 8 | cabal facts@Facts{..} 9 | | factsUseNix = Nix.cabal facts 10 | | otherwise = (,) "cabal" 11 | -------------------------------------------------------------------------------- /src/Tinc/Cache.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | {-# LANGUAGE TupleSections #-} 5 | module Tinc.Cache ( 6 | Cache 7 | , CachedPackage(..) 8 | , readCache 9 | , findReusablePackages 10 | , cachedExecutables 11 | , populateCache 12 | 13 | #ifdef TEST 14 | , PopulateCacheAction(..) 15 | , populateCacheAction 16 | 17 | , PackageLocation(..) 18 | , readPackageGraph 19 | , readAddSourceHashes 20 | , addAddSourceHashes 21 | , listSandboxes 22 | #endif 23 | ) where 24 | 25 | import Control.Monad.Catch 26 | import Control.Monad 27 | import Control.Monad.IO.Class 28 | import Data.List 29 | import qualified Data.Map as Map 30 | import Data.Yaml 31 | import System.Directory hiding (getDirectoryContents, withCurrentDirectory) 32 | import System.FilePath 33 | import System.IO.Temp 34 | import Data.Function 35 | 36 | import Tinc.Fail 37 | import Tinc.GhcInfo 38 | import Tinc.GhcPkg 39 | import Tinc.Package 40 | import Tinc.PackageGraph 41 | import Tinc.Process 42 | import Tinc.Sandbox 43 | import Tinc.SourceDependency 44 | import Tinc.Types 45 | import Util 46 | 47 | data CachedPackage = CachedPackage { 48 | cachedPackageName :: Package 49 | , cachedPackageConfig :: Path PackageConfig 50 | } deriving (Eq, Show) 51 | 52 | cachedExecutables :: CachedPackage -> IO [FilePath] 53 | cachedExecutables (CachedPackage package (Path config)) = do 54 | exists <- doesDirectoryExist binDir 55 | if exists 56 | then listDirectoryContents binDir >>= mapM canonicalizePath 57 | else return [] 58 | where 59 | binDir = dropFileName config ".." "bin" showPackage package 60 | 61 | findReusablePackages :: Cache -> [Package] -> [CachedPackage] 62 | findReusablePackages (Cache globalPackages packageGraphs) installPlan = reusablePackages 63 | where 64 | reusablePackages :: [CachedPackage] 65 | reusablePackages = nubBy ((==) `on` cachedPackageName) (concatMap findReusable packageGraphs) 66 | 67 | findReusable :: PackageGraph PackageLocation -> [CachedPackage] 68 | findReusable packageGraph = 69 | [CachedPackage p c | (p, PackageConfig c) <- calculateReusablePackages packages packageGraph] 70 | where 71 | packages = nubBy ((==) `on` packageName) (installPlan ++ map fromSimplePackage globalPackages) 72 | 73 | data Cache = Cache { 74 | _cacheGlobalPackages :: [SimplePackage] 75 | , _cachePackageGraphs :: [PackageGraph PackageLocation] 76 | } 77 | 78 | data PackageLocation = GlobalPackage | PackageConfig (Path PackageConfig) 79 | deriving (Eq, Ord, Show) 80 | 81 | fromSimplePackage :: SimplePackage -> Package 82 | fromSimplePackage (SimplePackage name version) = Package name (Version version Nothing) 83 | 84 | readPackageGraph :: (MonadIO m, Fail m, GhcPkg m) => [SimplePackage] -> Path PackageDb -> Path PackageDb -> m (PackageGraph PackageLocation) 85 | readPackageGraph globalPackages globalPackageDb packageDb = do 86 | packageConfigs <- liftIO $ cachedListPackages packageDb 87 | let globalValues = map (, GlobalPackage) globalPackages 88 | let values = map (fmap PackageConfig) packageConfigs 89 | dot <- readDotFile 90 | fromDot (globalValues ++ values) dot >>= liftIO . addAddSourceHashes packageDb 91 | where 92 | dotFile = path packageDb "packages.dot" 93 | readDotFile = do 94 | cachedIOAfter (liftIO $ touchPackageCache packageDb) dotFile $ do 95 | readGhcPkg [globalPackageDb, packageDb] ["dot"] 96 | 97 | addSourceHashesFile :: FilePath 98 | addSourceHashesFile = "add-source.yaml" 99 | 100 | readAddSourceHashes :: Path PackageDb -> IO [SourceDependency] 101 | readAddSourceHashes packageDb = do 102 | let file = path packageDb addSourceHashesFile 103 | exists <- doesFileExist file 104 | if exists 105 | then decodeFileEither file >>= either (dieLoc . show) return 106 | else return [] 107 | 108 | writeAddSourceHashes :: Path PackageDb -> [SourceDependency] -> IO () 109 | writeAddSourceHashes packageDb addSourceHashes 110 | | null addSourceHashes = return () 111 | | otherwise = do 112 | encodeFile (path packageDb addSourceHashesFile) addSourceHashes 113 | touchPackageCache packageDb 114 | 115 | addAddSourceHash :: Map.Map String String -> SimplePackage -> PackageLocation -> Package 116 | addAddSourceHash hashes (SimplePackage name version) location = case location of 117 | PackageConfig _ -> maybe package (\ hash -> Package name (Version version $ Just hash)) (Map.lookup (packageName package) hashes) 118 | GlobalPackage -> package 119 | where 120 | package = Package name (Version version Nothing) 121 | 122 | addAddSourceHashes :: Path PackageDb -> SimplePackageGraph PackageLocation -> IO (PackageGraph PackageLocation) 123 | addAddSourceHashes packageDb graph = do 124 | hashes <- mkMap <$> readAddSourceHashes packageDb 125 | return $ mapIndex (addAddSourceHash hashes) graph 126 | where 127 | mkMap :: [SourceDependency] -> Map.Map String String 128 | mkMap hashes = Map.fromList (map (\ (SourceDependency name hash) -> (name, hash)) hashes) 129 | 130 | readCache :: GhcInfo -> Path CacheDir -> IO Cache 131 | readCache ghcInfo cacheDir = do 132 | globalPackages <- listGlobalPackages 133 | sandboxes <- listSandboxes cacheDir 134 | cache <- forM sandboxes $ \ sandbox -> do 135 | packageDbPath <- findPackageDb sandbox 136 | readPackageGraph globalPackages (ghcInfoGlobalPackageDb ghcInfo) packageDbPath 137 | return (Cache globalPackages cache) 138 | 139 | validMarker :: FilePath 140 | validMarker = "tinc.valid.v3" 141 | 142 | listSandboxes :: Path CacheDir -> IO [Path Sandbox] 143 | listSandboxes (Path cacheDir) = map Path <$> listEntries 144 | where 145 | isValidCacheEntry :: FilePath -> IO Bool 146 | isValidCacheEntry p = doesFileExist (p validMarker) 147 | 148 | listEntries :: IO [FilePath] 149 | listEntries = listDirectories cacheDir >>= filterM isValidCacheEntry 150 | 151 | data PopulateCacheAction = PopulateCacheAction { 152 | populateCacheActionInstallPlan :: [Package] 153 | , populateCacheActionAddSource :: [Path SourceDependency] 154 | , populateCacheActionWriteAddSourceHashes :: [SourceDependency] 155 | } deriving (Eq, Show) 156 | 157 | populateCacheAction :: Path SourceDependencyCache -> [Package] -> [CachedPackage] -> Either [CachedPackage] PopulateCacheAction 158 | populateCacheAction sourceDependencyCache missing reusable 159 | | null missing = Left reusable 160 | | otherwise = Right PopulateCacheAction { 161 | populateCacheActionInstallPlan = installPlan 162 | , populateCacheActionAddSource = addSource 163 | , populateCacheActionWriteAddSourceHashes = [SourceDependency name hash | Package name (Version _ (Just hash)) <- (missing ++ map cachedPackageName reusable)] 164 | } 165 | where 166 | installPlan :: [Package] 167 | installPlan = missing ++ [p | p@(Package _ (Version _ Nothing)) <- map cachedPackageName reusable] 168 | 169 | addSource :: [Path SourceDependency] 170 | addSource = map (sourceDependencyPath sourceDependencyCache) [SourceDependency name hash | Package name (Version _ (Just hash)) <- missing] 171 | 172 | populateCache :: (MonadIO m, MonadMask m, Fail m, MonadProcess m) => Path CacheDir -> Path SourceDependencyCache -> [Package] -> [CachedPackage] -> m [CachedPackage] 173 | populateCache cacheDir sourceDependencyCache missing reusable = either return populate (populateCacheAction sourceDependencyCache missing reusable) 174 | where 175 | populate PopulateCacheAction{..} = do 176 | sandbox <- liftIO $ newCacheEntry cacheDir 177 | withCurrentDirectory sandbox $ do 178 | packageDb <- initSandbox populateCacheActionAddSource (map cachedPackageConfig reusable) 179 | liftIO $ do 180 | writeAddSourceHashes packageDb populateCacheActionWriteAddSourceHashes 181 | writeFile validMarker "" 182 | callProcessM "cabal" ("v1-install" : "--bindir=$prefix/bin/$pkgid" : map showPackage populateCacheActionInstallPlan) 183 | map (uncurry CachedPackage) 184 | . ignore_add_source_hashes_for_now_as_we_currently_do_not_need_them 185 | <$> cachedListPackages packageDb 186 | 187 | ignore_add_source_hashes_for_now_as_we_currently_do_not_need_them = map (\ (a, b) -> (fromSimplePackage a, b)) 188 | 189 | newCacheEntry :: Path CacheDir -> IO FilePath 190 | newCacheEntry cacheDir = do 191 | basename <- takeBaseName <$> getCurrentDirectory 192 | createTempDirectory (path cacheDir) (basename ++ "-") 193 | -------------------------------------------------------------------------------- /src/Tinc/Config.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | module Tinc.Config ( 3 | getAdditionalDependencies 4 | , configFile 5 | ) where 6 | 7 | import GHC.Generics 8 | import Hpack.Config 9 | import Hpack.Yaml 10 | import System.Directory 11 | 12 | import Tinc.Fail 13 | 14 | data Config = Config { 15 | configDependencies :: Dependencies 16 | } deriving (Eq, Show, Generic) 17 | 18 | instance FromValue Config 19 | 20 | configFile :: FilePath 21 | configFile = "tinc.yaml" 22 | 23 | getAdditionalDependencies :: IO Dependencies 24 | getAdditionalDependencies = do 25 | exists <- doesFileExist configFile 26 | if exists 27 | then readConfig 28 | else return mempty 29 | 30 | readConfig :: IO Dependencies 31 | readConfig = decodeYaml configFile >>= either die (return . configDependencies . fst) . (>>= decodeValue . snd) 32 | -------------------------------------------------------------------------------- /src/Tinc/Facts.hs: -------------------------------------------------------------------------------- 1 | module Tinc.Facts where 2 | 3 | import Data.List 4 | import Control.Monad 5 | import Data.Maybe 6 | import System.Directory 7 | import System.Environment 8 | import System.FilePath 9 | import Data.Function 10 | 11 | import Tinc.GhcInfo 12 | import Tinc.SourceDependency 13 | import Tinc.Types 14 | 15 | data NixCache 16 | type Plugins = [Plugin] 17 | type Plugin = (String, FilePath) 18 | 19 | data Facts = Facts { 20 | factsCache :: Path CacheDir 21 | , factsGitCache :: Path GitCache 22 | , factsSourceDependencyCache :: Path SourceDependencyCache 23 | , factsNixCache :: Path NixCache 24 | , factsUseNix :: Bool 25 | , factsNixResolver :: Maybe String 26 | , factsPlugins :: Plugins 27 | , factsGhcInfo :: GhcInfo 28 | } deriving (Eq, Show) 29 | 30 | tincEnvVar :: String 31 | tincEnvVar = "TINC_USE_NIX" 32 | 33 | useNix :: FilePath -> IO Bool 34 | useNix executablePath = do 35 | maybe (isInNixStore executablePath) (`notElem` ["no", "0"]) <$> lookupEnv tincEnvVar 36 | 37 | isInNixStore :: FilePath -> Bool 38 | isInNixStore = ("/nix/" `isPrefixOf`) 39 | 40 | getNixResolver :: IO (Maybe String) 41 | getNixResolver = lookupEnv "TINC_NIX_RESOLVER" 42 | 43 | discoverFacts :: FilePath -> IO Facts 44 | discoverFacts executablePath = getGhcInfo >>= discoverFacts_impl executablePath 45 | 46 | discoverFacts_impl :: FilePath -> GhcInfo -> IO Facts 47 | discoverFacts_impl executablePath ghcInfo = do 48 | home <- getHomeDirectory 49 | useNix_ <- useNix executablePath 50 | nixResolver <- getNixResolver 51 | let pluginsDir :: FilePath 52 | pluginsDir = home ".tinc" "plugins" 53 | 54 | cacheDir :: Path CacheDir 55 | cacheDir = Path (home ".tinc" "cache" ghcFlavor ghcInfo) 56 | 57 | gitCache :: Path GitCache 58 | gitCache = Path (home ".tinc" "cache" "git") 59 | 60 | sourceDependencyCache :: Path SourceDependencyCache 61 | sourceDependencyCache = Path (home ".tinc" "cache" "add-source") 62 | 63 | nixCache :: Path NixCache 64 | nixCache = Path (home ".tinc" "cache" "nix") 65 | 66 | createDirectoryIfMissing True (path cacheDir) 67 | createDirectoryIfMissing True (path nixCache) 68 | createDirectoryIfMissing True pluginsDir 69 | plugins <- listAllPlugins pluginsDir 70 | if useNix_ 71 | then setEnv tincEnvVar "yes" 72 | else setEnv tincEnvVar "no" 73 | return Facts { 74 | factsCache = cacheDir 75 | , factsGitCache = gitCache 76 | , factsSourceDependencyCache = sourceDependencyCache 77 | , factsNixCache = nixCache 78 | , factsUseNix = useNix_ 79 | , factsNixResolver = nixResolver 80 | , factsPlugins = plugins 81 | , factsGhcInfo = ghcInfo 82 | } 83 | 84 | listAllPlugins :: FilePath -> IO Plugins 85 | listAllPlugins pluginsDir = do 86 | plugins <- listPlugins pluginsDir 87 | pathPlugins <- getSearchPath >>= listPathPlugins 88 | return (pathPlugins ++ plugins) 89 | 90 | listPlugins :: FilePath -> IO Plugins 91 | listPlugins pluginsDir = do 92 | exists <- doesDirectoryExist pluginsDir 93 | if exists 94 | then do 95 | files <- mapMaybe (stripPrefix "tinc-") <$> getDirectoryContents pluginsDir 96 | let f name = (name, pluginsDir "tinc-" ++ name) 97 | filterM isExecutable (map f files) 98 | else return [] 99 | 100 | isExecutable :: Plugin -> IO Bool 101 | isExecutable = fmap executable . getPermissions . snd 102 | 103 | listPathPlugins :: [FilePath] -> IO Plugins 104 | listPathPlugins = fmap (nubBy ((==) `on` fst) . concat) . mapM listPlugins 105 | -------------------------------------------------------------------------------- /src/Tinc/Fail.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ConstrainedClassMethods #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | module Tinc.Fail where 4 | 5 | import Data.CallStack 6 | import Control.Exception 7 | 8 | class (Functor m, Applicative m, Monad m) => Fail m where 9 | die :: String -> m a 10 | 11 | dieLoc :: HasCallStack => String -> m a 12 | dieLoc message = die (maybe "" ((++ ": ") . srcLocFile) location ++ message) 13 | where 14 | location :: HasCallStack => Maybe SrcLoc 15 | location = case reverse callStack of 16 | (_, loc) : _ -> Just loc 17 | _ -> Nothing 18 | 19 | bug :: HasCallStack => String -> m a 20 | bug message = (dieLoc . unlines) [ 21 | message 22 | , "This is most likely a bug. Please report an issue at:" 23 | , "" 24 | , " https://github.com/sol/tinc/issues" 25 | ] 26 | 27 | instance Fail IO where 28 | die = throwIO . ErrorCall 29 | -------------------------------------------------------------------------------- /src/Tinc/Freeze.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE ViewPatterns #-} 4 | module Tinc.Freeze ( 5 | Constraint 6 | , writeFreezeFile 7 | , readFreezeFile 8 | , freezeFile 9 | , addSourceConstraint 10 | ) where 11 | 12 | import Data.Aeson 13 | import qualified Data.ByteString as B 14 | import Data.Char 15 | import Data.Ord 16 | import Data.List 17 | import Data.Version (showVersion) 18 | import qualified Data.Yaml as Yaml 19 | import Hpack.Yaml 20 | import Data.Aeson.Types 21 | import Control.Exception 22 | import Control.Monad 23 | import System.IO.Error 24 | import System.Directory 25 | 26 | import Tinc.Fail 27 | import Tinc.Package 28 | import Tinc.SourceDependency 29 | 30 | type Constraint = String 31 | 32 | freezeFile :: FilePath 33 | freezeFile = "tinc.freeze" 34 | 35 | data Dependency = Dependency { 36 | name :: String 37 | , version :: String 38 | } deriving (Eq, Show, Generic) 39 | 40 | instance FromJSON Dependency 41 | 42 | instance ToJSON Dependency where 43 | toJSON = genericToJSON defaultOptions 44 | 45 | data FreezeFile = FreezeFile { 46 | dependencies :: [Dependency] 47 | } deriving (Eq, Show, Generic) 48 | 49 | instance FromJSON FreezeFile 50 | 51 | instance ToJSON FreezeFile where 52 | toJSON = genericToJSON defaultOptions 53 | 54 | writeFreezeFile :: [Package] -> IO () 55 | writeFreezeFile deps = do 56 | old <- either (const Nothing) Just <$> tryJust (guard . isDoesNotExistError) (B.readFile freezeFile) 57 | unless (Just contents == old) $ do 58 | B.writeFile freezeFile contents 59 | where 60 | contents = Yaml.encode $ FreezeFile (sortByName $ map toDependency deps) 61 | 62 | sortByName :: [Dependency] -> [Dependency] 63 | sortByName = sortBy $ comparing f 64 | where 65 | f :: Dependency -> (String, String) 66 | f (Dependency n _) = (map toLower n, n) 67 | 68 | toDependency :: Package -> Dependency 69 | toDependency (Package n (Version v _)) = Dependency {name = n, version = v} 70 | 71 | toConstraint :: Dependency -> Constraint 72 | toConstraint (Dependency n v) = "--constraint=" ++ n ++ " == " ++ v 73 | 74 | readFreezeFile :: [SourceDependency] -> IO [Constraint] 75 | readFreezeFile (map sourceDependencyPackageName -> sourceDependencies) = do 76 | exists <- doesFileExist freezeFile 77 | if exists 78 | then decodeYaml freezeFile >>= 79 | (either die (return . map toConstraint . removeAddSourceDependencies . dependencies)) . (>>= parseEither parseJSON . snd) 80 | else return [] 81 | where 82 | removeAddSourceDependencies = filter ((`notElem` sourceDependencies) . name) 83 | 84 | addSourceConstraint :: SourceDependencyWithVersion -> Constraint 85 | addSourceConstraint (SourceDependency n _, v) = toConstraint (Dependency n $ showVersion v) 86 | -------------------------------------------------------------------------------- /src/Tinc/GhcInfo.hs: -------------------------------------------------------------------------------- 1 | module Tinc.GhcInfo where 2 | 3 | import System.Process 4 | 5 | import Tinc.GhcPkg 6 | import Tinc.Types 7 | import Tinc.Fail 8 | 9 | data GhcInfo = GhcInfo { 10 | ghcInfoPlatform :: String 11 | , ghcInfoVersion :: String 12 | , ghcInfoGlobalPackageDb :: Path PackageDb 13 | } deriving (Eq, Show) 14 | 15 | getGhcInfo :: IO GhcInfo 16 | getGhcInfo = do 17 | fields <- read <$> readProcess "ghc" ["--info"] "" 18 | let lookupField :: String -> IO String 19 | lookupField name = do 20 | let err = "Output from `ghc --info` does not contain the field " ++ show name 21 | maybe (dieLoc err) return (lookup name fields) 22 | GhcInfo 23 | <$> lookupField "Target platform" 24 | <*> lookupField "Project version" 25 | <*> (Path <$> lookupField "Global Package DB") 26 | 27 | ghcFlavor :: GhcInfo -> String 28 | ghcFlavor ghcInfo = ghcInfoPlatform ghcInfo ++ "-ghc-" ++ ghcInfoVersion ghcInfo 29 | -------------------------------------------------------------------------------- /src/Tinc/GhcPkg.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ViewPatterns #-} 2 | module Tinc.GhcPkg ( 3 | PackageDb 4 | , GhcPkg(..) 5 | , listGlobalPackages 6 | ) where 7 | 8 | import System.Process 9 | 10 | import Tinc.Package 11 | import Tinc.Types 12 | 13 | data PackageDb 14 | 15 | class (Functor m, Applicative m, Monad m) => GhcPkg m where 16 | readGhcPkg :: [Path PackageDb] -> [String] -> m String 17 | 18 | instance GhcPkg IO where 19 | readGhcPkg (packageDbsToArgs -> packageDbs) args = do 20 | readProcess "ghc-pkg" ("--no-user-package-conf" : "--simple-output" : packageDbs ++ args) "" 21 | 22 | listGlobalPackages :: GhcPkg m => m [SimplePackage] 23 | listGlobalPackages = parsePackages <$> readGhcPkg [] ["list"] 24 | where 25 | parsePackages :: String -> [SimplePackage] 26 | parsePackages = map parsePackage . words 27 | 28 | packageDbsToArgs :: [Path PackageDb] -> [String] 29 | packageDbsToArgs packageDbs = concatMap (\ packageDb -> ["--package-conf", path packageDb]) packageDbs 30 | -------------------------------------------------------------------------------- /src/Tinc/Hpack.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedLists #-} 2 | module Tinc.Hpack ( 3 | readConfig 4 | , doesConfigExist 5 | , render 6 | , mkPackage 7 | ) where 8 | 9 | import System.Directory hiding (getDirectoryContents) 10 | import qualified Hpack.Config as Hpack 11 | import qualified Hpack.Render as Hpack 12 | 13 | import Tinc.Fail 14 | 15 | doesConfigExist :: IO Bool 16 | doesConfigExist = doesFileExist Hpack.packageConfig 17 | 18 | readConfig :: Hpack.Dependencies -> IO (String, Hpack.Package) 19 | readConfig additionalDeps = do 20 | r <- Hpack.readPackageConfig Hpack.defaultDecodeOptions >>= either die return 21 | return $ (Hpack.decodeResultCabalVersion r, addDependencies (Hpack.decodeResultPackage r)) 22 | where 23 | addDependencies :: Hpack.Package -> Hpack.Package 24 | addDependencies p 25 | | additionalDeps == mempty = p 26 | | otherwise = p {Hpack.packageExecutables = [mkExecutable additionalDeps] <> Hpack.packageExecutables p} 27 | 28 | render :: (String, Hpack.Package) -> (FilePath, String) 29 | render (cabalVersion, pkg) = (name, cabalVersion ++ contents) 30 | where 31 | name :: String 32 | name = Hpack.packageName pkg ++ ".cabal" 33 | 34 | contents :: String 35 | contents = Hpack.renderPackageWith Hpack.defaultRenderSettings 2 [] [] pkg 36 | 37 | mkPackage :: Hpack.Dependencies -> (String, Hpack.Package) 38 | mkPackage deps = ("cabal-version: >= 1.10\n", (Hpack.package "tinc-generated" "0.0.0"){Hpack.packageExecutables = [mkExecutable deps]}) 39 | 40 | mkExecutable :: Hpack.Dependencies -> (String, Hpack.Section Hpack.Executable) 41 | mkExecutable deps = 42 | ("tinc-generated", (Hpack.section $ Hpack.Executable (Just "Generated.hs") [] []){Hpack.sectionDependencies = deps}) 43 | -------------------------------------------------------------------------------- /src/Tinc/Install.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE ViewPatterns #-} 6 | module Tinc.Install ( 7 | installDependencies 8 | #ifdef TEST 9 | , cabalInstallPlan 10 | , cabalDryInstall 11 | , copyFreezeFile 12 | , generateCabalFile 13 | #endif 14 | ) where 15 | 16 | import Control.Monad.Catch 17 | import Control.Monad 18 | import Control.Monad.IO.Class 19 | import Data.List 20 | import System.Directory hiding (getDirectoryContents, withCurrentDirectory) 21 | import System.IO.Temp 22 | import System.FilePath 23 | import Control.Exception (IOException) 24 | 25 | import qualified Hpack.Config as Hpack 26 | import Tinc.Cabal 27 | import Tinc.Cache 28 | import Tinc.Config 29 | import Tinc.Fail 30 | import Tinc.Freeze 31 | import Tinc.GhcInfo 32 | import qualified Tinc.Hpack as Hpack 33 | import Tinc.Package 34 | import Tinc.Process 35 | import Tinc.Sandbox 36 | import Tinc.SourceDependency 37 | import Tinc.Facts 38 | import Tinc.Types 39 | import qualified Tinc.Nix as Nix 40 | import Tinc.RecentCheck 41 | import Util 42 | 43 | installDependencies :: Bool -> Facts -> IO () 44 | installDependencies dryRun facts@Facts{..} = do 45 | solveDependencies facts >>= if factsUseNix 46 | then doNix 47 | else doCabal 48 | where 49 | doCabal = 50 | createInstallPlan factsGhcInfo factsCache 51 | >=> tee printInstallPlan 52 | >=> unless dryRun . ( 53 | realizeInstallPlan factsCache factsSourceDependencyCache 54 | >=> \() -> markRecent factsGhcInfo 55 | ) 56 | where 57 | printInstallPlan :: InstallPlan -> IO () 58 | printInstallPlan (InstallPlan reusable missing) = do 59 | mapM_ (putStrLn . ("Reusing " ++) . showPackageDetailed) (map cachedPackageName reusable) 60 | mapM_ (putStrLn . ("Installing " ++) . showPackageDetailed) missing 61 | doNix = 62 | tee printInstallPlan 63 | >=> unless dryRun . ( 64 | tee writeFreezeFile -- Write the freeze file before generating the nix expressions, so that our recency check works properly 65 | >=> Nix.createDerivations facts 66 | ) 67 | where 68 | printInstallPlan :: [Package] -> IO () 69 | printInstallPlan packages = do 70 | mapM_ (putStrLn . ("Using " ++) . showPackageDetailed) packages 71 | 72 | data InstallPlan = InstallPlan { 73 | _installPlanReusable :: [CachedPackage] 74 | , _installPlanMissing :: [Package] 75 | } deriving (Eq, Show) 76 | 77 | createInstallPlan :: GhcInfo -> Path CacheDir -> [Package] -> IO InstallPlan 78 | createInstallPlan ghcInfo cacheDir installPlan = do 79 | cache <- readCache ghcInfo cacheDir 80 | let reusable = findReusablePackages cache installPlan 81 | missing = installPlan \\ map cachedPackageName reusable 82 | return (InstallPlan reusable missing) 83 | 84 | solveDependencies :: Facts -> IO [Package] 85 | solveDependencies facts@Facts{..} = do 86 | additionalDeps <- getAdditionalDependencies 87 | sourceDependencies <- extractSourceDependencies factsGitCache factsSourceDependencyCache additionalDeps 88 | cabalInstallPlan facts additionalDeps sourceDependencies 89 | 90 | cabalInstallPlan :: (MonadIO m, MonadMask m, Fail m, MonadProcess m) => Facts -> Hpack.Dependencies -> [SourceDependencyWithVersion] -> m [Package] 91 | cabalInstallPlan facts@Facts{..} additionalDeps sourceDependencyWithVersion = withSystemTempDirectory "tinc" $ \dir -> do 92 | liftIO $ copyFreezeFile dir 93 | cabalFile <- liftIO (generateCabalFile additionalDeps) 94 | constraints <- liftIO (readFreezeFile sourceDependencies) 95 | withCurrentDirectory dir $ do 96 | liftIO $ uncurry writeFile cabalFile 97 | _ <- initSandbox (map (sourceDependencyPath factsSourceDependencyCache) sourceDependencies) [] 98 | installPlan <- cabalDryInstall facts args constraints 99 | return $ markAddSourceDependencies installPlan 100 | where 101 | sourceDependencies = map fst sourceDependencyWithVersion 102 | addSourceConstraints = map addSourceConstraint sourceDependencyWithVersion 103 | args = ["--only-dependencies", "--enable-tests"] ++ addSourceConstraints 104 | markAddSourceDependencies = map addAddSourceHash 105 | addAddSourceHash :: SimplePackage -> Package 106 | addAddSourceHash (SimplePackage name version) = case lookup name addSourceHashes of 107 | Just rev -> Package name (Version version (Just rev)) 108 | Nothing -> Package name (Version version Nothing) 109 | addSourceHashes = [(name, rev) | SourceDependency name rev <- sourceDependencies] 110 | 111 | cabalDryInstall :: (MonadIO m, Fail m, MonadProcess m, MonadCatch m) => Facts -> [String] -> [Constraint] -> m [SimplePackage] 112 | cabalDryInstall facts args constraints = go >>= parseInstallPlan 113 | where 114 | install xs = uncurry readProcessM (cabal facts ("v1-install" : "--dry-run" : xs)) "" 115 | 116 | go = do 117 | r <- try $ install (args ++ constraints) 118 | case r of 119 | Left _ | (not . null) constraints -> install args 120 | Left err -> throwM (err :: IOException) 121 | Right s -> return s 122 | 123 | copyFreezeFile :: FilePath -> IO () 124 | copyFreezeFile dst = do 125 | exists <- doesFileExist cabalFreezeFile 126 | when exists $ do 127 | copyFile cabalFreezeFile (dst cabalFreezeFile) 128 | where 129 | cabalFreezeFile = "cabal.config" 130 | 131 | generateCabalFile :: Hpack.Dependencies -> IO (FilePath, String) 132 | generateCabalFile additionalDeps = do 133 | hasHpackConfig <- Hpack.doesConfigExist 134 | cabalFiles <- getCabalFiles "." 135 | case cabalFiles of 136 | _ | hasHpackConfig -> renderHpack 137 | [] | not (additionalDeps == mempty) -> return generated 138 | [cabalFile] -> reuseExisting cabalFile 139 | [] -> die "No cabal file found." 140 | _ -> die "Multiple cabal files found." 141 | where 142 | renderHpack :: IO (FilePath, String) 143 | renderHpack = Hpack.render <$> Hpack.readConfig additionalDeps 144 | 145 | generated :: (FilePath, String) 146 | generated = Hpack.render (Hpack.mkPackage additionalDeps) 147 | 148 | reuseExisting :: FilePath -> IO (FilePath, String) 149 | reuseExisting file = (,) file <$> readFile file 150 | 151 | realizeInstallPlan :: Path CacheDir -> Path SourceDependencyCache -> InstallPlan -> IO () 152 | realizeInstallPlan cacheDir sourceDependencyCache (InstallPlan reusable missing) = do 153 | packages <- populateCache cacheDir sourceDependencyCache missing reusable 154 | writeFreezeFile (missing ++ map cachedPackageName reusable) -- Write the freeze file before creating the sandbox, so that our recency check works properly 155 | void . initSandbox [] $ map cachedPackageConfig packages 156 | mapM cachedExecutables packages >>= mapM_ linkExecutable . concat 157 | where 158 | linkExecutable :: FilePath -> IO () 159 | linkExecutable name = linkFile name cabalSandboxBinDirectory 160 | -------------------------------------------------------------------------------- /src/Tinc/Nix.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ViewPatterns #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | module Tinc.Nix ( 5 | NixCache 6 | , cabal 7 | , nixShell 8 | , resolverFile 9 | , createDerivations 10 | #ifdef TEST 11 | , Function (..) 12 | , defaultDerivation 13 | , shellDerivation 14 | , resolverDerivation 15 | , pkgImport 16 | , parseNixFunction 17 | , disableTests 18 | , extractDependencies 19 | , derivationFile 20 | #endif 21 | ) where 22 | 23 | import Data.Char 24 | import Data.Maybe 25 | import Data.List 26 | import System.Directory 27 | import System.FilePath 28 | import System.Process.Internals (translate) 29 | import System.Process 30 | import System.IO 31 | 32 | import Tinc.Facts 33 | import Tinc.Package 34 | import Tinc.Types 35 | import Tinc.SourceDependency 36 | import Util 37 | 38 | type NixExpression = String 39 | type Argument = String 40 | type HaskellDependency = String 41 | type SystemDependency = String 42 | data Function = Function { 43 | _functionArguments :: [Argument] 44 | , _functionBody :: NixExpression 45 | } deriving (Eq, Show) 46 | 47 | packageFile :: FilePath 48 | packageFile = "package.nix" 49 | 50 | resolverFile :: FilePath 51 | resolverFile = "tinc.nix" 52 | 53 | defaultFile :: FilePath 54 | defaultFile = "default.nix" 55 | 56 | shellFile :: FilePath 57 | shellFile = "shell.nix" 58 | 59 | formatNixResolver :: Facts -> String 60 | formatNixResolver Facts{..} = maybe "haskellPackages" (("haskell.packages." ++) . show) factsNixResolver 61 | 62 | cabal :: Facts -> [String] -> (String, [String]) 63 | cabal facts args = ("nix-shell", ["-p", "curl", formatNixResolver facts ++ ".ghcWithPackages (p: [ p.cabal-install ])", "--pure", "--run", unwords $ "cabal" : map translate args]) 64 | 65 | nixShell :: String -> [String] -> (String, [String]) 66 | nixShell command args = ("nix-shell", [shellFile, "--run", unwords $ command : map translate args]) 67 | 68 | createDerivations :: Facts -> [Package] -> IO () 69 | createDerivations facts@Facts{..} dependencies = do 70 | mapM_ (populateCache factsSourceDependencyCache factsNixCache) dependencies 71 | pkgDerivation <- cabalToNix "." 72 | 73 | let knownHaskellDependencies = map packageName dependencies 74 | mapM (readDependencies factsNixCache knownHaskellDependencies) dependencies >>= resolverDerivation facts >>= writeFile resolverFile 75 | writeFile packageFile pkgDerivation 76 | writeFile defaultFile defaultDerivation 77 | writeFile shellFile shellDerivation 78 | 79 | populateCache :: Path SourceDependencyCache -> Path NixCache -> Package -> IO () 80 | populateCache sourceDependencyCache cache pkg = do 81 | _ <- cachedIO (derivationFile cache pkg) $ disableDocumentation . disableTests <$> go 82 | return () 83 | where 84 | go = case pkg of 85 | Package _ (Version _ Nothing) -> cabalToNix ("cabal://" ++ showPackage pkg) 86 | Package name (Version _ (Just ref)) -> do 87 | let p = path . sourceDependencyPath sourceDependencyCache $ SourceDependency name ref 88 | canonicalizePath p >>= cabalToNix 89 | 90 | disable :: String -> NixExpression -> NixExpression 91 | disable s xs = case lines xs of 92 | ys | attribute `elem` ys -> xs 93 | ys -> unlines . (++ [attribute, "}"]) . init $ ys 94 | where 95 | attribute = " " ++ s ++ " = false;" 96 | 97 | disableTests :: NixExpression -> NixExpression 98 | disableTests = disable "doCheck" 99 | 100 | disableDocumentation :: NixExpression -> NixExpression 101 | disableDocumentation = disable "doHaddock" 102 | 103 | cabalToNix :: String -> IO NixExpression 104 | cabalToNix uri = do 105 | hPutStrLn stderr $ "cabal2nix " ++ uri 106 | readProcess "cabal2nix" [uri] "" 107 | 108 | defaultDerivation :: NixExpression 109 | defaultDerivation = unlines [ 110 | "let" 111 | , " default = { nixpkgs ? import {} }:" 112 | , " (import ./" ++ resolverFile ++ " { inherit nixpkgs; }).resolver.callPackage ./" ++ packageFile ++ " {};" 113 | , " overrideFile = ./default-override.nix;" 114 | , " expr = if builtins.pathExists overrideFile then import overrideFile else default;" 115 | , "in expr" 116 | ] 117 | 118 | shellDerivation :: NixExpression 119 | shellDerivation = unlines [ 120 | "{ nixpkgs ? import {} }:" 121 | , "(import ./" ++ defaultFile ++ " { inherit nixpkgs; }).env" 122 | ] 123 | 124 | indent :: Int -> [String] -> [String] 125 | indent n = map f 126 | where 127 | f xs = case xs of 128 | "" -> "" 129 | _ -> replicate n ' ' ++ xs 130 | 131 | resolverDerivation :: Facts -> [(Package, [HaskellDependency], [SystemDependency])] -> IO NixExpression 132 | resolverDerivation facts@Facts{..} dependencies = do 133 | overrides <- concat <$> mapM getPkgDerivation dependencies 134 | return . unlines $ [ 135 | "{ nixpkgs }:" 136 | , "rec {" 137 | , " compiler = nixpkgs." ++ formatNixResolver facts ++ ";" 138 | , " resolver =" 139 | ] ++ indent 4 [ 140 | "let" 141 | , " callPackage = compiler.callPackage;" 142 | , "" 143 | , " overrideFunction = self: super: rec {" 144 | ] ++ indent 8 overrides ++ 145 | indent 4 [ 146 | " };" 147 | , "" 148 | , " newResolver = compiler.override {" 149 | , " overrides = overrideFunction;" 150 | , " };" 151 | , "" 152 | , "in newResolver;" 153 | ] ++ ["}"] 154 | where 155 | getPkgDerivation packageDeps@(package, _, _) = pkgImport packageDeps <$> readFile (derivationFile factsNixCache package) 156 | 157 | pkgImport :: (Package, [HaskellDependency], [SystemDependency]) -> NixExpression -> [String] 158 | pkgImport ((Package name _), haskellDependencies, systemDependencies) derivation = begin : indent 2 definition 159 | where 160 | begin = name ++ " = callPackage" 161 | derivationLines = lines derivation 162 | inlineDerivation = ["("] ++ indent 2 derivationLines ++ [")"] 163 | args = "{ " ++ inheritHaskellDependencies ++ inheritSystemDependencies ++ "};" 164 | definition = inlineDerivation ++ [args] 165 | inheritHaskellDependencies 166 | | null haskellDependencies = "" 167 | | otherwise = "inherit " ++ intercalate " " haskellDependencies ++ "; " 168 | inheritSystemDependencies 169 | | null systemDependencies = "" 170 | | otherwise = "inherit (nixpkgs) " ++ intercalate " " systemDependencies ++ "; " 171 | 172 | readDependencies :: Path NixCache -> [HaskellDependency] -> Package -> IO (Package, [HaskellDependency], [SystemDependency]) 173 | readDependencies cache knownHaskellDependencies package = do 174 | (\(haskellDeps, systemDeps) -> (package, haskellDeps, systemDeps)) . (`extractDependencies` knownHaskellDependencies) . parseNixFunction <$> readFile (derivationFile cache package) 175 | 176 | derivationFile :: Path NixCache -> Package -> FilePath 177 | derivationFile cache package = path cache showPackage package ++ rev ++ ".nix" 178 | where 179 | rev = case packageVersion package of 180 | Version _ (Just hash) -> "-" ++ hash 181 | _ -> "" 182 | 183 | parseNixFunction :: NixExpression -> Function 184 | parseNixFunction xs = case break (== '}') xs of 185 | (args, body) -> Function (split . filter (not . isSpace). dropWhile (`elem` "{ ") $ args) (dropWhile (`elem` "}: ") body) 186 | where 187 | split :: String -> [Argument] 188 | split = go "" 189 | where 190 | go acc ys = case ys of 191 | ',' : zs -> reverse acc : go "" zs 192 | z : zs -> go (z : acc) zs 193 | "" -> [reverse acc] 194 | 195 | extractDependencies :: Function -> [HaskellDependency] -> ([HaskellDependency], [SystemDependency]) 196 | extractDependencies (Function args body) knownHaskellDependencies = 197 | (haskellDependencies, systemDependencies) 198 | where 199 | haskellDependencies = filter (`notElem` systemDependencies) . filter (`elem` knownHaskellDependencies) $ args 200 | systemDependencies = parseSystemDependencies body 201 | 202 | parseSystemDependencies :: NixExpression -> [SystemDependency] 203 | parseSystemDependencies body = concatMap (words . takeWhile (/= ']')) . mapMaybe (stripPrefix "librarySystemDepends = [" . dropWhile isSpace) . lines $ body 204 | -------------------------------------------------------------------------------- /src/Tinc/Package.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | module Tinc.Package ( 4 | Package(..) 5 | , Version(..) 6 | , showPackage 7 | , showPackageDetailed 8 | , SimplePackage(..) 9 | , parsePackage 10 | , parseInstallPlan 11 | ) where 12 | 13 | import Data.List 14 | import Data.String 15 | import Data.Store 16 | import GHC.Generics 17 | 18 | import Tinc.Fail 19 | 20 | data Package = Package { 21 | packageName :: String 22 | , packageVersion :: Version 23 | } deriving (Eq, Ord, Show) 24 | 25 | data Version = Version { 26 | versionNumber :: String 27 | , versionAddSourceHash :: Maybe String 28 | } deriving (Eq, Ord, Show) 29 | 30 | instance IsString Version where 31 | fromString version = Version version Nothing 32 | 33 | showPackage :: Package -> String 34 | showPackage (Package name version) = name ++ "-" ++ showVersion version 35 | 36 | showVersion :: Version -> String 37 | showVersion (Version v _) = v 38 | 39 | showPackageDetailed :: Package -> String 40 | showPackageDetailed (Package name version) = name ++ "-" ++ showVersionDetailed version 41 | 42 | showVersionDetailed :: Version -> String 43 | showVersionDetailed (Version v mHash) = v ++ maybe "" (\ hash -> " (" ++ hash ++ ")") mHash 44 | 45 | data SimplePackage = SimplePackage { 46 | simplePackageName :: String 47 | , simplePackageVersion :: String 48 | } deriving (Eq, Ord, Show, Generic, Store) 49 | 50 | parsePackage :: String -> SimplePackage 51 | parsePackage s = case break (== '-') (reverse s) of 52 | (v, '-' : p) -> SimplePackage (reverse p) (reverse v) 53 | _ -> SimplePackage s "" 54 | 55 | parseInstallPlan :: Fail m => String -> m [SimplePackage] 56 | parseInstallPlan input = case lines input of 57 | "Resolving dependencies..." : what : packages | needsInstalls what -> return (parse packages) 58 | "Resolving dependencies..." : what : _ | alreadyInstalled what -> return [] 59 | _ -> bug ("unexpected output from `cabal v1-install --dry-run':\n\n " ++ show input ++ "\n") 60 | where 61 | needsInstalls = ("the following would be installed" `isInfixOf`) 62 | alreadyInstalled = (== "All the requested packages are already installed:") 63 | parse = map parsePackage . concatMap (take 1 . words) 64 | -------------------------------------------------------------------------------- /src/Tinc/PackageGraph.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TupleSections #-} 2 | {-# LANGUAGE ViewPatterns #-} 3 | module Tinc.PackageGraph ( 4 | PackageGraph 5 | , SimplePackageGraph 6 | , fromDot 7 | , calculateReusablePackages 8 | , mapIndex 9 | ) where 10 | 11 | import Control.Monad 12 | import Data.Graph.Wrapper as G 13 | import Data.Map (Map) 14 | import qualified Data.Map as Map 15 | import Data.Set (member) 16 | import qualified Data.Set as Set 17 | import Language.Dot.Parser as Dot 18 | import qualified Language.Dot.Syntax as Dot 19 | import Language.Dot.Syntax hiding (Graph) 20 | import Text.Parsec.Error 21 | 22 | import Tinc.Package 23 | import Tinc.Fail 24 | 25 | mapIndex :: (Ord i, Ord j) => (i -> v -> j) -> Graph i v -> Graph j v 26 | mapIndex f g = fromList $ map convert $ toList g 27 | where 28 | convert (i, v, depedencies) = (convertNode i, v, map convertNode depedencies) 29 | convertNode node = f node (vertex g node) 30 | 31 | type PackageGraph a = Graph Package a 32 | 33 | calculateReusablePackages :: Ord i => [i] -> Graph i v -> [(i, v)] 34 | calculateReusablePackages installPlan cache = filter p cachedPackages 35 | where 36 | installPlanSet = Set.fromList installPlan 37 | 38 | cachedPackages = map f (toList cache) 39 | where f (i, v, _) = (i, v) 40 | 41 | p (package, _) = 42 | package `member` installPlanSet && 43 | all (`member` installPlanSet) dependencies 44 | where 45 | dependencies = reachableVertices cache package 46 | 47 | -- * dot 48 | 49 | type SimplePackageGraph a = Graph SimplePackage a 50 | 51 | fromDot :: Fail m => [(SimplePackage, v)] -> String -> m (SimplePackageGraph v) 52 | fromDot values dot = case parseDot "" dot of 53 | Right (Dot.Graph _ _ _ statements) -> 54 | fmap fromMap $ 55 | foldM collectStatements (Map.fromList $ map (fmap (,[])) values) statements 56 | Left parseError -> dieLoc $ unlines $ map messageString $ errorMessages parseError 57 | 58 | type PackageMap v = Map SimplePackage (v, [SimplePackage]) 59 | 60 | collectStatements :: Fail m => PackageMap v -> Statement -> m (PackageMap v) 61 | collectStatements packageMap s = case s of 62 | NodeStatement (toPackage -> a) _ -> addDependencies a [] packageMap 63 | EdgeStatement [ENodeId _ (toPackage -> a), ENodeId _ (toPackage -> b)] _ -> 64 | addDependencies b [] packageMap >>= addDependencies a [b] 65 | x -> dieLoc ("Unsupported dot statements: " ++ show x) 66 | 67 | addDependencies :: Fail m => (Ord i, Show i) => i -> [dep] -> Map i (v, [dep]) -> m (Map i (v, [dep])) 68 | addDependencies package dependencies graph = case Map.lookup package graph of 69 | Nothing -> dieLoc ("No value for package: " ++ show package) 70 | Just (v, xs) -> return (Map.insert package (v, dependencies ++ xs) graph) 71 | 72 | fromMap :: Ord i => Map i (v, [i]) -> Graph i v 73 | fromMap = fromList . map f . Map.toList 74 | where 75 | f (i, (v, xs)) = (i, v, xs) 76 | 77 | toPackage :: NodeId -> SimplePackage 78 | toPackage (NodeId i _) = parsePackage $ case i of 79 | NameId s -> s 80 | StringId s -> s 81 | IntegerId int -> show int 82 | FloatId f -> show f 83 | x@XmlId{} -> show x 84 | -------------------------------------------------------------------------------- /src/Tinc/Process.hs: -------------------------------------------------------------------------------- 1 | module Tinc.Process where 2 | 3 | import qualified System.Process 4 | 5 | process :: MonadProcess m => Process m 6 | process = Process { 7 | readProcess = readProcessM 8 | , callProcess = callProcessM 9 | } 10 | 11 | data Process m = Process { 12 | readProcess :: FilePath -> [String] -> String -> m String 13 | , callProcess :: FilePath -> [String] -> m () 14 | } 15 | 16 | class (Functor m, Applicative m, Monad m) => MonadProcess m where 17 | readProcessM :: FilePath -> [String] -> String -> m String 18 | callProcessM :: FilePath -> [String] -> m () 19 | 20 | instance MonadProcess IO where 21 | readProcessM = System.Process.readProcess 22 | callProcessM = System.Process.callProcess 23 | -------------------------------------------------------------------------------- /src/Tinc/RecentCheck.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | module Tinc.RecentCheck ( 4 | isRecent 5 | , markRecent 6 | , tincEnvCreationTime 7 | ) where 8 | 9 | import Data.Maybe 10 | import Data.Time 11 | import System.Directory 12 | import System.FilePath 13 | 14 | import Tinc.Facts 15 | import Tinc.Nix 16 | import Tinc.Sandbox 17 | import Tinc.GhcInfo 18 | import qualified Tinc.Config as Tinc 19 | import qualified Hpack.Config as Hpack 20 | import Tinc.Freeze (freezeFile) 21 | import Util 22 | 23 | isRecent :: Maybe UTCTime -> IO Bool 24 | isRecent envCreationTime = case envCreationTime of 25 | Just packageMTime -> modificationTime freezeFile >>= \case 26 | Just freezeMTime -> do 27 | cabalFiles <- getCabalFiles "." 28 | xs <- mapM modificationTime (Tinc.configFile : Hpack.packageConfig : cabalFiles) 29 | return $ maximum (freezeMTime : catMaybes xs) < packageMTime 30 | Nothing -> return False 31 | Nothing -> return False 32 | 33 | tincEnvCreationTime :: Facts -> IO (Maybe UTCTime) 34 | tincEnvCreationTime Facts{..} = if factsUseNix 35 | then packageDotNixCreationTime 36 | else sandboxCreationTime factsGhcInfo 37 | 38 | modificationTime :: FilePath -> IO (Maybe UTCTime) 39 | modificationTime file = do 40 | exists <- doesFileExist file 41 | if exists then Just <$> getModificationTime file else return Nothing 42 | 43 | packageDotNixCreationTime :: IO (Maybe UTCTime) 44 | packageDotNixCreationTime = modificationTime resolverFile 45 | 46 | recentMarker :: GhcInfo -> FilePath 47 | recentMarker ghcInfo = cabalSandboxDirectory ghcFlavor ghcInfo ++ ".tinc" 48 | 49 | sandboxCreationTime :: GhcInfo -> IO (Maybe UTCTime) 50 | sandboxCreationTime ghcInfo = do 51 | modificationTime $ recentMarker ghcInfo 52 | 53 | markRecent :: GhcInfo -> IO () 54 | markRecent ghcInfo = do 55 | writeFile (recentMarker ghcInfo) "" 56 | -------------------------------------------------------------------------------- /src/Tinc/Sandbox.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | module Tinc.Sandbox ( 6 | PackageConfig 7 | , Sandbox 8 | 9 | , findPackageDb 10 | , touchPackageCache 11 | , initSandbox 12 | 13 | , cabalSandboxDirectory 14 | , cabalSandboxBinDirectory 15 | 16 | , cachedListPackages 17 | 18 | #ifdef TEST 19 | , listPackages 20 | , packageFromPackageConfig 21 | , registerPackage 22 | #endif 23 | ) where 24 | 25 | import Control.Monad 26 | import Control.Monad.IO.Class 27 | import Data.List 28 | import Data.Maybe 29 | import System.Directory hiding (getDirectoryContents) 30 | import System.FilePath 31 | import System.PosixCompat.Files 32 | 33 | import Util 34 | import Tinc.Fail 35 | import Tinc.GhcPkg 36 | import Tinc.Package 37 | import Tinc.Process 38 | import Tinc.Types 39 | import Tinc.SourceDependency 40 | 41 | data PackageConfig 42 | 43 | data Sandbox 44 | 45 | currentDirectory :: Path Sandbox 46 | currentDirectory = "." 47 | 48 | touchPackageCache :: Path PackageDb -> IO () 49 | touchPackageCache packageDb = touchFile (path packageDb "package.cache") 50 | 51 | initSandbox :: (MonadIO m, Fail m, MonadProcess m) => [Path SourceDependency] -> [Path PackageConfig] -> m (Path PackageDb) 52 | initSandbox sourceDependencies packageConfigs = do 53 | deleteSandbox 54 | callProcessM "cabal" ["v1-sandbox", "init"] 55 | packageDb <- findPackageDb currentDirectory 56 | registerPackageConfigs packageDb packageConfigs 57 | mapM_ (\ dep -> callProcessM "cabal" ["v1-sandbox", "add-source", path dep]) sourceDependencies 58 | liftIO $ createDirectoryIfMissing False cabalSandboxBinDirectory 59 | return packageDb 60 | 61 | deleteSandbox :: (MonadIO m, MonadProcess m) => m () 62 | deleteSandbox = do 63 | exists <- liftIO $ doesDirectoryExist cabalSandboxDirectory 64 | when exists (callProcessM "cabal" ["v1-sandbox", "delete"]) 65 | 66 | findPackageDb :: (MonadIO m, Fail m) => Path Sandbox -> m (Path PackageDb) 67 | findPackageDb sandbox = do 68 | xs <- liftIO $ getDirectoryContents sandboxDir 69 | case listToMaybe (filter isPackageDb xs) of 70 | Just p -> liftIO $ Path <$> canonicalizePath (sandboxDir p) 71 | Nothing -> dieLoc ("No package database found in " ++ show sandboxDir) 72 | where 73 | sandboxDir = path sandbox cabalSandboxDirectory 74 | 75 | isPackageDb :: FilePath -> Bool 76 | isPackageDb = ("-packages.conf.d" `isSuffixOf`) 77 | 78 | cabalSandboxDirectory :: FilePath 79 | cabalSandboxDirectory = ".cabal-sandbox" 80 | 81 | cabalSandboxBinDirectory :: FilePath 82 | cabalSandboxBinDirectory = cabalSandboxDirectory "bin" 83 | 84 | registerPackageConfigs :: (MonadIO m, MonadProcess m) => Path PackageDb -> [Path PackageConfig] -> m () 85 | registerPackageConfigs _packageDb [] = return () 86 | registerPackageConfigs packageDb packages = do 87 | liftIO $ forM_ packages (registerPackage packageDb) 88 | recache packageDb 89 | 90 | registerPackage :: Path PackageDb -> Path PackageConfig -> IO () 91 | registerPackage packageDb package = linkFile (path package) (path packageDb) 92 | 93 | cachedListPackages :: MonadIO m => Path PackageDb -> m [(SimplePackage, Path PackageConfig)] 94 | cachedListPackages p = do 95 | map (fmap Path) <$> cachedIOAfterStore (liftIO $ touchPackageCache p) cacheFile (listPackages p) 96 | where 97 | cacheFile = path p "packages.v2" 98 | 99 | listPackages :: MonadIO m => Path PackageDb -> m [(SimplePackage, FilePath)] 100 | listPackages p = do 101 | packageConfigs <- liftIO $ filter (".conf" `isSuffixOf`) <$> getDirectoryContents (path p) 102 | absolutePackageConfigs <- liftIO . mapM canonicalizePath $ map (path p ) packageConfigs 103 | packages <- mapM (liftIO . packageFromPackageConfig) absolutePackageConfigs 104 | return (zip packages absolutePackageConfigs) 105 | 106 | packageFromPackageConfig :: FilePath -> IO SimplePackage 107 | packageFromPackageConfig conf = do 108 | input <- readFile conf 109 | case parsePackageConfig (lines input) of 110 | Just x -> return x 111 | Nothing -> dieLoc (conf ++ ": parse error") 112 | 113 | parsePackageConfig :: [String] -> Maybe SimplePackage 114 | parsePackageConfig input = SimplePackage <$> name <*> version 115 | where 116 | name = readField "name" input 117 | version = readField "version" input 118 | readField field = listToMaybe . mapMaybe (stripPrefix $ field ++ ": ") 119 | 120 | recache :: MonadProcess m => Path PackageDb -> m () 121 | recache packageDb = callProcessM "ghc-pkg" ["--no-user-package-conf", "recache", "--package-conf", path packageDb] 122 | -------------------------------------------------------------------------------- /src/Tinc/SourceDependency.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ViewPatterns #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | {-# LANGUAGE DeriveGeneric #-} 5 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 6 | module Tinc.SourceDependency ( 7 | GitCache 8 | , SourceDependencyCache 9 | , SourceDependency(..) 10 | , SourceDependencyWithVersion 11 | , sourceDependencyPath 12 | , extractSourceDependencies 13 | #ifdef TEST 14 | , HpackSourceDependency(..) 15 | , Source(..) 16 | , Ref(..) 17 | , Rev(..) 18 | , CachedRev(..) 19 | , mapLocalDependencyToGitDependency 20 | , parseAddSourceDependencies 21 | , removeDuplicates 22 | , populateSourceDependencyCache 23 | 24 | , copyPackageConfig 25 | 26 | , gitClone_impl 27 | 28 | , gitRefToRev_impl 29 | , isGitRev 30 | , checkCabalName 31 | , findCabalFile 32 | , CabalPackage(..) 33 | , parseCabalFile 34 | #endif 35 | ) where 36 | 37 | import Control.Monad 38 | import Data.Function 39 | import Data.List 40 | import Data.Maybe 41 | import Data.String 42 | import Data.Tree 43 | import Data.Version 44 | 45 | import qualified Distribution.Version as Cabal 46 | 47 | import Distribution.Package hiding (Package) 48 | import Distribution.PackageDescription hiding (Git) 49 | import Distribution.PackageDescription.Parsec (readGenericPackageDescription) 50 | import Distribution.Verbosity 51 | import GHC.Fingerprint 52 | import qualified Hpack.Config as Hpack 53 | import System.Directory hiding (getDirectoryContents, withCurrentDirectory) 54 | import System.FilePath 55 | import System.IO.Temp 56 | import Data.Aeson 57 | import GHC.Generics 58 | import GHC.Exts 59 | 60 | import Tinc.Fail 61 | import Tinc.Types 62 | import Tinc.Process 63 | import Tinc.Hpack 64 | import Util 65 | 66 | data GitCache 67 | data SourceDependencyCache 68 | 69 | data SourceDependency = SourceDependency { 70 | sourceDependencyPackageName :: String 71 | 72 | -- This is one of: 73 | -- + git revision for git dependencies 74 | -- + md5(md5(git revision), md5(subdir)) for git dependencies that specify a subdir 75 | -- + md5 of local dependency for local dependencies 76 | , sourceDependencyHash :: String 77 | 78 | } deriving (Eq, Show, Generic) 79 | 80 | type SourceDependencyWithVersion = (SourceDependency, Version) 81 | 82 | data HpackSourceDependency a = HpackSourceDependency { 83 | _hpackSourceDependencyName :: String 84 | , _hpackSourceDependencySource :: Source a 85 | } deriving (Eq, Show) 86 | 87 | newtype Ref = Ref String 88 | deriving (Eq, Show, IsString) 89 | 90 | newtype Rev = Rev String 91 | deriving (Eq, Show, IsString) 92 | 93 | newtype CachedRev = CachedRev {unCachedRev :: String} 94 | deriving (Eq, Show, IsString) 95 | 96 | data Source a = Local FilePath | Git String a (Maybe FilePath) 97 | deriving (Eq, Show) 98 | 99 | addSourceJsonOptions :: Options 100 | addSourceJsonOptions = defaultOptions{fieldLabelModifier = camelTo2 '-' . drop (length ("SourceDependency" :: String))} 101 | 102 | instance FromJSON SourceDependency where 103 | parseJSON = genericParseJSON addSourceJsonOptions 104 | 105 | instance ToJSON SourceDependency where 106 | toJSON = genericToJSON addSourceJsonOptions 107 | 108 | sourceDependencyPath :: Path SourceDependencyCache -> SourceDependency -> Path SourceDependency 109 | sourceDependencyPath (Path cache) (SourceDependency name rev) = Path $ cache name rev 110 | 111 | extractSourceDependencies :: Path GitCache -> Path SourceDependencyCache -> Hpack.Dependencies -> IO [SourceDependencyWithVersion] 112 | extractSourceDependencies gitCache sourceDependencyCache additionalDeps = do 113 | parseAddSourceDependencies (toList additionalDeps) >>= fmap removeDuplicates . unfoldForestM go 114 | where 115 | go :: HpackSourceDependency Ref -> IO (SourceDependencyWithVersion, [HpackSourceDependency Ref]) 116 | go dep@(HpackSourceDependency _ source) = do 117 | resolvedDep <- resolveGitReferences dep 118 | cachedDep <- cacheGitRev gitCache resolvedDep >>= populateSourceDependencyCache gitCache sourceDependencyCache 119 | deps <- addSourceDependenciesFrom sourceDependencyCache (resolvedDep, cachedDep) 120 | version <- cabalPackageVersion <$> parseCabalFile (path $ sourceDependencyPath sourceDependencyCache cachedDep) source 121 | return ((cachedDep, version), deps) 122 | 123 | removeDuplicates :: Forest (SourceDependency, a) -> [(SourceDependency, a)] 124 | removeDuplicates = nubByPackageName . concat . removeFakeRoot . levels . addFakeRoot 125 | where 126 | fakeRoot = error "Tinc.SourceDependency.removeDuplicates: fake-root" 127 | addFakeRoot = Node fakeRoot 128 | removeFakeRoot = drop 1 129 | nubByPackageName = nubBy ((==) `on` (sourceDependencyPackageName . fst)) 130 | 131 | mapLocalDependencyToGitDependency :: Source Rev -> HpackSourceDependency Ref -> HpackSourceDependency Ref 132 | mapLocalDependencyToGitDependency source (HpackSourceDependency name dep) = case (source, dep) of 133 | (_, Git _ _ _) -> HpackSourceDependency name dep 134 | (Git url (Rev rev) subdir, Local path) -> HpackSourceDependency name (Git url (Ref rev) (Just p)) 135 | where 136 | p = normalise $ fromMaybe "." subdir path 137 | (Local path, Local p) -> HpackSourceDependency name (Local $ normalise (path p)) 138 | 139 | resolveGitReferences :: HpackSourceDependency Ref -> IO (HpackSourceDependency Rev) 140 | resolveGitReferences (HpackSourceDependency name source) = HpackSourceDependency name <$> case source of 141 | Git url ref subdir -> Git url <$> gitRefToRev url ref <*> pure subdir 142 | Local dir -> return (Local dir) 143 | 144 | cacheGitRev :: Path GitCache -> HpackSourceDependency Rev -> IO (HpackSourceDependency CachedRev) 145 | cacheGitRev cache (HpackSourceDependency name source) = HpackSourceDependency name <$> case source of 146 | Git url rev subdir -> Git url <$> gitClone cache url rev <*> pure subdir 147 | Local dir -> return (Local dir) 148 | 149 | gitClone :: Path GitCache -> String -> Rev -> IO CachedRev 150 | gitClone = gitClone_impl process 151 | 152 | gitClone_impl :: Process IO -> Path GitCache -> String -> Rev -> IO CachedRev 153 | gitClone_impl Process{..} cache url (Rev rev) = do 154 | createDirectoryIfMissing True (path cache) 155 | withTempDirectory (path cache) "tmp" $ \sandbox -> do 156 | let tmp = sandbox rev 157 | alreadyInCache <- doesDirectoryExist dst 158 | unless alreadyInCache $ do 159 | callProcess "git" ["clone", url, tmp] 160 | withCurrentDirectory tmp $ do 161 | callProcess "git" ["reset", "--hard", rev] 162 | removeDirectoryRecursive ".git" 163 | renameDirectory tmp dst 164 | return cachedRev 165 | where 166 | cachedRev = CachedRev rev 167 | Path dst = cachedRevPath cache cachedRev 168 | 169 | cachedRevPath :: Path GitCache -> CachedRev -> Path CachedRev 170 | cachedRevPath (Path cache) (CachedRev rev) = Path (cache rev) 171 | 172 | addSourceDependenciesFrom :: Path SourceDependencyCache -> (HpackSourceDependency Rev, SourceDependency) -> IO [HpackSourceDependency Ref] 173 | addSourceDependenciesFrom sourceDependencyCache (HpackSourceDependency _ source, addSource) = map (mapLocalDependencyToGitDependency source) <$> do 174 | exists <- doesFileExist config 175 | if exists 176 | then Hpack.readPackageConfig options >>= either die (return . filterAddSource . Hpack.packageDependencies . Hpack.decodeResultPackage) 177 | else return [] 178 | where 179 | options = Hpack.defaultDecodeOptions {Hpack.decodeOptionsTarget = config} 180 | config = path (sourceDependencyPath sourceDependencyCache addSource) Hpack.packageConfig 181 | 182 | filterAddSource :: [(String, Hpack.DependencyInfo)] -> [HpackSourceDependency Ref] 183 | filterAddSource deps = [HpackSourceDependency name (toSource addSource) | (name, Hpack.DependencyInfo _ (Hpack.DependencyVersion (Just addSource) _)) <- deps] 184 | where 185 | toSource :: Hpack.SourceDependency -> Source Ref 186 | toSource x = case x of 187 | Hpack.GitRef repo ref subdir -> Git repo (Ref ref) subdir 188 | Hpack.Local dir -> Local dir 189 | 190 | parseAddSourceDependencies :: [(String, Hpack.DependencyInfo)] -> IO [HpackSourceDependency Ref] 191 | parseAddSourceDependencies additionalDeps = do 192 | exists <- doesConfigExist 193 | packageDeps <- if exists 194 | then do 195 | pkg <- readConfig mempty 196 | return $ Hpack.packageDependencies (snd pkg) 197 | else return [] 198 | let deps = additionalDeps ++ packageDeps 199 | return (nubBy ((==) `on` _hpackSourceDependencyName) $ filterAddSource deps) 200 | 201 | populateSourceDependencyCache :: Path GitCache -> Path SourceDependencyCache -> HpackSourceDependency CachedRev -> IO SourceDependency 202 | populateSourceDependencyCache gitCache cache dep@(HpackSourceDependency name source) = do 203 | createDirectoryIfMissing True (path cache name) 204 | case source of 205 | Git _ rev subdir -> do 206 | let 207 | cacheKey = case subdir of 208 | Nothing -> unCachedRev rev 209 | Just dir -> show $ fingerprintFingerprints [fingerprintString (unCachedRev rev), fingerprintString dir] 210 | addSource = SourceDependency name cacheKey 211 | src = maybe revPath (revPath ) subdir 212 | where revPath = path (cachedRevPath gitCache rev) 213 | dst = (path $ sourceDependencyPath cache addSource) 214 | alreadyInCache <- doesDirectoryExist dst 215 | unless alreadyInCache $ do 216 | checkCabalName src dep 217 | linkFile src dst 218 | return addSource 219 | Local dir -> do 220 | withTempDirectory (path cache) "tmp" $ \sandbox -> do 221 | let tmp = sandbox name 222 | createDirectory tmp 223 | cabalSdist dir tmp 224 | copyPackageConfig dir tmp 225 | fp <- fingerprint tmp 226 | let addSource = SourceDependency name fp 227 | moveToSourceDependencyCache cache tmp dep addSource 228 | return addSource 229 | 230 | copyPackageConfig :: FilePath -> FilePath -> IO () 231 | copyPackageConfig srcDir dstDir = do 232 | whenM (doesFileExist src) $ do 233 | copyFile src dst 234 | where 235 | src = srcDir Hpack.packageConfig 236 | dst = dstDir Hpack.packageConfig 237 | 238 | gitRefToRev :: String -> Ref -> IO Rev 239 | gitRefToRev = gitRefToRev_impl process {readProcess = verboseReadProcess} 240 | where 241 | verboseReadProcess command args input = do 242 | putStrLn (unwords $ command : args) 243 | r <- readProcess process command args input 244 | putStr r 245 | return r 246 | 247 | gitRefToRev_impl :: Fail m => Process m -> String -> Ref -> m Rev 248 | gitRefToRev_impl Process{..} repo (Ref ref) 249 | | isGitRev ref = return (Rev ref) 250 | | otherwise = do 251 | r <- readProcess "git" ["ls-remote", repo, ref] "" 252 | case words r of 253 | rev : _ | isGitRev rev -> return (Rev rev) 254 | _ -> die ("invalid reference " ++ show ref ++ " for git repository " ++ repo) 255 | 256 | isGitRev :: String -> Bool 257 | isGitRev ref = length ref == 40 && all (`elem` "0123456789abcdef") ref 258 | 259 | cabalSdist :: FilePath -> FilePath -> IO () 260 | cabalSdist sourceDirectory dst = do 261 | withCurrentDirectory sourceDirectory $ do 262 | callProcessM "cabal" ["v1-sdist", "--output-directory", dst] 263 | 264 | moveToSourceDependencyCache :: Path SourceDependencyCache -> FilePath -> HpackSourceDependency a -> SourceDependency -> IO () 265 | moveToSourceDependencyCache cache src hpackDep dep = do 266 | checkCabalName src hpackDep 267 | let dst = sourceDependencyPath cache dep 268 | unlessM (doesDirectoryExist $ path dst) $ do 269 | renameDirectory src $ path dst 270 | 271 | checkCabalName :: FilePath -> HpackSourceDependency a -> IO () 272 | checkCabalName directory (HpackSourceDependency expectedName source) = do 273 | name <- cabalPackageName <$> parseCabalFile directory source 274 | if name == expectedName 275 | then return () 276 | else die ("the " ++ subject source ++ " contains package " ++ show name 277 | ++ ", expected: " ++ show expectedName) 278 | 279 | subject :: Source a -> String 280 | subject addSource = case addSource of 281 | Git url _ subdir -> maybe "" (\dir -> "directory " ++ show dir ++ " of ") subdir ++ "git repository " ++ url 282 | Local dir -> "directory " ++ dir 283 | 284 | data CabalPackage = CabalPackage { 285 | cabalPackageName :: String 286 | , cabalPackageVersion :: Version 287 | } deriving (Eq, Show) 288 | 289 | parseCabalFile :: FilePath -> Source a -> IO CabalPackage 290 | parseCabalFile dir source = do 291 | cabalFile <- findCabalFile dir source 292 | pkg <- package . packageDescription <$> readGenericPackageDescription silent cabalFile 293 | case Cabal.versionNumbers (pkgVersion pkg) of 294 | [] -> die $ "the cabal file in " ++ subject source ++ " does not specify a version" 295 | v -> return $ CabalPackage (unPackageName $ pkgName pkg) (makeVersion v) 296 | 297 | findCabalFile :: FilePath -> Source a -> IO FilePath 298 | findCabalFile dir addSource = do 299 | cabalFiles <- getCabalFiles dir 300 | case cabalFiles of 301 | [cabalFile] -> return (dir cabalFile) 302 | [] -> die ("Couldn't find .cabal file in " ++ subject addSource) 303 | _ -> die ("Multiple cabal files found in " ++ subject addSource) 304 | -------------------------------------------------------------------------------- /src/Tinc/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | module Tinc.Types where 3 | 4 | import Data.String 5 | 6 | data CacheDir 7 | 8 | newtype Path a = Path {path :: FilePath} 9 | deriving (Eq, Ord, Show, IsString) 10 | -------------------------------------------------------------------------------- /src/Util.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module Util where 3 | 4 | import Control.Monad.Catch 5 | import Control.Monad 6 | import Control.Monad.IO.Class 7 | import Data.Char 8 | import Data.List 9 | import GHC.Fingerprint 10 | import System.Directory hiding (getDirectoryContents, withCurrentDirectory) 11 | import qualified System.Directory as Directory 12 | import System.FilePath 13 | import System.Process 14 | import qualified Data.ByteString as B 15 | import Data.Store 16 | 17 | import Tinc.Fail 18 | 19 | strip :: String -> String 20 | strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse 21 | 22 | linkFile :: FilePath -> FilePath -> IO () 23 | linkFile src_ dst = do 24 | src <- canonicalizePath src_ 25 | callProcess "ln" ["-s", src, dst] 26 | 27 | withCurrentDirectory :: (MonadIO m, MonadMask m) => FilePath -> m a -> m a 28 | withCurrentDirectory dir action = do 29 | bracket (liftIO getCurrentDirectory) (liftIO . setCurrentDirectory) $ \ _ -> do 30 | liftIO $ setCurrentDirectory dir 31 | action 32 | 33 | getDirectoryContents :: FilePath -> IO [FilePath] 34 | getDirectoryContents dir = filter (`notElem` [".", ".."]) <$> Directory.getDirectoryContents dir 35 | 36 | listDirectoryContents :: FilePath -> IO [FilePath] 37 | listDirectoryContents dir = sort . map (dir ) <$> getDirectoryContents dir 38 | 39 | listDirectories :: FilePath -> IO [FilePath] 40 | listDirectories dir = listDirectoryContents dir >>= filterM doesDirectoryExist 41 | 42 | listFilesRecursively :: FilePath -> IO [FilePath] 43 | listFilesRecursively dir = do 44 | c <- listDirectoryContents dir 45 | subdirsFiles <- filterM doesDirectoryExist c >>= mapM listFilesRecursively 46 | files <- filterM doesFileExist c 47 | return (files ++ concat subdirsFiles) 48 | 49 | fingerprint :: FilePath -> IO String 50 | fingerprint dir = withCurrentDirectory dir $ do 51 | files <- listFilesRecursively "." 52 | show . fingerprintFingerprints . sort <$> mapM fingerprintFile files 53 | where 54 | fingerprintFile :: FilePath -> IO Fingerprint 55 | fingerprintFile file = do 56 | hash <- getFileHash file 57 | return $ fingerprintFingerprints [hash, fingerprintString file] 58 | 59 | cachedIO :: FilePath -> IO String -> IO String 60 | cachedIO = cachedIOAfter (return ()) 61 | 62 | cachedIOAfter :: MonadIO m => m () -> FilePath -> m String -> m String 63 | cachedIOAfter = cachedIOAfterWith writeFile (fmap Just <$> readFile) 64 | 65 | cachedIOAfterStore :: (MonadIO m, Store a) => m () -> FilePath -> m a -> m a 66 | cachedIOAfterStore actionAfter file = cachedIOAfterWith store load actionAfter (file ++ ".store-" ++ VERSION_store) 67 | where 68 | store name = B.writeFile name . encode 69 | load name = either (const Nothing) Just . decode <$> B.readFile name 70 | 71 | cachedIOAfterWith :: MonadIO m => (FilePath -> a -> IO ()) -> (FilePath -> IO (Maybe a)) -> m () -> FilePath -> m a -> m a 72 | cachedIOAfterWith store load actionAfter file action = do 73 | exists <- liftIO $ doesFileExist file 74 | if exists 75 | then do 76 | liftIO $ do 77 | r <- load file 78 | case r of 79 | Just x -> return x 80 | Nothing -> dieLoc (file ++ ": parse error") 81 | else do 82 | result <- action 83 | liftIO $ store (file ++ ".tmp") result 84 | liftIO $ renameFile (file ++ ".tmp") file 85 | actionAfter 86 | return result 87 | 88 | tee :: Monad m => (a -> m ()) -> a -> m a 89 | tee action a = action a >> return a 90 | 91 | getCabalFiles :: FilePath -> IO [FilePath] 92 | getCabalFiles dir = filter (not . ("." `isPrefixOf`)) . filter (".cabal" `isSuffixOf`) <$> getDirectoryContents dir 93 | 94 | whenM :: Monad m => m Bool -> m () -> m () 95 | whenM condition action = condition >>= (`when` action) 96 | 97 | unlessM :: Monad m => m Bool -> m () -> m () 98 | unlessM condition action = condition >>= (`unless` action) 99 | -------------------------------------------------------------------------------- /test/All.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=All #-} 2 | -------------------------------------------------------------------------------- /test/Helper.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# OPTIONS_GHC -fno-warn-orphans #-} 3 | module Helper ( 4 | module Test.Hspec 5 | , module Test.Mockery.Directory 6 | , facts 7 | 8 | , module Tinc.Process 9 | , process 10 | ) where 11 | 12 | import Test.Hspec 13 | import Test.Mockery.Directory 14 | import Test.Mockery.Action 15 | 16 | import Tinc.Facts 17 | import Tinc.Process hiding (process) 18 | 19 | facts :: Facts 20 | facts = Facts { 21 | factsCache = error "factsCache" 22 | , factsGitCache = error "factsGitCache" 23 | , factsSourceDependencyCache = error "factsAddSoruceCache" 24 | , factsNixCache = error "factsNixCache" 25 | , factsUseNix = False 26 | , factsNixResolver = Nothing 27 | , factsPlugins = [] 28 | , factsGhcInfo = error "factsGhcInfo" 29 | } 30 | 31 | process :: HasCallStack => Process IO 32 | process = Process { 33 | readProcess = dummy "readProcess" 34 | , callProcess = dummy "callProcess" 35 | } 36 | -------------------------------------------------------------------------------- /test/MockedEnv.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | module MockedEnv where 3 | 4 | import Control.Monad.Catch 5 | import Control.Monad.Trans.Reader 6 | import Control.Monad.IO.Class 7 | 8 | import Tinc.Fail 9 | 10 | import Control.Monad.Trans.Class 11 | 12 | newtype WithEnv e a = WithEnv (ReaderT e IO a) 13 | deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch, MonadMask) 14 | 15 | instance Fail (WithEnv e) where 16 | die = WithEnv . lift . die 17 | 18 | withEnv :: e -> WithEnv e a -> IO a 19 | withEnv e (WithEnv action) = runReaderT action e 20 | -------------------------------------------------------------------------------- /test/MockedProcess.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | module MockedProcess where 3 | 4 | import MockedEnv 5 | 6 | import Control.Monad.IO.Class 7 | import Control.Monad.Trans.Reader 8 | 9 | import Tinc.Process 10 | 11 | type ReadProcess = FilePath -> [String] -> String -> IO String 12 | type CallProcess = FilePath -> [String] -> IO () 13 | 14 | data Env = Env { 15 | envReadProcess :: ReadProcess 16 | , envCallProcess :: CallProcess 17 | } 18 | 19 | env :: Env 20 | env = Env readProcessM callProcessM 21 | 22 | instance MonadProcess (WithEnv Env) where 23 | readProcessM command args input = WithEnv $ asks envReadProcess >>= liftIO . ($ input) . ($ args) . ($ command) 24 | callProcessM command args = WithEnv $ asks envCallProcess >>= liftIO . ($ args) . ($ command) 25 | -------------------------------------------------------------------------------- /test/RunSpec.hs: -------------------------------------------------------------------------------- 1 | module RunSpec (spec) where 2 | 3 | import Helper 4 | import System.Exit 5 | 6 | import Run 7 | 8 | spec :: Spec 9 | spec = do 10 | describe "callPlugin" $ do 11 | it "propagates success" $ do 12 | callPlugin "true" [] `shouldThrow` (== ExitSuccess) 13 | 14 | it "propagates error" $ do 15 | callPlugin "false" [] `shouldThrow` (== ExitFailure 1) 16 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Test.Hspec 4 | 5 | import Run (unsetEnvVars) 6 | import qualified All 7 | 8 | main :: IO () 9 | main = hspec spec 10 | 11 | spec :: Spec 12 | spec = beforeAll_ unsetEnvVars All.spec 13 | -------------------------------------------------------------------------------- /test/Test/Mockery/Action.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | module Test.Mockery.Action ( 5 | Dummy (..) 6 | , dummy 7 | , dummy_ 8 | , Stub (..) 9 | , Mockable (..) 10 | ) where 11 | 12 | import Control.Monad.IO.Class 13 | import Control.Monad 14 | import Data.IORef 15 | import Data.List 16 | import Test.Hspec 17 | 18 | failure :: HasCallStack => String -> IO a 19 | failure err = expectationFailure err >> return undefined 20 | 21 | dummy :: HasCallStack => Dummy a => String -> a 22 | dummy = dummyNamed . Just 23 | 24 | dummy_ :: HasCallStack => Dummy a => a 25 | dummy_ = dummyNamed Nothing 26 | 27 | class Dummy a where 28 | dummyNamed :: HasCallStack => Maybe String -> a 29 | 30 | instance Dummy (IO r) where 31 | dummyNamed name = dummyNamed name () 32 | 33 | instance Dummy (a -> IO r) where 34 | dummyNamed name = dummyNamed name () 35 | 36 | instance Dummy (a -> b -> IO r) where 37 | dummyNamed name = dummyNamed name () 38 | 39 | instance Dummy (a -> b -> c -> IO r) where 40 | dummyNamed name = dummyNamed name () 41 | 42 | instance Dummy (a -> b -> c -> d -> IO r) where 43 | dummyNamed name = dummyNamed name () 44 | 45 | instance Dummy (a -> b -> c -> d -> e -> IO r) where 46 | dummyNamed name = dummyNamed name () 47 | 48 | instance Dummy (a -> b -> c -> d -> e -> f -> IO r) where 49 | dummyNamed name _ _ _ _ _ _ = do 50 | let err = "Unexpected call to dummy action" ++ maybe "!" (": " ++) name 51 | failure err 52 | 53 | class Stub a where 54 | type Action_ a 55 | stub :: HasCallStack => a -> Action_ a 56 | 57 | instance (MonadIO m, Eq a, Show a) => Stub (a, m r) where 58 | type Action_ (a, m r) = (a -> m r) 59 | stub option = stub [option] 60 | 61 | instance (MonadIO m, Eq a, Show a, Eq b, Show b) => Stub (a, b, m r) where 62 | type Action_ (a, b, m r) = (a -> b -> m r) 63 | stub option = stub [option] 64 | 65 | instance (MonadIO m, Eq a, Show a, Eq b, Show b, Eq c, Show c) => Stub (a, b, c, m r) where 66 | type Action_ (a, b, c, m r) = (a -> b -> c -> m r) 67 | stub option = stub [option] 68 | 69 | instance (MonadIO m, Eq a, Show a) => Stub [(a, m r)] where 70 | type Action_ [(a, m r)] = a -> m r 71 | stub expected actual = case lookup actual expected of 72 | Just r -> r 73 | _ -> unexpectedParameters False (map fst expected) actual 74 | 75 | instance (MonadIO m, Eq a, Show a, Eq b, Show b) => Stub [(a, b, m r)] where 76 | type Action_ [(a, b, m r)] = (a -> b -> m r) 77 | stub options a1 b1 = case lookup actual expected of 78 | Just r -> r 79 | _ -> unexpectedParameters True (map fst expected) actual 80 | where 81 | actual = (a1, b1) 82 | expected = map (\(a, b, r) -> ((a, b), r)) options 83 | 84 | instance (MonadIO m, Eq a, Show a, Eq b, Show b, Eq c, Show c) => Stub [(a, b, c, m r)] where 85 | type Action_ [(a, b, c, m r)] = (a -> b -> c -> m r) 86 | stub options a1 b1 c1 = case lookup actual expected of 87 | Just r -> r 88 | _ -> unexpectedParameters True (map fst expected) actual 89 | where 90 | actual = (a1, b1, c1) 91 | expected = map (\(a, b, c, r) -> ((a, b, c), r)) options 92 | 93 | unexpectedParameters :: HasCallStack => (MonadIO m, Show a) => Bool -> [a] -> a -> m r 94 | unexpectedParameters plural expected actual = do 95 | liftIO . failure . unlines $ [ 96 | message 97 | , expectedMessage 98 | , actualMessage 99 | ] 100 | where 101 | message 102 | | plural = "Unexected parameters to stubbed action!" 103 | | otherwise = "Unexected parameter to stubbed action!" 104 | 105 | expectedMessage = case expected of 106 | [x] -> "expected: " ++ show x 107 | _ -> "expected one of: " ++ (intercalate ", " $ map show expected) 108 | 109 | actualMessage = case expected of 110 | [_] -> " but got: " ++ show actual 111 | _ -> " but got: " ++ show actual 112 | 113 | class Mockable a where 114 | withMock :: HasCallStack => a -> (a -> IO x) -> IO x 115 | mockChain :: HasCallStack => [a] -> (a -> IO x) -> IO x 116 | 117 | instance Mockable (a -> IO r) where 118 | withMock action inner = withMock (\() -> action) $ inner . ($ ()) 119 | mockChain options inner = mockChain (map const options) $ inner . ($ ()) 120 | 121 | instance Mockable (a -> b -> IO r) where 122 | withMock action inner = withMock (\() -> action) $ inner . ($ ()) 123 | mockChain options inner = mockChain (map const options) $ inner . ($ ()) 124 | 125 | instance Mockable (a -> b -> c -> IO r) where 126 | withMock action inner = withMock (\() -> action) $ inner . ($ ()) 127 | mockChain options inner = mockChain (map const options) $ inner . ($ ()) 128 | 129 | instance Mockable (a -> b -> c -> d -> IO r) where 130 | withMock action inner = withMock (\() -> action) $ inner . ($ ()) 131 | mockChain options inner = mockChain (map const options) $ inner . ($ ()) 132 | 133 | instance Mockable (a -> b -> c -> d -> e -> IO r) where 134 | withMock action inner = withMock (\() -> action) $ inner . ($ ()) 135 | mockChain options inner = mockChain (map const options) $ inner . ($ ()) 136 | 137 | instance Mockable (a -> b -> c -> d -> e -> f -> IO r) where 138 | withMock action inner = do 139 | ref <- newIORef (0 :: Integer) 140 | let wrapped a b c d e f = action a b c d e f <* modifyIORef ref succ 141 | inner wrapped <* do 142 | n <- readIORef ref 143 | unless (n == 1) $ do 144 | failure ("Expected to be called once, but it was called " ++ show n ++ " times instead!") 145 | 146 | mockChain options inner = do 147 | let n = length options 148 | ref <- newIORef options 149 | let 150 | takeOption xs = case xs of 151 | y : ys -> (ys, Just y) 152 | [] -> ([], Nothing) 153 | 154 | wrapped a b c d e f = do 155 | option <- atomicModifyIORef ref takeOption 156 | case option of 157 | Just action -> action a b c d e f 158 | Nothing -> failure ("Expected to be called only " ++ pluralize n "time" ++ ", but it received an additional call!") 159 | 160 | inner wrapped <* do 161 | leftover <- readIORef ref 162 | case leftover of 163 | [] -> return () 164 | xs -> failure ("Expected to be called " ++ pluralize n "time" ++ ", but it was called " ++ pluralize (n - length xs) "time" ++ " instead!") 165 | 166 | pluralize :: Int -> String -> String 167 | pluralize 1 s = "1 " ++ s 168 | pluralize n s = show n ++ " " ++ s ++ "s" 169 | -------------------------------------------------------------------------------- /test/Test/Mockery/ActionSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module Test.Mockery.ActionSpec (spec) where 3 | 4 | import Test.Hspec 5 | import Control.Monad 6 | 7 | import Test.HUnit.Lang 8 | import Test.Mockery.Action 9 | 10 | hUnitFailure :: String -> HUnitFailure -> Bool 11 | hUnitFailure actual (HUnitFailure _ reason) = case reason of 12 | Reason expected -> actual == expected 13 | _ -> False 14 | 15 | spec :: Spec 16 | spec = do 17 | describe "dummy" $ do 18 | it "fails" $ do 19 | (dummy "test" :: Int -> Int -> IO Int) 23 42 `shouldThrow` hUnitFailure "Unexpected call to dummy action: test" 20 | 21 | describe "stub" $ do 22 | context "with one parameter" $ do 23 | context "when receiving specified parameters" $ do 24 | it "returns specified value" $ do 25 | stub ("foo", return "r") "foo" `shouldReturn` "r" 26 | 27 | context "when receiving unexpected parameters" $ do 28 | it "throws an exception" $ do 29 | stub ("foo", return "r") "bar" `shouldThrow` (hUnitFailure . unlines) [ 30 | "Unexected parameter to stubbed action!" 31 | , "expected: " ++ show "foo" 32 | , " but got: " ++ show "bar" 33 | ] 34 | 35 | context "with two parameters" $ do 36 | context "when receiving specified parameters" $ do 37 | it "returns specified value" $ do 38 | stub ("foo", "bar", return "r") "foo" "bar" `shouldReturn` "r" 39 | 40 | context "when receiving unexpected parameters" $ do 41 | it "throws an exception" $ do 42 | stub ("foo", "bar", return "r") "23" "42" `shouldThrow` (hUnitFailure . unlines) [ 43 | "Unexected parameters to stubbed action!" 44 | , "expected: " ++ show ("foo", "bar") 45 | , " but got: " ++ show ("23", "42") 46 | ] 47 | 48 | context "with three parameters" $ do 49 | context "when receiving specified parameters" $ do 50 | it "returns specified value" $ do 51 | stub ("foo", "bar", "baz", return "r") "foo" "bar" "baz" `shouldReturn` "r" 52 | 53 | context "when receiving unexpected parameters" $ do 54 | it "throws an exception" $ do 55 | stub ("foo", "bar", "baz", return "r") "23" "42" "65" `shouldThrow` (hUnitFailure . unlines) [ 56 | "Unexected parameters to stubbed action!" 57 | , "expected: " ++ show ("foo", "bar", "baz") 58 | , " but got: " ++ show ("23", "42", "65") 59 | ] 60 | 61 | context "when used with lists" $ do 62 | context "with two parameters" $ do 63 | context "when receiving specified parameters" $ do 64 | it "returns specified value" $ do 65 | stub [("foo", "bar", return "r"), ("foo", "baz", return "_")] "foo" "bar" `shouldReturn` "r" 66 | 67 | context "when receiving unexpected parameters" $ do 68 | it "throws an exception" $ do 69 | stub [(10, 20, return ()), (23, 42, return ())] (23 :: Int) (65 :: Int) `shouldThrow` (hUnitFailure . unlines) [ 70 | "Unexected parameters to stubbed action!" 71 | , "expected one of: (10,20), (23,42)" 72 | , " but got: (23,65)" 73 | ] 74 | 75 | describe "withMock" $ do 76 | let 77 | withMockSpec stubbedAction call = do 78 | context "when action is called once" $ do 79 | it "passes" $ do 80 | withMock stubbedAction $ \action -> do 81 | call action 82 | `shouldReturn` "r" 83 | 84 | context "when action is called multiple times" $ do 85 | it "fails" $ do 86 | withMock stubbedAction $ \action -> do 87 | replicateM_ 10 (call action) 88 | `shouldThrow` hUnitFailure "Expected to be called once, but it was called 10 times instead!" 89 | 90 | context "when action is not called" $ do 91 | it "fails" $ do 92 | withMock stubbedAction $ \_ -> do 93 | return () 94 | `shouldThrow` hUnitFailure "Expected to be called once, but it was called 0 times instead!" 95 | 96 | context "with one parameter" $ do 97 | let stubbedAction = stub ("foo", return "r") 98 | call action = action "foo" 99 | withMockSpec stubbedAction call 100 | 101 | context "with two parameters" $ do 102 | let stubbedAction = stub ("foo", "bar", return "r") 103 | call action = action "foo" "bar" 104 | withMockSpec stubbedAction call 105 | 106 | context "with three parameters" $ do 107 | let stubbedAction = stub ("foo", "bar", "baz", return "r") 108 | call action = action "foo" "bar" "baz" 109 | withMockSpec stubbedAction call 110 | 111 | describe "mockChain" $ do 112 | let actions = replicate 2 $ stub ("foo", "bar", return "r") 113 | 114 | context "when mock is called the specified number of times" $ do 115 | it "passes" $ do 116 | mockChain actions $ \mock -> do 117 | replicateM_ 2 (mock "foo" "bar") 118 | 119 | context "when mock is called too often" $ do 120 | it "fails" $ do 121 | mockChain actions $ \mock -> do 122 | replicateM_ 3 (mock "foo" "bar") 123 | `shouldThrow` hUnitFailure "Expected to be called only 2 times, but it received an additional call!" 124 | 125 | context "when mock is not called often enough" $ do 126 | it "fails" $ do 127 | mockChain actions $ \mock -> do 128 | replicateM_ 1 (mock "foo" "bar") 129 | `shouldThrow` hUnitFailure "Expected to be called 2 times, but it was called 1 time instead!" 130 | -------------------------------------------------------------------------------- /test/Tinc/CacheSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE ViewPatterns #-} 4 | module Tinc.CacheSpec (spec) where 5 | 6 | import Helper 7 | import MockedEnv 8 | import MockedProcess 9 | import Test.Mockery.Action 10 | 11 | import Control.Monad.IO.Class 12 | import Control.Monad.Trans.Reader 13 | import Data.List 14 | import qualified Data.Graph.Wrapper as G 15 | import Safe 16 | import System.FilePath 17 | import System.IO.Temp 18 | import System.Directory 19 | 20 | import Tinc.Cache 21 | import Tinc.GhcPkg 22 | import Tinc.Package 23 | import Tinc.Sandbox 24 | import Tinc.SourceDependency 25 | import Tinc.Types 26 | 27 | import Tinc.SandboxSpec (writePackageConfig) 28 | 29 | data ReadGhcPkgEnv = ReadGhcPkgEnv { 30 | envReadGhcPkg :: [Path PackageDb] -> [String] -> IO String 31 | } 32 | 33 | ghcPkgEnv :: ReadGhcPkgEnv 34 | ghcPkgEnv = ReadGhcPkgEnv readGhcPkg 35 | 36 | instance GhcPkg (WithEnv ReadGhcPkgEnv) where 37 | readGhcPkg packageDbs args = WithEnv $ asks envReadGhcPkg >>= liftIO . ($ args) . ($ packageDbs) 38 | 39 | toSimplePackage :: Package -> SimplePackage 40 | toSimplePackage (Package name (Version version _)) = SimplePackage name version 41 | 42 | fromSimplePackage :: SimplePackage -> Package 43 | fromSimplePackage (SimplePackage name version) = Package name (Version version Nothing) 44 | 45 | spec :: Spec 46 | spec = do 47 | describe "readPackageGraph" $ do 48 | context "when a package has no dependencies and no other packages depend on it" $ do 49 | it "includes package" $ do 50 | -- NOTE: `ghc-pkg dot` omits packages from the graph that both: 51 | -- 52 | -- 1. have no dependencies 53 | -- 2. no other packages depend on 54 | -- 55 | -- This test case makes sure that we properly handle this. 56 | 57 | withSystemTempDirectory "tinc" $ \ (Path -> packageDb) -> do 58 | let package = Package "foo" "0.1.0" 59 | packageConfig = Path $ path packageDb "foo-0.1.0-8b77e2706d2c2c9243c5d86e44c11aa6.conf" 60 | graph = "digraph g {}" 61 | globalPackageDb = "/path/to/global/package.conf.d" 62 | packageDbs = [globalPackageDb, packageDb] 63 | 64 | mockedEnv = ghcPkgEnv {envReadGhcPkg = stub (packageDbs, ["dot"], return graph)} 65 | writePackageConfig (toSimplePackage package, path packageConfig) 66 | touch $ path packageDb "package.cache" 67 | 68 | withEnv mockedEnv (readPackageGraph [] globalPackageDb packageDb) 69 | `shouldReturn` G.fromList [(package, PackageConfig packageConfig, [])] 70 | 71 | describe "addAddSourceHashes" $ do 72 | let hash = "8cd0e753e18b1576cbe3eb2e61977a3b0debf430" 73 | foo = SimplePackage "foo" "0.1.0" 74 | writeAddSourceHashes packageDb = 75 | writeFile (path packageDb "add-source.yaml") "- {package-name: foo, hash: 8cd0e753e18b1576cbe3eb2e61977a3b0debf430}" 76 | 77 | it "adds add-source hashes to a package graph" $ do 78 | withSystemTempDirectory "tinc" $ \ (Path -> packageDb) -> do 79 | let fooConfig = PackageConfig "" 80 | graph = G.fromList [(foo, fooConfig, [])] 81 | writeAddSourceHashes packageDb 82 | addAddSourceHashes packageDb graph `shouldReturn` 83 | G.fromList [(Package "foo" (Version "0.1.0" $ Just hash), fooConfig, [])] 84 | 85 | it "doesn't attach add-source hashes to global packages" $ do 86 | withSystemTempDirectory "tinc" $ \ (Path -> packageDb) -> do 87 | let fooConfig = GlobalPackage 88 | graph = G.fromList [(foo, fooConfig, [])] 89 | writeAddSourceHashes packageDb 90 | addAddSourceHashes packageDb graph `shouldReturn` 91 | G.fromList [(fromSimplePackage foo, fooConfig, [])] 92 | 93 | describe "populateCacheAction" $ do 94 | let sourceDependencyCache = "/path/to/add-source-cache" 95 | 96 | it "adds add-source dependencies to the sandbox" $ do 97 | let missing = [Package "foo" (Version "0.1.0" $ Just "foo-hash")] 98 | populateCacheActionAddSource <$> populateCacheAction sourceDependencyCache missing [] `shouldBe` 99 | Right ["/path/to/add-source-cache/foo/foo-hash"] 100 | 101 | it "does not add reusable add-source dependencies to the sandbox" $ do 102 | let missing = [Package "foo" "0.1.0"] 103 | reusable = [CachedPackage (Package "bar" (Version "0.2.0" $ Just "bar-hash")) "bar.conf"] 104 | populateCacheActionAddSource <$> populateCacheAction sourceDependencyCache missing reusable `shouldBe` Right [] 105 | 106 | it "does not include reusable add-source dependencies in the install plan" $ do 107 | let missing = [Package "foo" "0.1.0"] 108 | reusable = [CachedPackage (Package "bar" (Version "0.2.0" $ Just "bar-hash")) "bar.conf"] 109 | populateCacheActionInstallPlan <$> populateCacheAction sourceDependencyCache missing reusable `shouldBe` Right missing 110 | 111 | it "stores hashes of add-source dependencies in the cache" $ do 112 | let missing = [Package "foo" (Version "0.1.0" $ Just "foo-hash")] 113 | reusable = [CachedPackage (Package "bar" (Version "0.2.0" $ Just "bar-hash")) "bar.conf"] 114 | populateCacheActionWriteAddSourceHashes <$> populateCacheAction sourceDependencyCache missing reusable `shouldBe` 115 | Right [SourceDependency "foo" "foo-hash", SourceDependency "bar" "bar-hash"] 116 | 117 | context "when list of missing packages is empty" $ do 118 | let missing = [] 119 | it "returns reusable packages" $ do 120 | let reusable = [CachedPackage (Package "foo" "0.1.0") "foo.conf", CachedPackage (Package "bar" "0.2.0") "bar.conf"] 121 | populateCacheAction sourceDependencyCache missing reusable `shouldBe` Left reusable 122 | 123 | describe "populateCache" $ do 124 | let cabalSandboxInit = ("cabal", ["v1-sandbox", "init"], touch ".cabal-sandbox/x86_64-linux-ghc-7.8.4-packages.conf.d/package.cache") 125 | 126 | it "uses add-source dependencies" $ 127 | inTempDirectory $ do 128 | withSystemTempDirectory "tinc" $ \ (Path -> cache) -> do 129 | withSystemTempDirectory "tinc" $ \ (Path -> sourceDependencyCache) -> do 130 | let mockedCallProcess command args = stub [cabalSandboxInit, cabalAddSource, cabalInstall, recache] command args 131 | where 132 | packageDb = atDef "/path/to/some/tmp/dir" args 3 133 | cabalAddSource = ("cabal", ["v1-sandbox", "add-source", path sourceDependencyCache "foo" "abc"], writeFile "add-source" "foo") 134 | cabalInstall = ("cabal", ["v1-install", "--bindir=$prefix/bin/$pkgid", "foo-0.1.0"], (readFile "add-source" `shouldReturn` "foo") >> writeFile "install" "bar") 135 | recache = ("ghc-pkg", ["--no-user-package-conf", "recache", "--package-conf", packageDb], return ()) 136 | 137 | mockedEnv = env {envReadProcess = dummy "envReadProcess", envCallProcess = mockedCallProcess} 138 | _ <- withEnv mockedEnv $ 139 | populateCache cache sourceDependencyCache [Package "foo" "0.1.0"{versionAddSourceHash = Just "abc"}] [] 140 | [sandbox] <- listSandboxes cache 141 | readFile (path sandbox "install") `shouldReturn` "bar" 142 | 143 | it "stores hashes of add-source dependencies in the cache" $ 144 | inTempDirectory $ do 145 | withSystemTempDirectory "tinc" $ \ (Path -> cache) -> do 146 | withSystemTempDirectory "tinc" $ \ (Path -> sourceDependencyCache) -> do 147 | let mockedCallProcess command args = stub [cabalSandboxInit, cabalAddSource "foo/abc", cabalAddSource "bar/def", cabalInstall, recache] command args 148 | where 149 | packageDb = atDef "/path/to/some/tmp/dir" args 3 150 | cabalAddSource packageCachePath = 151 | ("cabal", ["v1-sandbox", "add-source", path sourceDependencyCache packageCachePath], return ()) 152 | cabalInstall = ("cabal", ["v1-install", "--bindir=$prefix/bin/$pkgid", "foo-0.1.0"], return ()) 153 | recache = ("ghc-pkg", ["--no-user-package-conf", "recache", "--package-conf", packageDb], return ()) 154 | 155 | mockedEnv = env {envReadProcess = dummy "envReadProcess", envCallProcess = mockedCallProcess} 156 | let barPackageConfig = Path (path cache "foo") 157 | touch $ path barPackageConfig 158 | _ <- withEnv mockedEnv $ 159 | populateCache cache sourceDependencyCache 160 | [Package "foo" "0.1.0"{versionAddSourceHash = Just "abc"}] 161 | [CachedPackage (Package "bar" "0.1.0"{versionAddSourceHash = Just "def"}) barPackageConfig] 162 | [sandbox] <- listSandboxes cache 163 | packageDb <- findPackageDb sandbox 164 | readAddSourceHashes packageDb `shouldReturn` [SourceDependency "foo" "abc", SourceDependency "bar" "def"] 165 | 166 | context "when list of missing packages is empty" $ do 167 | it "returns reusable packages" $ do 168 | let mockedEnv = env {envReadProcess = undefined, envCallProcess = undefined} 169 | reusable = [ 170 | CachedPackage (Package "foo" "0.1.0") "foo.conf" 171 | , CachedPackage (Package "bar" "0.1.0") "bar.conf" 172 | ] 173 | withEnv mockedEnv (populateCache undefined undefined [] reusable) 174 | `shouldReturn` reusable 175 | 176 | describe "listSandboxes" $ do 177 | it "lists sandboxes" $ do 178 | inTempDirectory $ do 179 | touch "foo/tinc.valid.v3" 180 | touch "bar/tinc.valid.v3" 181 | sandboxes <- listSandboxes "." 182 | sandboxes `shouldMatchList` ["./foo", "./bar"] 183 | 184 | it "rejects invalid sandboxes" $ do 185 | inTempDirectory $ do 186 | touch "foo/tinc.valid.v3" 187 | touch "bar/something" 188 | sandboxes <- listSandboxes "." 189 | sandboxes `shouldMatchList` ["./foo"] 190 | 191 | describe "cachedExecutables" $ do 192 | let sandbox = ".cabal-sandbox" 193 | packageConfig = Path (sandbox "packages.conf.d/markdown-unlit-0.1.0-269c14.conf") 194 | package = Package "markdown-unlit" "0.1.0" 195 | cachedPackage = CachedPackage package packageConfig 196 | executables = [ 197 | sandbox "bin/markdown-unlit-0.1.0/foo" 198 | , sandbox "bin/markdown-unlit-0.1.0/bar" 199 | ] 200 | it "returns executables for specified package" $ do 201 | inTempDirectory $ do 202 | touch (path packageConfig) 203 | mapM_ touch executables 204 | dir <- getCurrentDirectory 205 | cachedExecutables cachedPackage `shouldReturn` sort (map (dir ) executables) 206 | 207 | context "when package has no executables" $ do 208 | it "returns empty list" $ do 209 | inTempDirectory $ do 210 | touch (path packageConfig) 211 | cachedExecutables cachedPackage `shouldReturn` [] 212 | -------------------------------------------------------------------------------- /test/Tinc/ConfigSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE OverloadedLists #-} 3 | module Tinc.ConfigSpec where 4 | 5 | import Test.Hspec 6 | import Test.Mockery.Directory 7 | 8 | import Tinc.SourceDependencySpec (anyVersion) 9 | 10 | import Tinc.Config 11 | 12 | spec :: Spec 13 | spec = do 14 | describe "getAdditionalDependencies" $ do 15 | it "return additional dependencies from tinc.yaml" $ do 16 | inTempDirectory $ do 17 | writeFile "tinc.yaml" $ unlines [ 18 | "dependencies:" 19 | , " - foo" 20 | ] 21 | getAdditionalDependencies `shouldReturn` [("foo", anyVersion)] 22 | 23 | context "when tinc.yaml does not exist" $ do 24 | it "returns an empty list" $ do 25 | inTempDirectory $ do 26 | getAdditionalDependencies `shouldReturn` mempty 27 | -------------------------------------------------------------------------------- /test/Tinc/FactsSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards #-} 2 | module Tinc.FactsSpec (spec) where 3 | 4 | import Test.Hspec 5 | import Test.Mockery.Directory 6 | import Test.Mockery.Environment 7 | import System.Directory 8 | import System.Environment 9 | import System.FilePath 10 | import System.Process 11 | import System.IO.Temp 12 | 13 | import Tinc.Types 14 | import Tinc.GhcInfo 15 | import Tinc.Facts 16 | 17 | mkExecutable :: FilePath -> IO () 18 | mkExecutable p = do 19 | touch p 20 | callProcess "chmod" ["+x", p] 21 | 22 | withTempHome :: IO () -> IO () 23 | withTempHome action = withSystemTempDirectory "hspec" $ \dir -> do 24 | env <- filter ((== "PATH") . fst) <$> getEnvironment 25 | withEnvironment (("HOME", dir) : env) action 26 | 27 | withUseNix :: Maybe String -> IO a -> IO a 28 | withUseNix value action = do 29 | env <- filter ((/= "TINC_USE_NIX") . fst) <$> getEnvironment 30 | withEnvironment (tincUseNix ++ env) action 31 | where 32 | tincUseNix = maybe [] (return . (,) "TINC_USE_NIX") value 33 | 34 | spec :: Spec 35 | spec = do 36 | describe "discoverFacts_impl" $ around_ withTempHome $ do 37 | let ghcInfo = GhcInfo { 38 | ghcInfoPlatform = "x86_64-unknown-linux" 39 | , ghcInfoVersion = "7.10.3" 40 | , ghcInfoGlobalPackageDb = error "ghcInfoGlobalPackageDb" 41 | } 42 | it "includes GHC version in cache directory" $ do 43 | Facts{..} <- discoverFacts_impl "/some/path/to/tinc" ghcInfo 44 | path factsCache `shouldContain` ghcInfoVersion factsGhcInfo 45 | 46 | describe "factsUseNix" $ do 47 | context "when TINC_USE_NIX is not set" $ around_ (withUseNix Nothing) $ do 48 | context "when executable is installed under /nix" $ do 49 | it "is True" $ do 50 | Facts{..} <- discoverFacts_impl "/nix/some/path/to/tinc" ghcInfo 51 | factsUseNix `shouldBe` True 52 | 53 | context "when executable is not installed under /nix" $ do 54 | it "is False" $ do 55 | Facts{..} <- discoverFacts_impl "/some/path/to/tinc" ghcInfo 56 | factsUseNix `shouldBe` False 57 | 58 | context "when TINC_USE_NIX is set to 'yes'" $ around_ (withUseNix $ Just "yes") $ do 59 | context "when executable is installed under /nix" $ do 60 | it "is True" $ do 61 | Facts{..} <- discoverFacts_impl "/nix/some/path/to/tinc" ghcInfo 62 | factsUseNix `shouldBe` True 63 | 64 | context "when executable is not installed under /nix" $ do 65 | it "is True" $ do 66 | Facts{..} <- discoverFacts_impl "/some/path/to/tinc" ghcInfo 67 | factsUseNix `shouldBe` True 68 | 69 | 70 | context "when TINC_USE_NIX is set to 'no'" $ around_ (withUseNix $ Just "no") $ do 71 | context "when executable is installed under /nix" $ do 72 | it "is False" $ do 73 | Facts{..} <- discoverFacts_impl "/nix/some/path/to/tinc" ghcInfo 74 | factsUseNix `shouldBe` False 75 | 76 | context "when executable is not installed under /nix" $ do 77 | it "is False" $ do 78 | Facts{..} <- discoverFacts_impl "/some/path/to/tinc" ghcInfo 79 | factsUseNix `shouldBe` False 80 | 81 | 82 | describe "listPlugins" $ do 83 | it "lists plugins" $ do 84 | inTempDirectory $ do 85 | mkExecutable "tinc-foo" 86 | mkExecutable "tinc-bar" 87 | pluginsDir <- getCurrentDirectory 88 | plugins <- listPlugins pluginsDir 89 | plugins `shouldMatchList` [ 90 | ("foo", pluginsDir "tinc-foo") 91 | , ("bar", pluginsDir "tinc-bar") 92 | ] 93 | 94 | it "excludes files that are not executable" $ do 95 | inTempDirectory $ do 96 | touch "tinc-foo" 97 | (getCurrentDirectory >>= listPlugins) `shouldReturn` [] 98 | 99 | context "when directory does not exist" $ do 100 | it "returns an empty list" $ do 101 | listPlugins "foobar" `shouldReturn` [] 102 | 103 | describe "listPathPlugins" $ do 104 | it "lists plugins" $ do 105 | inTempDirectory $ do 106 | mkExecutable "tinc-foo" 107 | dir1 <- getCurrentDirectory 108 | inTempDirectory $ do 109 | mkExecutable "tinc-bar" 110 | dir2 <- getCurrentDirectory 111 | 112 | plugins <- listPathPlugins [dir1, dir2] 113 | plugins `shouldMatchList` [ 114 | ("foo", dir1 "tinc-foo") 115 | , ("bar", dir2 "tinc-bar") 116 | ] 117 | 118 | it "gives first occurrence precedence" $ do 119 | inTempDirectory $ do 120 | mkExecutable "tinc-foo" 121 | dir1 <- getCurrentDirectory 122 | inTempDirectory $ do 123 | mkExecutable "tinc-foo" 124 | dir2 <- getCurrentDirectory 125 | 126 | plugins <- listPathPlugins [dir1, dir2] 127 | plugins `shouldMatchList` [ 128 | ("foo", dir1 "tinc-foo") 129 | ] 130 | -------------------------------------------------------------------------------- /test/Tinc/FreezeSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Tinc.FreezeSpec (spec) where 3 | 4 | import Test.Hspec 5 | import Test.Mockery.Directory 6 | import System.Posix.Files 7 | 8 | import Tinc.Freeze 9 | import Tinc.Package 10 | import Tinc.SourceDependency 11 | 12 | spec :: Spec 13 | spec = around_ inTempDirectory $ do 14 | describe "writeFreezeFile" $ do 15 | context "when nothing has changed" $ do 16 | it "it does not update the file modification time" $ do 17 | let contents = [Package "hspec" "2.2.0"] 18 | writeFreezeFile contents 19 | let t0 = 0 20 | setFileTimes freezeFile t0 t0 21 | writeFreezeFile contents 22 | t1 <- modificationTime <$> getFileStatus "tinc.freeze" 23 | t1 `shouldBe` t0 24 | 25 | describe "readFreezeFile" $ do 26 | it "returns constraints from freeze file" $ do 27 | writeFreezeFile [Package "hspec" "2.2.0"] 28 | readFreezeFile [] `shouldReturn` ["--constraint=hspec == 2.2.0"] 29 | 30 | it "omits add-source dependencies" $ do 31 | writeFreezeFile [Package "HUnit" "1.4.0.0", Package "hspec" "2.2.0"] 32 | readFreezeFile [SourceDependency "HUnit" "some-rev"] `shouldReturn` ["--constraint=hspec == 2.2.0"] 33 | 34 | context "without freeze file" $ do 35 | it "returns empty list" $ do 36 | readFreezeFile [] `shouldReturn` [] 37 | -------------------------------------------------------------------------------- /test/Tinc/GhcInfoSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module Tinc.GhcInfoSpec (spec) where 3 | 4 | import Test.Hspec 5 | 6 | import Data.List 7 | import System.Info 8 | 9 | import Tinc.Types 10 | import Tinc.GhcInfo 11 | 12 | spec :: Spec 13 | spec = do 14 | describe "getGhcInfo" $ do 15 | beforeAll getGhcInfo $ do 16 | it "includes the target platform" $ \ ghcInfo -> do 17 | ghcInfoPlatform ghcInfo `shouldStartWith` arch 18 | 19 | it "includes the GHC version" $ \ ghcInfo -> do 20 | let major = [head $ show (__GLASGOW_HASKELL__ :: Int)] 21 | ghcInfoVersion ghcInfo `shouldSatisfy` (major `isPrefixOf`) 22 | 23 | it "includes the path to the global package database" $ \ ghcInfo -> do 24 | path (ghcInfoGlobalPackageDb ghcInfo) `shouldEndWith` "package.conf.d" 25 | -------------------------------------------------------------------------------- /test/Tinc/GhcPkgSpec.hs: -------------------------------------------------------------------------------- 1 | module Tinc.GhcPkgSpec (spec) where 2 | 3 | import Control.Monad 4 | import System.Environment 5 | import Helper 6 | 7 | import Tinc.Facts 8 | import Tinc.GhcPkg 9 | import Tinc.Package 10 | 11 | globalPackages :: [String] 12 | globalPackages = [ 13 | "array" 14 | , "base" 15 | , "binary" 16 | , "bytestring" 17 | , "Cabal" 18 | , "containers" 19 | , "deepseq" 20 | , "directory" 21 | , "filepath" 22 | , "ghc" 23 | , "ghc-boot" 24 | , "ghc-boot-th" 25 | , "ghci" 26 | , "ghc-prim" 27 | , "haskeline" 28 | , "hpc" 29 | , "integer-gmp" 30 | , "pretty" 31 | , "process" 32 | , "rts" 33 | , "template-haskell" 34 | , "terminfo" 35 | , "time" 36 | , "transformers" 37 | , "unix" 38 | , "xhtml" 39 | , "ghc-compact" 40 | , "mtl" 41 | , "parsec" 42 | , "stm" 43 | , "text" 44 | ] 45 | 46 | spec :: Spec 47 | spec = do 48 | describe "listGlobalPackages" $ before_ (getExecutablePath >>= useNix >>= (`when` pending)) $ do 49 | it "lists packages from global package database" $ do 50 | packages <- listGlobalPackages 51 | map simplePackageName packages `shouldMatchList` globalPackages 52 | -------------------------------------------------------------------------------- /test/Tinc/InstallSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ImplicitParams #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | {-# LANGUAGE ViewPatterns #-} 5 | module Tinc.InstallSpec (spec) where 6 | 7 | import Helper 8 | import MockedEnv 9 | import MockedProcess 10 | import Test.Mockery.Action 11 | 12 | import Data.List 13 | import Data.Version (makeVersion) 14 | import System.Directory hiding (withCurrentDirectory) 15 | import System.FilePath 16 | 17 | import GHC.Exts 18 | 19 | import Tinc.SourceDependencySpec (anyVersion) 20 | 21 | import Tinc.Facts 22 | import Tinc.Install 23 | import Tinc.Package 24 | import Tinc.SourceDependency 25 | import Tinc.Types 26 | import Util 27 | 28 | writeCabalFile :: String -> String -> [String] -> IO () 29 | writeCabalFile name version dependencies = do 30 | writeFile (name ++ ".cabal") $ unlines [ 31 | "name: " ++ name 32 | , "version: " ++ version 33 | , "build-type: Simple" 34 | , "cabal-version: >= 1.10" 35 | , "library" 36 | , " build-depends: " ++ intercalate ", " dependencies 37 | ] 38 | 39 | createCachedSourceDependency :: Path SourceDependencyCache -> SourceDependency -> String -> IO FilePath 40 | createCachedSourceDependency sourceDependencyCache SourceDependency{..} version = do 41 | createDirectoryIfMissing True dependencyPath 42 | withCurrentDirectory dependencyPath $ do 43 | writeCabalFile sourceDependencyPackageName version [] 44 | return dependencyPath 45 | where 46 | dependencyPath = path sourceDependencyCache sourceDependencyPackageName sourceDependencyHash 47 | 48 | spec :: Spec 49 | spec = do 50 | describe "cabalInstallPlan" $ do 51 | 52 | let cabalSandboxInit = ("cabal", ["v1-sandbox", "init"], touch ".cabal-sandbox/x86_64-linux-ghc-7.8.4-packages.conf.d/package.cache") 53 | 54 | withCabalFile action = inTempDirectory $ do 55 | writeCabalFile "foo" "0.0.0" ["setenv <= 0.1.1.3"] 56 | getCurrentDirectory >>= action 57 | 58 | mkCabalInstallOutput :: [String] -> String 59 | mkCabalInstallOutput dependencies = unlines $ [ 60 | "Resolving dependencies..." 61 | , "In order, the following would be installed (use -v for more details):" 62 | ] ++ dependencies 63 | 64 | mockedEnv :: (?mockedReadProcess :: ReadProcess, ?mockedCallProcess :: CallProcess) => Env 65 | mockedEnv = env {envReadProcess = ?mockedReadProcess, envCallProcess = ?mockedCallProcess} 66 | 67 | withMockedEnv :: (?mockedReadProcess :: ReadProcess, ?mockedCallProcess :: CallProcess) => WithEnv Env a -> IO a 68 | withMockedEnv = withEnv mockedEnv 69 | 70 | it "returns install plan" $ do 71 | withCabalFile $ \_ -> do 72 | let cabalInstallResult = return $ mkCabalInstallOutput ["setenv-0.1.1.3"] 73 | let ?mockedCallProcess = stub cabalSandboxInit 74 | ?mockedReadProcess = stub ("cabal", ["v1-install", "--dry-run", "--only-dependencies", "--enable-tests"], "", cabalInstallResult) 75 | withMockedEnv (cabalInstallPlan facts mempty []) `shouldReturn` [Package "setenv" "0.1.1.3"] 76 | 77 | it "takes add-source dependencies into account" $ do 78 | withCabalFile $ \sandbox -> do 79 | let name = "setenv" 80 | version = "0.1.1.2" 81 | hash = "fc2b9dbb754edcc14b0d9fa21201d67bc00794ec" 82 | cachedDependency = SourceDependency name hash 83 | sourceDependencyCache = Path (sandbox "add-source-cache") 84 | dependency = Package name (Version version $ Just hash) 85 | 86 | dependencyPath <- createCachedSourceDependency sourceDependencyCache cachedDependency version 87 | 88 | let cabalInstallResult = readFile "cabal-output" 89 | let ?mockedCallProcess = stub [ 90 | cabalSandboxInit 91 | , ("cabal", ["v1-sandbox", "add-source", dependencyPath], writeFile "cabal-output" $ mkCabalInstallOutput [showPackage dependency]) 92 | ] 93 | ?mockedReadProcess = stub ("cabal", ["v1-install", "--dry-run", "--only-dependencies", "--enable-tests", "--constraint=setenv == 0.1.0"], "", cabalInstallResult) 94 | withMockedEnv (cabalInstallPlan facts {factsSourceDependencyCache = sourceDependencyCache} mempty [(cachedDependency, makeVersion [0,1,0])]) `shouldReturn` [dependency] 95 | 96 | describe "copyFreezeFile" $ do 97 | it "copies freeze file" $ do 98 | inTempDirectory $ do 99 | writeFile "cabal.config" "some constraints" 100 | touch "foo/bar" 101 | copyFreezeFile "foo" 102 | readFile "foo/cabal.config" `shouldReturn` "some constraints" 103 | 104 | context "when there is no freeze file" $ do 105 | it "does nothing" $ do 106 | inTempDirectory $ do 107 | copyFreezeFile "foo" 108 | 109 | describe "generateCabalFile" $ do 110 | context "when there are additional dependencies" $ do 111 | it "generates a cabal file" $ do 112 | inTempDirectory $ do 113 | generateCabalFile (fromList [("foo", anyVersion)]) `shouldReturn` ("tinc-generated.cabal", unlines [ 114 | "cabal-version: >= 1.10" 115 | , "name: tinc-generated" 116 | , "version: 0.0.0" 117 | , "build-type: Simple" 118 | , "" 119 | , "executable tinc-generated" 120 | , " main-is: Generated.hs" 121 | , " build-depends:" 122 | , " foo" 123 | , " default-language: Haskell2010" 124 | ]) 125 | 126 | context "when there is a package.yaml" $ do 127 | it "generates a cabal file" $ do 128 | inTempDirectory $ do 129 | writeFile "package.yaml" $ unlines [ 130 | "name: foo" 131 | ] 132 | generateCabalFile mempty `shouldReturn` ("foo.cabal", unlines [ 133 | "cabal-version: 1.12" 134 | , "" 135 | , "name: foo" 136 | , "version: 0.0.0" 137 | , "build-type: Simple" 138 | ]) 139 | 140 | context "when there are both a package.yaml and additional dependencies" $ do 141 | it "combines them" $ do 142 | inTempDirectory $ do 143 | writeFile "package.yaml" $ unlines [ 144 | "name: foo" 145 | , "library:" 146 | , " dependencies: foo" 147 | ] 148 | generateCabalFile (fromList [("bar", anyVersion)]) `shouldReturn` ("foo.cabal", unlines [ 149 | "cabal-version: 1.12" 150 | , "" 151 | , "name: foo" 152 | , "version: 0.0.0" 153 | , "build-type: Simple" 154 | , "" 155 | , "library" 156 | , " other-modules:" 157 | , " Paths_foo" 158 | , " build-depends:" 159 | , " foo" 160 | , " default-language: Haskell2010" 161 | , "" 162 | , "executable tinc-generated" 163 | , " main-is: Generated.hs" 164 | , " build-depends:" 165 | , " bar" 166 | , " default-language: Haskell2010" 167 | ]) 168 | 169 | context "when there is a cabal file" $ do 170 | it "returns contents" $ do 171 | inTempDirectory $ do 172 | writeFile "foo.cabal" "foo" 173 | generateCabalFile mempty `shouldReturn` ("foo.cabal", "foo") 174 | 175 | context "when there are additional dependencies" $ do 176 | it "ignores them (for now)" $ do 177 | inTempDirectory $ do 178 | writeFile "foo.cabal" "foo" 179 | generateCabalFile (fromList [("foo", anyVersion)]) `shouldReturn` ("foo.cabal", "foo") 180 | 181 | context "when there are multiple cabal files" $ do 182 | it "fails" $ do 183 | inTempDirectory $ do 184 | touch "foo.cabal" 185 | touch "bar.cabal" 186 | generateCabalFile mempty `shouldThrow` errorCall "Multiple cabal files found." 187 | 188 | context "when there is no cabal file" $ do 189 | it "fails" $ do 190 | inTempDirectory $ do 191 | generateCabalFile mempty `shouldThrow` errorCall "No cabal file found." 192 | -------------------------------------------------------------------------------- /test/Tinc/NixSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Tinc.NixSpec (spec) where 3 | 4 | import Helper 5 | import System.FilePath 6 | import System.IO.Temp 7 | 8 | import Tinc.Package 9 | import Tinc.Nix 10 | import Tinc.Facts 11 | import Tinc.Types 12 | 13 | 14 | spec :: Spec 15 | spec = do 16 | let cache = "/path/to/nix/cache" 17 | 18 | describe "cabal" $ do 19 | it "executes cabal in an empty ghc environment" $ do 20 | cabal facts ["sandbox", "init"] `shouldBe` ("nix-shell", ["-p", "curl", "haskellPackages.ghcWithPackages (p: [ p.cabal-install ])", "--pure", "--run", "cabal sandbox init"]) 21 | 22 | it "escapes arguments" $ do 23 | cabal facts ["sandbox init"] `shouldBe` ("nix-shell", ["-p", "curl", "haskellPackages.ghcWithPackages (p: [ p.cabal-install ])", "--pure", "--run", "cabal 'sandbox init'"]) 24 | 25 | describe "nixShell" $ do 26 | it "executes command in project environment" $ do 27 | nixShell "foo" ["bar", "baz"] `shouldBe` ("nix-shell", ["shell.nix", "--run", "foo bar baz"]) 28 | 29 | it "escapes arguments" $ do 30 | nixShell "foo" ["bar baz"] `shouldBe` ("nix-shell", ["shell.nix", "--run", "foo 'bar baz'"]) 31 | 32 | describe "pkgImport" $ do 33 | it "imports a package" $ do 34 | let 35 | derivation = unlines [ 36 | "{ mkDerivation }:" 37 | , "mkDerivation { some derivation; }" 38 | ] 39 | inlined = [ 40 | "foo = callPackage" 41 | , " (" 42 | , " { mkDerivation }:" 43 | , " mkDerivation { some derivation; }" 44 | , " )" 45 | , " { };" 46 | ] 47 | pkgImport (Package "foo" "0.1.0", [], []) derivation `shouldBe` inlined; 48 | 49 | context "when given a list of Haskell dependencies" $ do 50 | it "specifies the dependencies in the expression" $ do 51 | let 52 | derivation = unlines [ 53 | "{ mkDerivation, bar, baz }:" 54 | , "mkDerivation { some derivation; }" 55 | ] 56 | inlined = [ 57 | "foo = callPackage" 58 | , " (" 59 | , " { mkDerivation, bar, baz }:" 60 | , " mkDerivation { some derivation; }" 61 | , " )" 62 | , " { inherit bar baz; };" 63 | ] 64 | pkgImport (Package "foo" "0.1.0", ["bar", "baz"], []) derivation `shouldBe` inlined 65 | 66 | context "when given a list of system dependencies" $ do 67 | it "specifies the dependencies in the expression" $ do 68 | let 69 | derivation = unlines [ 70 | "{ mkDerivation, bar }:" 71 | , "mkDerivation { some derivation; }" 72 | ] 73 | inlined = [ 74 | "foo = callPackage" 75 | , " (" 76 | , " { mkDerivation, bar }:" 77 | , " mkDerivation { some derivation; }" 78 | , " )" 79 | , " { inherit (nixpkgs) bar; };" 80 | ] 81 | pkgImport (Package "foo" "0.1.0", [], ["bar"]) derivation `shouldBe` inlined; 82 | 83 | describe "resolverDerivation" $ do 84 | it "generates resolver derivation" $ do 85 | let dependencies = [ 86 | (Package "foo" "0.1.0", [], []) 87 | , (Package "bar" "0.1.0", ["foo"], ["baz"]) 88 | ] 89 | fooDerivation = unlines [ 90 | "{ mkDerivation, base }:" 91 | , "mkDerivation { some derivation; }" 92 | ] 93 | barDerivation = unlines [ 94 | "{ mkDerivation, base, foo, baz }:" 95 | , "mkDerivation { some derivation; }" 96 | ] 97 | resolver = unlines [ 98 | "{ nixpkgs }:" 99 | , "rec {" 100 | , " compiler = nixpkgs.haskellPackages;" 101 | , " resolver =" 102 | , " let" 103 | , " callPackage = compiler.callPackage;" 104 | , "" 105 | , " overrideFunction = self: super: rec {" 106 | , " foo = callPackage" 107 | , " (" 108 | , " { mkDerivation, base }:" 109 | , " mkDerivation { some derivation; }" 110 | , " )" 111 | , " { };" 112 | , " bar = callPackage" 113 | , " (" 114 | , " { mkDerivation, base, foo, baz }:" 115 | , " mkDerivation { some derivation; }" 116 | , " )" 117 | , " { inherit foo; inherit (nixpkgs) baz; };" 118 | , " };" 119 | , "" 120 | , " newResolver = compiler.override {" 121 | , " overrides = overrideFunction;" 122 | , " };" 123 | , "" 124 | , " in newResolver;" 125 | , "}" 126 | ] 127 | 128 | withSystemTempDirectory "tinc" $ \dir -> do 129 | writeFile (dir "foo-0.1.0.nix") fooDerivation 130 | writeFile (dir "bar-0.1.0.nix") barDerivation 131 | resolverDerivation facts{ factsNixCache = Path dir } dependencies `shouldReturn` resolver 132 | 133 | describe "parseNixFunction" $ do 134 | it "parses a Nix function" $ do 135 | let nixFunction = "{ mkDerivation, aeson }: mkDerivation { someDerivation }" 136 | parseNixFunction nixFunction `shouldBe` Function ["mkDerivation", "aeson"] "mkDerivation { someDerivation }" 137 | 138 | describe "disableTests" $ do 139 | let derivation = unlines [ 140 | "{ mkDerivation }:" 141 | , "mkDerivation {" 142 | , " ..." 143 | , "}" 144 | ] 145 | derivationWithoutTests = unlines [ 146 | "{ mkDerivation }:" 147 | , "mkDerivation {" 148 | , " ..." 149 | , " doCheck = false;" 150 | , "}" 151 | ] 152 | 153 | it "disables tests" $ do 154 | disableTests derivation `shouldBe` derivationWithoutTests 155 | 156 | context "when tests are already disabled" $ do 157 | it "does nothing" $ do 158 | disableTests derivationWithoutTests `shouldBe` derivationWithoutTests 159 | 160 | describe "extractDependencies" $ do 161 | let knownHaskellDependencies = ["hspec", "aeson", "zlib"] 162 | it "extract Haskell dependencies" $ do 163 | let function = Function ["mkDerivation", "hspec"] "" 164 | extractDependencies function knownHaskellDependencies `shouldBe` (["hspec"], []) 165 | 166 | it "extract system dependencies" $ do 167 | let function = Function ["mkDerivation", "foo"] " librarySystemDepends = [ foo ];" 168 | extractDependencies function knownHaskellDependencies `shouldBe` ([], ["foo"]) 169 | 170 | context "when a known Haskell dependency has the same name as a system dependency" $ do 171 | it "omits the Haskell dependency with that name" $ do 172 | let function = Function ["mkDerivation", "zlib"] " librarySystemDepends = [ zlib ];" 173 | extractDependencies function knownHaskellDependencies `shouldBe` ([], ["zlib"]) 174 | 175 | describe "derivationFile" $ do 176 | it "returns path to derivation file" $ do 177 | derivationFile cache (Package "foo" "0.1.0") `shouldBe` "/path/to/nix/cache/foo-0.1.0.nix" 178 | 179 | context "when package has a git revision" $ do 180 | it "includes the git revision in the filename" $ do 181 | let package = Package "foo" (Version "0.1.0" $ Just "some-git-rev") 182 | derivationFile cache package `shouldBe` "/path/to/nix/cache/foo-0.1.0-some-git-rev.nix" 183 | -------------------------------------------------------------------------------- /test/Tinc/PackageGraphSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Tinc.PackageGraphSpec where 3 | 4 | import qualified Data.Graph.Wrapper as G 5 | 6 | import Helper 7 | 8 | import Tinc.Package 9 | import Tinc.PackageGraph 10 | 11 | spec :: Spec 12 | spec = do 13 | describe "calculateReusablePackages" $ do 14 | it "finds reusable packages" $ do 15 | let a = Package "a" "1" 16 | g = G.fromList [(a, (), [])] 17 | calculateReusablePackages [a] g `shouldBe` [(a, ())] 18 | 19 | context "when a package is not part of the install plan" $ do 20 | it "excludes the package" $ do 21 | let a = Package "a" "1" 22 | b = Package "b" "1" 23 | g = G.fromList [(a, (), [])] 24 | calculateReusablePackages [b] g `shouldBe` [] 25 | 26 | context "when the install plan misses a dependency" $ do 27 | it "excludes the package" $ do 28 | let a = Package "a" "1" 29 | b = Package "b" "1" 30 | g = G.fromList $ 31 | (a, (), [b]) : 32 | (b, (), []) : 33 | [] 34 | calculateReusablePackages [a] g `shouldBe` [] 35 | 36 | describe "fromDot" $ do 37 | let dot = unlines $ 38 | "digraph g {" : 39 | " b -> c;" : 40 | " a -> b;" : 41 | " d;" : 42 | "}" : 43 | [] 44 | expected = 45 | (SimplePackage "a" "", (), [SimplePackage "b" ""]) : 46 | (SimplePackage "b" "", (), [SimplePackage "c" ""]) : 47 | (SimplePackage "c" "", (), []) : 48 | (SimplePackage "d" "", (), []) : 49 | [] 50 | 51 | values = 52 | (SimplePackage "a" "", ()) : 53 | (SimplePackage "b" "", ()) : 54 | (SimplePackage "d" "", ()) : 55 | (SimplePackage "c" "", ()) : 56 | [] 57 | 58 | it "parses dot graphs" $ do 59 | fromDot values dot `shouldReturn` G.fromList expected 60 | 61 | context "when it encounters an outgoing node with a missing value" $ do 62 | it "returns an error" $ do 63 | fromDot (drop 1 values) dot `shouldThrow` 64 | errorCall ("src/Tinc/PackageGraph.hs: No value for package: " ++ show (SimplePackage "a" "")) 65 | 66 | context "when it encounters an ingoing node with a missing value" $ do 67 | it "returns an error" $ do 68 | fromDot (init values) dot `shouldThrow` 69 | errorCall ("src/Tinc/PackageGraph.hs: No value for package: " ++ show (SimplePackage "c" "")) 70 | -------------------------------------------------------------------------------- /test/Tinc/PackageSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Tinc.PackageSpec where 3 | 4 | import Helper 5 | 6 | import Tinc.Package 7 | 8 | spec :: Spec 9 | spec = do 10 | describe "showPackage" $ do 11 | it "ignores add-source hash" $ do 12 | showPackage (Package "foo" "0.1.0" {versionAddSourceHash = Just "32509a18bb6ddc01014863d135a247bd65d16c38"}) 13 | `shouldBe` "foo-0.1.0" 14 | 15 | describe "showPackageDetailed" $ do 16 | it "includes add-source hash" $ do 17 | showPackageDetailed (Package "foo" "0.1.0" {versionAddSourceHash = Just "32509a18bb6ddc01014863d135a247bd65d16c38"}) 18 | `shouldBe` "foo-0.1.0 (32509a18bb6ddc01014863d135a247bd65d16c38)" 19 | 20 | describe "parseInstallPlan" $ do 21 | it "parses output from `cabal install --dry-run`" $ do 22 | output <- readFile "test/resources/cabal-1.22.4.0-dry-run.txt" 23 | parseInstallPlan output `shouldReturn` [ 24 | SimplePackage "base-compat" "0.8.2" 25 | , SimplePackage "base-orphans" "0.3.2" 26 | , SimplePackage "tagged" "0.7.3" 27 | , SimplePackage "generics-sop" "0.1.1.2" 28 | , SimplePackage "getopt-generics" "0.6.3" 29 | ] 30 | 31 | context "when there is nothing to install" $ do 32 | it "returns an empty list" $ do 33 | output <- readFile "test/resources/cabal-1.22.4.0-dry-run-all-already-installed.txt" 34 | parseInstallPlan output `shouldReturn` [] 35 | 36 | context "on unexpected input" $ do 37 | it "throws an exception" $ do 38 | parseInstallPlan "foo" `shouldThrow` (errorCall . unlines) [ 39 | "src/Tinc/Package.hs: unexpected output from `cabal v1-install --dry-run':" 40 | , "" 41 | , " \"foo\"" 42 | , "" 43 | , "This is most likely a bug. Please report an issue at:" 44 | , "" 45 | , " https://github.com/sol/tinc/issues" 46 | ] 47 | 48 | describe "parsePackage" $ do 49 | it "parses packages" $ do 50 | parsePackage "foo-bar-1.2.3" `shouldBe` SimplePackage "foo-bar" "1.2.3" 51 | 52 | context "when package has no version" $ do 53 | it "returns package without version" $ do 54 | parsePackage "foo" `shouldBe` SimplePackage "foo" "" 55 | -------------------------------------------------------------------------------- /test/Tinc/RecentCheckSpec.hs: -------------------------------------------------------------------------------- 1 | module Tinc.RecentCheckSpec (spec) where 2 | 3 | import Helper 4 | 5 | import Data.Time 6 | import System.Directory 7 | import System.PosixCompat.Files 8 | import Foreign.C.Types (CTime) 9 | 10 | import Tinc.RecentCheck 11 | 12 | touchOlder :: FilePath -> IO () 13 | touchOlder name = do 14 | touch name 15 | setFileTimes name 0 0 16 | 17 | touchNewer :: FilePath -> IO () 18 | touchNewer name = do 19 | touch name 20 | setFileTimes name 2 2 21 | 22 | epochToUTCTime :: CTime -> IO UTCTime 23 | epochToUTCTime t = inTempDirectory $ do 24 | touch "foo.txt" 25 | setFileTimes "foo.txt" t t 26 | getModificationTime "foo.txt" 27 | 28 | spec :: Spec 29 | spec = do 30 | describe "isRecent" $ around_ inTempDirectory $ do 31 | context "with existing tinc environment" $ do 32 | let envCreationTime = Just <$> epochToUTCTime 1 33 | 34 | context "when tinc.freeze is older" $ before_ (touchOlder "tinc.freeze") $ do 35 | it "returns True" $ do 36 | (envCreationTime >>= isRecent) `shouldReturn` True 37 | 38 | context "when cabal file is newer" $ do 39 | it "returns False" $ do 40 | touchNewer "foo.cabal" 41 | (envCreationTime >>= isRecent) `shouldReturn` False 42 | 43 | context "when tinc.freeze is newer" $ do 44 | it "returns False" $ do 45 | touchNewer "tinc.freeze" 46 | (envCreationTime >>= isRecent) `shouldReturn` False 47 | 48 | context "without tinc.freeze" $ do 49 | it "returns False" $ do 50 | (envCreationTime >>= isRecent) `shouldReturn` False 51 | 52 | context "without tinc environment" $ do 53 | it "returns False" $ do 54 | isRecent Nothing `shouldReturn` False 55 | -------------------------------------------------------------------------------- /test/Tinc/SandboxSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Tinc.SandboxSpec where 3 | 4 | import Helper 5 | 6 | import System.Directory 7 | import System.FilePath 8 | import System.IO.Temp 9 | 10 | import Util 11 | import Tinc.Package 12 | import Tinc.Sandbox 13 | import Tinc.Types 14 | 15 | writePackageConfig :: (SimplePackage, FilePath) -> IO () 16 | writePackageConfig (SimplePackage name version, packageConfig) = do 17 | writeFile packageConfig $ unlines [ 18 | "name: " ++ name 19 | , "version: " ++ version 20 | ] 21 | 22 | spec :: Spec 23 | spec = do 24 | describe "findPackageDb" $ do 25 | it "finds the sandbox package db" $ do 26 | withSystemTempDirectory "tinc" $ \ sandbox -> do 27 | let packageDb = sandbox ".cabal-sandbox/x86_64-linux-ghc-7.8.4-packages.conf.d" 28 | createDirectoryIfMissing True packageDb 29 | findPackageDb (Path sandbox) `shouldReturn` (Path packageDb) 30 | 31 | context "when sandbox does not contain a package db" $ do 32 | it "throws an exception" $ do 33 | withSystemTempDirectory "tinc" $ \ sandbox -> do 34 | let p = sandbox ".cabal-sandbox" 35 | createDirectory p 36 | findPackageDb (Path sandbox) `shouldThrow` errorCall ("src/Tinc/Sandbox.hs: No package database found in " ++ show p) 37 | 38 | describe "listPackages" $ do 39 | it "lists packages package database" $ withSystemTempDirectory "tinc" $ \ p -> do 40 | let packages = [ 41 | (SimplePackage "foo" "2.1.7", p "foo-2.1.7-8b77e2706d2c2c9243c5d86e44c11aa6.conf") 42 | , (SimplePackage "bar" "0.0.0", p "bar-0.0.0-57c8091ea57afec62c051eda2322cc2f.conf") 43 | , (SimplePackage "baz" "0.6.1", p "baz-0.6.1-91bc956c71d416cc2ca71cc535d34d6f.conf") 44 | ] 45 | mapM_ writePackageConfig packages 46 | listPackages (Path p) >>= (`shouldMatchList` packages) 47 | 48 | it "returns canonical file paths to package configs" $ do 49 | -- NOTE: This behavior is crucial for executable caching to work properly 50 | -- as the executables are found relative to the canonical location of the 51 | -- package config! 52 | 53 | inTempDirectory $ do 54 | let packageDb = ".cabal-sandbox/x86_64-linux-ghc-7.8.4-packages.conf.d" 55 | packageConfig = "foo" "foo-0.1.0-8b77e2.conf" 56 | package = SimplePackage "foo" "0.1.0" 57 | 58 | createDirectoryIfMissing True (path packageDb) 59 | createDirectoryIfMissing False "bar" 60 | createDirectoryIfMissing False "foo" 61 | writePackageConfig (package, packageConfig) 62 | 63 | linkFile packageConfig "bar" 64 | registerPackage packageDb (Path $ "bar" takeFileName packageConfig) 65 | 66 | dir <- getCurrentDirectory 67 | listPackages packageDb `shouldReturn` [(package, dir packageConfig)] 68 | 69 | describe "packageFromPackageConfig" $ do 70 | it "parses package from package config path" $ do 71 | inTempDirectory $ do 72 | let conf = "my.conf" 73 | writeFile conf $ unlines [ 74 | "name: tinc" 75 | , "version: 0.1.0" 76 | ] 77 | packageFromPackageConfig conf `shouldReturn` SimplePackage "tinc" "0.1.0" 78 | -------------------------------------------------------------------------------- /test/Tinc/SourceDependencySpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE TupleSections #-} 3 | {-# LANGUAGE LambdaCase #-} 4 | {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} 5 | module Tinc.SourceDependencySpec (spec, anyVersion) where 6 | 7 | import Helper 8 | import qualified Hpack.Config as Hpack 9 | import Data.Tree 10 | import Data.Version 11 | import System.Directory 12 | import System.FilePath 13 | import System.IO.Error 14 | import System.IO.Temp 15 | import Test.QuickCheck hiding (output) 16 | import GHC.Fingerprint 17 | 18 | import Test.Mockery.Action 19 | import Tinc.Types 20 | import Tinc.SourceDependency 21 | 22 | anyVersion :: Hpack.DependencyInfo 23 | anyVersion = Hpack.DependencyInfo [] $ Hpack.DependencyVersion Nothing Hpack.AnyVersion 24 | 25 | sourceDependency :: Hpack.GitUrl -> Hpack.GitRef -> Hpack.DependencyInfo 26 | sourceDependency url ref = Hpack.DependencyInfo [] $ Hpack.DependencyVersion (Just $ Hpack.GitRef url ref Nothing) Hpack.AnyVersion 27 | 28 | spec :: Spec 29 | spec = do 30 | describe "mapLocalDependencyToGitDependency" $ do 31 | context "with a git dependency" $ do 32 | it "is the identity" $ do 33 | let dep = HpackSourceDependency "bar" (Git "sol/bar" "some-rev" Nothing) :: HpackSourceDependency Ref 34 | mapLocalDependencyToGitDependency undefined dep `shouldBe` dep 35 | 36 | context "with a local dependency" $ do 37 | let dep = HpackSourceDependency "bar" (Local "./bar") :: HpackSourceDependency Ref 38 | context "when source is Git" $ do 39 | it "maps the local dependency to a git dependency" $ do 40 | let 41 | source = Git "sol/foo" "some-rev" Nothing 42 | expected = HpackSourceDependency "bar" (Git "sol/foo" "some-rev" (Just "bar")) 43 | mapLocalDependencyToGitDependency source dep `shouldBe` expected 44 | 45 | it "takes the subdir of the git dependency into account" $ do 46 | let 47 | source = Git "sol/foo" "some-rev" (Just "foo") 48 | expected = HpackSourceDependency "bar" (Git "sol/foo" "some-rev" (Just "foo/bar")) 49 | mapLocalDependencyToGitDependency source dep `shouldBe` expected 50 | 51 | context "when source is Local" $ do 52 | it "makes the path of the dependency relative to the source" $ do 53 | let 54 | source = Local "../packages/foo" 55 | expected = HpackSourceDependency "bar" (Local "../packages/foo/bar") 56 | mapLocalDependencyToGitDependency source dep `shouldBe` expected 57 | 58 | describe "parseAddSourceDependencies" $ do 59 | it "extracts git dependencies from package.yaml" $ do 60 | inTempDirectory $ do 61 | writeFile "package.yaml" $ unlines [ 62 | "dependencies:" 63 | , " - name: foo" 64 | , " git: https://github.com/sol/hpack" 65 | , " ref: master" 66 | , " - bar" 67 | , "library: {}" 68 | ] 69 | parseAddSourceDependencies [] `shouldReturn` [HpackSourceDependency "foo" (Git "https://github.com/sol/hpack" "master" Nothing)] 70 | 71 | it "extracts local dependencies" $ do 72 | inTempDirectory $ do 73 | writeFile "package.yaml" $ unlines [ 74 | "dependencies:" 75 | , " - name: foo" 76 | , " path: ../foo" 77 | , " - bar" 78 | , "library: {}" 79 | ] 80 | parseAddSourceDependencies [] `shouldReturn` [HpackSourceDependency "foo" (Local "../foo")] 81 | 82 | it "extracts git dependencies from list of additional dependencies " $ do 83 | inTempDirectory $ do 84 | parseAddSourceDependencies [("foo", sourceDependency "https://github.com/sol/hpack" "master"), ("bar", anyVersion)] `shouldReturn` 85 | [HpackSourceDependency "foo" (Git "https://github.com/sol/hpack" "master" Nothing)] 86 | 87 | context "when both source dependencies and regular dependencies are present" $ do 88 | it "gives source dependencies precedence" $ do 89 | inTempDirectory $ do 90 | writeFile "package.yaml" $ unlines [ 91 | "executables:" 92 | , " a:" 93 | , " main: Main.hs" 94 | , " dependencies:" 95 | , " - foo" 96 | , " b:" 97 | , " main: Main.hs" 98 | , " dependencies:" 99 | , " - name: foo" 100 | , " git: https://github.com/sol/hpack" 101 | , " ref: master" 102 | , " c:" 103 | , " main: Main.hs" 104 | , " dependencies:" 105 | , " - foo" 106 | ] 107 | parseAddSourceDependencies [] `shouldReturn` [HpackSourceDependency "foo" (Git "https://github.com/sol/hpack" "master" Nothing)] 108 | 109 | context "when the same git dependency is specified in both package.yaml and tinc.yaml" $ do 110 | it "gives tinc.yaml precedence" $ do 111 | inTempDirectory $ do 112 | writeFile "package.yaml" $ unlines [ 113 | "dependencies:" 114 | , " - name: foo" 115 | , " git: https://github.com/sol/hpack" 116 | , " ref: master" 117 | , " - bar" 118 | , "library: {}" 119 | ] 120 | parseAddSourceDependencies [("foo", sourceDependency "https://github.com/sol/hpack" "dev"), ("bar", anyVersion)] `shouldReturn` 121 | [HpackSourceDependency "foo" (Git "https://github.com/sol/hpack" "dev" Nothing)] 122 | 123 | context "when package.yaml can not be parsed" $ do 124 | it "throws an exception" $ do 125 | inTempDirectory $ do 126 | writeFile "package.yaml" $ unlines [ 127 | "ghc-options: 23" 128 | , "library: {}" 129 | ] 130 | parseAddSourceDependencies [] `shouldThrow` errorCall "package.yaml: Error while parsing $.ghc-options - expected String, but encountered Number" 131 | 132 | context "when package.yaml does not exist" $ do 133 | it "returns an empty list" $ do 134 | inTempDirectory $ do 135 | parseAddSourceDependencies [] `shouldReturn` [] 136 | 137 | describe "populateSourceDependencyCache" $ around_ inTempDirectory $ do 138 | let 139 | name = "hpack" 140 | url = "https://github.com/sol/hpack" 141 | rev = "6bebd90d1e22901e94460c02bba9d0fa5b343f81" 142 | 143 | 144 | cacheAddSourceDepSpec subdir cacheKey cabalFile = do 145 | let 146 | gitDependency = Git url (CachedRev rev) subdir 147 | 148 | cache :: Path SourceDependencyCache 149 | cache = "add-source" 150 | 151 | gitCache :: Path GitCache 152 | gitCache = "git-cache" 153 | 154 | cachedGitDependency = SourceDependency name cacheKey 155 | cachedGitDependencyPath = sourceDependencyPath cache cachedGitDependency 156 | 157 | context "when a revision is not yet in the cache" $ do 158 | it "adds the revision to the cache" $ do 159 | let file = cabalFile (path gitCache rev) 160 | touch file 161 | writeFile file "name: hpack\nversion: 0.1.0" 162 | 163 | populateSourceDependencyCache gitCache cache (HpackSourceDependency name gitDependency) 164 | `shouldReturn` cachedGitDependency 165 | doesDirectoryExist (path cachedGitDependencyPath) `shouldReturn` True 166 | 167 | context "when a revision is already in the cache" $ do 168 | it "does nothing" $ do 169 | touch (path cachedGitDependencyPath ".placeholder") 170 | populateSourceDependencyCache gitCache cache (HpackSourceDependency name gitDependency) 171 | `shouldReturn` cachedGitDependency 172 | 173 | context "without subdir" $ do 174 | let 175 | subdir = Nothing 176 | cacheKey = rev 177 | cabalFile = ( "hpack.cabal") 178 | cacheAddSourceDepSpec subdir cacheKey cabalFile 179 | 180 | context "with subdir" $ do 181 | let 182 | subdir = Just "subdir" 183 | cacheKey = show (fingerprintFingerprints [fingerprintString rev, fingerprintString "subdir"]) 184 | cabalFile = ( "subdir/hpack.cabal") 185 | cacheAddSourceDepSpec subdir cacheKey cabalFile 186 | 187 | describe "gitClone_impl" $ around_ inTempDirectory $ do 188 | let 189 | url = "https://github.com/sol/hpack" 190 | rev = "6bebd90d1e22901e94460c02bba9d0fa5b343f81" 191 | cache = "git-cache" 192 | dst = path cache rev 193 | git = [ 194 | clone 195 | , stub ("git", ["reset", "--hard", rev], writeFile "rev" rev) 196 | ] 197 | 198 | clone "git" ["clone", url_, dir] | url_ == url = do 199 | touch (dir ".git" ".placeholder") 200 | writeFile (dir "some-source-file") "some-code" 201 | 202 | action inner = do 203 | mockChain git $ \callProcess_ -> do 204 | gitClone_impl process {callProcess = callProcess_} cache url (Rev rev) `shouldReturn` CachedRev rev 205 | inner 206 | 207 | around_ action $ do 208 | it "clones a git repository" $ do 209 | readFile (dst "some-source-file") `shouldReturn` "some-code" 210 | 211 | it "resets to the specified revision" $ do 212 | readFile (dst "rev") `shouldReturn` rev 213 | 214 | it "removes .git" $ do 215 | doesDirectoryExist (dst ".git") `shouldReturn` False 216 | 217 | context "when revision is already in cache" $ do 218 | it "does nothing" $ do 219 | touch (dst "some-source-file") 220 | gitClone_impl process cache url (Rev rev) `shouldReturn` CachedRev rev 221 | readFile (dst "some-source-file") `shouldReturn` "" 222 | 223 | describe "gitRefToRev_impl" $ do 224 | let 225 | repo = "http://github.com/sol/with-location" 226 | 227 | it "resolves git references" $ do 228 | let 229 | ref = "master" 230 | output = "517c35a825cbb8eb53fadf4a24654f1227466155 refs/heads/master\n" 231 | p = process {readProcess = stub ("git", ["ls-remote", repo, ref], "", return output)} 232 | gitRefToRev_impl p repo (Ref ref) `shouldReturn` "517c35a825cbb8eb53fadf4a24654f1227466155" 233 | 234 | context "when git reference does not exist" $ do 235 | it "returns an error" $ do 236 | let 237 | ref = "master" 238 | output = "" 239 | p = process {readProcess = stub ("git", ["ls-remote", repo, ref], "", return output)} 240 | gitRefToRev_impl p repo (Ref ref) `shouldThrow` errorCall ("invalid reference " ++ show ref ++ " for git repository " ++ repo) 241 | 242 | describe "isGitRev" $ do 243 | context "when given a git revision" $ do 244 | it "it returns True" $ do 245 | isGitRev "cf3968b8c54a7204e4e73c04816d49317bad433d" `shouldBe` True 246 | 247 | context "when given a git reference" $ do 248 | it "it returns False" $ do 249 | isGitRev "master" `shouldBe` False 250 | 251 | context "when given a 40 character (160 bit) git reference" $ do 252 | it "it returns False" $ do 253 | isGitRev "very-long-branch-name-that-is-not-a-revi" `shouldBe` False 254 | 255 | describe "copyPackageConfig" $ (around_ inTempDirectory) $ do 256 | it "copies package.yaml" $ do 257 | touch "foo/package.yaml" 258 | touch "bar/.placeholder" 259 | copyPackageConfig "foo" "bar" 260 | doesFileExist "bar/package.yaml" `shouldReturn` True 261 | 262 | context "when package.yaml does not exist" $ do 263 | it "does nothing" $ do 264 | touch "foo/.placeholder" 265 | touch "bar/.placeholder" 266 | copyPackageConfig "foo" "bar" 267 | doesFileExist "bar/package.yaml" `shouldReturn` False 268 | 269 | describe "checkCabalName" $ do 270 | context "when git dependency name and cabal package name match" $ do 271 | it "succeeds" $ do 272 | withSystemTempDirectory "tinc" $ \ dir -> do 273 | let cabalFile = dir "foo.cabal" 274 | writeFile cabalFile "name: foo\nversion: 0.1.0" 275 | checkCabalName dir (HpackSourceDependency "foo" $ Git "" () Nothing) 276 | 277 | context "when git dependency name and cabal package name differ" $ do 278 | it "fails" $ do 279 | withSystemTempDirectory "tinc" $ \ dir -> do 280 | let cabalFile = dir "foo.cabal" 281 | writeFile cabalFile "name: foo\nversion: 0.1.0" 282 | checkCabalName dir (HpackSourceDependency "bar" $ Git "" () Nothing) 283 | `shouldThrow` errorCall "the git repository contains package \"foo\", expected: \"bar\"" 284 | 285 | describe "parseCabalFile" $ do 286 | it "returns package name and version" $ do 287 | withSystemTempDirectory "tinc" $ \ dir -> do 288 | let cabalFile = dir "foo.cabal" 289 | writeFile cabalFile "name: foo\nversion: 0.1.0" 290 | parseCabalFile dir (Git "" () Nothing) `shouldReturn` CabalPackage "foo" (makeVersion [0,1,0]) 291 | 292 | it "complains about invalid cabal files" $ do 293 | withSystemTempDirectory "tinc" $ \ dir -> do 294 | let cabalFile = dir "foo.cabal" 295 | writeFile cabalFile "library\n build-depends: foo bar" 296 | parseCabalFile dir (Git "" () Nothing) `shouldThrow` isUserError 297 | 298 | describe "findCabalFile" $ do 299 | it "finds cabal files in given directory" $ do 300 | withSystemTempDirectory "tinc" $ \ dir -> do 301 | let cabalFile = dir "foo.cabal" 302 | touch cabalFile 303 | findCabalFile dir (Git "" () Nothing) `shouldReturn` cabalFile 304 | 305 | context "when there is no cabal file" $ do 306 | it "reports an error" $ do 307 | withSystemTempDirectory "tinc" $ \ dir -> do 308 | findCabalFile dir (Git "" () Nothing) `shouldThrow` errorCall "Couldn't find .cabal file in git repository " 309 | 310 | context "when there are multiple cabal files" $ do 311 | it "reports an error" $ do 312 | withSystemTempDirectory "tinc" $ \ dir -> do 313 | touch (dir "foo.cabal") 314 | touch (dir "bar.cabal") 315 | findCabalFile dir (Git "" () Nothing) `shouldThrow` errorCall "Multiple cabal files found in git repository " 316 | 317 | describe "removeDuplicates" $ do 318 | let 319 | foo hash = (SourceDependency "foo" hash, ()) 320 | foo1 = foo "foo-hash1" 321 | foo2 = foo "foo-hash2" 322 | bar = (SourceDependency "bar" "bar-hash", ()) 323 | baz = (SourceDependency "baz" "baz-hash", ()) 324 | 325 | it "removes duplicates" $ do 326 | removeDuplicates [Node foo1 [], Node foo2 []] `shouldBe` [foo1] 327 | 328 | context "with a duplicate dependency in a single tree" $ do 329 | it "uses breadth-first precedence" $ do 330 | let 331 | deps = [Node bar [Node foo2 [], Node baz [Node foo1 []]]] 332 | forAll (permuteForest deps) $ \x -> do 333 | removeDuplicates x `shouldMatchList` [foo2, bar, baz] 334 | 335 | context "with a duplicate dependency in different trees" $ do 336 | it "uses breadth-first precedence" $ do 337 | let 338 | deps = [ 339 | Node bar [Node foo2 []] 340 | , Node baz [Node bar [Node foo1 []]] 341 | ] 342 | forAll (permuteForest deps) $ \x -> do 343 | removeDuplicates x `shouldMatchList` [foo2, bar, baz] 344 | 345 | permuteTree :: Tree a -> Gen (Tree a) 346 | permuteTree (Node a forest) = Node a <$> permuteForest forest 347 | 348 | permuteForest :: Forest a -> Gen (Forest a) 349 | permuteForest xs = mapM permuteTree xs >>= shuffle 350 | -------------------------------------------------------------------------------- /test/UtilSpec.hs: -------------------------------------------------------------------------------- 1 | module UtilSpec where 2 | 3 | import System.Directory 4 | import Test.Hspec 5 | import Test.Mockery.Directory 6 | 7 | import Util 8 | 9 | spec :: Spec 10 | spec = do 11 | describe "listDirectories" $ do 12 | it "lists directories" $ do 13 | inTempDirectory $ do 14 | createDirectory "foo" 15 | createDirectory "bar" 16 | writeFile "baz" "" 17 | listDirectories "." `shouldReturn` ["./bar", "./foo"] 18 | 19 | describe "listFilesRecursively" $ do 20 | it "lists files recursively" $ do 21 | inTempDirectory $ do 22 | touch "foo" 23 | touch "bar/baz" 24 | listFilesRecursively "." >>= (`shouldMatchList` ["./foo", "./bar/baz"]) 25 | 26 | describe "fingerprint" $ do 27 | it "returns a fingerprint for files in specified directory" $ do 28 | hash1 <- inTempDirectory $ do 29 | writeFile "foo" "some content" 30 | touch "bar/baz" 31 | writeFile "bar/baz" "some other content" 32 | fingerprint "." 33 | 34 | hash2 <- inTempDirectory $ do 35 | writeFile "foo" "some content" 36 | touch "bar/baz" 37 | writeFile "bar/baz" "some other content" 38 | fingerprint "." 39 | 40 | hash1 `shouldBe` hash2 41 | 42 | it "takes file contents into account" $ do 43 | hash1 <- inTempDirectory $ do 44 | writeFile "foo" "some content" 45 | fingerprint "." 46 | 47 | hash2 <- inTempDirectory $ do 48 | writeFile "foo" "some other content" 49 | fingerprint "." 50 | 51 | hash1 `shouldSatisfy` (/= hash2) 52 | 53 | it "takes filenames into account" $ do 54 | hash1 <- inTempDirectory $ do 55 | writeFile "foo" "some content" 56 | writeFile "bar" "some other content" 57 | fingerprint "." 58 | 59 | hash2 <- inTempDirectory $ do 60 | writeFile "bar" "some content" 61 | writeFile "foo" "some other content" 62 | fingerprint "." 63 | 64 | hash1 `shouldSatisfy` (/= hash2) 65 | 66 | it "ignores base path of filenames" $ do 67 | hash1 <- inTempDirectory $ do 68 | touch "foo/bar" 69 | writeFile "foo/bar" "some content" 70 | fingerprint "foo" 71 | 72 | hash2 <- inTempDirectory $ do 73 | touch "baz/bar" 74 | writeFile "baz/bar" "some content" 75 | fingerprint "baz" 76 | 77 | hash1 `shouldBe` hash2 78 | 79 | describe "cachedIO" $ do 80 | it "runs given action" $ do 81 | inTempDirectory $ do 82 | cachedIO "foo" (return "bar") `shouldReturn` "bar" 83 | 84 | it "caches the result of the given action" $ do 85 | inTempDirectory $ do 86 | _ <- cachedIO "foo" (return "bar") 87 | readFile "foo" `shouldReturn` "bar" 88 | 89 | it "reuses cached result" $ do 90 | inTempDirectory $ do 91 | writeFile "foo" "bar" 92 | cachedIO "foo" undefined `shouldReturn` "bar" 93 | 94 | describe "getCabalFiles" $ around_ inTempDirectory $ do 95 | it "returns all cabal files in the current directory" $ do 96 | touch "foo.cabal" 97 | touch "bar.cabal" 98 | getCabalFiles "." >>= (`shouldMatchList` ["bar.cabal", "foo.cabal"]) 99 | 100 | it "ignores dot files" $ do 101 | touch ".foo.cabal" 102 | getCabalFiles "." `shouldReturn` [] 103 | -------------------------------------------------------------------------------- /test/resources/cabal-1.22.4.0-dry-run-all-already-installed.txt: -------------------------------------------------------------------------------- 1 | Resolving dependencies... 2 | All the requested packages are already installed: 3 | Use --reinstall if you want to reinstall anyway. 4 | -------------------------------------------------------------------------------- /test/resources/cabal-1.22.4.0-dry-run.txt: -------------------------------------------------------------------------------- 1 | Resolving dependencies... 2 | In order, the following would be installed (use -v for more details): 3 | base-compat-0.8.2 4 | base-orphans-0.3.2 5 | tagged-0.7.3 (latest: 0.8.0.1) 6 | generics-sop-0.1.1.2 7 | getopt-generics-0.6.3 8 | -------------------------------------------------------------------------------- /tinc.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.34.2. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: tinc 8 | version: 0.2.0 9 | category: Development 10 | homepage: https://github.com/sol/tinc#readme 11 | bug-reports: https://github.com/sol/tinc/issues 12 | author: Simon Hengel 13 | maintainer: Simon Hengel 14 | copyright: (c) 2015 Sönke Hahn, 15 | (c) 2015-2017 Simon Hengel 16 | license: MIT 17 | license-file: LICENSE 18 | build-type: Simple 19 | extra-source-files: 20 | test/resources/cabal-1.22.4.0-dry-run-all-already-installed.txt 21 | test/resources/cabal-1.22.4.0-dry-run.txt 22 | 23 | source-repository head 24 | type: git 25 | location: https://github.com/sol/tinc 26 | 27 | executable tinc 28 | main-is: tinc.hs 29 | hs-source-dirs: 30 | src 31 | driver 32 | ghc-options: -Wall -fwarn-redundant-constraints 33 | build-depends: 34 | Cabal >=2.0.0.2 35 | , aeson >=0.11.0 36 | , base >=4.11 37 | , bytestring 38 | , call-stack 39 | , containers 40 | , directory 41 | , exceptions 42 | , filelock 43 | , filepath 44 | , graph-wrapper >=0.2.5 45 | , hpack >=0.34.2 46 | , language-dot 47 | , parsec 48 | , process >=1.2 49 | , store 50 | , temporary 51 | , time 52 | , transformers 53 | , unix-compat 54 | , yaml 55 | other-modules: 56 | Run 57 | Tinc.Cabal 58 | Tinc.Cache 59 | Tinc.Config 60 | Tinc.Facts 61 | Tinc.Fail 62 | Tinc.Freeze 63 | Tinc.GhcInfo 64 | Tinc.GhcPkg 65 | Tinc.Hpack 66 | Tinc.Install 67 | Tinc.Nix 68 | Tinc.Package 69 | Tinc.PackageGraph 70 | Tinc.Process 71 | Tinc.RecentCheck 72 | Tinc.Sandbox 73 | Tinc.SourceDependency 74 | Tinc.Types 75 | Util 76 | Paths_tinc 77 | default-language: Haskell2010 78 | 79 | test-suite spec 80 | type: exitcode-stdio-1.0 81 | main-is: Spec.hs 82 | hs-source-dirs: 83 | src 84 | test 85 | ghc-options: -Wall -fwarn-redundant-constraints 86 | cpp-options: -DTEST 87 | build-depends: 88 | Cabal >=2.0.0.2 89 | , HUnit >=1.4 90 | , QuickCheck 91 | , aeson >=0.11.0 92 | , base >=4.11 93 | , bytestring 94 | , call-stack 95 | , containers 96 | , directory 97 | , exceptions 98 | , filelock 99 | , filepath 100 | , graph-wrapper >=0.2.5 101 | , hpack >=0.34.2 102 | , hspec 103 | , language-dot 104 | , mockery >=0.3.3 105 | , parsec 106 | , process >=1.2 107 | , safe 108 | , store 109 | , temporary 110 | , time 111 | , transformers 112 | , unix 113 | , unix-compat 114 | , yaml 115 | other-modules: 116 | Run 117 | Tinc.Cabal 118 | Tinc.Cache 119 | Tinc.Config 120 | Tinc.Facts 121 | Tinc.Fail 122 | Tinc.Freeze 123 | Tinc.GhcInfo 124 | Tinc.GhcPkg 125 | Tinc.Hpack 126 | Tinc.Install 127 | Tinc.Nix 128 | Tinc.Package 129 | Tinc.PackageGraph 130 | Tinc.Process 131 | Tinc.RecentCheck 132 | Tinc.Sandbox 133 | Tinc.SourceDependency 134 | Tinc.Types 135 | Util 136 | All 137 | Helper 138 | MockedEnv 139 | MockedProcess 140 | RunSpec 141 | Test.Mockery.Action 142 | Test.Mockery.ActionSpec 143 | Tinc.CacheSpec 144 | Tinc.ConfigSpec 145 | Tinc.FactsSpec 146 | Tinc.FreezeSpec 147 | Tinc.GhcInfoSpec 148 | Tinc.GhcPkgSpec 149 | Tinc.InstallSpec 150 | Tinc.NixSpec 151 | Tinc.PackageGraphSpec 152 | Tinc.PackageSpec 153 | Tinc.RecentCheckSpec 154 | Tinc.SandboxSpec 155 | Tinc.SourceDependencySpec 156 | UtilSpec 157 | Paths_tinc 158 | default-language: Haskell2010 159 | -------------------------------------------------------------------------------- /tinc.freeze: -------------------------------------------------------------------------------- 1 | dependencies: 2 | - name: aeson 3 | version: 1.5.1.0 4 | - name: ansi-terminal 5 | version: 0.10.3 6 | - name: asn1-encoding 7 | version: 0.9.6 8 | - name: asn1-parse 9 | version: 0.9.5 10 | - name: asn1-types 11 | version: 0.3.4 12 | - name: assoc 13 | version: 1.0.1 14 | - name: async 15 | version: 2.2.2 16 | - name: attoparsec 17 | version: 0.13.2.4 18 | - name: base-compat 19 | version: 0.11.1 20 | - name: base-compat-batteries 21 | version: 0.11.1 22 | - name: base-orphans 23 | version: 0.8.2 24 | - name: base64-bytestring 25 | version: 1.1.0.0 26 | - name: basement 27 | version: 0.0.11 28 | - name: bifunctors 29 | version: 5.5.7 30 | - name: blaze-builder 31 | version: 0.4.1.0 32 | - name: byteable 33 | version: 0.1.1 34 | - name: Cabal 35 | version: 3.2.0.0 36 | - name: cabal-doctest 37 | version: 1.0.8 38 | - name: call-stack 39 | version: 0.2.0 40 | - name: case-insensitive 41 | version: 1.2.1.0 42 | - name: cereal 43 | version: 0.5.8.1 44 | - name: clock 45 | version: '0.8' 46 | - name: colour 47 | version: 2.3.5 48 | - name: comonad 49 | version: 5.0.6 50 | - name: conduit 51 | version: 1.3.2 52 | - name: connection 53 | version: 0.3.1 54 | - name: contravariant 55 | version: 1.5.2 56 | - name: cookie 57 | version: 0.4.5 58 | - name: cryptohash 59 | version: 0.11.9 60 | - name: cryptonite 61 | version: '0.26' 62 | - name: data-default-class 63 | version: 0.1.2.0 64 | - name: distributive 65 | version: 0.6.2 66 | - name: dlist 67 | version: 0.8.0.8 68 | - name: exceptions 69 | version: 0.10.4 70 | - name: fail 71 | version: 4.9.0.0 72 | - name: filelock 73 | version: 0.1.1.4 74 | - name: free 75 | version: 5.1.3 76 | - name: Glob 77 | version: 0.10.0 78 | - name: graph-wrapper 79 | version: 0.2.6.0 80 | - name: hashable 81 | version: 1.3.0.0 82 | - name: hourglass 83 | version: 0.2.12 84 | - name: hpack 85 | version: 0.34.2 86 | - name: hspec 87 | version: 2.7.1 88 | - name: hspec-core 89 | version: 2.7.1 90 | - name: hspec-discover 91 | version: 2.7.1 92 | - name: hspec-expectations 93 | version: 0.8.2 94 | - name: hspec-smallcheck 95 | version: 0.5.2 96 | - name: http-client 97 | version: 0.7.0 98 | - name: http-client-tls 99 | version: 0.3.5.3 100 | - name: http-types 101 | version: 0.12.3 102 | - name: HUnit 103 | version: 1.6.0.0 104 | - name: infer-license 105 | version: 0.2.0 106 | - name: integer-logarithms 107 | version: 1.0.3 108 | - name: language-dot 109 | version: 0.1.1 110 | - name: libyaml 111 | version: 0.1.2 112 | - name: lifted-base 113 | version: 0.2.3.12 114 | - name: logging-facade 115 | version: 0.3.0 116 | - name: logict 117 | version: 0.7.0.2 118 | - name: memory 119 | version: 0.15.0 120 | - name: mime-types 121 | version: 0.1.0.9 122 | - name: mockery 123 | version: 0.3.5 124 | - name: monad-control 125 | version: 1.0.2.3 126 | - name: mono-traversable 127 | version: 1.0.15.1 128 | - name: network 129 | version: 3.1.1.1 130 | - name: network-uri 131 | version: 2.6.3.0 132 | - name: pem 133 | version: 0.2.4 134 | - name: primitive 135 | version: 0.7.0.1 136 | - name: profunctors 137 | version: 5.5.2 138 | - name: QuickCheck 139 | version: '2.14' 140 | - name: quickcheck-io 141 | version: 0.2.0 142 | - name: random 143 | version: '1.1' 144 | - name: resourcet 145 | version: 1.2.4 146 | - name: safe 147 | version: 0.3.19 148 | - name: scientific 149 | version: 0.3.6.2 150 | - name: semigroupoids 151 | version: 5.3.4 152 | - name: semigroups 153 | version: 0.19.1 154 | - name: setenv 155 | version: 0.1.1.3 156 | - name: smallcheck 157 | version: 1.1.5 158 | - name: socks 159 | version: 0.6.1 160 | - name: split 161 | version: 0.2.3.4 162 | - name: splitmix 163 | version: 0.0.5 164 | - name: StateVar 165 | version: '1.2' 166 | - name: stm 167 | version: 2.5.0.0 168 | - name: store 169 | version: 0.7.4 170 | - name: store-core 171 | version: 0.4.4.2 172 | - name: streaming-commons 173 | version: 0.2.1.2 174 | - name: syb 175 | version: 0.7.1 176 | - name: tagged 177 | version: 0.8.6 178 | - name: temporary 179 | version: '1.3' 180 | - name: text-metrics 181 | version: 0.3.0 182 | - name: tf-random 183 | version: '0.5' 184 | - name: th-abstraction 185 | version: 0.3.2.0 186 | - name: th-expand-syns 187 | version: 0.4.6.0 188 | - name: th-lift 189 | version: 0.8.1 190 | - name: th-lift-instances 191 | version: 0.1.16 192 | - name: th-orphans 193 | version: 0.13.10 194 | - name: th-reify-many 195 | version: 0.1.9 196 | - name: th-utilities 197 | version: 0.2.4.0 198 | - name: these 199 | version: '1.1' 200 | - name: time-compat 201 | version: 1.9.3 202 | - name: tls 203 | version: 1.5.4 204 | - name: transformers-base 205 | version: 0.4.5.2 206 | - name: transformers-compat 207 | version: 0.6.5 208 | - name: unix-compat 209 | version: 0.5.2 210 | - name: unliftio-core 211 | version: 0.2.0.1 212 | - name: unordered-containers 213 | version: 0.2.10.0 214 | - name: uuid-types 215 | version: 1.0.3 216 | - name: vector 217 | version: 0.12.1.2 218 | - name: vector-algorithms 219 | version: 0.8.0.3 220 | - name: void 221 | version: 0.7.3 222 | - name: x509 223 | version: 1.7.5 224 | - name: x509-store 225 | version: 1.6.7 226 | - name: x509-system 227 | version: 1.6.6 228 | - name: x509-validation 229 | version: 1.6.11 230 | - name: yaml 231 | version: 0.11.4.0 232 | - name: zlib 233 | version: 0.6.2.1 234 | --------------------------------------------------------------------------------