hsenv 0.4 → 0.5
raw patch · 16 files changed
+605/−302 lines, 16 filesdep +http-streamsdep +io-streamsdep ~Cabaldep ~basedep ~process
Dependencies added: http-streams, io-streams
Dependency ranges changed: Cabal, base, process, unix
Files
- README.md +163/−72
- hsenv.cabal +59/−27
- hsenv.el +122/−23
- skeletons/activate +20/−0
- src/Actions.hs +64/−25
- src/Args.hs +26/−5
- src/HsenvMonad.hs +90/−0
- src/MyMonad.hs +0/−89
- src/PackageManagement.hs +15/−15
- src/Paths.hs +7/−7
- src/Process.hs +15/−15
- src/SanityCheck.hs +14/−14
- src/Types.hs +6/−4
- src/Util/Args/RawArgs.hs +0/−1
- src/Util/Args/Usage.hs +1/−2
- src/hsenv.hs +3/−3
README.md view
@@ -1,5 +1,5 @@-Virtual Haskell Environment-===========================+hsenv - Virtual Haskell Environment+=================================== What is it? -----------@@ -9,11 +9,11 @@ What does it do? -----------------It creates a sandboxed environment in a .hsenv_<ENVIRONMENT_NAME>/ sub-directory-of your project, which, when activated, allows you to use regular Haskell tools-(ghc, ghci, ghc-pkg, cabal) to manage your Haskell code and environment.-It's possible to create an environment, that uses different GHC version-than your currently installed. Very simple emacs integration mode is included.+It creates a sandboxed environment in a .hsenv/ subdirectory of your project,+which, when activated, allows you to use regular Haskell tools (ghc, ghci,+ghc-pkg, cabal) to manage your Haskell code and environment. It's possible to+create an environment, that uses a different GHC version than your currently+installed system GHC version. Very simple emacs integration mode is included. Basic usage -----------@@ -23,156 +23,247 @@ (perhaps an app and its dependent library), just choose any of them, it doesn't really matter). Enter that directory: -> cd ~/projects/foo+```bash+cd ~/projects/foo+``` Next, create your new isolated Haskell environment-(this is a one time only (per environment) step):+(this is a one-time-only (per environment) step): -> hsenv+```bash+hsenv+``` Now, every time you want to use this environment, you have to activate it: -> source .hsenv_foo/bin/activate+```bash+source .hsenv/bin/activate+``` -That's it! Now it's possible to use all regular Haskell tools like usual,-but it won't affect your global/system's Haskell environment, and also-your per-user environment (from ~/.cabal and ~/.ghc) will stay the same.-All cabal-installed packages will be private to this environment,-and also the external environments (global and user) will not affect it-(this environment will only inherit very basic packages,-mostly ghc and Cabal and their deps).+That's it! Now it's possible to use all regular Haskell tools like usual, but+it won't affect your global/system Haskell environment, and also your per-user+environment (from ~/.cabal and ~/.ghc) will stay the same. All cabal-installed+packages will be private to this environment, and the external environments+(global and user) will not affect it (this environment will only inherit very+basic packages, mostly ghc and Cabal and their deps). -When you're done working with this environment, enter command 'deactivate_hsenv',+When you're done working with this environment, enter command `deactivate_hsenv`, or just close the current shell (with exit). -> deactivate_hsenv+```bash+deactivate_hsenv+``` +Named vs Unnamed Environments+-----------------------------++By default, hsenv creates an "unnamed" environment, but sometimes for+particular use cases you might want to create different environments under+the same directory. This is achievable creating a "named" environment. To+do that, just pass the flag `--name=<ENVIRONMENT_NAME>` to hsenv:++```bash+hsenv --name=<ENVIRONMENT_NAME>+```++This will make hsenv generate a folder of the form `.hsenv_<ENVIRONMENT_NAME>`.++Customization+-------------++If you want to customize activation and deactivation, create one or more of the+following files in ~/.hsenv/bin/: pre-activate, post-activate, pre-deactivate,+post-deactivate. These shell scripts will be sourced automatically by the main+activation script.+ Advanced usage -------------- Here's the most advanced usage of hsenv. Let's say you want to: -* hack on json library-* do so comfortably-* use your own version of parsec library-* and do all this using nightly version of GHC+* Hack on a json library+* Do so comfortably+* Use your own version of the parsec library+* And do all this using the nightly version of GHC -First, download binary distribution of GHC for your platform+First, download the binary distribution of GHC for your platform (e.g. ghc-7.3.20111105-i386-unknown-linux.tar.bz2). Create a directory for you environment: -> mkdir /tmp/test; cd /tmp/test+```bash+mkdir /tmp/test+cd /tmp/test+``` Then, create a new environment using that GHC: -> hsenv --ghc=/path/to/ghc-7.3.20111105-i386-unknown-linux.tar.bz2+```bash+hsenv --name=test --ghc=/path/to/ghc-7.3.20111105-i386-unknown-linux.tar.bz2+``` Activate it: -> source .hsenv_test/bin/activate+```bash+source .hsenv_test/bin/activate+``` Download a copy of json library and your private version of parsec: -> darcs get http://patch-tag.com/r/Paczesiowa/parsec; cabal unpack json+```bash+darcs get http://patch-tag.com/r/Paczesiowa/parsec+cabal unpack json+``` Install parsec: -> cd parsec2; cabal install+```bash+cd parsec2+cabal install+``` -Install the rest of json deps:+Install the rest of the json deps: -> cd ../json-0.5; cabal install --only-dependencies+```bash+cd ../json-0.5+cabal install --only-dependencies+``` Now, let's say you want to hack on Parsec module of json library. Open it in emacs: -> emacsclient Text/JSON/Parsec.hs+```bash+emacsclient Text/JSON/Parsec.hs+``` Activate the virtual environment (hsenv must be required earlier): -> M-x hsenv-activate <RET> /tmp/test/ <RET>+```+M-x hsenv-activate <RET> /tmp/test/ <RET>+``` Edit some code and load it in ghci using 'C-c C-l'. If it type checks, you can play around with the code using nightly version of ghci running in your virtual environment. When you're happy with the code, exit emacs and install your edited json library: -> cabal install+```bash+cabal install+``` And that's it. +Fetching and downloading a remote version of GHC+------------------------------------------------++Recent versions of hsenv include the possibility to automatically download and+install a GHC version directly from the GHC main repository. To do that, all+you need to do is to pass the desired version of GHC you want to install:++```bash+hsenv --ghc=7.4.1+```++Or a valid URL pointing to a compressed GHC archive:++```bash+hsenv --ghc=http://www.haskell.org/ghc/dist/7.6.3/ghc-7.6.3-x86_64-apple-darwin.tar.bz2+```+ Misc -----hsenv has been tested on i386 Linux and FreeBSD systems,-but it should work on any Posix platform. External (from tarball) GHC feature-requires binary GHC distribution compiled for your platform,-that can be extracted with tar and installed with-"./configure --prefix=PATH; make install". +hsenv has been tested on Linux, Mac OS X, and FreeBSD systems, but it should+work on any POSIX platform. The external (from tarball) GHC feature requires+a binary GHC distribution compiled for your platform which that can be+extracted with tar and installed with "./configure --prefix=PATH; make+install".+ FAQ ----Q: Can I use it together with tools like cabal-dev or capri? +**Q: Can I use it together with tools like cabal-dev or capri?**+ A: No. All these tools work more or less the same (wrapping cabal command, setting GHC_PACKAGE_PATH env variable), so something will probably break. -Q: Using GHC from tarball fails, when using FreeBSD with a bunch of make tool- gibberish. What do I do? -A: Try '--make-cmd=gmake' switch. -Q: Can I use hsenv inside hsenv? +**Q: Using GHC from tarball fails with a bunch of make tool gibberish on+FreeBSD. What do I do?**++A: Try the '--make-cmd=gmake' switch.+++**Q: Can I use hsenv inside hsenv?**+ A: No. It may be supported in future versions. -Q: Does it work on x64 systems? -A: It hasn't been tested, but there's no reason why it shouldn't. -Q: Will it work on Mac? -A: I doubt it. It should be easy to make it work there with system's GHC,- Using GHC from tarball will be probably harder. I don't have any mac- machines, so you're on your own, but patches/ideas/questions are welcome.+**Q: Does it work on x64 systems?** -Q: Will it work on Windows? -A: I really doubt it would even compile. I don't have access to any windows+A: Yes.+++**Q: Will it work on Mac?**++A: Yes.+++**Q: Will it work on Windows?**++A: I really doubt it would even compile. I don't have access to any Windows machines, so you're on your own, but patches/ideas/questions are welcome.- Maybe it would work on cygwin.+ Maybe it would work on Cygwin. -Q: Does it require bash? ++**Q: Does it require Bash?**+ A: No, it should work with any POSIX-compliant shell. It's been tested with bash, bash --posix, dash, zsh and ksh. -Q: Can I use it with a different haskell package repository than hackage? -A: Yes, just adjust the url in .hsenv_<ENVIRONMENT_NAME>/cabal/config file. -Q: How do I remove the whole virtual environment? +**Q: Can I use it with a different haskell package repository than hackage?**++A: Yes, just adjust the url in .hsenv/cabal/config file.+++**Q: How do I remove the whole virtual environment?**+ A: If it's activated - 'deactivate_hsenv' it. Then, delete- the .hsenv_<ENVIRONMENT_NAME>/ directory.+ the .hsenv/ directory. -Q: Is every environment completely separate from other environments and- the system environment? ++**Q: Is every environment completely separate from other environments and+ the system environment?**+ A: Yes. The only (minor) exception is ghci history - there's only one per user history file. Also, if you alter your system's GHC, then virtual environments using system's GHC copy will probably break. Virtual environments using GHC from a tarball should continue to work. -Q: Can I use multiple environments in the same directory (e.g. to test- my project against different ghc versions)? -A: Yes, just use different names for all the environments. -Q: Can I share one cabalized project directory among multiple environments- (e.g. build cabalized project in the same dir using different environments)? -A: Yes. hsenv also overrides cabal with a wrapper, that will force using different- builddirs, so there shouldn't be even any recompilation between different environments.+**Q: Can I share one cabalized project directory among multiple environments+(e.g. build a cabalized project in the same directory using different+environments)?** -Q: Is it possible to activate an environment upon entering its directory? -A: Yes, if you really know what you're doing. Here's a snippet for bash:+A: Yes. hsenv also overrides cabal with a wrapper, that will force using+different build directories, so there shouldn't be even any recompilation+between different environments. ++**Q: Is it possible to activate an environment upon entering its directory?**++A: Yes, if you really know what you're doing. Here's a snippet for bash, which+ will activate both named and unnamed environments:++```bash function precmd() { if [[ -z $HSENV ]]; then- NUMBER_OF_ENVS=$(find . -maxdepth 1 -type d -name ".hsenv_*" | wc -l)+ NUMBER_OF_ENVS=$(find . -maxdepth 1 -type d -name ".hsenv*" | wc -l) case ${NUMBER_OF_ENVS} in "0") ;;- "1") source .hsenv_*/bin/activate;;+ "1") source .hsenv*/bin/activate;; *) echo multiple environments, manual activaton required;; esac fi } export PROMPT_COMMAND=precmd+```
hsenv.cabal view
@@ -1,45 +1,60 @@ Name: hsenv -Version: 0.4+Version: 0.5 Synopsis: Virtual Haskell Environment builder Description: hsenv is a tool (inspired by Python's virtualenv) to create isolated Haskell environments. .- It creates a sandboxed environment in a .hsenv_<ENVIRONMENT_NAME>/ directory, which, when activated,- allows you to use regular Haskell tools (ghc, ghci, ghc-pkg, cabal) to manage your Haskell- code and environment. It's possible to create an environment, that uses a different GHC version- than your currently installed system GHC. hsenv is supposed to be easier to learn (and use) than- similar packages (like cabal-dev or capri).+ It creates a sandboxed environment in a .hsenv/ sub-directory+ of your project, which, when activated, allows you to use regular Haskell tools+ (ghc, ghci, ghc-pkg, cabal) to manage your Haskell code and environment.+ It's possible to create an environment, that uses different GHC version+ than your currently installed. Very simple emacs integration mode is included. .- Basic usage.+ Basic usage .- First, choose a directory where you want to keep your sandboxed Haskell environment,- usually a good choice is a directory containing your cabalized project (if you want to work- on a few projects (perhaps an app and its dependent library), just choose any of them,+ First, choose a directory where you want to keep your+ sandboxed Haskell environment, usually a good choice is a directory containing+ your cabalized project (if you want to work on a few projects+ (perhaps an app and its dependent library), just choose any of them, it doesn't really matter). Enter that directory: . > cd ~/projects/foo .- Next, create your new isolated Haskell environment (this is a one time only (per environment) step):+ Next, create your new isolated Haskell environment+ (this is a one time only (per environment) step): . > hsenv .- Now, every time you want to use this enviroment, you have to activate it:+ Now, every time you want to use this environment, you have to activate it: .- > source .hsenv_foo/bin/activate+ > source .hsenv/bin/activate .- That's it! Now it's possible to use all regular Haskell tools like usual, but it won't affect- your global/system's Haskell environment, and also your per-user environment (from ~/.cabal and- ~/.ghc) will stay the same. All cabal-installed packages will be private to this environment,- and also the external environments (global and user) will not affect it (this environment- will only inherit very basic packages - mostly ghc and Cabal and their deps).+ That's it! Now it's possible to use all regular Haskell tools like usual,+ but it won't affect your global/system's Haskell environment, and also+ your per-user environment (from ~/.cabal and ~/.ghc) will stay the same.+ All cabal-installed packages will be private to this environment,+ and also the external environments (global and user) will not affect it+ (this environment will only inherit very basic packages,+ mostly ghc and Cabal and their deps). . When you're done working with this environment, enter command 'deactivate_hsenv', or just close the current shell (with exit). . > deactivate_hsenv .+ Named vs Unnamed Environments+ .+ By default, hsenv creates an "unnamed" environment, but sometimes for+ particular use cases you might want to create different environments under+ the same directory. This is achievable creating a "named" environment. To+ do that, just pass the flag "--name=<ENVIRONMENT_NAME>" to hsenv:+ .+ hsenv --name=<ENVIRONMENT_NAME>+ .+ This will make hsenv to generate a folder of the form ".hsenv_<ENVIRONMENT_NAME>".+ . Advanced usage. . The only advanced usage is using different GHC version. This can be useful to test your code@@ -52,12 +67,27 @@ . Then, proceed (with [de]activation) as in basic case. .- Misc.+ Fetching and downloading a remote version of GHC .- hsenv has been tested on i386 Linux systems, but it should work on any Posix platform.- External (from tarball) GHC feature requires binary GHC distribution compiled for your platform,- that can be extracted with tar and installed with "./configure --prefix=PATH; make install".+ Recent versions of hsenv include the possibility to automatically download+ and install a GHC version directly from the GHC main repository. To do that,+ as regards the example above, all you need to do is to pass the desired version+ of GHC you want to install: .+ > hsenv --ghc=7.4.1+ .+ Or a valid URL pointing to a compressed GHC archive:+ .+ > hsenv --ghc=http://www.haskell.org/ghc/dist/7.6.3/ghc-7.6.3-x86_64-apple-darwin.tar.bz2+ .+ Misc+ .+ hsenv has been tested on i386 Linux and FreeBSD systems,+ but it should work on any Posix platform. External (from tarball) GHC feature+ requires binary GHC distribution compiled for your platform,+ that can be extracted with tar and installed with+ "./configure --prefix=PATH; make install".+ . For more info please consult "hsenv --help" or the attached README file. Homepage: https://github.com/tmhedberg/hsenv@@ -101,17 +131,19 @@ Ghc-options: -threaded -Wall - Build-depends: base >= 4.2.0.0 && < 4.7- , process >= 1.0.1.2 && < 1.2+ Build-depends: base >= 4.2.0.0 && < 4.8+ , process >= 1.0.1.2 && < 1.3 , filepath >= 1.1.0.3 && < 1.4 , directory >= 1.0.1.0 && < 1.3- , Cabal >= 1.8.0.6 && < 1.17+ , Cabal >= 1.8.0.6 && < 1.19 , mtl >= 1.1.0.2 && < 2.2 , bytestring >= 0.9.1.7 && < 0.11 , file-embed >= 0.0.4.1 && < 0.1 , split >= 0.1.4 && < 0.3 , safe >= 0.3 && < 0.4- , unix >= 2.0 && < 2.7+ , unix >= 2.0 && < 2.8+ , http-streams >= 0.6.0.2 && <= 0.7+ , io-streams >= 1.1.0.0 && <= 1.2.0.0 Other-modules: Util.Cabal , Util.Args@@ -129,7 +161,7 @@ , Util.WordWrap , Skeletons , Types- , MyMonad+ , HsenvMonad , Args , Paths , SanityCheck
hsenv.el view
@@ -1,19 +1,51 @@+(require 'cl) ; for mapcar* block and return+ (defvar hsenv-active-environment nil)+ (defconst hsenv-path-prepend-file "path_var_prependix") (defconst hsenv-ghc-package-path-file "ghc_package_path_var") +(defun hsenv-compare-ghc-version (version-string &optional threshold)+ (save-match-data+ (when (string-match "\\(\\([0-9]+\\.?\\)+\\)$" version-string)+ (let* ((threshold (or threshold (list 7 6 1)))+ (version (match-string 1 version-string))+ (version-numbers+ (mapcar #'string-to-number (split-string version "\\."))))+ (block nil+ (mapcar* #'(lambda (v1 v2)+ (when (< v1 v2)+ (return 'lt))+ (when (> v1 v2)+ (return 'gt)))+ version-numbers+ threshold)+ 'eq)))))++(defun hsenv-select-opt-suffix ()+ (let ((cmp-result (hsenv-compare-ghc-version (shell-command-to-string "ghc --version"))))+ (unless cmp-result+ (error "Cannot get GHC version"))+ (if (eq 'lt cmp-result)+ "conf"+ "db")))+ (defun hsenv-valid-dirp (hsenv-dir) (let ((valid (and (file-accessible-directory-p hsenv-dir)- (file-readable-p (concat hsenv-dir hsenv-path-prepend-file))- (file-readable-p (concat hsenv-dir hsenv-ghc-package-path-file)))))+ (file-readable-p+ (concat hsenv-dir hsenv-path-prepend-file))+ (file-readable-p+ (concat hsenv-dir hsenv-ghc-package-path-file))))) (when (not valid)- (message "The environment you provided is not a valid hsenv directory (%s)." hsenv-dir))+ (message "The environment you provided is not a valid hsenv directory (%s)."+ hsenv-dir)) valid)) (defun hsenv-is-not-active () (let ((is-not-active (not hsenv-active-environment))) (when (not is-not-active)- (message "An hsenv is already activated (%s)." (assoc-default 'dir hsenv-active-environment)))+ (message "An hsenv is already activated (%s)."+ (assoc-default 'dir hsenv-active-environment))) is-not-active)) (defun hsenv-is-active ()@@ -25,23 +57,75 @@ (defun hsenv-read-file-content (hsenv-dir file) (with-temp-buffer (insert-file-contents (concat hsenv-dir file))- (buffer-string)))+ (replace-regexp-in-string "\n+$" "" (buffer-string)))) -(defun hsenv-activate-environment (hsenv-dir)+(defun hsenv-replace-pkg (template package-dbs)+ (apply #'concat+ (mapcar #'(lambda (db)+ (concat template db))+ package-dbs)))++(defun hsenv-activate-environment (hsenv-dir env env-name) "Activate the Virtual Haskell Environment in directory HSENV-DIR" (when (and (hsenv-valid-dirp hsenv-dir) (hsenv-is-not-active))- ; Create an hsenv active environment and backup paths- (setq hsenv-active-environment (list `(path-backup . ,(getenv "PATH"))- `(exec-path-backup . ,exec-path)- `(dir . ,hsenv-dir)))+ ; Prepend paths- (let* ((path-prepend (hsenv-read-file-content hsenv-dir hsenv-path-prepend-file)))+ (let* ((new-hsenv-active-environment (list `(path-backup . ,(getenv "PATH"))+ `(exec-path-backup . ,exec-path)+ `(dir . ,hsenv-dir)))+ (path-prepend (hsenv-read-file-content hsenv-dir+ hsenv-path-prepend-file))+ (package-db (hsenv-read-file-content hsenv-dir hsenv-ghc-package-path-file))+ (package-dbs (split-string package-db ":"))+ (suffix (hsenv-select-opt-suffix))) (setenv "PATH" (concat path-prepend ":" (getenv "PATH")))- (setq exec-path (append (split-string path-prepend ":") exec-path)))- ; Set ghc-package- (setenv "GHC_PACKAGE_PATH" (hsenv-read-file-content hsenv-dir hsenv-ghc-package-path-file))))+ (setq exec-path (append (split-string path-prepend ":") exec-path))+ (setenv "PACKAGE_DB_FOR_GHC"+ (concat "-no-user-package-" suffix+ (hsenv-replace-pkg (concat " -package-" suffix "=") package-dbs)))+ (setenv "PACKAGE_DB_FOR_CABAL"+ (hsenv-replace-pkg " --package-db=" package-dbs))+ (setenv "PACKAGE_DB_FOR_GHC_PKG"+ (concat "--no-user-package-" suffix+ (hsenv-replace-pkg (concat " --package-" suffix "=") package-dbs)))+ (setenv "PACKAGE_DB_FOR_GHC_MOD"+ (concat "-g -no-user-package-" suffix+ (hsenv-replace-pkg (concat " -g -package-" suffix "=") package-dbs)))+ (setenv "HASKELL_PACKAGE_SANDBOX" package-db)+ (setenv "HSENV" env)+ (setenv "HSENV_NAME" env-name)+ ; Save an hsenv active environment and backup paths+ (setq hsenv-active-environment new-hsenv-active-environment)+ (message "Environment activated: %s" hsenv-dir)))) +(defun hsenv-env-name-from-dir (directory)+ "Return the name of an environment based on DIRECTORY."+ (save-match-data+ (let ((offs (string-match "[.]hsenv\\([^\\/]*\\)$" directory)))+ (cond+ (offs+ (substring directory (+ 6 offs)))+ ((string-match "[.]hsenv$" directory)+ "(default)")+ (t+ (error "Not an hsenv directory %s" directory))))))++;;; Tests:+;; (and (equal "foo" (hsenv-env-name-from-dir "/home/bar/baz/.hsenv_foo"))+;; (equal "foo" (hsenv-env-name-from-dir "/home/bar/.hsenv_boo/baz/.hsenv_foo"))+;; (equal "(default)"+;; (hsenv-env-name-from-dir "/home/bar/.hsenv_boo/baz/.hsenv")))++(defun hsenv-make-env (directory)+ (cons (hsenv-env-name-from-dir directory) directory))++(defun hsenv-env-name (env)+ (car env))++(defun hsenv-env-dir (env)+ (cdr env))+ (defun hsenv-deactivate () "Deactivate the Virtual Haskell Environment" (interactive)@@ -49,24 +133,39 @@ ; Restore paths (setenv "PATH" (assoc-default 'path-backup hsenv-active-environment)) (setq exec-path (assoc-default 'exec-path-backup hsenv-active-environment))+ ; Unset variables+ (setenv "PACKAGE_DB_FOR_GHC")+ (setenv "PACKAGE_DB_FOR_GHC_PKG")+ (setenv "PACKAGE_DB_FOR_GHC_MOD")+ (setenv "PACKAGE_DB_FOR_CABAL")+ (setenv "HSENV")+ (setenv "HSENV_NAME")+ (setenv "HASKELL_PACKAGE_SANDBOX") ; Destroy the hsenv active environment- (setq hsenv-active-environment nil)))+ (let ((old-dir (cdr (assoc 'dir hsenv-active-environment))))+ (setq hsenv-active-environment nil)+ (message "Environment deactivated: %s" old-dir)))) (defun hsenv-activate-dir (dir) (let ((environments (hsenv-list-environments dir))) (if (null environments) (message "Directory %s does not contain any hsenv." dir)- (let* ((env-name (if (= 1 (length environments))- (car environments)- (completing-read "Environment:" environments)))- (hsenv-dir-name (concat dir ".hsenv_" env-name))- (hsenv-dir (file-name-as-directory hsenv-dir-name)))- (hsenv-activate-environment hsenv-dir)))))+ (let* ((env-name+ (if (= 1 (length environments))+ (hsenv-env-name (car environments))+ (completing-read "Environment:"+ (mapcar #'hsenv-env-name environments))))+ (env (assoc env-name environments)))+ (let* ((hsenv-dir-name (hsenv-env-dir env))+ (hsenv-dir (file-name-as-directory hsenv-dir-name)))+ (hsenv-activate-environment hsenv-dir dir env-name)))))) (defun hsenv-list-environments (dir)- (let ((hsenv-dirs (file-expand-wildcards (concat dir ".hsenv_*"))))- (mapcar (lambda (hsenv-dir) (substring hsenv-dir (+ 7 (length dir)))) hsenv-dirs)))+ "Returns an assoc list of all environments avaliable in DIR. +The assoc list contains pairs of the form (NAME . DIRECTORY)."+ (let ((hsenv-dirs (directory-files dir t "^\\.hsenv\\(_.*\\)?$")))+ (mapcar #'hsenv-make-env hsenv-dirs))) (defun hsenv-activate (&optional select-dir) "Activate a Virtual Haskell Environment"
skeletons/activate view
@@ -10,6 +10,13 @@ return 1 fi +# Source a user script.+hsenv_bin() {+ if [ -f ~/.hsenv/bin/$1 ]; then+ . ~/.hsenv/bin/$1+ fi+}+ export HSENV="<HSENV>" export HSENV_NAME="<HSENV_NAME>" @@ -19,6 +26,8 @@ echo "" echo "To exit from this virtual environment, enter command 'deactivate_hsenv'." +hsenv_bin pre-activate+ HSENV_PATH_BACKUP="$PATH" if <MODIFY_PS1>; then@@ -29,6 +38,8 @@ echo "Deactivating ${HSENV_NAME} Virtual Haskell Environment (at ${HSENV})." echo "Restoring previous environment settings." + hsenv_bin pre-deactivate+ export PATH="$HSENV_PATH_BACKUP" unset -v HSENV_PATH_BACKUP @@ -37,12 +48,17 @@ unset -v HSENV_PS1_BACKUP fi + hsenv_bin post-deactivate+ unset -v PACKAGE_DB_FOR_CABAL unset -v PACKAGE_DB_FOR_GHC_PKG unset -v PACKAGE_DB_FOR_GHC+ unset -v PACKAGE_DB_FOR_GHC_MOD unset -v HSENV unset -v HSENV_NAME+ unset -v HASKELL_PACKAGE_SANDBOX unset -f deactivate_hsenv+ unset -f hsenv_bin if [ -n "$BASH" -o -n "$ZSH_VERSION" ]; then hash -r@@ -84,6 +100,8 @@ PKG_DB_OPT_SUFFIX="db" fi +export HASKELL_PACKAGE_SANDBOX="`<<HSENV_DIR>/ghc_package_path_var`"+ GHC_PACKAGE_PATH_REPLACEMENT="$(cat <HSENV_DIR>/ghc_package_path_var | sed -e 's/^/:/' -e 's/::*/:/g' -e 's/:\s*$//')" replace_pkg () {@@ -113,3 +131,5 @@ if [ -n "$BASH" -o -n "$ZSH_VERSION" ]; then hash -r fi++hsenv_bin post-activate
src/Actions.hs view
@@ -14,6 +14,7 @@ import Control.Monad import System.Directory (setCurrentDirectory, getCurrentDirectory, createDirectory, removeDirectoryRecursive, getAppUserDataDirectory, doesFileExist, findExecutable) import System.FilePath ((</>))+import System.Info (arch, os) import System.Posix hiding (createDirectory, version) import Distribution.Version (Version (..)) import Distribution.Package (PackageName(..))@@ -21,7 +22,11 @@ import Data.List (intercalate) import Data.Maybe (fromMaybe, isJust) -import MyMonad+import Network.Http.Client+import qualified Data.ByteString.Char8 as C8+import qualified System.IO.Streams as S++import HsenvMonad import Types import Paths import PackageManagement@@ -31,7 +36,7 @@ import Skeletons -- update cabal package info inside Virtual Haskell Environment-cabalUpdate :: MyMonad ()+cabalUpdate :: Hsenv () cabalUpdate = do noSharingFlag <- asks noSharing if noSharingFlag then do@@ -60,7 +65,7 @@ -- install cabal wrapper (in bin/ directory) inside virtual environment dir structure-installCabalWrapper :: MyMonad ()+installCabalWrapper :: Hsenv () installCabalWrapper = do cabalConfig <- cabalConfigLocation dirStructure <- hseDirStructure@@ -79,7 +84,7 @@ liftIO $ writeFile cabalWrapper cabalWrapperContents liftIO $ makeExecutable cabalWrapper -installActivateScriptSupportFiles :: MyMonad ()+installActivateScriptSupportFiles :: Hsenv () installActivateScriptSupportFiles = do debug "installing supporting files" dirStructure <- hseDirStructure@@ -88,11 +93,11 @@ let pathVarPrependixLocation = hsEnvDir dirStructure </> "path_var_prependix" pathVarElems = case ghc of- System -> [hsEnvBinDir dirStructure, cabalBinDir dirStructure]- Tarball _ -> [ hsEnvBinDir dirStructure- , cabalBinDir dirStructure- , ghcBinDir dirStructure- ]+ System -> [hsEnvBinDir dirStructure, cabalBinDir dirStructure]+ _ -> [ hsEnvBinDir dirStructure+ , cabalBinDir dirStructure+ , ghcBinDir dirStructure+ ] pathVarPrependix = intercalate ":" pathVarElems debug $ "installing path_var_prependix file to " ++ pathVarPrependixLocation indentMessages $ trace $ "path_var_prependix contents: " ++ pathVarPrependix@@ -105,7 +110,7 @@ liftIO $ writeFile ghcPackagePathVarLocation ghcPackagePathVar -- install activate script (in bin/ directory) inside virtual environment dir structure-installActivateScript :: MyMonad ()+installActivateScript :: Hsenv () installActivateScript = do info "Installing activate script" hsEnvName' <- asks hsEnvName@@ -131,7 +136,7 @@ indentMessages installActivateScriptSupportFiles -- install cabal's config file (in cabal/ directory) inside virtual environment dir structure-installCabalConfig :: MyMonad ()+installCabalConfig :: Hsenv () installCabalConfig = do cabalConfig <- cabalConfigLocation dirStructure <- hseDirStructure@@ -154,10 +159,10 @@ indentMessages $ mapM_ trace $ lines cabalConfigContents liftIO $ writeFile cabalConfig cabalConfigContents -installSimpleWrappers :: MyMonad ()+installSimpleWrappers :: Hsenv () installSimpleWrappers = mapM_ installSimpleWrapper simpleWrappers -installSimpleWrapper :: (String, String) -> MyMonad ()+installSimpleWrapper :: (String, String) -> Hsenv () installSimpleWrapper (targetFilename, skeleton) = do ghcPkgDbPath <- indentMessages ghcPkgDbPathLocation dirStructure <- hseDirStructure@@ -167,7 +172,7 @@ liftIO $ writeFile ghcWrapper ghcWrapperContents liftIO $ makeExecutable ghcWrapper -installProgSymlinks :: MyMonad ()+installProgSymlinks :: Hsenv () installProgSymlinks = mapM_ installSymlink extraProgs extraProgs :: [String]@@ -197,7 +202,7 @@ , "uhc" ] -installSymlink :: String -> MyMonad ()+installSymlink :: String -> Hsenv () installSymlink prog = do dirStructure <- hseDirStructure ghcSourceOpt <- asks ghcSource@@ -213,13 +218,13 @@ -- | Install a symbolic link to a skeleton script in hsenv's bin directory symlinkToSkeleton :: String -- ^ Name of skeleton -> String -- ^ Name of link- -> MyMonad ()+ -> Hsenv () symlinkToSkeleton skel link = do dirStructure <- hseDirStructure let prependBinDir = (hsEnvBinDir dirStructure </>) liftIO $ createSymbolicLink (prependBinDir skel) (prependBinDir link) -createDirStructure :: MyMonad ()+createDirStructure :: Hsenv () createDirStructure = do dirStructure <- hseDirStructure info "Creating Virtual Haskell directory structure"@@ -232,13 +237,13 @@ liftIO $ createDirectory $ hsEnvBinDir dirStructure -- initialize private GHC package database inside virtual environment-initGhcDb :: MyMonad ()+initGhcDb :: Hsenv () initGhcDb = do dirStructure <- hseDirStructure info $ "Initializing GHC Package database at " ++ ghcPackagePath dirStructure out <- indentMessages $ outsideGhcPkg ["--version"] case lastMay $ words out of- Nothing -> throwError $ MyException $ "Couldn't extract ghc-pkg version number from: " ++ out+ Nothing -> throwError $ HsenvException $ "Couldn't extract ghc-pkg version number from: " ++ out Just versionString -> do indentMessages $ trace $ "Found version string: " ++ versionString version <- parseVersion versionString@@ -252,7 +257,7 @@ -- copy optional packages and don't fail completely if this copying fails -- some packages mail fail to copy and it's not fatal (e.g. older GHCs don't have haskell2010)-transplantOptionalPackage :: String -> MyMonad ()+transplantOptionalPackage :: String -> Hsenv () transplantOptionalPackage name = transplantPackage (PackageName name) `catchError` handler where handler e = do warning $ "Failed to copy optional package " ++ name ++ " from system's GHC: "@@ -268,7 +273,7 @@ -- when using GHC from tarball, just reuse its package database -- cannot do the same when using system's GHC, because there might be additional packages installed -- then it wouldn't be possible to work on them insie virtual environment-copyBaseSystem :: MyMonad ()+copyBaseSystem :: Hsenv () copyBaseSystem = do info "Copying necessary packages from original GHC package database" indentMessages $ do@@ -278,18 +283,19 @@ transplantPackage $ PackageName "base" transplantPackage $ PackageName "Cabal" mapM_ transplantOptionalPackage ["haskell98", "haskell2010", "ghc", "ghc-binary"]- Tarball _ ->- debug "Using external GHC - nothing to copy, Virtual environment will reuse GHC package database"+ _ -> debug "Using external GHC - nothing to copy, Virtual environment will reuse GHC package database" -installGhc :: MyMonad ()+installGhc :: Hsenv () installGhc = do info "Installing GHC" ghc <- asks ghcSource case ghc of System -> indentMessages $ debug "Using system version of GHC - nothing to install." Tarball tarballPath -> indentMessages $ installExternalGhc tarballPath+ Url url -> indentMessages $ installRemoteGhc url+ Release tag -> indentMessages $ installReleasedGhc tag -installExternalGhc :: FilePath -> MyMonad ()+installExternalGhc :: FilePath -> Hsenv () installExternalGhc tarballPath = do info $ "Installing GHC from " ++ tarballPath indentMessages $ do@@ -310,3 +316,36 @@ configureAndInstall `finally` liftIO (setCurrentDirectory cwd) liftIO $ removeDirectoryRecursive tmpGhcDir return ()++-- Download a file over HTTP using streams, so it+-- has constant memory allocation.+downloadFile :: URL -> FilePath -> Hsenv ()+downloadFile url name = do+ m_ex <- liftIO $ get url $ \response inStream ->+ case getStatusCode response of+ 200 -> S.withFileAsOutput name (S.connect inStream) >> return Nothing+ code -> return $ Just $ HsenvException $+ "Failed to download "+ ++ name+ ++ ": http response returned "+ ++ show code+ maybe (return ()) throwError m_ex++installRemoteGhc :: String -> Hsenv ()+installRemoteGhc url = do+ dirStructure <- hseDirStructure+ downloadDir <- liftIO $ createTemporaryDirectory (hsEnv dirStructure) "ghc-download"+ let tarball = downloadDir </> "tarball"+ debug $ "Downloading GHC from " ++ url+ downloadFile (C8.pack url) tarball+ installExternalGhc tarball+ liftIO $ removeDirectoryRecursive downloadDir+ return ()++installReleasedGhc :: String -> Hsenv ()+installReleasedGhc tag = do+ let url = "http://www.haskell.org/ghc/dist/" ++ tag ++ "/ghc-" ++ tag ++ "-" ++ platform ++ ".tar.bz2"+ installRemoteGhc url++platform :: String+platform = intercalate "-" [arch, if os == "darwin" then "apple" else "unknown", os]
src/Args.hs view
@@ -3,6 +3,7 @@ module Args (getArgs) where import Control.Arrow+import Data.Char import Util.Args import Types @@ -57,10 +58,10 @@ ghcOpt = DynOpt { dynOptName = "ghc"- , dynOptTemplate = "FILE"+ , dynOptTemplate = "VERSION|URL|FILE" , dynOptDescription = "system's copy of GHC" , dynOptHelp =- "Use GHC from provided tarball (e.g. ghc-7.0.4-i386-unknown-linux.tar.bz2)"+ "Use GHC from provided location -- a GHC version number, an HTTP or HTTPS URL or a path to a tarball (e.g. ghc-7.0.4-i386-unknown-linux.tar.bz2)" } makeOpt :: StaticOpt@@ -85,7 +86,12 @@ noPS1' <- getOpt noPS1Opt -< () let ghc = case ghcFlag of Nothing -> System- Just path -> Tarball path+ -- First check for URLs (@//@ is not meaningful in Posix file+ -- paths), then versions and then default to path.+ Just s | "https://" == take 8 s -> Url s+ | "http://" == take 7 s -> Url s+ | isVersion s -> Release s+ | otherwise -> Tarball s skipSanityCheckFlag <- getOpt skipSanityOpt -< () noSharingFlag <- getOpt sharingOpt -< () make <- getOpt makeOpt -< ()@@ -100,5 +106,20 @@ getArgs :: IO Options getArgs = parseArgs argParser versionString outro- where outro = "Creates Virtual Haskell Environment in the current directory.\n"- ++ "All files will be stored in the .hsenv_ENVNAME/ subdirectory."+ where+ outro = "Creates Virtual Haskell Environment in the current directory.\n"+ ++ "All files will be stored in the .hsenv[_NAME]/ subdirectory.\n"+ ++ "\n"+ ++ "To activate a sandbox in the current directory, run:\n"+ ++ "\n"+ ++ " source .hsenv/bin/activate\n"+ ++ "\n"+ ++ "To deactivate an active sandbox, run:\n"+ ++ "\n"+ ++ " deactivate_hsenv"++isVersion :: String -> Bool+isVersion s = case dropWhile isDigit s of+ "" -> s /= ""+ '.':s' -> s /= '.':s' && isVersion s'+ _ -> False
+ src/HsenvMonad.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-}+module HsenvMonad ( Hsenv+ , runHsenv+ , indentMessages+ , debug+ , info+ , trace+ , warning+ , finally+ , throwError+ , catchError+ , ask+ , asks+ , gets+ , tell+ , modify+ , liftIO+ ) where++import Types++import Control.Exception as Exception (IOException, catch)+import Control.Applicative+import Control.Monad.Trans (MonadIO, liftIO)+import Control.Monad.Reader (ReaderT, MonadReader, runReaderT, asks, ask)+import Control.Monad.Writer (WriterT, MonadWriter, runWriterT, tell)+import Control.Monad.State (StateT, MonadState, evalStateT, modify, gets)+import Control.Monad.Error (ErrorT, MonadError, runErrorT, throwError, catchError)+import Control.Monad (when)+import System.IO (stderr, hPutStrLn)++import Prelude hiding (log)++newtype Hsenv a = Hsenv (StateT HsenvState (ReaderT Options (ErrorT HsenvException (WriterT [String] IO))) a)+ deriving (Functor, Applicative, Monad, MonadReader Options, MonadState HsenvState, MonadError HsenvException, MonadWriter [String])++instance MonadIO Hsenv where+ liftIO m = Hsenv $ do+ x <- liftIO $ (Right `fmap` m) `Exception.catch` \(e :: IOException) -> return $ Left e+ case x of+ Left e -> throwError $ HsenvException $ "IO error: " ++ show e+ Right y -> return y++runHsenv :: Hsenv a -> Options -> IO (Either HsenvException a, [String])+runHsenv (Hsenv m) = runWriterT . runErrorT . runReaderT (evalStateT m (HsenvState 0))++finally :: Hsenv a -> Hsenv b -> Hsenv a+finally m sequel = do+ result <- (Right `fmap` m) `catchError` (return . Left)+ _ <- sequel+ case result of+ Left e -> throwError e+ Right x -> return x++indentMessages :: Hsenv a -> Hsenv a+indentMessages m = do+ modify (\s -> s{logDepth = logDepth s + 2})+ result <- m+ modify (\s -> s{logDepth = logDepth s - 2})+ return result++-- add message to private log and return adjusted message (with log depth)+-- that can be printed somewhere else+privateLog :: String -> Hsenv String+privateLog str = do+ depth <- gets logDepth+ let text = replicate (fromInteger depth) ' ' ++ str+ tell [text]+ return text++log :: Verbosity -> String -> Hsenv ()+log minLevel str = do+ text <- privateLog str+ flag <- asks verbosity+ when (flag >= minLevel) $+ liftIO $ putStrLn text++debug :: String -> Hsenv ()+debug = log Verbose++info :: String -> Hsenv ()+info = log Quiet++trace :: String -> Hsenv ()+trace = log VeryVerbose++warning :: String -> Hsenv ()+warning str = do+ text <- privateLog str+ liftIO $ hPutStrLn stderr text
− src/MyMonad.hs
@@ -1,89 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-}-module MyMonad ( MyMonad- , runMyMonad- , indentMessages- , debug- , info- , trace- , warning- , finally- , throwError- , catchError- , ask- , asks- , gets- , tell- , modify- , liftIO- ) where--import Types--import Control.Exception as Exception (IOException, catch)-import Control.Monad.Trans (MonadIO, liftIO)-import Control.Monad.Reader (ReaderT, MonadReader, runReaderT, asks, ask)-import Control.Monad.Writer (WriterT, MonadWriter, runWriterT, tell)-import Control.Monad.State (StateT, MonadState, evalStateT, modify, gets)-import Control.Monad.Error (ErrorT, MonadError, runErrorT, throwError, catchError)-import Control.Monad (when)-import System.IO (stderr, hPutStrLn)--import Prelude hiding (log)--newtype MyMonad a = MyMonad (StateT MyState (ReaderT Options (ErrorT MyException (WriterT [String] IO))) a)- deriving (Functor, Monad, MonadReader Options, MonadState MyState, MonadError MyException, MonadWriter [String])--instance MonadIO MyMonad where- liftIO m = MyMonad $ do- x <- liftIO $ (Right `fmap` m) `Exception.catch` \(e :: IOException) -> return $ Left e- case x of- Left e -> throwError $ MyException $ "IO error: " ++ show e- Right y -> return y--runMyMonad :: MyMonad a -> Options -> IO (Either MyException a, [String])-runMyMonad (MyMonad m) = runWriterT . runErrorT . runReaderT (evalStateT m (MyState 0))--finally :: MyMonad a -> MyMonad b -> MyMonad a-finally m sequel = do- result <- (Right `fmap` m) `catchError` (return . Left)- _ <- sequel- case result of- Left e -> throwError e- Right x -> return x--indentMessages :: MyMonad a -> MyMonad a-indentMessages m = do- modify (\s -> s{logDepth = logDepth s + 2})- result <- m- modify (\s -> s{logDepth = logDepth s - 2})- return result---- add message to private log and return adjusted message (with log depth)--- that can be printed somewhere else-privateLog :: String -> MyMonad String-privateLog str = do- depth <- gets logDepth- let text = replicate (fromInteger depth) ' ' ++ str- tell [text]- return text--log :: Verbosity -> String -> MyMonad ()-log minLevel str = do- text <- privateLog str- flag <- asks verbosity- when (flag >= minLevel) $- liftIO $ putStrLn text--debug :: String -> MyMonad ()-debug = log Verbose--info :: String -> MyMonad ()-info = log Quiet--trace :: String -> MyMonad ()-trace = log VeryVerbose--warning :: String -> MyMonad ()-warning str = do- text <- privateLog str- liftIO $ hPutStrLn stderr text
src/PackageManagement.hs view
@@ -9,28 +9,28 @@ import Control.Monad (unless) import Types-import MyMonad+import HsenvMonad import Process (outsideProcess', insideProcess) import Util.Cabal (prettyPkgInfo, prettyVersion) import qualified Util.Cabal (parseVersion, parsePkgInfo) -outsideGhcPkg :: [String] -> MyMonad String+outsideGhcPkg :: [String] -> Hsenv String outsideGhcPkg = outsideProcess' "ghc-pkg" -insideGhcPkg :: [String] -> Maybe String -> MyMonad String+insideGhcPkg :: [String] -> Maybe String -> Hsenv String insideGhcPkg = insideProcess "ghc-pkg" -parseVersion :: String -> MyMonad Version+parseVersion :: String -> Hsenv Version parseVersion s = case Util.Cabal.parseVersion s of- Nothing -> throwError $ MyException $ "Couldn't parse " ++ s ++ " as a package version"+ Nothing -> throwError $ HsenvException $ "Couldn't parse " ++ s ++ " as a package version" Just version -> return version -parsePkgInfo :: String -> MyMonad PackageIdentifier+parsePkgInfo :: String -> Hsenv PackageIdentifier parsePkgInfo s = case Util.Cabal.parsePkgInfo s of- Nothing -> throwError $ MyException $ "Couldn't parse package identifier " ++ s+ Nothing -> throwError $ HsenvException $ "Couldn't parse package identifier " ++ s Just pkgInfo -> return pkgInfo -getDeps :: PackageIdentifier -> MyMonad [PackageIdentifier]+getDeps :: PackageIdentifier -> Hsenv [PackageIdentifier] getDeps pkgInfo = do let prettyPkg = prettyPkgInfo pkgInfo debug $ "Extracting dependencies of " ++ prettyPkg@@ -39,7 +39,7 @@ -- depends: ghc-prim-0.2.0.0-3fbcc20c802efcd7c82089ec77d92990 -- integer-gmp-0.2.0.0-fa82a0df93dc30b4a7c5654dd7c68cf4 builtin_rts case words out of- [] -> throwError $ MyException $ "Couldn't parse ghc-pkg output to find dependencies of " ++ prettyPkg+ [] -> throwError $ HsenvException $ "Couldn't parse ghc-pkg output to find dependencies of " ++ prettyPkg _:depStrings -> do -- skip 'depends:' indentMessages $ trace $ "Found dependency strings: " ++ unwords depStrings mapM parsePkgInfo depStrings@@ -47,7 +47,7 @@ -- things that can be copied from system's GHC pkg database -- to GHC pkg database inside virtual environment class Transplantable a where- transplantPackage :: a -> MyMonad ()+ transplantPackage :: a -> Hsenv () -- choose the highest installed version of package with this name instance Transplantable PackageName where@@ -59,15 +59,15 @@ -- example output: -- version: 1.1.4 -- version: 1.2.0.3- let extractVersionString :: String -> MyMonad String+ let extractVersionString :: String -> Hsenv String extractVersionString line = case words line of [_, x] -> return x- _ -> throwError $ MyException $ "Couldn't extract version string from: " ++ line+ _ -> throwError $ HsenvException $ "Couldn't extract version string from: " ++ line versionStrings <- mapM extractVersionString $ lines out indentMessages $ trace $ "Found version strings: " ++ unwords versionStrings versions <- mapM parseVersion versionStrings case versions of- [] -> throwError $ MyException $ "No versions of package " ++ packageName ++ " found"+ [] -> throwError $ HsenvException $ "No versions of package " ++ packageName ++ " found" (v:vs) -> do indentMessages $ debug $ "Found: " ++ unwords (map prettyVersion versions) let highestVersion = foldr max v vs@@ -76,7 +76,7 @@ transplantPackage pkgInfo -- check if this package is already installed in Virtual Haskell Environment-checkIfInstalled :: PackageIdentifier -> MyMonad Bool+checkIfInstalled :: PackageIdentifier -> Hsenv Bool checkIfInstalled pkgInfo = do let package = prettyPkgInfo pkgInfo debug $ "Checking if " ++ package ++ " is already installed."@@ -101,7 +101,7 @@ movePackage pkgInfo -- copy single package that already has all deps satisfied-movePackage :: PackageIdentifier -> MyMonad ()+movePackage :: PackageIdentifier -> Hsenv () movePackage pkgInfo = do let prettyPkg = prettyPkgInfo pkgInfo debug $ "Moving package " ++ prettyPkg ++ " to Virtual Haskell Environment."
src/Paths.hs view
@@ -11,11 +11,11 @@ import Util.IO (getEnvVar) import Types-import MyMonad+import HsenvMonad -- returns record containing paths to all important directories -- inside virtual environment dir structure-hseDirStructure :: MyMonad DirStructure+hseDirStructure :: Hsenv DirStructure hseDirStructure = do cwd <- liftIO getCurrentDirectory dirName <- dotDirName@@ -37,19 +37,19 @@ constructDotDirName opts = maybe ".hsenv" (".hsenv_" ++) (hsEnvName opts) -- directory name of hsEnvDir-dotDirName :: MyMonad String+dotDirName :: Hsenv String dotDirName = do opts <- ask return $ constructDotDirName opts -- returns location of cabal's config file inside virtual environment dir structure-cabalConfigLocation :: MyMonad FilePath+cabalConfigLocation :: Hsenv FilePath cabalConfigLocation = do dirStructure <- hseDirStructure return $ cabalDir dirStructure </> "config" -- returns value of $PATH env variable to be used inside virtual environment-insidePathVar :: MyMonad String+insidePathVar :: Hsenv String insidePathVar = do oldPathVar <- liftIO $ getEnvVar "PATH" let oldPathVarSuffix = case oldPathVar of@@ -58,6 +58,6 @@ dirStructure <- hseDirStructure ghc <- asks ghcSource let extraPathElems = case ghc of- System -> [cabalBinDir dirStructure]- Tarball _ -> [cabalBinDir dirStructure, ghcBinDir dirStructure]+ System -> [cabalBinDir dirStructure]+ _ -> [cabalBinDir dirStructure, ghcBinDir dirStructure] return $ intercalate ":" extraPathElems ++ oldPathVarSuffix
src/Process.hs view
@@ -4,7 +4,7 @@ , ghcPkgDbPathLocation ) where -import MyMonad+import HsenvMonad import Paths import Types @@ -16,7 +16,7 @@ import System.FilePath ((</>)) import System.Process (readProcessWithExitCode) -runProcess :: Maybe Environment -> FilePath -> [String] -> Maybe String -> MyMonad String+runProcess :: Maybe Environment -> FilePath -> [String] -> Maybe String -> Hsenv String runProcess env prog args input = do case input of Nothing -> return ()@@ -48,30 +48,30 @@ case exitCode of ExitSuccess -> return output- ExitFailure errCode -> throwError $ MyException $ prog ++ " process failed with status " ++ show errCode+ ExitFailure errCode -> throwError $ HsenvException $ prog ++ " process failed with status " ++ show errCode -- run regular process, takes: -- * program name, looks for it in $PATH, -- * list of arguments -- * maybe standard input -- returns standard output-outsideProcess :: String -> [String] -> Maybe String -> MyMonad String+outsideProcess :: String -> [String] -> Maybe String -> Hsenv String outsideProcess progName args input = do debug $ unwords $ ["Running outside process:", progName] ++ args indentMessages $ do trace $ unwords ["Looking for", progName, "in $PATH"] program <- liftIO $ which Nothing progName case program of- Nothing -> throwError $ MyException $ unwords ["No", progName, "in $PATH"]+ Nothing -> throwError $ HsenvException $ unwords ["No", progName, "in $PATH"] Just programPath -> do trace $ unwords [progName, "->", programPath] runProcess Nothing programPath args input -outsideProcess' :: String -> [String] -> MyMonad String+outsideProcess' :: String -> [String] -> Hsenv String outsideProcess' progName args = outsideProcess progName args Nothing -- returns path to GHC (installed from tarball) builtin package database-externalGhcPkgDb :: MyMonad FilePath+externalGhcPkgDb :: Hsenv FilePath externalGhcPkgDb = do trace "Checking where GHC (installed from tarball) keeps its package database" indentMessages $ do@@ -81,10 +81,10 @@ ghcPkgOutput <- indentMessages $ runProcess Nothing ghcPkg ["list"] Nothing debug "Trying to parse ghc-pkg's output" case lines ghcPkgOutput of- [] -> throwError $ MyException "ghc-pkg returned empty output"+ [] -> throwError $ HsenvException "ghc-pkg returned empty output" lineWithPath:_ -> case lineWithPath of- "" -> throwError $ MyException "ghc-pkg's first line of output is empty"+ "" -> throwError $ HsenvException "ghc-pkg's first line of output is empty" _ -> do -- ghc-pkg ends pkg db path with trailing colon -- but only when not run from the terminal@@ -94,18 +94,18 @@ -- returns value of GHC_PACKAGE_PATH that should be used inside virtual environment -- defined in this module, because insideProcess needs it-ghcPkgDbPathLocation :: MyMonad String+ghcPkgDbPathLocation :: Hsenv String ghcPkgDbPathLocation = do trace "Determining value of GHC_PACKAGE_PATH to be used inside virtual environment" dirStructure <- hseDirStructure ghc <- asks ghcSource case ghc of- System -> return $ ghcPackagePath dirStructure- Tarball _ -> do+ System -> return $ ghcPackagePath dirStructure+ _ -> do externalGhcPkgDbPath <- indentMessages externalGhcPkgDb return $ ghcPackagePath dirStructure ++ ":" ++ externalGhcPkgDbPath -virtualEnvironment :: MyMonad Environment+virtualEnvironment :: Hsenv Environment virtualEnvironment = do debug "Calculating unix env dictionary used inside virtual environment" indentMessages $ do@@ -128,7 +128,7 @@ -- returns standard output -- process is run in altered environment (new $GHC_PACKAGE_PATH env var, -- adjusted $PATH var)-insideProcess :: String -> [String] -> Maybe String -> MyMonad String+insideProcess :: String -> [String] -> Maybe String -> Hsenv String insideProcess progName args input = do debug $ unwords $ ["Running inside process:", progName] ++ args indentMessages $ do@@ -136,7 +136,7 @@ trace $ unwords ["Looking for", progName, "in", pathVar] program <- liftIO $ which (Just pathVar) progName case program of- Nothing -> throwError $ MyException $ unwords ["No", progName, "in", pathVar]+ Nothing -> throwError $ HsenvException $ unwords ["No", progName, "in", pathVar] Just programPath -> do trace $ unwords [progName, "->", programPath] env <- virtualEnvironment
src/SanityCheck.hs view
@@ -5,11 +5,11 @@ import Util.IO (getEnvVar, which) import Types-import MyMonad+import HsenvMonad import Paths (hseDirStructure, dotDirName) -- check if any virtual env is already active-checkHSE :: MyMonad ()+checkHSE :: Hsenv () checkHSE = do hsEnvVar <- liftIO $ getEnvVar "HSENV" case hsEnvVar of@@ -19,44 +19,44 @@ case hsEnvNameVar of Nothing -> do debug $ "warning: HSENV environment variable is defined" ++ ", but no HSENV_NAME environment variable defined."- throwError $ MyException $ "There is already active Virtual Haskell Environment (at " ++ path ++ ")."+ throwError $ HsenvException $ "There is already active Virtual Haskell Environment (at " ++ path ++ ")." Just name ->- throwError $ MyException $ "There is already active " ++ name ++ " Virtual Haskell Environment (at " ++ path ++ ")."+ throwError $ HsenvException $ "There is already active " ++ name ++ " Virtual Haskell Environment (at " ++ path ++ ")." -checkHsenvAlreadyExists :: MyMonad ()+checkHsenvAlreadyExists :: Hsenv () checkHsenvAlreadyExists = do dirStructure <- hseDirStructure flag <- liftIO $ doesDirectoryExist $ hsEnvDir dirStructure dotDir <- dotDirName- when flag $ throwError $ MyException $ "There is already " ++ dotDir ++ " directory at " ++ hsEnv dirStructure+ when flag $ throwError $ HsenvException $ "There is already " ++ dotDir ++ " directory at " ++ hsEnv dirStructure -- check if cabal binary exist on PATH-checkCabalInstall :: MyMonad ()+checkCabalInstall :: Hsenv () checkCabalInstall = do cabalInstallPath <- liftIO $ which Nothing "cabal" case cabalInstallPath of Just _ -> return ()- Nothing -> throwError $ MyException "Couldn't find cabal binary (from cabal-install package) in your $PATH."+ Nothing -> throwError $ HsenvException "Couldn't find cabal binary (from cabal-install package) in your $PATH." -- check if GHC tools (ghc, ghc-pkg) exist on PATH -- skip the check if using GHC from a tarball-checkGhc :: MyMonad ()+checkGhc :: Hsenv () checkGhc = do ghcSrc <- asks ghcSource case ghcSrc of- Tarball _ -> return ()- System -> do+ System -> do ghcPath <- liftIO $ which Nothing "ghc" case ghcPath of Just _ -> return ()- Nothing -> throwError $ MyException "Couldn't find ghc binary in your $PATH."+ Nothing -> throwError $ HsenvException "Couldn't find ghc binary in your $PATH." ghc_pkgPath <- liftIO $ which Nothing "ghc-pkg" case ghc_pkgPath of Just _ -> return ()- Nothing -> throwError $ MyException "Couldn't find ghc-pkg binary in your $PATH."+ Nothing -> throwError $ HsenvException "Couldn't find ghc-pkg binary in your $PATH."+ _ -> return () -- check if everything is sane-sanityCheck :: MyMonad ()+sanityCheck :: Hsenv () sanityCheck = do checkHSE checkHsenvAlreadyExists
src/Types.hs view
@@ -1,9 +1,9 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Types ( GhcSource(..) , Options(..)- , MyState(..)+ , HsenvState(..) , DirStructure(..)- , MyException(..)+ , HsenvException(..) , Verbosity(..) ) where @@ -11,6 +11,8 @@ data GhcSource = System -- Use System's copy of GHC | Tarball FilePath -- Use GHC from tarball+ | Url String -- Use GHC downloadable at URL+ | Release String -- Infer a URL and use GHC from there data Verbosity = Quiet | Verbose@@ -26,10 +28,10 @@ , noPS1 :: Bool -- Don't modify shell prompt } -data MyState = MyState { logDepth :: Integer -- used for indentation of logging messages+data HsenvState = HsenvState { logDepth :: Integer -- used for indentation of logging messages } -newtype MyException = MyException { getExceptionMessage :: String }+newtype HsenvException = HsenvException { getExceptionMessage :: String } deriving Error -- Only absolute paths!
src/Util/Args/RawArgs.hs view
@@ -4,7 +4,6 @@ import Data.Monoid (Monoid(..)) import Control.Monad (liftM)-import Control.Monad.Instances () import Util.List (breakOn) {-# ANN Args "HLint: ignore Use String" #-}
src/Util/Args/Usage.hs view
@@ -40,7 +40,6 @@ usage arrow outro = do self <- getProgName let intro = "usage: " ++ self ++ " [FLAGS]"- return $ unlines $ [intro, "", "Flags:"] ++ flagsDescr ++ [""] ++ outro'+ return $ unlines $ [intro, "", "Flags:"] ++ flagsDescr ++ [""] ++ [outro] where flagsDescr = concatMap showFlagDescr $ argDescrSort $ getKnownArgs arrow argDescrSort = sortBy (compare `on` argName)- outro' = wordWrap 80 outro
src/hsenv.hs view
@@ -3,7 +3,7 @@ import System.FilePath ((</>)) import Types-import MyMonad+import HsenvMonad import Actions import SanityCheck (sanityCheck) import Args (getArgs)@@ -12,7 +12,7 @@ main :: IO () main = do options <- getArgs- (result, messageLog) <- runMyMonad realMain options+ (result, messageLog) <- runHsenv realMain options case result of Left err -> do hPutStrLn stderr $ getExceptionMessage err@@ -25,7 +25,7 @@ let dotDir = constructDotDirName options writeFile (dotDir </> "hsenv.log") $ unlines messageLog -realMain :: MyMonad ()+realMain :: Hsenv () realMain = do skipSanityCheckFlag <- asks skipSanityCheck if skipSanityCheckFlag then