├── .gitignore ├── .travis.yml ├── CHANGES.md ├── LICENSE ├── README.md ├── Setup.hs ├── TODO.md ├── package.yaml ├── sandman.cabal ├── src ├── Main.hs └── Sandman │ ├── InstalledPackage.hs │ ├── PackageDb.hs │ ├── Stack.hs │ └── Util.hs └── stack.yaml /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | *.swp 3 | *.o 4 | *.hi 5 | cabal.sandbox.config 6 | .cabal-sandbox 7 | .stack-work 8 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # From http://docs.haskellstack.org/en/stable/GUIDE/#travis-with-caching 2 | 3 | sudo: false 4 | language: c 5 | 6 | cache: 7 | directories: 8 | - $HOME/.ghc 9 | - $HOME/.cabal 10 | - $HOME/.stack 11 | 12 | matrix: 13 | include: 14 | - env: BUILD=cabal GHCVER=7.8.4 CABALVER=1.18 15 | compiler: ": #GHC 7.8.4" 16 | addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} 17 | - env: BUILD=cabal GHCVER=7.10.3 CABALVER=1.22 18 | compiler: ": #GHC 7.10.3" 19 | addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} 20 | - env: BUILD=cabal GHCVER=8.0.1 CABALVER=1.24 21 | compiler: ": #GHC 8.0.1" 22 | addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}} 23 | 24 | # Build with the newest GHC and cabal-install. This is an accepted failure, 25 | # see below. 26 | - env: BUILD=cabal GHCVER=head CABALVER=head 27 | compiler: ": #GHC HEAD" 28 | addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} 29 | 30 | # The Stack builds. We can pass in arbitrary Stack arguments via the ARGS 31 | # variable, such as using --stack-yaml to point to a different file. 32 | - env: BUILD=stack ARGS="" 33 | compiler: ": #stack default" 34 | addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} 35 | 36 | - env: BUILD=stack ARGS="--resolver lts-2" 37 | compiler: ": #stack 7.8.4" 38 | addons: {apt: {packages: [ghc-7.8.4], sources: [hvr-ghc]}} 39 | 40 | - env: BUILD=stack ARGS="--resolver lts-3" 41 | compiler: ": #stack 7.10.2" 42 | addons: {apt: {packages: [ghc-7.10.2], sources: [hvr-ghc]}} 43 | 44 | - env: BUILD=stack ARGS="--resolver lts-5" 45 | compiler: ": #stack 7.10.3" 46 | addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} 47 | 48 | # Nightly builds are allowed to fail 49 | - env: BUILD=stack ARGS="--resolver nightly" 50 | compiler: ": #stack nightly" 51 | addons: {apt: {packages: [libgmp,libgmp-dev]}} 52 | 53 | # Build on OS X in addition to Linux 54 | - env: BUILD=stack ARGS="" 55 | compiler: ": #stack default osx" 56 | os: osx 57 | 58 | - env: BUILD=stack ARGS="--resolver lts-2" 59 | compiler: ": #stack 7.8.4 osx" 60 | os: osx 61 | 62 | - env: BUILD=stack ARGS="--resolver lts-3" 63 | compiler: ": #stack 7.10.2 osx" 64 | os: osx 65 | 66 | - env: BUILD=stack ARGS="--resolver lts-5" 67 | compiler: ": #stack 7.10.3 osx" 68 | os: osx 69 | 70 | - env: BUILD=stack ARGS="--resolver nightly" 71 | compiler: ": #stack nightly osx" 72 | os: osx 73 | 74 | allow_failures: 75 | - env: BUILD=cabal GHCVER=head CABALVER=head 76 | - env: BUILD=stack ARGS="--resolver nightly" 77 | 78 | before_install: 79 | - unset CC 80 | 81 | # We want to always allow newer versions of packages when building on GHC HEAD 82 | - CABALARGS="" 83 | - if [ "x$GHCVER" = "xhead" ]; then CABALARGS=--allow-newer; fi 84 | 85 | # Download and unpack the stack executable 86 | - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:$HOME/.cabal/bin:$PATH 87 | - mkdir -p ~/.local/bin 88 | - | 89 | if [ `uname` = "Darwin" ] 90 | then 91 | travis_retry curl --insecure -L https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin 92 | else 93 | travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 94 | fi 95 | 96 | # Use the more reliable S3 mirror of Hackage 97 | mkdir -p $HOME/.cabal 98 | echo 'remote-repo: hackage.haskell.org:http://hackage.fpcomplete.com/' > $HOME/.cabal/config 99 | echo 'remote-repo-cache: $HOME/.cabal/packages' >> $HOME/.cabal/config 100 | 101 | if [ "$CABALVER" != "1.16" ] 102 | then 103 | echo 'jobs: $ncpus' >> $HOME/.cabal/config 104 | fi 105 | 106 | # Get the list of packages from the stack.yaml file 107 | - PACKAGES=$(stack --install-ghc query locals | grep '^ *path' | sed 's@^ *path:@@') 108 | 109 | install: 110 | - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" 111 | - if [ -f configure.ac ]; then autoreconf -i; fi 112 | - | 113 | set -ex 114 | case "$BUILD" in 115 | stack) 116 | stack --no-terminal --install-ghc $ARGS test --bench --only-dependencies 117 | ;; 118 | cabal) 119 | cabal --version 120 | travis_retry cabal update 121 | cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES 122 | ;; 123 | esac 124 | set +ex 125 | 126 | script: 127 | - | 128 | set -ex 129 | case "$BUILD" in 130 | stack) 131 | stack --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps 132 | ;; 133 | cabal) 134 | cabal install --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES 135 | 136 | ORIGDIR=$(pwd) 137 | for dir in $PACKAGES 138 | do 139 | cd $dir 140 | cabal check || [ "$CABALVER" == "1.16" ] 141 | cabal sdist 142 | SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && \ 143 | (cd dist && cabal install --force-reinstalls "$SRC_TGZ") 144 | cd $ORIGDIR 145 | done 146 | ;; 147 | esac 148 | set +ex 149 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | 0.2.0.1 2 | ======= 3 | 4 | - Support GHC 8. 5 | 6 | 7 | 0.2.0.0 8 | ======= 9 | 10 | - Add support for mixing in package databases from stack snapshots. 11 | - "stack" is now a reserved name when creating sandboxes. 12 | 13 | 14 | 0.1.0.1 15 | ======= 16 | 17 | - Loosen version constraints. 18 | 19 | 20 | 0.1.0.0 21 | ======= 22 | 23 | - Initial release. 24 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015 Abhinav Gupta 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included 12 | in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 17 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 18 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 19 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 20 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | `sandman` helps manage Cabal sandboxes so that you can avoid rebuilding 2 | packages that you use often. 3 | 4 | It does so by managing a global collection of sandboxes that were built 5 | separately. You can `mix` any number of these sandboxes into the package 6 | database for your project-specific sandbox. 7 | 8 | Usage: sandman COMMAND 9 | 10 | Available options: 11 | -h,--help Show this help text 12 | 13 | Available commands: 14 | list List sandman sandboxes or the packages in them 15 | new Create a new sandman sandbox 16 | destroy Delete a sandman sandbox 17 | install Install a new package 18 | mix Mix a sandman sandbox into the current project 19 | clean Remove all mixed sandboxes from the current project 20 | 21 | # Example usage 22 | 23 | First, we create a sandbox that will contain packages we commonly use for 24 | development. 25 | 26 | $ sandman list 27 | lens (25 packages) 28 | 29 | $ sandman new common 30 | [..] 31 | Created sandbox common. 32 | 33 | Managed sandboxes can be told to use specific versions of GHC. This information 34 | will be propagated to projects with which this sandbox is mixed. 35 | 36 | $ sandman new common --with-ghc ghc-7.6.3 37 | 38 | We install our commonly used packages 39 | 40 | $ sandman install common classy-prelude 41 | [..] 42 | Configuring classy-prelude-0.10.2... 43 | Building classy-prelude-0.10.2... 44 | Installed classy-prelude-0.10.2 45 | 46 | $ sandman list 47 | lens (25 packages) 48 | common (45 packages) 49 | 50 | $ sandman list common 51 | [..] 52 | classy-prelude-0.10.2 53 | [..] 54 | 55 | $ sandman destroy lens 56 | Removed sandbox lens. 57 | 58 | $ sandman list 59 | common (45 packages) 60 | 61 | $ sandman install common optparse-applicative aeson 62 | 63 | Next, we mix it into an existing project. 64 | 65 | $ cd my_project 66 | $ cabal sandbox init 67 | $ cabal sandbox hc-pkg list | grep classy-prelude 68 | 69 | 70 | $ sandman mix common 71 | Mixing 45 new packages into package DB at [..] 72 | Rebuilding package cache. 73 | 74 | $ cabal sandbox hc-pkg list | grep classy-prelude 75 | classy-prelude-0.10.2 76 | 77 | $ cabal repl 78 | GHCi, version 7.8.3: http://www.haskell.org/ghc/ :? for help 79 | Loading package ghc-prim ... linking ... done. 80 | Loading package integer-gmp ... linking ... done. 81 | Loading package base ... linking ... done. 82 | λ> import ClassyPrelude 83 | λ> 84 | 85 | $ sandman clean 86 | Removing all mixed sandboxes. 87 | Removed 45 packages. 88 | Rebuilding package cache. 89 | 90 | `sandman` can also mix in only specific packages and their dependencies from 91 | managed sandboxes. 92 | 93 | $ sandman mix common --only system-filepath --only system-fileio 94 | Mixing 3 new packages into package DB at [..] 95 | Rebuilding package cache. 96 | 97 | $ cabal sandbox hc-pkg list 98 | [..] 99 | system-fileio-0.3.16 100 | system-filepath-0.4.13.1 101 | text-1.2.0.4 102 | 103 | The `--executables` option may be used to include executables from a sandbox. 104 | 105 | $ sandman mix common --executables --only hspec 106 | Mixing 15 new packages into package DB at [..] 107 | Rebuilding package cache. 108 | 109 | $ ls .cabal-sandbox/bin 110 | hspec-discover 111 | 112 | # Stack 113 | 114 | `sandman` also supports mixing in packages from a [`stack`] snapshot package 115 | database. 116 | 117 | $ sandman mix stack 118 | 119 | This mixes in all packages from the default snapshot database into the current 120 | Cabal sandbox. The `-o/--only` options may be used to limit the packages to a 121 | minimal subset. 122 | 123 | $ sandman mix stack -o text 124 | 125 | [`stack`]: https://github.com/commercialhaskell/stack 126 | 127 | # Status 128 | 129 | Sandman is stable enough for basic use cases but there are surely a lot of 130 | unexplored corner cases. Feel free to try it out. Keep in mind that since 131 | you're breaking sandbox boundaries, there is a higher chance of running into 132 | version conflicts. 133 | 134 | # Installation 135 | 136 | You can download and install `sandman` from Hackage by using, 137 | 138 | $ cabal install sandman 139 | 140 | Or if you would rather not pollute your global package database, install it 141 | into a sandbox and copy the executable somewhere on your `$PATH`. 142 | 143 | $ mkdir tmp && cd tmp 144 | $ cabal sandbox init 145 | $ cabal install sandman 146 | $ cp .cabal-sandbox/bin/sandman ~/bin 147 | 148 | Or simply use `stack`: 149 | 150 | $ stack install sandman 151 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | - Add `ghc` and `ghci` commands 2 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | name: sandman 3 | version: 0.2.0.1 4 | github: abhinav/sandman 5 | author: Abhinav Gupta 6 | maintainer: Abhinav Gupta 7 | license: MIT 8 | category: Development 9 | copyright: (c) 2016 Abhinav Gupta 10 | synopsis: Manages Cabal sandboxes to avoid rebuilding packages. 11 | description: | 12 | sandman aims to reduce the amount of time spent rebuilding commonly used 13 | Hackage packages by managing a global set of Cabal sandboxes that can be 14 | mixed into any project's Cabal sandbox. 15 | 16 | For more information, check the 17 | . 18 | extra-source-files: 19 | - README.md 20 | - CHANGES.md 21 | 22 | ghc-options: -Wall 23 | 24 | executables: 25 | sandman: 26 | main: Main.hs 27 | source-dirs: src 28 | dependencies: 29 | - base >= 4.7 && < 5 30 | - Cabal 31 | - containers >= 0.5 32 | - directory >= 1.2 33 | - filepath >= 1.3 34 | - optparse-applicative >= 0.11 35 | - process >= 1.2 36 | - text >= 1.2 37 | - unix-compat >= 0.4 38 | -------------------------------------------------------------------------------- /sandman.cabal: -------------------------------------------------------------------------------- 1 | -- This file has been generated from package.yaml by hpack version 0.13.0. 2 | -- 3 | -- see: https://github.com/sol/hpack 4 | 5 | name: sandman 6 | version: 0.2.0.1 7 | synopsis: Manages Cabal sandboxes to avoid rebuilding packages. 8 | description: sandman aims to reduce the amount of time spent rebuilding commonly used 9 | Hackage packages by managing a global set of Cabal sandboxes that can be 10 | mixed into any project's Cabal sandbox. 11 | . 12 | For more information, check the 13 | . 14 | category: Development 15 | homepage: https://github.com/abhinav/sandman#readme 16 | bug-reports: https://github.com/abhinav/sandman/issues 17 | author: Abhinav Gupta 18 | maintainer: Abhinav Gupta 19 | copyright: (c) 2016 Abhinav Gupta 20 | license: MIT 21 | license-file: LICENSE 22 | build-type: Simple 23 | cabal-version: >= 1.10 24 | 25 | extra-source-files: 26 | CHANGES.md 27 | README.md 28 | 29 | source-repository head 30 | type: git 31 | location: https://github.com/abhinav/sandman 32 | 33 | executable sandman 34 | main-is: Main.hs 35 | hs-source-dirs: 36 | src 37 | ghc-options: -Wall 38 | build-depends: 39 | base >= 4.7 && < 5 40 | , Cabal 41 | , containers >= 0.5 42 | , directory >= 1.2 43 | , filepath >= 1.3 44 | , optparse-applicative >= 0.11 45 | , process >= 1.2 46 | , text >= 1.2 47 | , unix-compat >= 0.4 48 | other-modules: 49 | Sandman.InstalledPackage 50 | Sandman.PackageDb 51 | Sandman.Stack 52 | Sandman.Util 53 | default-language: Haskell2010 54 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NamedFieldPuns #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | module Main (main) where 4 | 5 | import Control.Applicative 6 | import Control.Monad 7 | import Data.List (stripPrefix) 8 | import Data.Maybe (fromMaybe, isJust, listToMaybe) 9 | import Data.Monoid 10 | import Data.Set (Set) 11 | import Data.Text (Text) 12 | import System.Directory (canonicalizePath, copyFile, 13 | createDirectoryIfMissing, doesDirectoryExist, 14 | doesFileExist, findExecutable, getHomeDirectory, 15 | removeFile) 16 | import System.Exit (ExitCode (..)) 17 | import System.FilePath (splitDirectories, takeDirectory, takeFileName, 18 | ()) 19 | 20 | import qualified Data.Map.Strict as Map 21 | import qualified Data.Set as Set 22 | import qualified Data.Text as T 23 | import qualified Data.Text.IO as TIO 24 | import qualified Distribution.InstalledPackageInfo as PInfo 25 | import qualified Distribution.Text as Cabal 26 | import qualified Options.Applicative as O 27 | import qualified System.Process as Proc 28 | 29 | import Sandman.InstalledPackage 30 | import Sandman.PackageDb 31 | import Sandman.Util 32 | 33 | import qualified Sandman.Stack as Stack 34 | 35 | ------------------------------------------------------------------------------ 36 | -- | Main context for the program. 37 | -- 38 | -- Currently this just consists of the root directory where all sandman files 39 | -- will be stored. 40 | newtype Sandman = Sandman { sandmanDirectory :: FilePath } 41 | deriving (Show, Ord, Eq) 42 | 43 | 44 | -- | Build the context with default settings. 45 | defaultSandman :: IO Sandman 46 | defaultSandman = do 47 | home <- getHomeDirectory 48 | return $! Sandman (home ".sandman") 49 | 50 | 51 | -- | Path to the directory which will hold the sandboxes. 52 | sandboxesDirectory :: Sandman -> FilePath 53 | sandboxesDirectory Sandman{sandmanDirectory} = 54 | sandmanDirectory "sandboxes" 55 | 56 | 57 | -- | Get all managed sandboxes. 58 | getSandboxes :: Sandman -> IO [Sandbox] 59 | getSandboxes sandman = do 60 | exists <- doesDirectoryExist sandboxesDir 61 | if exists 62 | then map Sandbox <$> listDirectory sandboxesDir 63 | else return [] 64 | where 65 | sandboxesDir = sandboxesDirectory sandman 66 | 67 | 68 | -- | Get the sandbox with the given name. 69 | getSandbox :: Sandman -> Text -> IO (Maybe Sandbox) 70 | getSandbox sandman name = do 71 | exists <- doesDirectoryExist sandboxDir 72 | if exists 73 | then return . Just . Sandbox $ sandboxDir 74 | else return Nothing 75 | where 76 | sandboxDir = sandboxesDirectory sandman T.unpack name 77 | 78 | 79 | ------------------------------------------------------------------------------ 80 | -- | Represents a cabal sandbox. 81 | newtype Sandbox = Sandbox { 82 | sandboxRoot :: FilePath 83 | -- ^ Path to the sandbox root. 84 | -- 85 | -- Note: This is /not/ the project root. It just happens to be that the 86 | -- project root and sandbox root is the same for managed sandboxes. 87 | } deriving (Show, Ord, Eq) 88 | 89 | 90 | -- | Name of the sandbox. 91 | sandboxName :: Sandbox -> Text 92 | sandboxName = T.pack . takeFileName . sandboxRoot 93 | 94 | 95 | -- | Create a new managed sandbox with the given name. 96 | createSandbox :: Sandman -> Text -> IO Sandbox 97 | createSandbox sandman name = do 98 | whenM (doesDirectoryExist sandboxDir) $ 99 | die $ "Sandbox " <> name <> " already exists." 100 | 101 | createDirectoryIfMissing True sandboxDir 102 | 103 | let proc = (Proc.proc "cabal" ["sandbox", "init", "--sandbox=."]) { 104 | Proc.cwd = Just sandboxDir 105 | } 106 | 107 | (_, _, _, procHandle) <- Proc.createProcess proc 108 | exitResult <- Proc.waitForProcess procHandle 109 | case exitResult of 110 | ExitSuccess -> return $! Sandbox sandboxDir 111 | ExitFailure _ -> die $ "Failed to create sandbox " <> name 112 | where 113 | sandboxDir = sandboxesDirectory sandman T.unpack name 114 | 115 | -- | Install the specified packages into the sandbox. 116 | installPackages :: Sandbox -> [Text] -> IO () 117 | installPackages sandbox@Sandbox{sandboxRoot} packages = do 118 | (_, _, _, procHandle) <- Proc.createProcess proc 119 | exitResult <- Proc.waitForProcess procHandle 120 | case exitResult of 121 | ExitSuccess -> return () 122 | ExitFailure _ -> die $ "Failed to install packages to " <> name 123 | where 124 | name = sandboxName sandbox 125 | proc = (Proc.proc "cabal" $ ["install"] <> map T.unpack packages) { 126 | Proc.cwd = Just sandboxRoot 127 | } 128 | 129 | ------------------------------------------------------------------------------ 130 | 131 | -- TODO probably need another data type for Projects. 132 | 133 | getPackageGhcPath :: FilePath -> IO (Maybe FilePath) 134 | getPackageGhcPath packageRoot = do 135 | hasConfig <- doesFileExist cabalConfigPath 136 | if not hasConfig 137 | then return Nothing 138 | else TIO.readFile cabalConfigPath 139 | <&> map readField . T.lines 140 | <&> filter (("with-compiler" ==) . fst) 141 | <&> fmap (T.unpack . snd) . listToMaybe 142 | where 143 | readField line = (T.strip k, T.strip $ T.drop 1 v) 144 | where (k, v) = T.breakOn ":" $ T.strip line 145 | cabalConfigPath = packageRoot "cabal.config" 146 | 147 | 148 | setPackageGhcPath :: FilePath -> FilePath -> IO () 149 | setPackageGhcPath packageRoot ghc = do 150 | hasConfig <- doesFileExist cabalConfigPath 151 | if not hasConfig 152 | then TIO.writeFile cabalConfigPath entry 153 | else TIO.readFile cabalConfigPath 154 | <&> T.unlines . loop [] . T.lines 155 | >>= TIO.writeFile cabalConfigPath 156 | where 157 | entry = "with-compiler: " <> T.pack ghc 158 | cabalConfigPath = packageRoot "cabal.config" 159 | loop outLines [] = reverse outLines 160 | loop outLines (x:xs) 161 | | "with-compiler" `T.isPrefixOf` T.strip x 162 | = loop (entry:outLines) xs 163 | | otherwise = loop (x:outLines) xs 164 | 165 | 166 | 167 | -- | Get the PackageDb for the given package. 168 | -- 169 | -- The package root is the directory containing the @cabal.sandbox.config@. 170 | determinePackageDb :: FilePath -> IO (Either String PackageDb) 171 | determinePackageDb packageRoot = do 172 | -- TODO check if sandboxConfig exists 173 | matches <- TIO.readFile sandboxConfig 174 | <&> filter ("package-db:" `T.isPrefixOf`) . T.lines 175 | case listToMaybe matches of 176 | Nothing -> return . Left $ 177 | "Could not determine package DB for " ++ packageRoot 178 | Just line -> 179 | let right = T.drop 1 $ T.dropWhile (/= ':') line 180 | value = T.dropWhile (\c -> c == ' ' || c == '\t') right 181 | root = T.unpack value 182 | in getPackageDb root 183 | where 184 | sandboxConfig = packageRoot "cabal.sandbox.config" 185 | 186 | -- | Get the base package DB given the path to GHC. 187 | -- 188 | -- Uses the default GHC if given @Nothing@. 189 | getBasePackageDb :: Maybe FilePath -> IO (Either String PackageDb) 190 | getBasePackageDb ghcPath' = 191 | Proc.readProcess ghcPath ["--print-global-package-db"] "" 192 | <&> T.unpack . T.strip . T.pack 193 | >>= getPackageDb 194 | where 195 | ghcPath = fromMaybe "ghc" ghcPath' 196 | 197 | -- | Get the number of packages installed in the given package DB. 198 | installedPackageCount :: PackageDb -> Int 199 | installedPackageCount = length . packageDbInstalledPackages 200 | 201 | 202 | ------------------------------------------------------------------------------ 203 | list :: IO () 204 | list = do 205 | sandman <- defaultSandman -- FIXME 206 | sandboxes <- getSandboxes sandman 207 | when (null sandboxes) $ 208 | putStrLn "No sandboxes created." 209 | forM_ sandboxes $ \sandbox -> do 210 | let name = sandboxName sandbox 211 | packageDb' <- determinePackageDb (sandboxRoot sandbox) 212 | case packageDb' of 213 | Left err -> do 214 | warn (T.pack err) 215 | TIO.putStrLn $ name <> "(ERROR: could not read package DB)" 216 | Right packageDb -> do 217 | let packageCount = installedPackageCount packageDb 218 | TIO.putStrLn $ T.unwords 219 | [name, "(" <> tshow packageCount, "packages)"] 220 | 221 | 222 | ------------------------------------------------------------------------------ 223 | new :: Maybe FilePath -> Text -> IO () 224 | new ghcPath' name = do 225 | when (name == "stack") $ 226 | die "Sandbox 'stack' could not be created. That name is reserved." 227 | ghcPath <- maybe (return Nothing) 228 | (fmap Just . resolveExecutable) 229 | ghcPath' 230 | sandman <- defaultSandman -- FIXME 231 | Sandbox{sandboxRoot} <- createSandbox sandman name 232 | maybe (return ()) 233 | (setPackageGhcPath sandboxRoot) 234 | ghcPath 235 | TIO.putStrLn $ "Created sandbox " <> name <> "." 236 | where 237 | resolveExecutable path = do 238 | exists <- doesFileExist path 239 | if exists 240 | then canonicalizePath path 241 | else 242 | findExecutable path >>= 243 | maybe (die $ "Could not find GHC at " <> T.pack path) return 244 | 245 | ------------------------------------------------------------------------------ 246 | destroy :: Text -> IO () 247 | destroy name = do 248 | sandman <- defaultSandman 249 | Sandbox{sandboxRoot} <- getSandbox sandman name 250 | >>= maybe (die $ "Sandbox " <> name <> " does not exist.") return 251 | removeTree sandboxRoot 252 | TIO.putStrLn $ "Removed sandbox " <> name <> "." 253 | 254 | 255 | ------------------------------------------------------------------------------ 256 | install :: Text -> [Text] -> IO () 257 | install name packages = do 258 | -- TODO parse package IDs 259 | sandman <- defaultSandman 260 | sandbox <- getSandbox sandman name 261 | >>= maybe (die $ "Sandbox " <> name <> " does not exist.") return 262 | installPackages sandbox packages 263 | 264 | 265 | ------------------------------------------------------------------------------ 266 | listPackages :: Text -> IO () 267 | listPackages name = do 268 | sandman <- defaultSandman 269 | -- TODO get rid of all this duplication 270 | sandbox <- getSandbox sandman name 271 | >>= maybe (die $ "Sandbox " <> name <> " does not exist.") return 272 | packageDb <- determinePackageDb (sandboxRoot sandbox) 273 | >>= either fail return 274 | let packageIds = packageDbInstalledPackages packageDb 275 | <&> installedPackageId 276 | 277 | when (null packageIds) $ 278 | dieHappy $ name <> " does not contain any packages." 279 | 280 | forM_ packageIds TIO.putStrLn 281 | 282 | 283 | ------------------------------------------------------------------------------ 284 | mix :: [Text] -> Bool -> Text -> IO () 285 | mix packageNames includeExecutables name = do 286 | currentPackageDb <- determinePackageDb "." >>= either fail return 287 | 288 | (sandboxPackageDb, basePackageDb, copyExecutables, getGhcPath) <- 289 | getSandboxAndBasePackageDb 290 | 291 | let sandboxPackageNames = Set.fromList . map installedPackageName $ 292 | packageDbInstalledPackages sandboxPackageDb 293 | 294 | -- Make sure that all requested packages are installed. 295 | forM_ packageNames $ \requestedPackage -> 296 | unless (requestedPackage `Set.member` sandboxPackageNames) $ 297 | die $ requestedPackage <> " is not installed in " <> name 298 | 299 | let basePackageIds = map installedPackageId 300 | $ packageDbInstalledPackages basePackageDb 301 | 302 | -- Returns True if another package with the same name has already been 303 | -- installed to the target sandbox 304 | isAlreadyInstalled = 305 | (`Set.member` alreadyInstalled) . installedPackageName 306 | where 307 | alreadyInstalled = Set.fromList . map installedPackageName $ 308 | packageDbInstalledPackages currentPackageDb 309 | 310 | 311 | -- Reverse mapping from Cabal's InstalledPackageId to InstalledPackage 312 | -- for all packages in the managed sandbox 313 | installedPackageIdIndex = Map.fromList $ do 314 | installedPackage <- packageDbInstalledPackages sandboxPackageDb 315 | let pinfo = installedPackageInfo installedPackage 316 | return (PInfo.installedPackageId pinfo, installedPackage) 317 | 318 | -- Reverse mapping from package names to InstalledPackages for all 319 | -- packages in the managed sandbox 320 | installedPackageNameIndex = Map.fromList $ do 321 | installedPackage <- packageDbInstalledPackages sandboxPackageDb 322 | return (installedPackageName installedPackage, installedPackage) 323 | 324 | isBase pkgId' = any (`T.isPrefixOf` pkgId) basePackageIds 325 | where pkgId = T.pack $ Cabal.display pkgId' 326 | 327 | -- Get the InstalledPackage objects for the direct dependencies of the 328 | -- given InstaledPackage 329 | getDirectDependencies pkg = do 330 | dep <- PInfo.depends (installedPackageInfo pkg) 331 | if isBase dep then mzero else 332 | case dep `Map.lookup` installedPackageIdIndex of 333 | Nothing -> error $ unwords [ 334 | "Installed package", T.unpack (installedPackageName pkg) 335 | , "depends on", Cabal.display dep 336 | , "which is not installed in sandbox", T.unpack name 337 | ] 338 | Just depPkg -> return depPkg 339 | 340 | -- Get the InstalledPackage objects for all dependencies of the given 341 | -- InstaledPackage. 342 | -- 343 | -- This includes dependencies of dependencies and so on. 344 | getDependencies _pkg = loop Set.empty [] [_pkg] 345 | where 346 | loop _ result [] = result 347 | loop visited result (pkg:pkgs) 348 | | pname `Set.member` visited = loop visited result pkgs 349 | | otherwise = 350 | loop (pname `Set.insert` visited) 351 | (pkg:result) 352 | (pkgs ++ getDirectDependencies pkg) 353 | where 354 | pname = installedPackageName pkg 355 | 356 | -- Names of requested packages and their dependencies 357 | requestedPackages :: Set Text 358 | requestedPackages = Set.fromList $ do 359 | pkgName <- packageNames 360 | case pkgName `Map.lookup` installedPackageNameIndex of 361 | Nothing -> error $ unwords [ 362 | "Requested package", T.unpack pkgName 363 | , "is not installed in sandbox", T.unpack name 364 | ] 365 | Just installedPkg -> do 366 | depPkg <- getDependencies installedPkg 367 | [pkgName, installedPackageName depPkg] 368 | 369 | -- Whether a package was requested for installation. 370 | -- 371 | -- Always returns True if --only was skipped. If --only was given, 372 | -- returns true only for requested packages and their dependencies. 373 | isRequested = if null packageNames then const True else 374 | (`Set.member` requestedPackages) . installedPackageName 375 | 376 | -- Returns True if the package should be installed 377 | shouldInstall pkg = isRequested pkg && not (isAlreadyInstalled pkg) 378 | 379 | -- List of packages that will be installed 380 | packagesToInstall = filter shouldInstall $ 381 | packageDbInstalledPackages sandboxPackageDb 382 | 383 | newPackageCount = length packagesToInstall 384 | 385 | when (newPackageCount == 0) $ 386 | dieHappy "No packages to mix in." 387 | 388 | putStrLn $ unwords [ 389 | "Mixing", show newPackageCount 390 | , "new packages into package DB at" 391 | , packageDbRoot currentPackageDb 392 | ] 393 | 394 | let currentPackageDbRoot = packageDbRoot currentPackageDb 395 | forM_ packagesToInstall $ \installedPackage -> do 396 | let currentPath = installedPackageInfoPath installedPackage 397 | newPath = currentPackageDbRoot takeFileName currentPath 398 | copyFile currentPath newPath 399 | 400 | -- Copy executables to bin/ directory if requested. 401 | copyExecutables $ takeDirectory currentPackageDbRoot "bin" 402 | 403 | ghcPath <- getGhcPath 404 | case ghcPath of 405 | Nothing -> return () 406 | Just path -> do 407 | putStrLn $ "Setting GHC version for project to " ++ path 408 | setPackageGhcPath "." path 409 | 410 | putStrLn "Rebuilding package cache." 411 | Proc.callProcess "cabal" ["sandbox", "hc-pkg", "recache"] 412 | where 413 | getSandboxAndBasePackageDb 414 | | name == "stack" = do 415 | sandboxPackageDb <- Stack.getSnapshotPackageDb Nothing 416 | >>= either fail return 417 | basePackageDb <- Stack.getGlobalPackageDb 418 | >>= either fail return 419 | 420 | let copyExecutables _ = when includeExecutables . die $ T.unwords 421 | [ "Copying executables for stack snapshots is" 422 | , "not supported." 423 | ] 424 | getGhcPath = Just <$> Stack.getGhcPath 425 | 426 | return 427 | ( sandboxPackageDb 428 | , basePackageDb 429 | , copyExecutables 430 | , getGhcPath 431 | ) 432 | 433 | | otherwise = do 434 | sandman <- defaultSandman 435 | sandbox <- getSandbox sandman name 436 | >>= maybe (die $ "Sandbox " <> name <> " does not exist.") 437 | return 438 | sandboxPackageDb <- determinePackageDb (sandboxRoot sandbox) 439 | >>= either fail return 440 | basePackageDb <- getPackageGhcPath (sandboxRoot sandbox) 441 | >>= getBasePackageDb 442 | >>= either fail return 443 | 444 | let binDir = sandboxRoot sandbox "bin" 445 | 446 | copyExecutables newBinDir = do 447 | executables <- listDirectory binDir 448 | when (includeExecutables && not (null executables)) $ do 449 | createDirectoryIfMissing True newBinDir 450 | forM_ executables $ \exec -> do 451 | let newPath = newBinDir takeFileName exec 452 | alreadyExists <- doesFileExist newPath 453 | unless alreadyExists $ copyFile exec newPath 454 | 455 | return 456 | ( sandboxPackageDb 457 | , basePackageDb 458 | , copyExecutables 459 | , getPackageGhcPath (sandboxRoot sandbox) 460 | ) 461 | 462 | ------------------------------------------------------------------------------ 463 | clean :: IO () 464 | clean = do 465 | currentPackageDb <- determinePackageDb "." >>= either fail return 466 | sandman <- defaultSandman 467 | putStrLn "Removing all mixed sandboxes." 468 | 469 | let packages = filterPackages sandman $ 470 | packageDbInstalledPackages currentPackageDb 471 | 472 | when (null packages) $ 473 | dieHappy "No packages to remove." 474 | 475 | forM_ packages $ removeFile . installedPackageInfoPath 476 | putStrLn $ "Removed " <> show (length packages) <> " packages." 477 | 478 | putStrLn "Rebuilding package cache." 479 | Proc.callProcess "cabal" ["sandbox", "hc-pkg", "recache"] 480 | where 481 | -- FIXME this will probably cause all kinds of trouble if one managed 482 | -- sandbox is mixed into another. That should be disallowed or this should 483 | -- be smarter. 484 | filterPackages :: Sandman -> [InstalledPackage] -> [InstalledPackage] 485 | filterPackages Sandman{sandmanDirectory} = filter isMixedIn 486 | where 487 | isSandmanPath p = isJust $ 488 | stripPrefix (splitDirectories sandmanDirectory) 489 | (splitDirectories p) 490 | 491 | isMixedIn installedPackage = any isSandmanPath $ 492 | concatMap ($ packageInfo) [ 493 | PInfo.importDirs 494 | , PInfo.libraryDirs 495 | , PInfo.haddockInterfaces 496 | ] 497 | where 498 | packageInfo = installedPackageInfo installedPackage 499 | 500 | 501 | ------------------------------------------------------------------------------ 502 | argParser :: O.Parser (IO ()) 503 | argParser = O.subparser $ mconcat [ 504 | -- TODO come up with a better name for managed sandboxes than "sandman 505 | -- sandboxes" 506 | command "list" "List sandman sandboxes or the packages in them" $ 507 | maybe list listPackages <$> listNameArgument 508 | , command "new" "Create a new sandman sandbox" $ 509 | new <$> newOptions 510 | <*> nameArgument 511 | , command "destroy" "Delete a sandman sandbox" $ 512 | destroy <$> nameArgument 513 | , command "install" "Install a new package" $ 514 | install <$> nameArgument <*> packagesArgument 515 | , command "mix" 516 | (unwords 517 | [ "Mix a sandman sandbox into the current project." 518 | , "Use the name 'stack' to mix in packages from stack snapshots." 519 | ]) $ 520 | mix <$> many (T.pack <$> packageNameOption) 521 | <*> includeExecutablesOption 522 | <*> nameArgument 523 | , command "clean" "Remove all mixed sandboxes from the current project" $ 524 | pure clean 525 | ] 526 | where 527 | includeExecutablesOption = O.switch $ 528 | O.long "executables" <> O.short 'x' <> 529 | O.help "Mix executables from the managed sandbox into the project." 530 | packageNameOption = O.strOption $ 531 | O.long "only" <> O.short 'o' <> O.metavar "PACKAGE" <> 532 | O.help (unwords [ 533 | "If added, only the specified packages (and their dependencies)" 534 | , "will be mixed in. This option may be specified multiple times." 535 | ]) 536 | newOptions = O.optional . O.strOption $ 537 | O.long "with-ghc" <> O.metavar "GHC" <> 538 | O.help (unwords [ 539 | "Use a different version of GHC in this sandbox." 540 | , "When this sandbox is mixed into package sandboxes, their" 541 | , "cabal.config will be updated to use this version of GHC." 542 | ]) 543 | listNameArgument = O.optional . textArgument $ O.metavar "name" <> 544 | O.help (unwords [ 545 | "If given, list packages installed in the specified sandbox," 546 | , "otherwise list all sandman sandboxes" 547 | ]) 548 | packagesArgument = O.some . textArgument $ 549 | O.metavar "PACKAGES" <> O.help "Packages to install" 550 | nameArgument = textArgument $ 551 | O.metavar "NAME" <> O.help "Name of the sandman sandbox" 552 | textArgument = fmap T.pack . O.strArgument 553 | command name desc p = 554 | O.command name (O.info (O.helper <*> p) (O.progDesc desc)) 555 | 556 | 557 | main :: IO () 558 | main = join $ O.execParser opts 559 | where 560 | opts = O.info (O.helper <*> argParser) O.fullDesc 561 | -------------------------------------------------------------------------------- /src/Sandman/InstalledPackage.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NamedFieldPuns #-} 2 | module Sandman.InstalledPackage ( 3 | InstalledPackage 4 | , installedPackageInfo 5 | , installedPackageInfoPath 6 | , installedPackageId 7 | , installedPackageName 8 | , installedPackageVersion 9 | 10 | , getInstalledPackage 11 | ) where 12 | 13 | import Data.Text (Text) 14 | import Distribution.Version (Version) 15 | import System.Directory (doesFileExist) 16 | 17 | import qualified Data.Text as Text 18 | import qualified Distribution.InstalledPackageInfo as Cabal 19 | import qualified Distribution.Package as Cabal 20 | import qualified Distribution.Text as Cabal 21 | 22 | -- | Represents a Cabal package installed somewhere in the system. 23 | data InstalledPackage = InstalledPackage { 24 | installedPackageInfo :: Cabal.InstalledPackageInfo 25 | -- ^ 'Cabal.InstalledPackageInfo' for the package. 26 | , installedPackageInfoPath :: FilePath 27 | -- ^ Path where the 'Cabal.InstalledPackageInfo' file is stored. 28 | , cabalPackageId :: Cabal.PackageId 29 | -- ^ Cabal package ID 30 | } 31 | 32 | -- | Get the package ID for the given InstalledPackage 33 | installedPackageId :: InstalledPackage -> Text 34 | installedPackageId = Text.pack . Cabal.display . cabalPackageId 35 | 36 | -- | Get the package name 37 | installedPackageName :: InstalledPackage -> Text 38 | installedPackageName = 39 | Text.pack . Cabal.display . Cabal.pkgName . cabalPackageId 40 | 41 | -- | Get the package version 42 | installedPackageVersion :: InstalledPackage -> Version 43 | installedPackageVersion = Cabal.pkgVersion . cabalPackageId 44 | 45 | -- | Build a 'InstalledPackage' object from the given path. 46 | -- 47 | -- Returns either an error or the 'InstalledPackage' object. 48 | getInstalledPackage :: FilePath -> IO (Either String InstalledPackage) 49 | getInstalledPackage path = 50 | doesFileExist path >>= \exists -> 51 | if not exists 52 | then return (Left $ "File does not exist: " ++ path) 53 | else getInstalledPackage_ path 54 | 55 | getInstalledPackage_ :: FilePath -> IO (Either String InstalledPackage) 56 | getInstalledPackage_ installedPackageInfoPath = 57 | readFile installedPackageInfoPath >>= \contents -> 58 | case Cabal.parseInstalledPackageInfo contents of 59 | Cabal.ParseFailed e -> return . Left $ 60 | "Failed to parse " ++ installedPackageInfoPath ++ ": " ++ show e 61 | Cabal.ParseOk _ installedPackageInfo -> return . Right $ 62 | InstalledPackage{ 63 | installedPackageInfo 64 | , installedPackageInfoPath 65 | , cabalPackageId = Cabal.sourcePackageId installedPackageInfo 66 | } 67 | -------------------------------------------------------------------------------- /src/Sandman/PackageDb.hs: -------------------------------------------------------------------------------- 1 | module Sandman.PackageDb ( 2 | PackageDb 3 | , packageDbRoot 4 | , packageDbInstalledPackages 5 | , getPackageDb 6 | ) where 7 | 8 | import Control.Applicative 9 | import Data.Either 10 | import Data.List (isSuffixOf) 11 | import System.Directory (doesDirectoryExist) 12 | 13 | import Sandman.InstalledPackage (InstalledPackage, getInstalledPackage) 14 | import Sandman.Util 15 | 16 | -- | Represents a Cabal package database. 17 | data PackageDb = PackageDb { 18 | packageDbRoot :: FilePath 19 | -- ^ Root directory of the package database. 20 | , packageDbInstalledPackages :: [InstalledPackage] 21 | -- ^ List of packages installed inside the database. 22 | } 23 | 24 | -- | Get the package database for the given root directory. 25 | getPackageDb :: FilePath -> IO (Either String PackageDb) 26 | getPackageDb root = doesDirectoryExist root >>= \exists -> 27 | if not exists 28 | then return $ Left (root ++ " is not a package DB") 29 | else getPackageDb_ root 30 | 31 | getPackageDb_ :: FilePath -> IO (Either String PackageDb) 32 | getPackageDb_ root = do 33 | confFiles <- listDirectory root <&> filter (".conf" `isSuffixOf`) 34 | result <- partitionEithers <$> mapM getInstalledPackage confFiles 35 | return $ case result of 36 | ([], installedPackages) -> Right $ 37 | PackageDb root installedPackages 38 | (errs, _) -> Left . unlines $ 39 | ("Failed to read package DB at " ++ root) : errs 40 | -------------------------------------------------------------------------------- /src/Sandman/Stack.hs: -------------------------------------------------------------------------------- 1 | module Sandman.Stack 2 | ( getSnapshotPackageDb 3 | , getGlobalPackageDb 4 | , getGhcPath 5 | , Resolver 6 | ) where 7 | 8 | import Data.Char (isSpace) 9 | 10 | import qualified Data.List as L 11 | import qualified System.Process as Proc 12 | 13 | import Sandman.PackageDb (PackageDb, getPackageDb) 14 | import Sandman.Util 15 | 16 | type Resolver = String 17 | 18 | -- | Gets the package database for a stack snapshot. 19 | -- 20 | -- A resolver may be optionally specified. 21 | getSnapshotPackageDb :: Maybe Resolver -> IO (Either String PackageDb) 22 | getSnapshotPackageDb resolver = 23 | Proc.readProcess "stack" args "" 24 | <&> L.dropWhileEnd isSpace . L.dropWhile isSpace 25 | >>= getPackageDb 26 | where 27 | resolverArgs = case resolver of 28 | Nothing -> [] 29 | Just re -> ["--resolver", re] 30 | args = resolverArgs ++ ["path", "--snapshot-pkg-db"] 31 | 32 | 33 | getGlobalPackageDb :: IO (Either String PackageDb) 34 | getGlobalPackageDb = 35 | Proc.readProcess "stack" ["path", "--global-pkg-db"] "" 36 | <&> L.dropWhileEnd isSpace . L.dropWhile isSpace 37 | >>= getPackageDb 38 | 39 | getGhcPath :: IO FilePath 40 | getGhcPath = 41 | Proc.readProcess "stack" ["exec", "which", "ghc"] "" 42 | <&> L.dropWhileEnd isSpace . L.dropWhile isSpace 43 | -------------------------------------------------------------------------------- /src/Sandman/Util.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Sandman.Util ( 3 | (<&>) 4 | , whenM 5 | , tshow 6 | , listDirectory 7 | , removeTree 8 | , die 9 | , dieHappy 10 | , warn 11 | ) where 12 | 13 | import Control.Applicative 14 | import Control.Monad 15 | import Data.Monoid ((<>)) 16 | import Data.Text (Text) 17 | import System.Directory (doesDirectoryExist, getDirectoryContents, 18 | removeDirectory, removeFile) 19 | import System.Exit (exitFailure, exitSuccess) 20 | import System.FilePath (()) 21 | import System.IO (stderr) 22 | import System.PosixCompat.Files (getSymbolicLinkStatus, isDirectory) 23 | 24 | import qualified Data.Text as T 25 | import qualified Data.Text.IO as TIO 26 | 27 | -- | '<$>' with the arguments flipped. 28 | (<&>) :: Functor f => f a -> (a -> b) -> f b 29 | (<&>) = flip (<$>) 30 | infixl 1 <&> 31 | 32 | whenM :: Monad m => m Bool -> m () -> m () 33 | whenM p m = p >>= \c -> when c m 34 | 35 | tshow :: Show a => a -> Text 36 | tshow = T.pack . show 37 | 38 | listDirectory :: FilePath -> IO [FilePath] 39 | listDirectory d = doesDirectoryExist d >>= \exists -> 40 | if not exists 41 | then return [] 42 | else getDirectoryContents d 43 | <&> filter (`notElem` [".", ".."]) 44 | <&> map (d ) 45 | 46 | removeTree :: FilePath -> IO () 47 | removeTree path = do 48 | status <- getSymbolicLinkStatus path 49 | if isDirectory status 50 | then listDirectory path 51 | >>= mapM_ removeTree 52 | >> removeDirectory path 53 | else removeFile path 54 | 55 | -- | Print the given message and exit with a non-zero status code. 56 | die :: Text -> IO a 57 | die t = TIO.putStrLn t >> exitFailure 58 | 59 | 60 | -- | Print the given message and exit with status code zero. 61 | dieHappy :: Text -> IO a 62 | dieHappy t = TIO.putStrLn t >> exitSuccess 63 | 64 | warn :: Text -> IO () 65 | warn t = TIO.hPutStrLn stderr ("WARNING: " <> t) 66 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-4.0 2 | packages: 3 | - '.' 4 | extra-deps: [] 5 | flags: {} 6 | extra-package-dbs: [] 7 | --------------------------------------------------------------------------------