[prev in list] [next in list] [prev in thread] [next in thread]
List: darcs-devel
Subject: [darcs-devel] [patch2017] support ghc-8.8 and ghc-8.10
From: Ben Franksen <bugs () darcs ! net>
Date: 2020-04-28 10:25:31
Message-ID: 1N6szR-1j7MrB3KW7-018LGV () mrelayeu ! kundenserver ! de
[Download RAW message or body]
New submission from Ben Franksen <ben.franksen@online.de>:
This makes screened build cleanly (no warnings) with ghc-8.8 and ghc-8.10.
I started by selectively pulling patches from branch-2.14. As expected, most
of them conflicted. I would have liked to rebase them to avoid the
conflicts, but since rebase currently does not work correctly with
conflicted patches I could not do that. Therefore the many conflict
resolution patches. If you happen to find the time: it would be a valuable
real-world test of the new fullUnwind-based rebase implementation if you
were able to squash the conflict resolutions with the original patches
(please add a "[rebased]" marker to the patch name if you do that). I won't
immediately screen this bundle to give you some time to consider whether you
want to try that.
It turned out that shelly-1.9 breaks our shell tests even on Linux: the
harness no longer finds any of them. Since for Windows we already have a
special case here, requiring <1.7.2, I decided to import shelly-1.7.1 into
our source tree and fix the build problems, rather than keep waiting any
longer for upstream to get their homework done (which may in fact never
happen). This worked out remarkably well. However, it currently works only
when building from a darcs clone, since the files in the shelly sub
directory are not included in the cabal source dist. In the long run we
should consider switching to turtle, which is actually maintained by the
author (a well known and quite diligent member of the community).
Running the shell tests confirmed my suspicion that merely replacing fail
with error to avoid proliferating MonadFail constraints all over the place
is a bad idea. In fact there was only one single place where this is the
correct fix. In most other places we actually want to replace it with (throw
. userError), or, where possible, with (liftIO . fail). I will backport
these changes and the shelly patches to make a new 2.14.4 release.
33 patches for repository http://darcs.net/screened:
patch 46bebd0a1511232b216d387392d964cae6fcac2c
Author: Ben Franksen <ben.franksen@online.de>
Date: Tue Apr 21 10:12:58 CEST 2020
* loosen upper bound for haskeline to <0.9
This is required to find a valid build plan for ghc >= 8.8.
patch 5d63e665634c964d7b23dcf9c28efc72d6a6f947
Author: Ben Franksen <ben.franksen@online.de>
Date: Tue Apr 21 10:14:29 CEST 2020
* loosen upper bound for shelly to <1.10
This is required to find a build plan with ghc >= 8.8.
A comment in the cabal file claims we cannot use shelly-1.9 because of two
open issues. However, these issues only concern windows; but for windows we
use an even stricter bound in a separate build-depend stanza, where we
require < 1.7.2. I have moved the comment to this other stanza. The upshot
is that building against ghc versions >= 8.8 is currently not supported on
windows.
patch bc5ff9f3c122b590a26226091ab8717a6ba06abc
Author: Ben Franksen <ben.franksen@online.de>
Date: Mon Apr 27 14:52:16 CEST 2020
* resolve conflicts after 5d63e665634c964d7b23dcf9c28efc72d6a6f947
patch 2dbe7ff7042a2d909640f468c2d1dd39a00ca38b
Author: Ben Franksen <ben.franksen@online.de>
Date: Sun Apr 26 20:32:02 CEST 2020
* darcs.cabal: clean up extra-source-files
Also added C source files in addition to header files.
patch 9c2e42144da778426b09f6c3b8ec03d285a106b7
Author: Ben Franksen <ben.franksen@online.de>
Date: Mon Apr 27 15:15:40 CEST 2020
* resolve conflicts after 2dbe7ff7042a2d909640f468c2d1dd39a00ca38b
patch 353a1cfd0a42393b568c32f328b8a7d626a327f0
Author: Ben Franksen <ben.franksen@online.de>
Date: Mon Apr 27 15:16:27 CEST 2020
* fix license in darcs.cabal
patch 447f754fd0613f221cdf6174e67a2e020d71bdb6
Author: Ben Franksen <ben.franksen@online.de>
Date: Tue Apr 21 08:45:05 CEST 2020
* for base >=4.13 define fail in MonadFail instances
patch 8322b50f998b2f2244937d629ad66becf0f4df1e
Author: Ben Franksen <ben.franksen@online.de>
Date: Tue Apr 21 15:00:04 CEST 2020
* add some elementary build instructions to the README.md
patch cacc6c44c3e8ae94e3aa3456e3f0ded9d00371f5
Author: Ben Franksen <ben.franksen@online.de>
Date: Tue Apr 21 12:47:18 CEST 2020
* adapt release/release.sh for use with modern cabal
patch 82fe27cc6295a2e55936b3b1ff10fcb4966e1e5e
Author: Ben Franksen <ben.franksen@online.de>
Date: Fri Apr 24 10:45:44 CEST 2020
* mitigate issue2643 with a better error message
If the patch index is corrupt, output the name of the currupt file and
suggest its removal.
patch 838279091622f16b331cef25c0b96aac01ad71d4
Author: Ben Franksen <ben.franksen@online.de>
Date: Mon Apr 27 15:32:18 CEST 2020
* resolve conflicts after 447f754fd0613f221cdf6174e67a2e020d71bdb6
patch cf2e7bcff2195e03410305ffc25f2282e35f32a4
Author: Ben Franksen <ben.franksen@online.de>
Date: Mon Apr 27 15:34:05 CEST 2020
* resolve conflicts after 82fe27cc6295a2e55936b3b1ff10fcb4966e1e5e
patch 347aeb4b5c1eccfe00956ac318a2123bca9ef9ca
Author: Ben Franksen <ben.franksen@online.de>
Date: Sun Apr 26 20:26:07 CEST 2020
* clean up Darcs.Test.Patch.Check
There was a comment in the code about the strangeness of how in this test
module returning a Boolean was used to communicate a failure, and how this
should be replaced with a more conventional way of error handling. This is
now done, using the MaybeT monad transformer.
patch f85f4c41eeb116483655b6cd6c337845e63226ce
Author: Ben Franksen <ben.franksen@online.de>
Date: Mon Apr 27 15:54:37 CEST 2020
* resolve conflicts after 347aeb4b5c1eccfe00956ac318a2123bca9ef9ca
patch 64b5842ba3e32290d9eb479c8281eff4cfcea443
Author: Ben Franksen <ben.franksen@online.de>
Date: Fri Apr 24 15:27:26 CEST 2020
* add changelog entry for release 2.14.3
patch 31c1837213befdef6b8ff513ad20ea7aaebbca1b
Author: Ben Franksen <ben.franksen@online.de>
Date: Mon Apr 27 16:03:42 CEST 2020
* darcs.cabal: remove redundant version constraints
patch 3c481cfde19965f004913f1798a3036b4437bf59
Author: Ben Franksen <ben.franksen@online.de>
Date: Mon Apr 27 16:22:29 CEST 2020
* remove a redundant import from Setup.hs
patch 5f6825daaa5a145f827c83d0e1db826c45ee09e3
Author: Ben Franksen <ben.franksen@online.de>
Date: Sun Apr 26 21:04:14 CEST 2020
* no longer export fromJust from Darcs.Prelude [amended from branch-2.14]
While used in many places, fromJust is a partial function and we should not
encourage its unfettered use in Darcs.
patch 80223edc7108090f9c3231e36d4bdb94e1f52f6a
Author: Ben Franksen <ben.franksen@online.de>
Date: Sun Apr 26 20:40:58 CEST 2020
* remove redundant imports
This mostly concerns (<>) imported from Darcs.Util.Printer and (<$>) from
Control.Applicative. These are now consistently exported from Darcs.Prelude.
patch 68d2ba7bfe8b65168b2be95017ab5209521eccbd
Author: Ben Franksen <ben.franksen@online.de>
Date: Mon Apr 27 21:03:00 CEST 2020
* import shelly-1.7.1 as a new subdirectory
patch 241fee554ecef415e3c16e1147cf5c8d47b0af6b
Author: Ben Franksen <ben.franksen@online.de>
Date: Mon Apr 27 22:01:25 CEST 2020
* make shelly build w/o warning for all supported compilers
patch e24a22c1c41b52bb0f1436abaf24704ea7bdc985
Author: Ben Franksen <ben.franksen@online.de>
Date: Mon Apr 27 22:02:30 CEST 2020
* remove the special shelly upper bound for windows
This is no longer necessary as cabal will now always use our (fixed) copy of
shelly-1.7.1, at least when built from a clone. The cabal source distribution
won't be able to run the shell tests.
This is stop-gap-measure. We should eventually get rid of shelly.
patch ef62aa290cb72fdc8b06a11307cdebaad2a8f321
Author: Ben Franksen <ben.franksen@online.de>
Date: Tue Apr 28 08:03:17 CEST 2020
* resolve conflicts after 80223edc7108090f9c3231e36d4bdb94e1f52f6a
patch 466f1ac0b9623d0fa8c3ddf19f338af504d0b89c
Author: Ben Franksen <ben.franksen@online.de>
Date: Tue Apr 28 08:25:30 CEST 2020
* unwind tests: use condition compilation for MonadFail instances and imports
patch 670806d16f3fd429b009d826c01c7199c1e3c745
Author: Ben Franksen <ben.franksen@online.de>
Date: Tue Apr 28 08:28:22 CEST 2020
* avoid use of fail in Darcs.Patch.Depends.unwrapOneTagged
We specialize to monad Maybe and directly use Nothing.
patch ac8509387d1f8b87d3c8aeb758bd492b1a5ebfda
Author: Ben Franksen <ben.franksen@online.de>
Date: Tue Apr 28 08:30:00 CEST 2020
* more consequently throw MatchFailure exception
This avoids two uses of fail in Darcs.Patch.Match in the context of a monad
tranformer that is not necessarily IO based.
patch 5e2b79a3fc963ca1b8cfcd72b5ccf2f0d39d6837
Author: Ben Franksen <ben.franksen@online.de>
Date: Tue Apr 28 08:32:54 CEST 2020
* Darcs.Util.Prompt: add liftIO when calling fail
patch 4ff9cb1b4352e2a447cead067ea5cc1a34929c9c
Author: Ben Franksen <ben.franksen@online.de>
Date: Tue Apr 28 08:38:38 CEST 2020
* replace fail with error in Darcs.Repository.Diff
This is the /only/ case where the "quick fix" of replacing fail with error
is semantically valid. Here we clearly have a partial pattern match and it
would be a bug if we hit that case.
patch d2c7b97789f538ac80a9547ed86db06ad57aa209
Author: Ben Franksen <ben.franksen@online.de>
Date: Tue Apr 28 08:41:27 CEST 2020
* replace fail with throw.userError when applying a patch
There are several uses of apply (and its variants) where we catch
IOExceptions e.g. maybeApplyToTree. This makes sense: if we apply in the
context of IO (or a transformer over IO), then there may occur any kind of
IOException, not only the ones explicitly raised from our code, and we want
to catch them all.
patch faaceaffbf4c60a73c0c5643ea107ad8a2f8c753
Author: Ben Franksen <ben.franksen@online.de>
Date: Tue Apr 28 08:49:16 CEST 2020
* replace fail with throw.userError in Tree monads and index matching
The situation here is different from that of patch application. Here we want
the exception to percolate all the way up to the top level handler. In other
words, these are regular failures similar to IO exceptions.
patch 9e9c1c5e2c6b23632605a5885d958b3cd3e20bb1
Author: Ben Franksen <ben.franksen@online.de>
Date: Tue Apr 28 08:54:21 CEST 2020
* replace runhaskell with runghc in tests/renames.sh
It seems runghc is better supported by ghc packagers than runhaskell. This
is not a complete solution, though. If cabal is used with
--with-compiler=/path/to/ghc, there is no guarantee that we have a runghc or
a runhaskell in the PATH.
patch 5e216ccf2ae019a95d16a9830185ced1720c9de8
Author: Ben Franksen <ben.franksen@online.de>
Date: Tue Apr 28 09:43:25 CEST 2020
* darcs.cabal: remove containers from setup-depends
patch c7fb6002aa234d1462bbf70c32334497f17e0fa7
Author: Ben Franksen <ben.franksen@online.de>
Date: Tue Apr 28 11:00:37 CEST 2020
* raise upper bounds for base and Cabal dependencies
This allows to build with ghc-8.8 and ghc-8.10.
----------
files: loosen-upper-bound-for-haskeline-to-_0_9.dpatch, patch-preview.txt, unnamed
messages: 22006
nosy: bf
status: needs-screening
title: support ghc-8.8 and ghc-8.10
__________________________________
Darcs bug tracker <bugs@darcs.net>
<http://bugs.darcs.net/patch2017>
__________________________________
["patch-preview.txt" (text/x-darcs-patch)]
[loosen upper bound for haskeline to <0.9
Ben Franksen <ben.franksen@online.de>**20200421081258
Ignore-this: 1066d8d51e996bf5bf5b1c087eda687d8807942f3529e5979e46f8685f4ecbdac94df75030b032cd
This is required to find a valid build plan for ghc >= 8.8.
] hunk ./darcs.cabal 418
- - haskeline >= 0.7.2 && < 0.8,
+ haskeline >= 0.7.2 && < 0.9,
[loosen upper bound for shelly to <1.10
Ben Franksen <ben.franksen@online.de>**20200421081429
Ignore-this: f2a47bfd51083a65d445bf8c0e6d85a497d3462270d55ff1d6c4c54ce31d4cb72e281bddf733739e
This is required to find a build plan with ghc >= 8.8.
A comment in the cabal file claims we cannot use shelly-1.9 because of two
open issues. However, these issues only concern windows; but for windows we
use an even stricter bound in a separate build-depend stanza, where we
require < 1.7.2. I have moved the comment to this other stanza. The upshot
is that building against ghc versions >= 8.8 is currently not supported on
windows.
] conflictor [
hunk ./darcs.cabal 568
- - split >= 0.2.2 && < 0.3,
]
>
hunk ./darcs.cabal 562
- - -- note we can't allow 1.9 or above until
- - -- https://github.com/gregwebs/Shelly.hs/issues/176
- - -- and possibly
- - -- https://github.com/gregwebs/Shelly.hs/issues/177
- - -- are dealt with
- - shelly >= 1.6.8 && < 1.9,
+ shelly >= 1.6.8 && < 1.10,
conflictor [
hunk ./darcs.cabal 582
+ -- the tests shell out to a built darcs binary, so we depend on it to make
+ -- sure that it's built. It's not actually required for build, just at runtime,
+ -- but there isn't a way to express the latter and it seems harmless.
+ build-tool-depends: darcs:darcs
+
]
>
hunk ./darcs.cabal 582
- - -- https://github.com/yesodweb/Shelly.hs/issues/177
+ -- note for windows we can't allow 1.9 or above until
+ -- https://github.com/gregwebs/Shelly.hs/issues/176
+ -- and possibly
+ -- https://github.com/gregwebs/Shelly.hs/issues/177
+ -- are dealt with
[resolve conflicts after 5d63e665634c964d7b23dcf9c28efc72d6a6f947
Ben Franksen <ben.franksen@online.de>**20200427125216
Ignore-this: 47121a51606f226d64d22f3a2cde9a1661672e91d4eb7c1e0e0e292c76a9883ea42377a4ea1ef2a4
] hunk ./darcs.cabal 562
- - -- note we can't allow 1.9 or above until
- - -- https://github.com/gregwebs/Shelly.hs/issues/176
- - -- and possibly
- - -- https://github.com/gregwebs/Shelly.hs/issues/177
- - -- are dealt with
- - shelly >= 1.6.8 && < 1.9,
+ shelly >= 1.6.8 && < 1.10,
hunk ./darcs.cabal 577
- - -- https://github.com/yesodweb/Shelly.hs/issues/177
+ -- the tests shell out to a built darcs binary, so we depend on it to make
+ -- sure that it's built. It's not actually required for build, just at runtime,
+ -- but there isn't a way to express the latter and it seems harmless.
+ build-tool-depends: darcs:darcs
+
+ -- note for windows we can't allow 1.9 or above until
+ -- https://github.com/gregwebs/Shelly.hs/issues/176
+ -- and possibly
+ -- https://github.com/gregwebs/Shelly.hs/issues/177
+ -- are dealt with
[darcs.cabal: clean up extra-source-files
Ben Franksen <ben.franksen@online.de>**20200426183202
Ignore-this: dad300e139c8d13667a7dd304df4c54800ce821177d646399a1371e8503ae4420430cc4e4407e1bc
Also added C source files in addition to header files.
] hunk ./darcs.cabal 38
- - -- C headers
+ -- C files
+ src/*.c
conflictor [
hunk ./darcs.cabal 41
- - src/win32/send_email.h src/win32/sys/mman.h
+ src/win32/send_email.h
]
>
hunk ./darcs.cabal 41
- - src/win32/send_email.h src/win32/sys/mman.h
+ src/win32/send_email.c
+ src/win32/send_email.h
+ src/win32/sys/mman.h
conflictor [
hunk ./darcs.cabal 44
- - contrib/_darcs.zsh, contrib/darcs_completion,
- - contrib/cygwin-wrapper.bash, contrib/update_roundup.pl, contrib/upload.cgi,
- - contrib/darcs-errors.hlint,
- - contrib/runHLint.sh,
- -
- - README.md, CHANGELOG
+ contrib/_darcs.zsh
+ contrib/darcs_completion
+ contrib/cygwin-wrapper.bash
+ contrib/update_roundup.pl
+ contrib/upload.cgi
+ contrib/darcs-errors.hlint
+ contrib/runHLint.sh
+
+ README.md
+ CHANGELOG
]
>
hunk ./darcs.cabal 43
- - -- The contrib directory would make a sensible 'darcs-contrib' package
- - contrib/_darcs.zsh, contrib/darcs_completion,
- - contrib/cygwin-wrapper.bash, contrib/update_roundup.pl, contrib/upload.cgi,
- - contrib/darcs-errors.hlint,
- - contrib/runHLint.sh,
+ contrib/cygwin-wrapper.bash
+ contrib/darcs_completion
+ contrib/darcs-errors.hlint
+ contrib/_darcs.zsh
+ contrib/runHLint.sh
+ contrib/update_roundup.pl
+ contrib/upload.cgi
conflictor {{
>
hunk ./darcs.cabal 44
- - contrib/_darcs.zsh, contrib/darcs_completion,
- - contrib/cygwin-wrapper.bash, contrib/update_roundup.pl, contrib/upload.cgi,
- - contrib/darcs-errors.hlint,
- - contrib/runHLint.sh,
- -
- - README.md, CHANGELOG
+ contrib/_darcs.zsh
+ contrib/darcs_completion
+ contrib/cygwin-wrapper.bash
+ contrib/update_roundup.pl
+ contrib/upload.cgi
+ contrib/darcs-errors.hlint
+ contrib/runHLint.sh
+
+ README.md
+ CHANGELOG
>
hunk ./darcs.cabal 43
- - -- The contrib directory would make a sensible 'darcs-contrib' package
- - contrib/_darcs.zsh, contrib/darcs_completion,
- - contrib/cygwin-wrapper.bash, contrib/update_roundup.pl, contrib/upload.cgi,
- - contrib/darcs-errors.hlint,
- - contrib/runHLint.sh,
+ contrib/cygwin-wrapper.bash
+ contrib/darcs_completion
+ contrib/darcs-errors.hlint
+ contrib/_darcs.zsh
+ contrib/runHLint.sh
+ contrib/update_roundup.pl
+ contrib/upload.cgi
}} []
>
hunk ./darcs.cabal 49
- - README.md, CHANGELOG
+ README.md
+ CHANGELOG
conflictor [
hunk ./darcs.cabal 51
- - -- release data
- - release/distributed-version, release/distributed-context
- -
]
>
hunk ./darcs.cabal 52
- - release/distributed-version, release/distributed-context
+ release/distributed-version
+ release/distributed-context
hunk ./darcs.cabal 55
- - tests/data/*.tgz tests/data/README
+ tests/data/*.tgz
+ tests/data/README
hunk ./darcs.cabal 59
- - tests/data/convert/darcs1/*.dpatch tests/data/convert/darcs2/*.dpatch
+ tests/data/convert/darcs1/*.dpatch
+ tests/data/convert/darcs2/*.dpatch
[resolve conflicts after 2dbe7ff7042a2d909640f468c2d1dd39a00ca38b
Ben Franksen <ben.franksen@online.de>**20200427131540
Ignore-this: 594a85bb727bb1846df2027fc79527c77cf3fb98cedd87995784a2cc7b4ea64424075231f5e34a0c
] hunk ./darcs.cabal 39
- - src/*.c
hunk ./darcs.cabal 40
- - src/win32/send_email.h src/win32/sys/mman.h
+ src/win32/send_email.h
hunk ./darcs.cabal 42
- - -- The contrib directory would make a sensible 'darcs-contrib' package
- - contrib/_darcs.zsh, contrib/darcs_completion,
- - contrib/cygwin-wrapper.bash, contrib/update_roundup.pl, contrib/upload.cgi,
- - contrib/darcs-errors.hlint,
- - contrib/runHLint.sh,
+ contrib/cygwin-wrapper.bash
+ contrib/darcs_completion
+ contrib/darcs-errors.hlint
+ contrib/_darcs.zsh
+ contrib/runHLint.sh
+ contrib/update_roundup.pl
+ contrib/upload.cgi
hunk ./darcs.cabal 50
- - README.md, CHANGELOG
- -
- - -- release data
- - release/distributed-version, release/distributed-context
+ README.md
+ CHANGELOG
[fix license in darcs.cabal
Ben Franksen <ben.franksen@online.de>**20200427131627
Ignore-this: 8a47e30b0f654a5615842001a2a512d80d9ad9c48181a1e5be5823af6ec4c0903e703a2e7603f66b
] hunk ./darcs.cabal 4
- -License: GPL-2.0-only
+License: GPL-2.0-or-later
[for base >=4.13 define fail in MonadFail instances
Ben Franksen <ben.franksen@online.de>**20200421064505
Ignore-this: 699f039590bb43d8b2482a2a2bd13ec32b12e03aaaae589ad2f5f25096d051092ad8856aedeac3bc
] conflictor [
hunk ./src/Darcs/Patch/PatchInfoAnd.hs 18
- -module Darcs.Patch.PatchInfoAnd ( Hopefully(..), SimpleHopefully(..), \
PatchInfoAnd(..),
- - WPatchInfo, unWPatchInfo, compareWPatchInfo,
- - piap, n2pia, patchInfoAndPatch,
- - fmapFLPIAP, generaliseRepoTypePIAP,
- - conscientiously, hopefully, info, winfo,
- - hopefullyM, createHashed, extractHash,
- - actually, unavailable, patchDesc ) where
+module Darcs.Patch.PatchInfoAnd
+ ( Hopefully(..)
+ , SimpleHopefully(..)
+ , PatchInfoAnd(..)
+ , WPatchInfo
+ , unWPatchInfo
+ , compareWPatchInfo
+ , piap
+ , n2pia
+ , patchInfoAndPatch
+ , fmapFLPIAP
+ , conscientiously
+ , hopefully
+ , info
+ , winfo
+ , hopefullyM
+ , createHashed
+ , extractHash
+ , actually
+ , unavailable
+ , patchDesc
+ ) where
hunk ./src/Darcs/Patch/PatchInfoAnd.hs 17
- -
hunk ./src/Darcs/Patch/PatchInfoAnd.hs 20
- - , PatchInfoAnd(..)
+ , PatchInfoAnd
+ , PatchInfoAndG
hunk ./src/Darcs/Patch/PatchInfoAnd.hs 21
- - , PatchInfoAndG
+ , PatchInfoAndG(..)
hunk ./src/Darcs/Patch/PatchInfoAnd.hs 28
+ , fmapPIAP
hunk ./src/Darcs/Patch/PatchInfoAnd.hs 40
+ , patchcontentsRL
hunk ./src/Darcs/Patch/PatchInfoAnd.hs 18
- - ( Hopefully(..)
- - , SimpleHopefully(..)
+ ( Hopefully
hunk ./src/Darcs/Patch/PatchInfoAnd.hs 20
- - , PatchInfoAndG(..)
+ , PatchInfoAndG
hunk ./src/Darcs/Patch/PatchInfoAnd.hs 39
- - , patchcontentsRL
]
>
hunk ./src/Darcs/Patch/PatchInfoAnd.hs 18
+{-# LANGUAGE CPP #-}
conflictor [
hunk ./src/Darcs/Patch/PatchInfoAnd.hs 175
- -hopefullyM :: Monad m => PatchInfoAnd rt p wA wB -> m (Named rt p wA wB)
+hopefullyM :: Monad m => PatchInfoAnd rt p wA wB -> m (Named p wA wB)
hunk ./src/Darcs/Patch/PatchInfoAnd.hs 175
- -hopefullyM :: Monad m => PatchInfoAnd rt p wA wB -> m (Named p wA wB)
+hopefullyM :: Monad m => PatchInfoAndG rt p wA wB -> m (p wA wB)
]
>
hunk ./src/Darcs/Patch/PatchInfoAnd.hs 175
- -hopefullyM :: Monad m => PatchInfoAnd rt p wA wB -> m (Named rt p wA wB)
+hopefullyM ::
+#if MIN_VERSION_base(4,13,0)
+ MonadFail m
+#else
+ Monad m
+#endif
+ => PatchInfoAnd rt p wA wB -> m (Named rt p wA wB)
hunk ./src/Darcs/Patch/Prim/V1/Commute.hs 1
+{-# LANGUAGE CPP #-}
hunk ./src/Darcs/Patch/Prim/V1/Commute.hs 79
+#if MIN_VERSION_base(4,13,0)
+instance MonadFail Perhaps where
+#endif
conflictor [
hunk ./src/Darcs/Patch/ReadMonads.hs 1
- --- | This module defines our parsing monad. In the past there have been lazy
- --- and strict parsers in this module. Currently we have only the strict
- --- variant and it is used for parsing patch files.
- -module Darcs.Patch.ReadMonads (ParserM, Darcs.Patch.ReadMonads.take,
- - parse, parseStrictly, char, int,
- - option, choice, skipSpace, skipWhile, string,
- - lexChar, lexString, lexEof, takeTillChar,
- - myLex', anyChar, endOfInput, takeTill,
- - checkConsumes,
- - linesStartingWith, linesStartingWithEndingWith) where
- -
- -import Prelude ()
- -import Darcs.Prelude
- -
- -import Darcs.Util.ByteString ( dropSpace, breakSpace, breakFirstPS,
- - readIntPS, breakLastPS )
- -import qualified Data.ByteString as B (null, drop, length, tail, empty,
- - ByteString)
- -import qualified Data.ByteString.Char8 as BC ( uncons, dropWhile, break
- - , splitAt, length, head )
- -import Control.Applicative ( Alternative(..) )
- -import Data.Foldable ( asum )
- -import Control.Monad ( MonadPlus(..) )
- -
- --- | 'lexChar' checks if the next space delimited token from
- --- the input stream matches a specific 'Char'.
- --- Uses 'Maybe' inside 'ParserM' to handle failed matches, so
- --- that it always returns () on success.
- -lexChar :: ParserM m => Char -> m ()
- -lexChar c = do
- - skipSpace
- - char c
- - return ()
- -
- --- | 'lexString' fetches the next whitespace delimited token from
- --- from the input and checks if it matches the 'ByteString' input.
- --- Uses 'Maybe' inside 'ParserM' to handle failed matches, so
- --- that it always returns () on success.
- -lexString :: ParserM m => B.ByteString -> m ()
- -lexString str = work
- - $ \s -> case myLex s of
- - Just (xs :*: ys) | xs == str -> Just (() :*: ys)
- - _ -> Nothing
- -
- --- | Only succeeds if the characters in the input exactly match @str@.
- -string :: ParserM m => B.ByteString -> m ()
- -string str = work
- - $ \s -> case BC.splitAt (BC.length str) s of
- - (h, t) | h == str -> Just (() :*: t)
- - _ -> Nothing
- -
- --- | 'lexEof' looks for optional spaces followed by the end of input.
- --- Uses 'Maybe' inside 'ParserM' to handle failed matches, so
- --- that it always returns () on success.
- -lexEof :: ParserM m => m ()
- -lexEof = work
- - $ \s -> if B.null (dropSpace s)
- - then Just (() :*: B.empty)
- - else Nothing
- -
- --- | 'myLex' drops leading spaces and then breaks the string at the
- --- next space. Returns 'Nothing' when the string is empty after
- --- dropping leading spaces, otherwise it returns the first sequence
- --- of non-spaces and the remainder of the input.
- -myLex :: B.ByteString -> Maybe (ParserState B.ByteString)
- -myLex s = let s' = dropSpace s
- - in if B.null s'
- - then Nothing
- - else Just $ stuple $ breakSpace s'
- -
- --- | Like 'myLex' except that it is in ParserM
- -myLex' :: ParserM m => m B.ByteString
- -myLex' = work myLex
- -
- --- | Accepts the next character and returns it. Only fails at end of
- --- input.
- -anyChar :: ParserM m => m Char
- -anyChar = work $ \s -> stuple <$> BC.uncons s
- -
- --- | Only succeeds at end of input, consumes no characters.
- -endOfInput :: ParserM m => m ()
- -endOfInput = work $ \s -> if B.null s
- - then Just (() :*: s)
- - else Nothing
- -
- --- | Accepts only the specified character. Consumes a character, if
- --- available.
- -char :: ParserM m => Char -> m ()
- -char c = work $ \s ->
- - case BC.uncons s of
- - Just (c', s') | c == c' -> Just (() :*: s')
- - _ -> Nothing
- -
- --- | Parse an integer and return it. Skips leading whitespaces and
- --- | uses the efficient ByteString readInt.
- -int :: ParserM m => m Int
- -int = work $ \s -> stuple <$> readIntPS s
- -
- --- | Discards spaces until a non-space character is encountered.
- --- Always succeeds.
- -skipSpace :: ParserM m => m ()
- -skipSpace = alterInput dropSpace
- -
- --- | Discards any characters as long as @p@ returns True. Always
- --- | succeeds.
- -skipWhile :: ParserM m => (Char -> Bool) -> m ()
- -skipWhile p = alterInput (BC.dropWhile p)
- -
- --- | Takes characters while @p@ returns True. Always succeeds.
- -takeTill :: ParserM m => (Char -> Bool) -> m B.ByteString
- -takeTill p = work $ \s -> Just $ stuple (BC.break p s)
- -
- --- | Equivalent to @takeTill (==c)@, except that it is optimized for
- --- | the equality case.
- -takeTillChar :: ParserM m => Char -> m B.ByteString
- -takeTillChar c = work $ \s -> Just $ stuple (BC.break (==c) s)
- -
- --- | Takes exactly @n@ bytes, or fails.
- -take :: ParserM m => Int -> m B.ByteString
- -take n = work $ \s -> if B.length s >= n
- - then Just $ stuple $ BC.splitAt n s
- - else Nothing
- -
- --- | This is a highly optimized way to read lines that start with a
- --- particular character. To implement this efficiently we need access
- --- to the parser's internal state. If this is implemented in terms of
- --- the other primitives for the parser it requires us to consume one
- --- character at a time. That leads to @(>>=)@ wasting significant
- --- time.
- -linesStartingWith :: ParserM m => Char -> m [B.ByteString]
- -linesStartingWith c = work $ linesStartingWith' c
- -
- --- | Helper function for 'linesStartingWith'.
- -linesStartingWith' :: Char -> B.ByteString -> Maybe (ParserState [B.ByteString])
- -linesStartingWith' c thes - - Just (lsw [] thes)
- - where lsw acc s | B.null s || BC.head s /= c = reverse acc :*: s
- - lsw acc s = let s' = B.tail s
- - in case breakFirstPS '\n' s' of
- - Just (l, r) -> lsw (l:acc) r
- - Nothing -> reverse (s':acc) :*: B.empty
- -
- --- | This is a highly optimized way to read lines that start with a
- --- particular character, and stops when it reaches a particular |
- --- character. See 'linesStartingWith' for details on why this |
- --- defined here as a primitive.
- -linesStartingWithEndingWith :: ParserM m => Char -> Char -> m [B.ByteString]
- -linesStartingWithEndingWith st en = work $ linesStartingWithEndingWith' st en
- -
- --- | Helper function for 'linesStartingWithEndingWith'.
- -linesStartingWithEndingWith' :: Char -> Char -> B.ByteString
- - -> Maybe (ParserState [B.ByteString])
- -linesStartingWithEndingWith' st en = lswew
- - where
- - lswew x
- - | B.null x = Nothing
- - | BC.head x == en = Just $ [] :*: B.tail x
- - | BC.head x /= st = Nothing
- - | otherwise = case BC.break ('\n' ==) $ B.tail x of
- - (l,r) -> case lswew $ B.tail r of
- - Just (ls :*: r') -> Just ((l:ls) :*: r')
- - Nothing ->
- - case breakLastPS en l of
- - Just (l2,_) ->
- - Just ([l2] :*: B.drop (B.length l2+2) x)
- - Nothing -> Nothing
- -
- -
- --- | Applies a function to the input stream and discards the
- --- result of the function.
- -alterInput :: ParserM m
- - => (B.ByteString -> B.ByteString) -> m ()
- -alterInput f = work (\s -> Just (() :*: f s))
- -
- --- | If @p@ fails it returns @x@, otherwise it returns the result of @p@.
- -{-# INLINE option #-}
- -option :: Alternative f => a -> f a -> f a
- -option x p = p <|> pure x
- -
- --- | Attempts each option until one succeeds.
- -{-# INLINE choice #-}
- -choice :: Alternative f => [f a] -> f a
- -choice = asum
- -
- --- |Ensure that a parser consumes input when producing a result
- --- Causes the initial state of the input stream to be held on to while the
- --- parser runs, so use with caution.
- -{-# INLINE checkConsumes #-}
- -checkConsumes :: ParserM m => m a -> m a
- -checkConsumes parser = do
- - x <- B.length <$> peekInput
- - res <- parser
- - x' <- B.length <$> peekInput
- - if x' < x then return res else mzero
- -
- -class (Functor m, Applicative m, Alternative m, Monad m, MonadPlus m) => ParserM m \
where
- - -- | Applies a parsing function inside the 'ParserM' monad.
- - work :: (B.ByteString -> Maybe (ParserState a)) -> m a
- - -- | Allows for the inspection of the input that is yet to be parsed.
- - peekInput :: m B.ByteString
- - -- | Run the parser
- - parse :: m a -> B.ByteString -> Maybe (a, B.ByteString)
- -
- ------ Strict Monad -----
- --- | 'parseStrictly' applies the parser functions to a string
- --- and checks that each parser produced a result as it goes.
- --- The strictness is in the 'ParserM' instance for 'SM'.
- -parseStrictly :: SM a -> B.ByteString -> Maybe (a, B.ByteString)
- -parseStrictly (SM f) s = case f s of
- - Just (a :*: r) -> Just (a, r)
- - _ -> Nothing
- -
- --- | ParserState represents the internal state of the parser. We make it
- --- strict and specialize it on ByteString. This is purely to help GHC
- --- optimize. If performance were not a concern, it could be replaced
- --- with @(a, ByteString)@.
- -data ParserState a = !a :*: !B.ByteString
- -
- --- | Convert from a lazy tuple to a strict tuple.
- -stuple :: (a, B.ByteString) -> ParserState a
- -stuple (a, b) = a :*: b
- -
- --- | 'SM' is the Strict Monad for parsing.
- -newtype SM a = SM (B.ByteString -> Maybe (ParserState a))
- -
- -bindSM :: SM a -> (a -> SM b) -> SM b
- -bindSM (SM m) k = SM $ \s -> case m s of
- - Nothing -> Nothing
- - Just (x :*: s') ->
- - case k x of
- - SM y -> y s'
- -{-# INLINE bindSM #-}
- -returnSM :: a -> SM a
- -returnSM x = SM (\s -> Just (x :*: s))
- -{-# INLINE returnSM #-}
- -failSM :: String -> SM a
- -failSM _ = SM (\_ -> Nothing)
- -{-# INLINE failSM #-}
- -
- -instance Monad SM where
- - {-# INLINE (>>=) #-}
- - (>>=) = bindSM
- - {-# INLINE return #-}
- - return = returnSM
- - {-# INLINE fail #-}
- - fail = failSM
- -
- -instance ParserM SM where
- - work = SM
- - peekInput = SM $ \s -> Just (s :*: s)
- - parse = parseStrictly
- -
- --- The following instances allow us to use more conventional
- --- interfaces provided by other parser libraries. The instances are
- --- defined using bindSM, returnSM, and failSM to avoid any infinite,
- --- or even unneccessary, recursion of instances between between
- --- ParserM and Monad. Other recursive uses will be fine, such as
- --- (<|>) = mplus.
- -instance MonadPlus SM where
- - {-# INLINE mzero #-}
- - mzero = failSM ""
- - -- | Over using mplus can lead to space leaks. It's best to push
- - -- the use of mplus as far down as possible, because until the the
- - -- first parameter completes, we must hold on to the input.
- - {-# INLINE mplus #-}
- - mplus (SM a) (SM b) = SM $ \s ->
- - case a s of
- - Nothing -> b s
- - r -> r
- -
- -instance Functor SM where
- - {-# INLINE fmap #-}
- - fmap f m = m `bindSM` (returnSM . f)
- -
- -instance Applicative SM where
- - {-# INLINE pure #-}
- - pure = returnSM
- - {-# INLINE (<*>) #-}
- - a <*> b - - a `bindSM` \c ->
- - b `bindSM` \d ->
- - returnSM (c d)
- -
- -instance Alternative SM where
- - {-# INLINE empty #-}
- - empty = failSM ""
- - {-# INLINE (<|>) #-}
- - (<|>) = mplus
rmfile ./src/Darcs/Patch/ReadMonads.hs
]
>
hunk ./src/Darcs/Patch/ReadMonads.hs 4
+{-# LANGUAGE CPP #-}
conflictor {{
hunk ./src/Darcs/Patch/ReadMonads.hs 245
+ {-# INLINE fail #-}
hunk ./src/Darcs/Patch/ReadMonads.hs 1
- --- | This module defines our parsing monad. In the past there have been lazy
- --- and strict parsers in this module. Currently we have only the strict
- --- variant and it is used for parsing patch files.
- -module Darcs.Patch.ReadMonads (ParserM, Darcs.Patch.ReadMonads.take,
- - parse, parseStrictly, char, int,
- - option, choice, skipSpace, skipWhile, string,
- - lexChar, lexString, lexEof, takeTillChar,
- - myLex', anyChar, endOfInput, takeTill,
- - checkConsumes,
- - linesStartingWith, linesStartingWithEndingWith) where
- -
- -import Prelude ()
- -import Darcs.Prelude
- -
- -import Darcs.Util.ByteString ( dropSpace, breakSpace, breakFirstPS,
- - readIntPS, breakLastPS )
- -import qualified Data.ByteString as B (null, drop, length, tail, empty,
- - ByteString)
- -import qualified Data.ByteString.Char8 as BC ( uncons, dropWhile, break
- - , splitAt, length, head )
- -import Control.Applicative ( Alternative(..) )
- -import Data.Foldable ( asum )
- -import Control.Monad ( MonadPlus(..) )
- -
- --- | 'lexChar' checks if the next space delimited token from
- --- the input stream matches a specific 'Char'.
- --- Uses 'Maybe' inside 'ParserM' to handle failed matches, so
- --- that it always returns () on success.
- -lexChar :: ParserM m => Char -> m ()
- -lexChar c = do
- - skipSpace
- - char c
- - return ()
- -
- --- | 'lexString' fetches the next whitespace delimited token from
- --- from the input and checks if it matches the 'ByteString' input.
- --- Uses 'Maybe' inside 'ParserM' to handle failed matches, so
- --- that it always returns () on success.
- -lexString :: ParserM m => B.ByteString -> m ()
- -lexString str = work
- - $ \s -> case myLex s of
- - Just (xs :*: ys) | xs == str -> Just (() :*: ys)
- - _ -> Nothing
- -
- --- | Only succeeds if the characters in the input exactly match @str@.
- -string :: ParserM m => B.ByteString -> m ()
- -string str = work
- - $ \s -> case BC.splitAt (BC.length str) s of
- - (h, t) | h == str -> Just (() :*: t)
- - _ -> Nothing
- -
- --- | 'lexEof' looks for optional spaces followed by the end of input.
- --- Uses 'Maybe' inside 'ParserM' to handle failed matches, so
- --- that it always returns () on success.
- -lexEof :: ParserM m => m ()
- -lexEof = work
- - $ \s -> if B.null (dropSpace s)
- - then Just (() :*: B.empty)
- - else Nothing
- -
- --- | 'myLex' drops leading spaces and then breaks the string at the
- --- next space. Returns 'Nothing' when the string is empty after
- --- dropping leading spaces, otherwise it returns the first sequence
- --- of non-spaces and the remainder of the input.
- -myLex :: B.ByteString -> Maybe (ParserState B.ByteString)
- -myLex s = let s' = dropSpace s
- - in if B.null s'
- - then Nothing
- - else Just $ stuple $ breakSpace s'
- -
- --- | Like 'myLex' except that it is in ParserM
- -myLex' :: ParserM m => m B.ByteString
- -myLex' = work myLex
- -
- --- | Accepts the next character and returns it. Only fails at end of
- --- input.
- -anyChar :: ParserM m => m Char
- -anyChar = work $ \s -> stuple <$> BC.uncons s
- -
- --- | Only succeeds at end of input, consumes no characters.
- -endOfInput :: ParserM m => m ()
- -endOfInput = work $ \s -> if B.null s
- - then Just (() :*: s)
- - else Nothing
- -
- --- | Accepts only the specified character. Consumes a character, if
- --- available.
- -char :: ParserM m => Char -> m ()
- -char c = work $ \s ->
- - case BC.uncons s of
- - Just (c', s') | c == c' -> Just (() :*: s')
- - _ -> Nothing
- -
- --- | Parse an integer and return it. Skips leading whitespaces and
- --- | uses the efficient ByteString readInt.
- -int :: ParserM m => m Int
- -int = work $ \s -> stuple <$> readIntPS s
- -
- --- | Discards spaces until a non-space character is encountered.
- --- Always succeeds.
- -skipSpace :: ParserM m => m ()
- -skipSpace = alterInput dropSpace
- -
- --- | Discards any characters as long as @p@ returns True. Always
- --- | succeeds.
- -skipWhile :: ParserM m => (Char -> Bool) -> m ()
- -skipWhile p = alterInput (BC.dropWhile p)
- -
- --- | Takes characters while @p@ returns True. Always succeeds.
- -takeTill :: ParserM m => (Char -> Bool) -> m B.ByteString
- -takeTill p = work $ \s -> Just $ stuple (BC.break p s)
- -
- --- | Equivalent to @takeTill (==c)@, except that it is optimized for
- --- | the equality case.
- -takeTillChar :: ParserM m => Char -> m B.ByteString
- -takeTillChar c = work $ \s -> Just $ stuple (BC.break (==c) s)
- -
- --- | Takes exactly @n@ bytes, or fails.
- -take :: ParserM m => Int -> m B.ByteString
- -take n = work $ \s -> if B.length s >= n
- - then Just $ stuple $ BC.splitAt n s
- - else Nothing
- -
- --- | This is a highly optimized way to read lines that start with a
- --- particular character. To implement this efficiently we need access
- --- to the parser's internal state. If this is implemented in terms of
- --- the other primitives for the parser it requires us to consume one
- --- character at a time. That leads to @(>>=)@ wasting significant
- --- time.
- -linesStartingWith :: ParserM m => Char -> m [B.ByteString]
- -linesStartingWith c = work $ linesStartingWith' c
- -
- --- | Helper function for 'linesStartingWith'.
- -linesStartingWith' :: Char -> B.ByteString -> Maybe (ParserState [B.ByteString])
- -linesStartingWith' c thes - - Just (lsw [] thes)
- - where lsw acc s | B.null s || BC.head s /= c = reverse acc :*: s
- - lsw acc s = let s' = B.tail s
- - in case breakFirstPS '\n' s' of
- - Just (l, r) -> lsw (l:acc) r
- - Nothing -> reverse (s':acc) :*: B.empty
- -
- --- | This is a highly optimized way to read lines that start with a
- --- particular character, and stops when it reaches a particular |
- --- character. See 'linesStartingWith' for details on why this |
- --- defined here as a primitive.
- -linesStartingWithEndingWith :: ParserM m => Char -> Char -> m [B.ByteString]
- -linesStartingWithEndingWith st en = work $ linesStartingWithEndingWith' st en
- -
- --- | Helper function for 'linesStartingWithEndingWith'.
- -linesStartingWithEndingWith' :: Char -> Char -> B.ByteString
- - -> Maybe (ParserState [B.ByteString])
- -linesStartingWithEndingWith' st en = lswew
- - where
- - lswew x
- - | B.null x = Nothing
- - | BC.head x == en = Just $ [] :*: B.tail x
- - | BC.head x /= st = Nothing
- - | otherwise = case BC.break ('\n' ==) $ B.tail x of
- - (l,r) -> case lswew $ B.tail r of
- - Just (ls :*: r') -> Just ((l:ls) :*: r')
- - Nothing ->
- - case breakLastPS en l of
- - Just (l2,_) ->
- - Just ([l2] :*: B.drop (B.length l2+2) x)
- - Nothing -> Nothing
- -
- -
- --- | Applies a function to the input stream and discards the
- --- result of the function.
- -alterInput :: ParserM m
- - => (B.ByteString -> B.ByteString) -> m ()
- -alterInput f = work (\s -> Just (() :*: f s))
- -
- --- | If @p@ fails it returns @x@, otherwise it returns the result of @p@.
- -{-# INLINE option #-}
- -option :: Alternative f => a -> f a -> f a
- -option x p = p <|> pure x
- -
- --- | Attempts each option until one succeeds.
- -{-# INLINE choice #-}
- -choice :: Alternative f => [f a] -> f a
- -choice = asum
- -
- --- |Ensure that a parser consumes input when producing a result
- --- Causes the initial state of the input stream to be held on to while the
- --- parser runs, so use with caution.
- -{-# INLINE checkConsumes #-}
- -checkConsumes :: ParserM m => m a -> m a
- -checkConsumes parser = do
- - x <- B.length <$> peekInput
- - res <- parser
- - x' <- B.length <$> peekInput
- - if x' < x then return res else mzero
- -
- -class (Functor m, Applicative m, Alternative m, Monad m, MonadPlus m) => ParserM m \
where
- - -- | Applies a parsing function inside the 'ParserM' monad.
- - work :: (B.ByteString -> Maybe (ParserState a)) -> m a
- - -- | Allows for the inspection of the input that is yet to be parsed.
- - peekInput :: m B.ByteString
- - -- | Run the parser
- - parse :: m a -> B.ByteString -> Maybe (a, B.ByteString)
- -
- ------ Strict Monad -----
- --- | 'parseStrictly' applies the parser functions to a string
- --- and checks that each parser produced a result as it goes.
- --- The strictness is in the 'ParserM' instance for 'SM'.
- -parseStrictly :: SM a -> B.ByteString -> Maybe (a, B.ByteString)
- -parseStrictly (SM f) s = case f s of
- - Just (a :*: r) -> Just (a, r)
- - _ -> Nothing
- -
- --- | ParserState represents the internal state of the parser. We make it
- --- strict and specialize it on ByteString. This is purely to help GHC
- --- optimize. If performance were not a concern, it could be replaced
- --- with @(a, ByteString)@.
- -data ParserState a = !a :*: !B.ByteString
- -
- --- | Convert from a lazy tuple to a strict tuple.
- -stuple :: (a, B.ByteString) -> ParserState a
- -stuple (a, b) = a :*: b
- -
- --- | 'SM' is the Strict Monad for parsing.
- -newtype SM a = SM (B.ByteString -> Maybe (ParserState a))
- -
- -bindSM :: SM a -> (a -> SM b) -> SM b
- -bindSM (SM m) k = SM $ \s -> case m s of
- - Nothing -> Nothing
- - Just (x :*: s') ->
- - case k x of
- - SM y -> y s'
- -{-# INLINE bindSM #-}
- -returnSM :: a -> SM a
- -returnSM x = SM (\s -> Just (x :*: s))
- -{-# INLINE returnSM #-}
- -failSM :: String -> SM a
- -failSM _ = SM (\_ -> Nothing)
- -{-# INLINE failSM #-}
- -
- -instance Monad SM where
- - {-# INLINE (>>=) #-}
- - (>>=) = bindSM
- - {-# INLINE return #-}
- - return = returnSM
- - {-# INLINE fail #-}
- - fail = failSM
- -
- -instance ParserM SM where
- - work = SM
- - peekInput = SM $ \s -> Just (s :*: s)
- - parse = parseStrictly
- -
- --- The following instances allow us to use more conventional
- --- interfaces provided by other parser libraries. The instances are
- --- defined using bindSM, returnSM, and failSM to avoid any infinite,
- --- or even unneccessary, recursion of instances between between
- --- ParserM and Monad. Other recursive uses will be fine, such as
- --- (<|>) = mplus.
- -instance MonadPlus SM where
- - {-# INLINE mzero #-}
- - mzero = failSM ""
- - -- | Over using mplus can lead to space leaks. It's best to push
- - -- the use of mplus as far down as possible, because until the the
- - -- first parameter completes, we must hold on to the input.
- - {-# INLINE mplus #-}
- - mplus (SM a) (SM b) = SM $ \s ->
- - case a s of
- - Nothing -> b s
- - r -> r
- -
- -instance Functor SM where
- - {-# INLINE fmap #-}
- - fmap f m = m `bindSM` (returnSM . f)
- -
- -instance Applicative SM where
- - {-# INLINE pure #-}
- - pure = returnSM
- - {-# INLINE (<*>) #-}
- - a <*> b - - a `bindSM` \c ->
- - b `bindSM` \d ->
- - returnSM (c d)
- -
- -instance Alternative SM where
- - {-# INLINE empty #-}
- - empty = failSM ""
- - {-# INLINE (<|>) #-}
- - (<|>) = mplus
>
rmfile ./src/Darcs/Patch/ReadMonads.hs
>
hunk ./src/Darcs/Patch/ReadMonads.hs 4
+{-# LANGUAGE CPP #-}
hunk ./src/Darcs/Patch/ReadMonads.hs 245
+ {-# INLINE fail #-}
>
hunk ./src/Darcs/Patch/ReadMonads.hs 1
- --- | This module defines our parsing monad. In the past there have been lazy
- --- and strict parsers in this module. Currently we have only the strict
- --- variant and it is used for parsing patch files.
- -module Darcs.Patch.ReadMonads (ParserM, Darcs.Patch.ReadMonads.take,
- - parse, parseStrictly, char, int,
- - option, choice, skipSpace, skipWhile, string,
- - lexChar, lexString, lexEof, takeTillChar,
- - myLex', anyChar, endOfInput, takeTill,
- - checkConsumes,
- - linesStartingWith, linesStartingWithEndingWith) where
- -
- -import Prelude ()
- -import Darcs.Prelude
- -
- -import Darcs.Util.ByteString ( dropSpace, breakSpace, breakFirstPS,
- - readIntPS, breakLastPS )
- -import qualified Data.ByteString as B (null, drop, length, tail, empty,
- - ByteString)
- -import qualified Data.ByteString.Char8 as BC ( uncons, dropWhile, break
- - , splitAt, length, head )
- -import Control.Applicative ( Alternative(..) )
- -import Data.Foldable ( asum )
- -import Control.Monad ( MonadPlus(..) )
- -
- --- | 'lexChar' checks if the next space delimited token from
- --- the input stream matches a specific 'Char'.
- --- Uses 'Maybe' inside 'ParserM' to handle failed matches, so
- --- that it always returns () on success.
- -lexChar :: ParserM m => Char -> m ()
- -lexChar c = do
- - skipSpace
- - char c
- - return ()
- -
- --- | 'lexString' fetches the next whitespace delimited token from
- --- from the input and checks if it matches the 'ByteString' input.
- --- Uses 'Maybe' inside 'ParserM' to handle failed matches, so
- --- that it always returns () on success.
- -lexString :: ParserM m => B.ByteString -> m ()
- -lexString str = work
- - $ \s -> case myLex s of
- - Just (xs :*: ys) | xs == str -> Just (() :*: ys)
- - _ -> Nothing
- -
- --- | Only succeeds if the characters in the input exactly match @str@.
- -string :: ParserM m => B.ByteString -> m ()
- -string str = work
- - $ \s -> case BC.splitAt (BC.length str) s of
- - (h, t) | h == str -> Just (() :*: t)
- - _ -> Nothing
- -
- --- | 'lexEof' looks for optional spaces followed by the end of input.
- --- Uses 'Maybe' inside 'ParserM' to handle failed matches, so
- --- that it always returns () on success.
- -lexEof :: ParserM m => m ()
- -lexEof = work
- - $ \s -> if B.null (dropSpace s)
- - then Just (() :*: B.empty)
- - else Nothing
- -
- --- | 'myLex' drops leading spaces and then breaks the string at the
- --- next space. Returns 'Nothing' when the string is empty after
- --- dropping leading spaces, otherwise it returns the first sequence
- --- of non-spaces and the remainder of the input.
- -myLex :: B.ByteString -> Maybe (ParserState B.ByteString)
- -myLex s = let s' = dropSpace s
- - in if B.null s'
- - then Nothing
- - else Just $ stuple $ breakSpace s'
- -
- --- | Like 'myLex' except that it is in ParserM
- -myLex' :: ParserM m => m B.ByteString
- -myLex' = work myLex
- -
- --- | Accepts the next character and returns it. Only fails at end of
- --- input.
- -anyChar :: ParserM m => m Char
- -anyChar = work $ \s -> stuple <$> BC.uncons s
- -
- --- | Only succeeds at end of input, consumes no characters.
- -endOfInput :: ParserM m => m ()
- -endOfInput = work $ \s -> if B.null s
- - then Just (() :*: s)
- - else Nothing
- -
- --- | Accepts only the specified character. Consumes a character, if
- --- available.
- -char :: ParserM m => Char -> m ()
- -char c = work $ \s ->
- - case BC.uncons s of
- - Just (c', s') | c == c' -> Just (() :*: s')
- - _ -> Nothing
- -
- --- | Parse an integer and return it. Skips leading whitespaces and
- --- | uses the efficient ByteString readInt.
- -int :: ParserM m => m Int
- -int = work $ \s -> stuple <$> readIntPS s
- -
- --- | Discards spaces until a non-space character is encountered.
- --- Always succeeds.
- -skipSpace :: ParserM m => m ()
- -skipSpace = alterInput dropSpace
- -
- --- | Discards any characters as long as @p@ returns True. Always
- --- | succeeds.
- -skipWhile :: ParserM m => (Char -> Bool) -> m ()
- -skipWhile p = alterInput (BC.dropWhile p)
- -
- --- | Takes characters while @p@ returns True. Always succeeds.
- -takeTill :: ParserM m => (Char -> Bool) -> m B.ByteString
- -takeTill p = work $ \s -> Just $ stuple (BC.break p s)
- -
- --- | Equivalent to @takeTill (==c)@, except that it is optimized for
- --- | the equality case.
- -takeTillChar :: ParserM m => Char -> m B.ByteString
- -takeTillChar c = work $ \s -> Just $ stuple (BC.break (==c) s)
- -
- --- | Takes exactly @n@ bytes, or fails.
- -take :: ParserM m => Int -> m B.ByteString
- -take n = work $ \s -> if B.length s >= n
- - then Just $ stuple $ BC.splitAt n s
- - else Nothing
- -
- --- | This is a highly optimized way to read lines that start with a
- --- particular character. To implement this efficiently we need access
- --- to the parser's internal state. If this is implemented in terms of
- --- the other primitives for the parser it requires us to consume one
- --- character at a time. That leads to @(>>=)@ wasting significant
- --- time.
- -linesStartingWith :: ParserM m => Char -> m [B.ByteString]
- -linesStartingWith c = work $ linesStartingWith' c
- -
- --- | Helper function for 'linesStartingWith'.
- -linesStartingWith' :: Char -> B.ByteString -> Maybe (ParserState [B.ByteString])
- -linesStartingWith' c thes - - Just (lsw [] thes)
- - where lsw acc s | B.null s || BC.head s /= c = reverse acc :*: s
- - lsw acc s = let s' = B.tail s
- - in case breakFirstPS '\n' s' of
- - Just (l, r) -> lsw (l:acc) r
- - Nothing -> reverse (s':acc) :*: B.empty
- -
- --- | This is a highly optimized way to read lines that start with a
- --- particular character, and stops when it reaches a particular |
- --- character. See 'linesStartingWith' for details on why this |
- --- defined here as a primitive.
- -linesStartingWithEndingWith :: ParserM m => Char -> Char -> m [B.ByteString]
- -linesStartingWithEndingWith st en = work $ linesStartingWithEndingWith' st en
- -
- --- | Helper function for 'linesStartingWithEndingWith'.
- -linesStartingWithEndingWith' :: Char -> Char -> B.ByteString
- - -> Maybe (ParserState [B.ByteString])
- -linesStartingWithEndingWith' st en = lswew
- - where
- - lswew x
- - | B.null x = Nothing
- - | BC.head x == en = Just $ [] :*: B.tail x
- - | BC.head x /= st = Nothing
- - | otherwise = case BC.break ('\n' ==) $ B.tail x of
- - (l,r) -> case lswew $ B.tail r of
- - Just (ls :*: r') -> Just ((l:ls) :*: r')
- - Nothing ->
- - case breakLastPS en l of
- - Just (l2,_) ->
- - Just ([l2] :*: B.drop (B.length l2+2) x)
- - Nothing -> Nothing
- -
- -
- --- | Applies a function to the input stream and discards the
- --- result of the function.
- -alterInput :: ParserM m
- - => (B.ByteString -> B.ByteString) -> m ()
- -alterInput f = work (\s -> Just (() :*: f s))
- -
- --- | If @p@ fails it returns @x@, otherwise it returns the result of @p@.
- -{-# INLINE option #-}
- -option :: Alternative f => a -> f a -> f a
- -option x p = p <|> pure x
- -
- --- | Attempts each option until one succeeds.
- -{-# INLINE choice #-}
- -choice :: Alternative f => [f a] -> f a
- -choice = asum
- -
- --- |Ensure that a parser consumes input when producing a result
- --- Causes the initial state of the input stream to be held on to while the
- --- parser runs, so use with caution.
- -{-# INLINE checkConsumes #-}
- -checkConsumes :: ParserM m => m a -> m a
- -checkConsumes parser = do
- - x <- B.length <$> peekInput
- - res <- parser
- - x' <- B.length <$> peekInput
- - if x' < x then return res else mzero
- -
- -class (Functor m, Applicative m, Alternative m, Monad m, MonadPlus m) => ParserM m \
where
- - -- | Applies a parsing function inside the 'ParserM' monad.
- - work :: (B.ByteString -> Maybe (ParserState a)) -> m a
- - -- | Allows for the inspection of the input that is yet to be parsed.
- - peekInput :: m B.ByteString
- - -- | Run the parser
- - parse :: m a -> B.ByteString -> Maybe (a, B.ByteString)
- -
- ------ Strict Monad -----
- --- | 'parseStrictly' applies the parser functions to a string
- --- and checks that each parser produced a result as it goes.
- --- The strictness is in the 'ParserM' instance for 'SM'.
- -parseStrictly :: SM a -> B.ByteString -> Maybe (a, B.ByteString)
- -parseStrictly (SM f) s = case f s of
- - Just (a :*: r) -> Just (a, r)
- - _ -> Nothing
- -
- --- | ParserState represents the internal state of the parser. We make it
- --- strict and specialize it on ByteString. This is purely to help GHC
- --- optimize. If performance were not a concern, it could be replaced
- --- with @(a, ByteString)@.
- -data ParserState a = !a :*: !B.ByteString
- -
- --- | Convert from a lazy tuple to a strict tuple.
- -stuple :: (a, B.ByteString) -> ParserState a
- -stuple (a, b) = a :*: b
- -
- --- | 'SM' is the Strict Monad for parsing.
- -newtype SM a = SM (B.ByteString -> Maybe (ParserState a))
- -
- -bindSM :: SM a -> (a -> SM b) -> SM b
- -bindSM (SM m) k = SM $ \s -> case m s of
- - Nothing -> Nothing
- - Just (x :*: s') ->
- - case k x of
- - SM y -> y s'
- -{-# INLINE bindSM #-}
- -returnSM :: a -> SM a
- -returnSM x = SM (\s -> Just (x :*: s))
- -{-# INLINE returnSM #-}
- -failSM :: String -> SM a
- -failSM _ = SM (\_ -> Nothing)
- -{-# INLINE failSM #-}
- -
- -instance Monad SM where
- - {-# INLINE (>>=) #-}
- - (>>=) = bindSM
- - {-# INLINE return #-}
- - return = returnSM
- - {-# INLINE fail #-}
- - fail = failSM
- -
- -instance ParserM SM where
- - work = SM
- - peekInput = SM $ \s -> Just (s :*: s)
- - parse = parseStrictly
- -
- --- The following instances allow us to use more conventional
- --- interfaces provided by other parser libraries. The instances are
- --- defined using bindSM, returnSM, and failSM to avoid any infinite,
- --- or even unneccessary, recursion of instances between between
- --- ParserM and Monad. Other recursive uses will be fine, such as
- --- (<|>) = mplus.
- -instance MonadPlus SM where
- - {-# INLINE mzero #-}
- - mzero = failSM ""
- - -- | Over using mplus can lead to space leaks. It's best to push
- - -- the use of mplus as far down as possible, because until the the
- - -- first parameter completes, we must hold on to the input.
- - {-# INLINE mplus #-}
- - mplus (SM a) (SM b) = SM $ \s ->
- - case a s of
- - Nothing -> b s
- - r -> r
- -
- -instance Functor SM where
- - {-# INLINE fmap #-}
- - fmap f m = m `bindSM` (returnSM . f)
- -
- -instance Applicative SM where
- - {-# INLINE pure #-}
- - pure = returnSM
- - {-# INLINE (<*>) #-}
- - a <*> b - - a `bindSM` \c ->
- - b `bindSM` \d ->
- - returnSM (c d)
- -
- -instance Alternative SM where
- - {-# INLINE empty #-}
- - empty = failSM ""
- - {-# INLINE (<|>) #-}
- - (<|>) = mplus
}} [
hunk ./src/Darcs/Patch/ReadMonads.hs 245
+ {-# INLINE fail #-}
]
>
hunk ./src/Darcs/Patch/ReadMonads.hs 245
+#if MIN_VERSION_base(4,13,0)
+instance MonadFail SM where
+#endif
hunk ./src/Darcs/Patch/V1/Commute.hs 18
+{-# LANGUAGE CPP #-}
hunk ./src/Darcs/Patch/V1/Commute.hs 106
+#if MIN_VERSION_base(4,13,0)
+instance MonadFail Perhaps where
+#endif
[add some elementary build instructions to the README.md
Ben Franksen <ben.franksen@online.de>**20200421130004
Ignore-this: a45d26805e2b10d4b32e7af90fd2b482eb8263f1b50280934c1b035f5bea11e800545f4068e151e2
] hunk ./README.md 13
- -Build instructions are available at <http://darcs.net/Binaries>.
+Build instructions are available at <http://darcs.net/Binaries> but they may
+not be up-to-date.
+
+Here is a quick run down. The easiest way to build darcs is by using
+cabal-install version 3.2 or later. A plain
+
+> cabal build
+
+should work out of the box with any ghc-8.x version. You may see some cabal
+warnings. Ignore them. If you want to run the tests, you need
+
+> cabal build --enable-tests
+
+This can be made permanent by using
+
+> cabal configure --enable-tests
+
+before building, which is useful mainly for development. Or you can combine
+building and testing:
+
+> cabal test --test-show-details=streaming
+
+You can also run
+
+> cabal install
+
+to install the library and the executable.
[adapt release/release.sh for use with modern cabal
Ben Franksen <ben.franksen@online.de>**20200421104718
Ignore-this: cc8994d12b85b0e6abdc2660e2e2c9a19142ab9550747b73981d138e277c7396aa9242f4414f3a8f
] hunk ./release/release.sh 4
+if test $(ghc --numeric-version | sed 's/\.//g') -ge 880; then
+ echo "cannot currently build a release with ghc >= 8.8"
+ false
+fi
+
hunk ./release/release.sh 21
- -runghc Setup configure --user --enable-tests
- -runghc Setup sdist
- -
- -packagenameÚrcs-$VERSION
- -tarballname="$packagename.tar.gz"
- -
- -test -f dist/$tarballname
- -wd=`pwd`
+cabal clean
+rm -f release/distributed-*
+cabal build --disable-optimisation
+tarballpath=$(cabal sdist | tail -1)
+test -f $tarballpath
hunk ./release/release.sh 28
+packagenameÚrcs-$VERSION
hunk ./release/release.sh 30
- -cabal unpack $wd/dist/$tarballname
+cabal unpack $tarballpath
hunk ./release/release.sh 33
- -runghc Setup configure --user --enable-tests
- -runghc Setup build -j2
- -runghc Setup test --show-details=streaming
+cabal test --test-show-details=streaming
hunk ./release/release.sh 35
- -./dist/build/darcs/darcs --version
- -./dist/build/darcs/darcs --version | grep -q $VERSION
+darcs=$(find dist-newstyle -type f -name darcs)
+
+./$darcs --version
+./$darcs --version | grep -q "$VERSION (release)"
hunk ./release/release.sh 47
- -echo ready: dist/$tarballname
+echo ready: $tarballpath
hunk ./release/release.sh 51
- -echo " cabal upload dist/$tarballname"
+echo " cabal upload $tarballpath"
[mitigate issue2643 with a better error message
Ben Franksen <ben.franksen@online.de>**20200424084544
Ignore-this: dfa5f9871de9ea06cb11abec5b40cb61e5684bae0ff75e3f6d8420b4ee6d443da8d32860b5340eb4
If the patch index is corrupt, output the name of the currupt file and
suggest its removal.
] conflictor [
hunk ./src/Darcs/Repository/PatchIndex.hs 39
+import Control.Exception ( catch )
+import Control.Monad ( forM_, unless, when )
+import Control.Monad.State.Strict ( evalState, execState, State, gets, modify )
+import Control.Applicative ( (<$>) )
+
]
>
hunk ./src/Darcs/Repository/PatchIndex.hs 39
- -import Data.Binary ( encodeFile, decodeFile )
+import Data.Binary ( Binary, encodeFile, decodeFileOrFail )
hunk ./src/Darcs/Repository/PatchIndex.hs 533
+decodeFile :: Binary a => FilePath -> IO a
+decodeFile path = do
+ result <- decodeFileOrFail path
+ case result of
+ Left (offset, msg) ->
+ fail $
+ "Patch index is corrupt (file "++path++" at offset "++show offset++"): \
"++msg++ + "\nPlease remove the corrupt file and then try again."
+ Right r -> return r
+
[resolve conflicts after 447f754fd0613f221cdf6174e67a2e020d71bdb6
Ben Franksen <ben.franksen@online.de>**20200427133218
Ignore-this: 6072de876c780806a6a73b4349caf37b4ef464eee1c8cd1af1ed0df6dbea418e6508c01aac82d778
] hunk ./src/Darcs/Patch/PatchInfoAnd.hs 18
- -module Darcs.Patch.PatchInfoAnd ( Hopefully(..), SimpleHopefully(..), \
PatchInfoAnd(..),
- - WPatchInfo, unWPatchInfo, compareWPatchInfo,
- - piap, n2pia, patchInfoAndPatch,
- - fmapFLPIAP, generaliseRepoTypePIAP,
- - conscientiously, hopefully, info, winfo,
- - hopefullyM, createHashed, extractHash,
- - actually, unavailable, patchDesc ) where
+{-# LANGUAGE CPP #-}
+module Darcs.Patch.PatchInfoAnd
+ ( Hopefully
+ , PatchInfoAnd
+ , PatchInfoAndG
+ , WPatchInfo
+ , unWPatchInfo
+ , compareWPatchInfo
+ , piap
+ , n2pia
+ , patchInfoAndPatch
+ , fmapPIAP
+ , fmapFLPIAP
+ , conscientiously
+ , hopefully
+ , info
+ , winfo
+ , hopefullyM
+ , createHashed
+ , extractHash
+ , actually
+ , unavailable
+ , patchDesc
+ ) where
hunk ./src/Darcs/Patch/PatchInfoAnd.hs 192
- -hopefullyM :: Monad m => PatchInfoAnd rt p wA wB -> m (Named rt p wA wB)
+hopefullyM ::
+#if MIN_VERSION_base(4,13,0)
+ MonadFail m
+#else
+ Monad m
+#endif
+ => PatchInfoAndG rt p wA wB -> m (p wA wB)
hunk ./src/Darcs/Patch/ReadMonads.hs 1
- --- | This module defines our parsing monad. In the past there have been lazy
- --- and strict parsers in this module. Currently we have only the strict
- --- variant and it is used for parsing patch files.
- -module Darcs.Patch.ReadMonads (ParserM, Darcs.Patch.ReadMonads.take,
- - parse, parseStrictly, char, int,
- - option, choice, skipSpace, skipWhile, string,
- - lexChar, lexString, lexEof, takeTillChar,
- - myLex', anyChar, endOfInput, takeTill,
- - checkConsumes,
- - linesStartingWith, linesStartingWithEndingWith) where
- -
- -import Prelude ()
- -import Darcs.Prelude
- -
- -import Darcs.Util.ByteString ( dropSpace, breakSpace, breakFirstPS,
- - readIntPS, breakLastPS )
- -import qualified Data.ByteString as B (null, drop, length, tail, empty,
- - ByteString)
- -import qualified Data.ByteString.Char8 as BC ( uncons, dropWhile, break
- - , splitAt, length, head )
- -import Control.Applicative ( Alternative(..) )
- -import Data.Foldable ( asum )
- -import Control.Monad ( MonadPlus(..) )
- -
- --- | 'lexChar' checks if the next space delimited token from
- --- the input stream matches a specific 'Char'.
- --- Uses 'Maybe' inside 'ParserM' to handle failed matches, so
- --- that it always returns () on success.
- -lexChar :: ParserM m => Char -> m ()
- -lexChar c = do
- - skipSpace
- - char c
- - return ()
- -
- --- | 'lexString' fetches the next whitespace delimited token from
- --- from the input and checks if it matches the 'ByteString' input.
- --- Uses 'Maybe' inside 'ParserM' to handle failed matches, so
- --- that it always returns () on success.
- -lexString :: ParserM m => B.ByteString -> m ()
- -lexString str = work
- - $ \s -> case myLex s of
- - Just (xs :*: ys) | xs == str -> Just (() :*: ys)
- - _ -> Nothing
- -
- --- | Only succeeds if the characters in the input exactly match @str@.
- -string :: ParserM m => B.ByteString -> m ()
- -string str = work
- - $ \s -> case BC.splitAt (BC.length str) s of
- - (h, t) | h == str -> Just (() :*: t)
- - _ -> Nothing
- -
- --- | 'lexEof' looks for optional spaces followed by the end of input.
- --- Uses 'Maybe' inside 'ParserM' to handle failed matches, so
- --- that it always returns () on success.
- -lexEof :: ParserM m => m ()
- -lexEof = work
- - $ \s -> if B.null (dropSpace s)
- - then Just (() :*: B.empty)
- - else Nothing
- -
- --- | 'myLex' drops leading spaces and then breaks the string at the
- --- next space. Returns 'Nothing' when the string is empty after
- --- dropping leading spaces, otherwise it returns the first sequence
- --- of non-spaces and the remainder of the input.
- -myLex :: B.ByteString -> Maybe (ParserState B.ByteString)
- -myLex s = let s' = dropSpace s
- - in if B.null s'
- - then Nothing
- - else Just $ stuple $ breakSpace s'
- -
- --- | Like 'myLex' except that it is in ParserM
- -myLex' :: ParserM m => m B.ByteString
- -myLex' = work myLex
- -
- --- | Accepts the next character and returns it. Only fails at end of
- --- input.
- -anyChar :: ParserM m => m Char
- -anyChar = work $ \s -> stuple <$> BC.uncons s
- -
- --- | Only succeeds at end of input, consumes no characters.
- -endOfInput :: ParserM m => m ()
- -endOfInput = work $ \s -> if B.null s
- - then Just (() :*: s)
- - else Nothing
- -
- --- | Accepts only the specified character. Consumes a character, if
- --- available.
- -char :: ParserM m => Char -> m ()
- -char c = work $ \s ->
- - case BC.uncons s of
- - Just (c', s') | c == c' -> Just (() :*: s')
- - _ -> Nothing
- -
- --- | Parse an integer and return it. Skips leading whitespaces and
- --- | uses the efficient ByteString readInt.
- -int :: ParserM m => m Int
- -int = work $ \s -> stuple <$> readIntPS s
- -
- --- | Discards spaces until a non-space character is encountered.
- --- Always succeeds.
- -skipSpace :: ParserM m => m ()
- -skipSpace = alterInput dropSpace
- -
- --- | Discards any characters as long as @p@ returns True. Always
- --- | succeeds.
- -skipWhile :: ParserM m => (Char -> Bool) -> m ()
- -skipWhile p = alterInput (BC.dropWhile p)
- -
- --- | Takes characters while @p@ returns True. Always succeeds.
- -takeTill :: ParserM m => (Char -> Bool) -> m B.ByteString
- -takeTill p = work $ \s -> Just $ stuple (BC.break p s)
- -
- --- | Equivalent to @takeTill (==c)@, except that it is optimized for
- --- | the equality case.
- -takeTillChar :: ParserM m => Char -> m B.ByteString
- -takeTillChar c = work $ \s -> Just $ stuple (BC.break (==c) s)
- -
- --- | Takes exactly @n@ bytes, or fails.
- -take :: ParserM m => Int -> m B.ByteString
- -take n = work $ \s -> if B.length s >= n
- - then Just $ stuple $ BC.splitAt n s
- - else Nothing
- -
- --- | This is a highly optimized way to read lines that start with a
- --- particular character. To implement this efficiently we need access
- --- to the parser's internal state. If this is implemented in terms of
- --- the other primitives for the parser it requires us to consume one
- --- character at a time. That leads to @(>>=)@ wasting significant
- --- time.
- -linesStartingWith :: ParserM m => Char -> m [B.ByteString]
- -linesStartingWith c = work $ linesStartingWith' c
- -
- --- | Helper function for 'linesStartingWith'.
- -linesStartingWith' :: Char -> B.ByteString -> Maybe (ParserState [B.ByteString])
- -linesStartingWith' c thes - - Just (lsw [] thes)
- - where lsw acc s | B.null s || BC.head s /= c = reverse acc :*: s
- - lsw acc s = let s' = B.tail s
- - in case breakFirstPS '\n' s' of
- - Just (l, r) -> lsw (l:acc) r
- - Nothing -> reverse (s':acc) :*: B.empty
- -
- --- | This is a highly optimized way to read lines that start with a
- --- particular character, and stops when it reaches a particular |
- --- character. See 'linesStartingWith' for details on why this |
- --- defined here as a primitive.
- -linesStartingWithEndingWith :: ParserM m => Char -> Char -> m [B.ByteString]
- -linesStartingWithEndingWith st en = work $ linesStartingWithEndingWith' st en
- -
- --- | Helper function for 'linesStartingWithEndingWith'.
- -linesStartingWithEndingWith' :: Char -> Char -> B.ByteString
- - -> Maybe (ParserState [B.ByteString])
- -linesStartingWithEndingWith' st en = lswew
- - where
- - lswew x
- - | B.null x = Nothing
- - | BC.head x == en = Just $ [] :*: B.tail x
- - | BC.head x /= st = Nothing
- - | otherwise = case BC.break ('\n' ==) $ B.tail x of
- - (l,r) -> case lswew $ B.tail r of
- - Just (ls :*: r') -> Just ((l:ls) :*: r')
- - Nothing ->
- - case breakLastPS en l of
- - Just (l2,_) ->
- - Just ([l2] :*: B.drop (B.length l2+2) x)
- - Nothing -> Nothing
- -
- -
- --- | Applies a function to the input stream and discards the
- --- result of the function.
- -alterInput :: ParserM m
- - => (B.ByteString -> B.ByteString) -> m ()
- -alterInput f = work (\s -> Just (() :*: f s))
- -
- --- | If @p@ fails it returns @x@, otherwise it returns the result of @p@.
- -{-# INLINE option #-}
- -option :: Alternative f => a -> f a -> f a
- -option x p = p <|> pure x
- -
- --- | Attempts each option until one succeeds.
- -{-# INLINE choice #-}
- -choice :: Alternative f => [f a] -> f a
- -choice = asum
- -
- --- |Ensure that a parser consumes input when producing a result
- --- Causes the initial state of the input stream to be held on to while the
- --- parser runs, so use with caution.
- -{-# INLINE checkConsumes #-}
- -checkConsumes :: ParserM m => m a -> m a
- -checkConsumes parser = do
- - x <- B.length <$> peekInput
- - res <- parser
- - x' <- B.length <$> peekInput
- - if x' < x then return res else mzero
- -
- -class (Functor m, Applicative m, Alternative m, Monad m, MonadPlus m) => ParserM m \
where
- - -- | Applies a parsing function inside the 'ParserM' monad.
- - work :: (B.ByteString -> Maybe (ParserState a)) -> m a
- - -- | Allows for the inspection of the input that is yet to be parsed.
- - peekInput :: m B.ByteString
- - -- | Run the parser
- - parse :: m a -> B.ByteString -> Maybe (a, B.ByteString)
- -
- ------ Strict Monad -----
- --- | 'parseStrictly' applies the parser functions to a string
- --- and checks that each parser produced a result as it goes.
- --- The strictness is in the 'ParserM' instance for 'SM'.
- -parseStrictly :: SM a -> B.ByteString -> Maybe (a, B.ByteString)
- -parseStrictly (SM f) s = case f s of
- - Just (a :*: r) -> Just (a, r)
- - _ -> Nothing
- -
- --- | ParserState represents the internal state of the parser. We make it
- --- strict and specialize it on ByteString. This is purely to help GHC
- --- optimize. If performance were not a concern, it could be replaced
- --- with @(a, ByteString)@.
- -data ParserState a = !a :*: !B.ByteString
- -
- --- | Convert from a lazy tuple to a strict tuple.
- -stuple :: (a, B.ByteString) -> ParserState a
- -stuple (a, b) = a :*: b
- -
- --- | 'SM' is the Strict Monad for parsing.
- -newtype SM a = SM (B.ByteString -> Maybe (ParserState a))
- -
- -bindSM :: SM a -> (a -> SM b) -> SM b
- -bindSM (SM m) k = SM $ \s -> case m s of
- - Nothing -> Nothing
- - Just (x :*: s') ->
- - case k x of
- - SM y -> y s'
- -{-# INLINE bindSM #-}
- -returnSM :: a -> SM a
- -returnSM x = SM (\s -> Just (x :*: s))
- -{-# INLINE returnSM #-}
- -failSM :: String -> SM a
- -failSM _ = SM (\_ -> Nothing)
- -{-# INLINE failSM #-}
- -
- -instance Monad SM where
- - {-# INLINE (>>=) #-}
- - (>>=) = bindSM
- - {-# INLINE return #-}
- - return = returnSM
- - fail = failSM
- -
- -instance ParserM SM where
- - work = SM
- - peekInput = SM $ \s -> Just (s :*: s)
- - parse = parseStrictly
- -
- --- The following instances allow us to use more conventional
- --- interfaces provided by other parser libraries. The instances are
- --- defined using bindSM, returnSM, and failSM to avoid any infinite,
- --- or even unneccessary, recursion of instances between between
- --- ParserM and Monad. Other recursive uses will be fine, such as
- --- (<|>) = mplus.
- -instance MonadPlus SM where
- - {-# INLINE mzero #-}
- - mzero = failSM ""
- - -- | Over using mplus can lead to space leaks. It's best to push
- - -- the use of mplus as far down as possible, because until the the
- - -- first parameter completes, we must hold on to the input.
- - {-# INLINE mplus #-}
- - mplus (SM a) (SM b) = SM $ \s ->
- - case a s of
- - Nothing -> b s
- - r -> r
- -
- -instance Functor SM where
- - {-# INLINE fmap #-}
- - fmap f m = m `bindSM` (returnSM . f)
- -
- -instance Applicative SM where
- - {-# INLINE pure #-}
- - pure = returnSM
- - {-# INLINE (<*>) #-}
- - a <*> b - - a `bindSM` \c ->
- - b `bindSM` \d ->
- - returnSM (c d)
- -
- -instance Alternative SM where
- - {-# INLINE empty #-}
- - empty = failSM ""
- - {-# INLINE (<|>) #-}
- - (<|>) = mplus
rmfile ./src/Darcs/Patch/ReadMonads.hs
[resolve conflicts after 82fe27cc6295a2e55936b3b1ff10fcb4966e1e5e
Ben Franksen <ben.franksen@online.de>**20200427133405
Ignore-this: 46373f5655aabaab1c79ec1061f4f8c1368f89edbea3552a4363ee42b6cb1f9d8b484f1a04a2526d
] hunk ./src/Darcs/Repository/PatchIndex.hs 39
- -import Data.Binary ( encodeFile, decodeFile )
+import Control.Exception ( catch )
+import Control.Monad ( forM_, unless, when )
+import Control.Monad.State.Strict ( evalState, execState, State, gets, modify )
+import Control.Applicative ( (<$>) )
+
+import Data.Binary ( Binary, encodeFile, decodeFileOrFail )
[clean up Darcs.Test.Patch.Check
Ben Franksen <ben.franksen@online.de>**20200426182607
Ignore-this: fb38c25c164f284cc6b9ab7db57a5af6a0c848cc89ab6fe1add562917512c3b132c269931b0cb388
There was a comment in the code about the strangeness of how in this test
module returning a Boolean was used to communicate a failure, and how this
should be replaced with a more conventional way of error handling. This is
now done, using the MaybeT monad transformer.
] hunk ./harness/Darcs/Test/Patch/Check.hs 18
- -{-# LANGUAGE GeneralizedNewtypeDeriving #-}
- -module Darcs.Test.Patch.Check ( PatchCheck(), doCheck, fileExists, dirExists,
+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}
+module Darcs.Test.Patch.Check ( PatchCheck, doCheck, fileExists, dirExists,
hunk ./harness/Darcs/Test/Patch/Check.hs 21
- - insertLine, deleteLine, isValid, doVerboseCheck,
+ insertLine, deleteLine, isValid,
hunk ./harness/Darcs/Test/Patch/Check.hs 23
- - checkMove, modifyFile, FileContents(..)
+ checkMove, modifyFile, FileContents(..),
+ inconsistent, handleInconsistent
hunk ./harness/Darcs/Test/Patch/Check.hs 30
- -import System.IO.Unsafe ( unsafePerformIO )
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 31
- -import Data.List ( isPrefixOf, inits )
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 32
- -import Control.Monad.State ( State, evalState, runState )
+import Control.Monad.State ( State, evalState )
+import Control.Monad.Trans.Maybe ( MaybeT(..) )
hunk ./harness/Darcs/Test/Patch/Check.hs 34
- -import Control.Monad.Fail ( MonadFail(fail) )
- --- use Map, not IntMap, because Map has mapKeys and IntMap hasn't
- -import Data.Map ( Map )
- -import qualified Data.Map as M ( mapKeys, delete, insert, empty, lookup, null )
+import qualified Data.IntMap as M ( IntMap, mapKeys, delete, insert, empty, lookup, \
null ) hunk ./harness/Darcs/Test/Patch/Check.hs 50
- -data FileContents = FC { fcLines :: Map Int B.ByteString
+data FileContents = FC { fcLines :: M.IntMap B.ByteString
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 57
+
hunk ./harness/Darcs/Test/Patch/Check.hs 66
+
hunk ./harness/Darcs/Test/Patch/Check.hs 54
- -data Prop = FileEx String | DirEx String | NotEx String
- - | FileLines String FileContents
- - deriving (Eq)
+data Prop
+ = FileEx AnchoredPath
+ | DirEx AnchoredPath
+ | NotEx AnchoredPath
+ | FileLines AnchoredPath FileContents
+ deriving (Eq)
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 57
- --- | A @KnownState@ is a simulated repository state. The repository is either
- --- inconsistent, or it has two lists of properties: one list with properties
- --- that hold for this repo, and one with properties that do not hold for this
- --- repo. These two lists may not have any common elements: if they had, the
- --- repository would be inconsistent.
- -data KnownState = P [Prop] [Prop]
- - | Inconsistent
- - deriving (Show)
+
hunk ./harness/Darcs/Test/Patch/Check.hs 71
- --- TODO the way that the standard way to use PatchCheck is
- --- by returning PatchCheck Bool but then often ignoring the
- --- result and instead checking again for state consistency
- --- is weird. It should be possible to replace it by a more normal
- --- error handling mechanism.
+-- | A simulated repository state. The repository is assumed to be
+-- consistent, and it has two lists of properties: one list with properties
+-- that hold for this repo, and one with properties that do not hold for this
+-- repo. These two lists may not have any common elements: if they had, the
+-- repository would be inconsistent.
+data ValidState = P [Prop] [Prop] deriving Show
hunk ./harness/Darcs/Test/Patch/Check.hs 79
- -newtype PatchCheck a = PatchCheck { runPatchCheck :: State KnownState a }
- - deriving (Functor, Applicative, Monad, MonadState KnownState)
+newtype PatchCheck a = PatchCheck { runPatchCheck :: MaybeT (State ValidState) a }
+ deriving (Functor, Applicative, Monad, MonadState ValidState)
+
+-- The existing instance definitions in Control.Monad.Except make it
+-- impossible to provide an 'instance MonadError () (MaybeT m)'.
+
+throwPC :: PatchCheck a
+throwPC = PatchCheck $ MaybeT $ return Nothing
hunk ./harness/Darcs/Test/Patch/Check.hs 88
- -instance MonadFail PatchCheck where
- - fail = error
+catchPC :: PatchCheck a -> PatchCheck a -> PatchCheck a
+PatchCheck m `catchPC` h + PatchCheck $ MaybeT $ do
+ a <- runMaybeT m
+ case a of
+ Nothing -> runMaybeT (runPatchCheck h)
+ Just r -> return (Just r)
+
+inconsistent :: PatchCheck ()
+inconsistent = throwPC
hunk ./harness/Darcs/Test/Patch/Check.hs 108
- -handleInconsistent v a = do state <- get
- - case state of
- - Inconsistent -> return v
- - _ -> a
- -
- -doCheck :: PatchCheck a -> a
- -doCheck p = evalState (runPatchCheck p) (P [] [])
+handleInconsistent v a = a `catchPC` return v
hunk ./harness/Darcs/Test/Patch/Check.hs 110
- --- | Run a check, and print the final repository state
- -doVerboseCheck :: PatchCheck a -> a
- -doVerboseCheck p - - case runState (runPatchCheck p) (P [] []) of
- - (b, pc) -> unsafePerformIO $ do print pc
- - return b
+doCheck :: PatchCheck a -> Bool
+doCheck p + evalState (maybe False (const True) <$> runMaybeT (runPatchCheck p)) (P \
[] []) hunk ./harness/Darcs/Test/Patch/Check.hs 114
- --- | Returns true if the current repository state is not inconsistent
- -isValid :: PatchCheck Bool
- -isValid = handleInconsistent False (return True)
+isValid :: PatchCheck ()
+isValid = return ()
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 121
- - -> (Maybe FileContents -> Maybe FileContents)
- - -> PatchCheck Bool
+ -> (Maybe FileContents -> Maybe FileContents)
+ -> PatchCheck Bool
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 121
- - -> (Maybe FileContents -> Maybe FileContents)
- - -> PatchCheck Bool
+ -> (Maybe FileContents -> Maybe FileContents)
+ -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 124
- - _ <- fileExists f
+ fileExists f
hunk ./harness/Darcs/Test/Patch/Check.hs 128
- - Just c' -> do setContents f c'
- - isValid
+ Just c' -> setContents f c'
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 130
- -insertLine :: String -> Int -> B.ByteString -> PatchCheck Bool
+insertLine :: AnchoredPath -> Int -> B.ByteString -> PatchCheck Bool
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 130
- -insertLine :: String -> Int -> B.ByteString -> PatchCheck Bool
+insertLine :: String -> Int -> B.ByteString -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 140
- - return True
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 143
- -deleteLine :: String -> Int -> B.ByteString -> PatchCheck Bool
+deleteLine :: AnchoredPath -> Int -> B.ByteString -> PatchCheck Bool
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 143
- -deleteLine :: String -> Int -> B.ByteString -> PatchCheck Bool
+deleteLine :: String -> Int -> B.ByteString -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 155
- - do_delete = do
- - setContents f c''
- - isValid
+ do_delete = setContents f c''
hunk ./harness/Darcs/Test/Patch/Check.hs 163
- -setContents f c = handleInconsistent () $ do
+setContents f c = do
hunk ./harness/Darcs/Test/Patch/Check.hs 174
- -fileContents f = handleInconsistent Nothing $ do
+fileContents f = do
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 183
- - -> PatchCheck Bool
+ -> PatchCheck Bool
hunk ./harness/Darcs/Test/Patch/Check.hs 182
- -fileEmpty :: String -- ^ Name of the file to check
+fileEmpty :: AnchoredPath -- ^ Name of the file to check
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 182
- -fileEmpty :: String -- ^ Name of the file to check
- - -> PatchCheck Bool
+fileEmpty :: String -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 189
- - _ <- if empty
- - then do setContents f emptyFilecontents
- - isValid
+ if empty
+ then setContents f emptyFilecontents
hunk ./harness/Darcs/Test/Patch/Check.hs 193
- - return empty
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 196
- -doSwap :: String -> String -> PatchCheck Bool
+doSwap :: AnchoredPath -> AnchoredPath -> PatchCheck Bool
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 196
- -doSwap :: String -> String -> PatchCheck Bool
- -doSwap f f' = handleInconsistent False $ do
- - modify map_sw
- - return True
+doSwap :: String -> String -> PatchCheck ()
+doSwap f f' = modify map_sw
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 210
- - map_sw _ = impossible
+ map_sw _ = error "impossible case"
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 210
- - map_sw _ = impossible
hunk ./harness/Darcs/Test/Patch/Check.hs 217
- -assert :: Prop -> PatchCheck Bool
- -assert p = handleInconsistent False $ do
+assert :: Prop -> PatchCheck ()
+assert p = do
hunk ./harness/Darcs/Test/Patch/Check.hs 221
- - then do
- - put Inconsistent
- - return False
+ then inconsistent
hunk ./harness/Darcs/Test/Patch/Check.hs 223
- - then return True
- - else do
- - put (P (p:ks) nots)
- - return True
+ then isValid
+ else put (P (p:ks) nots)
hunk ./harness/Darcs/Test/Patch/Check.hs 228
- -assertNot :: Prop -> PatchCheck Bool
- -assertNot p = handleInconsistent False $ do
+assertNot :: Prop -> PatchCheck ()
+assertNot p = do
hunk ./harness/Darcs/Test/Patch/Check.hs 232
- - then do
- - put Inconsistent
- - return False
+ then inconsistent
hunk ./harness/Darcs/Test/Patch/Check.hs 234
- - then return True
- - else do
- - put (P ks (p:nots))
- - return True
+ then isValid
+ else put (P ks (p:nots))
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 245
- - filter_nots _ = impossible
+ filter_nots _ = error "impossible case"
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 240
- -changeToTrue :: Prop -> PatchCheck Bool
- -changeToTrue p = handleInconsistent False $ do
- - modify filter_nots
- - return True
- - where filter_nots (P ks nots) = P (p:ks) (filter (p /=) nots)
- - filter_nots _ = impossible
+changeToTrue :: Prop -> PatchCheck ()
+changeToTrue p = modify filter_nots
+ where filter_nots (P ks nots) = P (p:ks) (filter (p /=) nots)
hunk ./harness/Darcs/Test/Patch/Check.hs 250
- -changeToFalse :: Prop -> PatchCheck Bool
- -changeToFalse p = handleInconsistent False $ do
+changeToFalse :: Prop -> PatchCheck ()
+changeToFalse p = do
hunk ./harness/Darcs/Test/Patch/Check.hs 253
- - return True
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 254
- - filter_ks _ = impossible
+ filter_ks _ = error "impossible case"
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 254
- - filter_ks _ = impossible
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 256
- -assertFileExists :: String -> PatchCheck Bool
+assertFileExists :: AnchoredPath -> PatchCheck Bool
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 256
- -assertFileExists :: String -> PatchCheck Bool
- -assertFileExists f = do _ <- assertNot $ NotEx f
- - _ <- assertNot $ DirEx f
+assertFileExists :: String -> PatchCheck ()
+assertFileExists f = do assertNot $ NotEx f
+ assertNot $ DirEx f
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 260
+
hunk ./harness/Darcs/Test/Patch/Check.hs 261
- -assertDirExists :: String -> PatchCheck Bool
+assertDirExists :: AnchoredPath -> PatchCheck Bool
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 260
- -assertDirExists :: String -> PatchCheck Bool
- -assertDirExists d = do _ <- assertNot $ NotEx d
- - _ <- assertNot $ FileEx d
+assertDirExists :: String -> PatchCheck ()
+assertDirExists d = do assertNot $ NotEx d
+ assertNot $ FileEx d
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 264
+
hunk ./harness/Darcs/Test/Patch/Check.hs 265
- -assertExists :: String -> PatchCheck Bool
+assertExists :: AnchoredPath -> PatchCheck Bool
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 264
- -assertExists :: String -> PatchCheck Bool
+assertExists :: String -> PatchCheck ()
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 267
- -assertNoSuch :: String -> PatchCheck Bool
+assertNoSuch :: AnchoredPath -> PatchCheck Bool
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 267
- -assertNoSuch :: String -> PatchCheck Bool
- -assertNoSuch f = do _ <- assertNot $ FileEx f
- - _ <- assertNot $ DirEx f
+assertNoSuch :: String -> PatchCheck ()
+assertNoSuch f = do assertNot $ FileEx f
+ assertNot $ DirEx f
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 272
- -createFile :: String -> PatchCheck Bool
+createFile :: AnchoredPath -> PatchCheck Bool
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 272
- -createFile :: String -> PatchCheck Bool
+createFile :: String -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 274
- - _ <- superdirsExist fn
- - _ <- assertNoSuch fn
- - _ <- changeToTrue (FileEx fn)
+ superdirsExist fn
+ assertNoSuch fn
+ changeToTrue (FileEx fn)
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 279
- -createDir :: String -> PatchCheck Bool
+createDir :: AnchoredPath -> PatchCheck Bool
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 279
- -createDir :: String -> PatchCheck Bool
+createDir :: String -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 281
- - _ <- substuffDontExist fn
- - _ <- superdirsExist fn
- - _ <- assertNoSuch fn
- - _ <- changeToTrue (DirEx fn)
+ substuffDontExist fn
+ superdirsExist fn
+ assertNoSuch fn
+ changeToTrue (DirEx fn)
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 287
- -removeFile :: String -> PatchCheck Bool
+removeFile :: AnchoredPath -> PatchCheck Bool
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 287
- -removeFile :: String -> PatchCheck Bool
+removeFile :: String -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 289
- - _ <- superdirsExist fn
- - _ <- assertFileExists fn
- - _ <- fileEmpty fn
- - _ <- changeToFalse (FileEx fn)
+ superdirsExist fn
+ assertFileExists fn
+ fileEmpty fn
+ changeToFalse (FileEx fn)
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 295
- -removeDir :: String -> PatchCheck Bool
+removeDir :: AnchoredPath -> PatchCheck Bool
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 295
- -removeDir :: String -> PatchCheck Bool
+removeDir :: String -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 297
- - _ <- substuffDontExist fn
- - _ <- superdirsExist fn
- - _ <- assertDirExists fn
- - _ <- changeToFalse (DirEx fn)
+ substuffDontExist fn
+ superdirsExist fn
+ assertDirExists fn
+ changeToFalse (DirEx fn)
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 303
- -checkMove :: String -> String -> PatchCheck Bool
+checkMove :: AnchoredPath -> AnchoredPath -> PatchCheck Bool
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 303
- -checkMove :: String -> String -> PatchCheck Bool
+checkMove :: String -> String -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 305
- - _ <- superdirsExist f
- - _ <- superdirsExist f'
- - _ <- assertExists f
- - _ <- assertNoSuch f'
+ superdirsExist f
+ superdirsExist f'
+ assertExists f
+ assertNoSuch f'
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 311
- -substuffDontExist :: String -> PatchCheck Bool
+substuffDontExist :: AnchoredPath -> PatchCheck Bool
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 311
- -substuffDontExist :: String -> PatchCheck Bool
- -substuffDontExist d = handleInconsistent False $ do
+substuffDontExist :: String -> PatchCheck ()
+substuffDontExist d = do
hunk ./harness/Darcs/Test/Patch/Check.hs 315
- - then return True
- - else do
- - put Inconsistent
- - return False
+ then isValid
+ else inconsistent
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 320
- - is_within_dir f = (d ++ "/") `isPrefixOf` f
- -
- --- the init and tail calls dump the final init (which is just the path itself
- --- again), the first init (which is empty), and the initial "." from
- --- splitDirectories
- -superdirsExist :: String -> PatchCheck Bool
- -superdirsExist fn = and `fmap` mapM assertDirExists superdirs
- - where superdirs = map (("./"++) . joinPath)
- - (init (tail (inits (tail (splitDirectories fn)))))
- -
- -fileExists :: String -> PatchCheck Bool
+ is_within_dir f = d `isPrefix` f && d /= f
+
+superdirsExist :: AnchoredPath -> PatchCheck Bool
+superdirsExist fn = and `fmap` mapM assertDirExists (parents fn)
+
+fileExists :: AnchoredPath -> PatchCheck Bool
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 325
- -superdirsExist :: String -> PatchCheck Bool
- -superdirsExist fn = and `fmap` mapM assertDirExists superdirs
+superdirsExist :: String -> PatchCheck ()
+superdirsExist fn = mapM_ assertDirExists superdirs
conflictor {{
>
hunk ./harness/Darcs/Test/Patch/Check.hs 320
- - is_within_dir f = (d ++ "/") `isPrefixOf` f
- -
- --- the init and tail calls dump the final init (which is just the path itself
- --- again), the first init (which is empty), and the initial "." from
- --- splitDirectories
- -superdirsExist :: String -> PatchCheck Bool
- -superdirsExist fn = and `fmap` mapM assertDirExists superdirs
- - where superdirs = map (("./"++) . joinPath)
- - (init (tail (inits (tail (splitDirectories fn)))))
- -
- -fileExists :: String -> PatchCheck Bool
+ is_within_dir f = d `isPrefix` f && d /= f
+
+superdirsExist :: AnchoredPath -> PatchCheck Bool
+superdirsExist fn = and `fmap` mapM assertDirExists (parents fn)
+
+fileExists :: AnchoredPath -> PatchCheck Bool
>
hunk ./harness/Darcs/Test/Patch/Check.hs 325
- -superdirsExist :: String -> PatchCheck Bool
- -superdirsExist fn = and `fmap` mapM assertDirExists superdirs
+superdirsExist :: String -> PatchCheck ()
+superdirsExist fn = mapM_ assertDirExists superdirs
}} []
>
hunk ./harness/Darcs/Test/Patch/Check.hs 330
- -fileExists :: String -> PatchCheck Bool
+fileExists :: String -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 332
- - _ <- superdirsExist fn
+ superdirsExist fn
conflictor [
hunk ./harness/Darcs/Test/Patch/Check.hs 335
- -dirExists :: String -> PatchCheck Bool
+dirExists :: AnchoredPath -> PatchCheck Bool
]
>
hunk ./harness/Darcs/Test/Patch/Check.hs 335
- -dirExists :: String -> PatchCheck Bool
+dirExists :: String -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 337
- - _ <- superdirsExist fn
+ superdirsExist fn
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 7
- -import Data.Maybe ( isNothing )
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 12
- - doCheck, FileContents(..)
+ doCheck, inconsistent, FileContents(..)
conflictor [
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 18
- -import Darcs.Util.Path ( fn2fp )
]
>
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 19
- -import qualified Data.Map as M ( mapMaybe )
+import qualified Data.IntMap as M ( mapMaybe )
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 38
- - checkPatch :: p wX wY -> PatchCheck Bool
+ checkPatch :: p wX wY -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 48
- -checkAPatch p = doCheck $ do _ <- checkPatch p
+checkAPatch p = doCheck $ do checkPatch p
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 52
- - checkPatch p = return $ isNothing $ isConsistent p
+ checkPatch p = maybe isValid (const inconsistent) $ isConsistent p
conflictor [
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 67
- - checkPatch _ = return True -- XXX
+ checkPatch _ = return True
+ -- XXX we have no equivalent of Darcs.Test.Patch.Check for FileUUID
]
>
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 67
- - checkPatch _ = return True -- XXX
+ checkPatch _ = isValid -- XXX
conflictor [
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 79
- - _ <- fileExists $ fn2fp f
- - mapM_ (deleteLine (fn2fp f) line) old
- - mapM_ (insertLine (fn2fp f) line) (reverse new)
+ _ <- fileExists f
+ mapM_ (deleteLine f line) old
+ mapM_ (insertLine f line) (reverse new)
]
>
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 79
- - _ <- fileExists $ fn2fp f
+ fileExists $ fn2fp f
conflictor [
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 88
- - _ <- fileExists $ fn2fp f
- - mapM_ (deleteLine (fn2fp f) 1) (linesPS o)
- - _ <- fileEmpty $ fn2fp f
- - mapM_ (insertLine (fn2fp f) 1) (reverse $ linesPS n)
+ _ <- fileExists f
+ mapM_ (deleteLine f 1) (linesPS o)
+ _ <- fileEmpty f
+ mapM_ (insertLine f 1) (reverse $ linesPS n)
]
>
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 88
- - _ <- fileExists $ fn2fp f
+ fileExists $ fn2fp f
conflictor {{
>
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 88
- - _ <- fileExists $ fn2fp f
- - mapM_ (deleteLine (fn2fp f) 1) (linesPS o)
- - _ <- fileEmpty $ fn2fp f
- - mapM_ (insertLine (fn2fp f) 1) (reverse $ linesPS n)
+ _ <- fileExists f
+ mapM_ (deleteLine f 1) (linesPS o)
+ _ <- fileEmpty f
+ mapM_ (insertLine f 1) (reverse $ linesPS n)
>
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 88
- - _ <- fileExists $ fn2fp f
+ fileExists $ fn2fp f
}} []
>
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 90
- - _ <- fileEmpty $ fn2fp f
+ fileEmpty $ fn2fp f
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 98
- - checkPatch (ChangePref _ _ _) = return True
+ checkPatch (ChangePref _ _ _) = isValid
[resolve conflicts after 347aeb4b5c1eccfe00956ac318a2123bca9ef9ca
Ben Franksen <ben.franksen@online.de>**20200427135437
Ignore-this: 9217132f46b0b7fb62c71b6202f744dcc480fbc1698f602ae2537b0566051c1b676f7790d32e5fec
] hunk ./darcs.cabal 563
+ transformers,
hunk ./harness/Darcs/Test/Patch/Check.hs 31
- -import Data.List ( isPrefixOf, inits )
- -import Control.Monad.State ( State, evalState, runState )
+import Control.Monad.State ( State, evalState )
+import Control.Monad.Trans.Maybe ( MaybeT(..) )
hunk ./harness/Darcs/Test/Patch/Check.hs 54
- -data Prop = FileEx String | DirEx String | NotEx String
- - | FileLines String FileContents
- - deriving (Eq)
- --- | A @KnownState@ is a simulated repository state. The repository is either
- --- inconsistent, or it has two lists of properties: one list with properties
- --- that hold for this repo, and one with properties that do not hold for this
- --- repo. These two lists may not have any common elements: if they had, the
- --- repository would be inconsistent.
- -data KnownState = P [Prop] [Prop]
- - | Inconsistent
- - deriving (Show)
+data Prop
+ = FileEx AnchoredPath
+ | DirEx AnchoredPath
+ | NotEx AnchoredPath
+ | FileLines AnchoredPath FileContents
+ deriving (Eq)
+
hunk ./harness/Darcs/Test/Patch/Check.hs 117
- - -> (Maybe FileContents -> Maybe FileContents)
- - -> PatchCheck Bool
+ -> (Maybe FileContents -> Maybe FileContents)
+ -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 126
- -insertLine :: String -> Int -> B.ByteString -> PatchCheck Bool
+insertLine :: AnchoredPath -> Int -> B.ByteString -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 139
- -deleteLine :: String -> Int -> B.ByteString -> PatchCheck Bool
+deleteLine :: AnchoredPath -> Int -> B.ByteString -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 178
- -fileEmpty :: String -- ^ Name of the file to check
- - -> PatchCheck Bool
+fileEmpty :: AnchoredPath -- ^ Name of the file to check
+ -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 192
- -doSwap :: String -> String -> PatchCheck Bool
- -doSwap f f' = handleInconsistent False $ do
- - modify map_sw
- - return True
+doSwap :: AnchoredPath -> AnchoredPath -> PatchCheck ()
+doSwap f f' = modify map_sw
hunk ./harness/Darcs/Test/Patch/Check.hs 204
- - map_sw _ = impossible
hunk ./harness/Darcs/Test/Patch/Check.hs 233
- -changeToTrue :: Prop -> PatchCheck Bool
- -changeToTrue p = handleInconsistent False $ do
- - modify filter_nots
- - return True
- - where filter_nots (P ks nots) = P (p:ks) (filter (p /=) nots)
- - filter_nots _ = impossible
+changeToTrue :: Prop -> PatchCheck ()
+changeToTrue p = modify filter_nots
+ where filter_nots (P ks nots) = P (p:ks) (filter (p /=) nots)
hunk ./harness/Darcs/Test/Patch/Check.hs 244
- - filter_ks _ = impossible
hunk ./harness/Darcs/Test/Patch/Check.hs 245
- -assertFileExists :: String -> PatchCheck Bool
- -assertFileExists f = do _ <- assertNot $ NotEx f
- - _ <- assertNot $ DirEx f
+assertFileExists :: AnchoredPath -> PatchCheck ()
+assertFileExists f = do assertNot $ NotEx f
+ assertNot $ DirEx f
hunk ./harness/Darcs/Test/Patch/Check.hs 249
- -assertDirExists :: String -> PatchCheck Bool
- -assertDirExists d = do _ <- assertNot $ NotEx d
- - _ <- assertNot $ FileEx d
+
+assertDirExists :: AnchoredPath -> PatchCheck ()
+assertDirExists d = do assertNot $ NotEx d
+ assertNot $ FileEx d
hunk ./harness/Darcs/Test/Patch/Check.hs 254
- -assertExists :: String -> PatchCheck Bool
+
+assertExists :: AnchoredPath -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 258
- -assertNoSuch :: String -> PatchCheck Bool
- -assertNoSuch f = do _ <- assertNot $ FileEx f
- - _ <- assertNot $ DirEx f
+assertNoSuch :: AnchoredPath -> PatchCheck ()
+assertNoSuch f = do assertNot $ FileEx f
+ assertNot $ DirEx f
hunk ./harness/Darcs/Test/Patch/Check.hs 263
- -createFile :: String -> PatchCheck Bool
+createFile :: AnchoredPath -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 270
- -createDir :: String -> PatchCheck Bool
+createDir :: AnchoredPath -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 278
- -removeFile :: String -> PatchCheck Bool
+removeFile :: AnchoredPath -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 286
- -removeDir :: String -> PatchCheck Bool
+removeDir :: AnchoredPath -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 294
- -checkMove :: String -> String -> PatchCheck Bool
+checkMove :: AnchoredPath -> AnchoredPath -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 302
- -substuffDontExist :: String -> PatchCheck Bool
- -substuffDontExist d = handleInconsistent False $ do
+substuffDontExist :: AnchoredPath -> PatchCheck ()
+substuffDontExist d = do
hunk ./harness/Darcs/Test/Patch/Check.hs 311
- - is_within_dir f = (d ++ "/") `isPrefixOf` f
+ is_within_dir f = d `isPrefix` f && d /= f
hunk ./harness/Darcs/Test/Patch/Check.hs 313
- --- the init and tail calls dump the final init (which is just the path itself
- --- again), the first init (which is empty), and the initial "." from
- --- splitDirectories
- -superdirsExist :: String -> PatchCheck Bool
- -superdirsExist fn = and `fmap` mapM assertDirExists superdirs
- - where superdirs = map (("./"++) . joinPath)
- - (init (tail (inits (tail (splitDirectories fn)))))
+superdirsExist :: AnchoredPath -> PatchCheck ()
+superdirsExist fn = mapM_ assertDirExists (parents fn)
hunk ./harness/Darcs/Test/Patch/Check.hs 316
- -fileExists :: String -> PatchCheck Bool
+fileExists :: AnchoredPath -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Check.hs 321
- -dirExists :: String -> PatchCheck Bool
+dirExists :: AnchoredPath -> PatchCheck ()
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 18
- -import Darcs.Util.Path ( fn2fp )
- -import qualified Data.Map as M ( mapMaybe )
+import qualified Data.IntMap as M ( mapMaybe )
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 66
- - checkPatch _ = return True -- XXX
+ checkPatch _ = isValid -- XXX
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 76
- - checkPatch (FP _ (Hunk _ [] [])) = return True
+ checkPatch (FP _ (Hunk _ [] [])) = isValid
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 78
- - _ <- fileExists $ fn2fp f
- - mapM_ (deleteLine (fn2fp f) line) old
- - mapM_ (insertLine (fn2fp f) line) (reverse new)
- - isValid
+ fileExists f
+ mapM_ (deleteLine f line) old
+ mapM_ (insertLine f line) (reverse new)
hunk ./harness/Darcs/Test/Patch/Properties/Check.hs 86
- - _ <- fileExists $ fn2fp f
- - mapM_ (deleteLine (fn2fp f) 1) (linesPS o)
- - _ <- fileEmpty $ fn2fp f
- - mapM_ (insertLine (fn2fp f) 1) (reverse $ linesPS n)
- - isValid
+ fileExists f
+ mapM_ (deleteLine f 1) (linesPS o)
+ fileEmpty f
+ mapM_ (insertLine f 1) (reverse $ linesPS n)
[add changelog entry for release 2.14.3
Ben Franksen <ben.franksen@online.de>**20200424132726
Ignore-this: 1e152b101f2897bea632fb00394a479970974be5bab895a40dec4c65079de51acb0a9f73e57bef2a
] hunk ./CHANGELOG 1
+Darcs 2.14.3, 24 April 2020
+
+ * Support for GHC 8.8 and GHC 8.10
+ * Loosen upper bounds for a few dependencies
+ * mitigate issue 2643 (corrupt patch index) with a better error message
+ * remove our own optimisation settings in darcs.cabal
+ * Setup.hs: allow use of darcs as a cabal subproject
+
[darcs.cabal: remove redundant version constraints
Ben Franksen <ben.franksen@online.de>**20200427140342
Ignore-this: 13501612338c6df2258acfaf2f9d71c5840e14f25849f66cc874e1fd20b18e6e4c34d34789e51e31
] hunk ./darcs.cabal 533
- - build-depends: darcs,
- - base >= 4.10 && < 4.13
+ build-depends: darcs, base
hunk ./darcs.cabal 554
- - base >= 4.10 && < 4.13,
- - array >= 0.5.1.0 && < 0.6,
- - bytestring >= 0.10.6 && < 0.11,
+ base,
+ array,
+ bytestring,
hunk ./darcs.cabal 558
- - containers >= 0.5.6.2 && < 0.7,
- - constraints >= 0.11 && < 0.12,
- - filepath >= 1.4.1 && < 1.5.0.0,
- - mtl >= 2.2.1 && < 2.3,
+ containers,
+ constraints,
+ filepath,
+ mtl,
hunk ./darcs.cabal 565
- - text >= 1.2.1.3 && < 1.3,
- - directory >= 1.2.7 && < 1.4,
+ text,
+ directory,
hunk ./darcs.cabal 575
- - vector >= 0.11 && < 0.13,
- - zip-archive >= 0.3 && < 0.5
+ vector,
+ zip-archive
[remove a redundant import from Setup.hs
Ben Franksen <ben.franksen@online.de>**20200427142229
Ignore-this: 392d862d1820db8e78809447f51952b9a9e486be421d30b8d155c2129eeb40f0ca17a83e88ffe6c7
] hunk ./Setup.hs 44
- -import Data.List( isInfixOf, lines )
+import Data.List( isInfixOf )
[no longer export fromJust from Darcs.Prelude [amended from branch-2.14]
Ben Franksen <ben.franksen@online.de>**20200426190414
Ignore-this: c0eb25fa6f237438cd22206a0bab4ffc730d783385bf4c21787b86f4b8a434dad3620f2242a55612
While used in many places, fromJust is a partial function and we should not
encourage its unfettered use in Darcs.
] hunk ./harness/Darcs/Test/Patch/Arbitrary/PrimFileUUID.hs 25
- -import Data.Maybe ( isJust )
+import Data.Maybe ( fromJust, isJust )
hunk ./harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs 42
- -import Data.Maybe ( isJust )
+import Data.Maybe ( fromJust, isJust )
hunk ./harness/Darcs/Test/Patch/FileUUIDModel.hs 40
+import Data.Maybe ( fromJust )
hunk ./src/Darcs/Prelude.hs 31
- - , module Data.Maybe
hunk ./src/Darcs/Prelude.hs 67
- -import Data.Maybe ( fromJust )
hunk ./src/Darcs/Repository/PatchIndex.hs 48
- -import Data.Maybe ( fromMaybe, isJust )
+import Data.Maybe ( fromJust, fromMaybe, isJust )
hunk ./src/Darcs/Repository/Traverse.hs 17
+import Data.Maybe ( fromJust )
hunk ./src/Darcs/UI/Commands/Convert/Export.hs 35
- -import Data.Maybe (catMaybes, fromMaybe)
+import Data.Maybe (catMaybes, fromJust, fromMaybe)
hunk ./src/Darcs/UI/Commands/Optimize.hs 26
- -import Data.Maybe ( isJust, fromJust )
+import Data.Maybe ( fromJust, isJust )
hunk ./src/Darcs/UI/Commands/Replace.hs 30
- -import Data.Maybe ( isJust )
+import Data.Maybe ( fromJust, isJust )
hunk ./src/Darcs/UI/Commands/ShowDependencies.hs 26
- -import Data.Maybe( fromMaybe )
+import Data.Maybe( fromJust, fromMaybe )
hunk ./src/Darcs/UI/Commands/Unrecord.hs 27
- -import Data.Maybe( isJust )
+import Data.Maybe( fromJust, isJust )
hunk ./src/Darcs/Util/Diff/Patience.hs 24
+import Data.Maybe ( fromJust )
hunk ./src/Darcs/Util/Lock.hs 54
- -import Data.Maybe ( isJust, listToMaybe )
+import Data.Maybe ( fromJust, isJust, listToMaybe )
[remove redundant imports
Ben Franksen <ben.franksen@online.de>**20200426184058
Ignore-this: 4acf362285c4d5f787935ef8439c091209b6f000f627270c2e7a7c4e42ac11b16830873e7baf81f1
This mostly concerns (<>) imported from Darcs.Util.Printer and (<$>) from
Control.Applicative. These are now consistently exported from Darcs.Prelude.
] conflictor [
hunk ./harness/Darcs/Test/Patch/Arbitrary/PrimFileUUID.hs 23
- -import Darcs.Patch.FromPrim ( PrimOf )
- -
]
>
hunk ./harness/Darcs/Test/Patch/Arbitrary/PrimFileUUID.hs 25
- -import Control.Applicative ( (<$>) )
conflictor [
hunk ./harness/Darcs/Test/Patch/Examples/Set2Unwitnessed.hs 34
+import Darcs.Patch.Commute ( Commute )
]
>
hunk ./harness/Darcs/Test/Patch/Examples/Set2Unwitnessed.hs 33
- -import Darcs.Patch ( invert, hunk )
hunk ./harness/Darcs/Test/Patch/FileUUIDModel.hs 36
- -import Control.Applicative ( (<$>) )
conflictor [
hunk ./src/Darcs/Patch/Bundle.hs 102
- -import Darcs.Util.Printer ( Doc, renderPS, newline, text, ($$),
- - (<>), vcat, vsep, renderString )
+import Darcs.Util.Printer
+ ( Doc
+ , ($$)
+ , (<>)
+ , newline
+ , renderPS
+ , renderString
+ , text
+ , vcat
+ , vsep
+ )
hunk ./src/Darcs/Patch/Bundle.hs 107
+ , packedString
hunk ./src/Darcs/Patch/Bundle.hs 102
+import Darcs.Util.Parser
+ ( Parser
+ , lexString
+ , lexWord
+ , optional
+ , parse
+ )
hunk ./src/Darcs/Patch/Bundle.hs 121
+import Darcs.Util.Tree( Tree )
+import Darcs.Util.Tree.Monad( virtualTreeIO )
+
]
>
hunk ./src/Darcs/Patch/Bundle.hs 103
- - (<>), vcat, vsep, renderString )
+ vcat, vsep, renderString )
hunk ./src/Darcs/Patch/Info.hs 80
- - empty, ($$), (<>), (<+>), vcat, text, cyanText, blueText, prefix \
) + empty, ($$), (<+>), vcat, text, cyanText, blueText, prefix )
conflictor [
hunk ./src/Darcs/Patch/Named/Wrapped.hs 38
- -import Darcs.Util.IsoDate ( getIsoDateTime )
- -import Darcs.Util.Text ( formatParas )
- -import Darcs.Util.Printer ( ($$), (<>), vcat, prefix )
- -
- -import Control.Applicative ( (<|>) )
+import Darcs.Util.Printer ( (<>) )
+
]
>
hunk ./src/Darcs/Patch/Named/Wrapped.hs 40
- -import Darcs.Util.Printer ( ($$), (<>), vcat, prefix )
+import Darcs.Util.Printer ( ($$), vcat, prefix )
hunk ./src/Darcs/Patch/Named.hs 79
- - ( Doc, ($$), (<+>), (<>), prefix, text, vcat, cyanText, blueText )
+ ( Doc, ($$), (<+>), prefix, text, vcat, cyanText, blueText )
hunk ./src/Darcs/Patch/Prim/Class.hs 18
- -import Darcs.Patch.Apply( ApplyState )
hunk ./src/Darcs/Patch/Prim/FileUUID/Read.hs 11
- -import Darcs.Patch.Prim.FileUUID.Core( Prim(..), Hunk(..), Location(..) )
+import Darcs.Patch.Prim.FileUUID.Core( Prim(..), Hunk(..) )
hunk ./src/Darcs/Patch/Prim/FileUUID/Show.hs 24
- - , (<+>), (<>), ($$), Doc, vcat
+ , (<+>), ($$), Doc, vcat
conflictor [
hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 28
- -import qualified Data.ByteString as B
- -import qualified Data.ByteString.Internal as BI
- -import qualified Data.ByteString as B ( ByteString, empty, null, concat )
- -import qualified Data.ByteString.Char8 as BC (pack, unpack, unlines)
+import qualified Data.ByteString as B
+ ( ByteString
+ , drop
+ , empty
+ , null
+ , concat
+ , isPrefixOf
+ , length
+ , splitAt
+ )
+import qualified Data.ByteString.Char8 as BC (pack, unpack, unlines, elemIndices)
]
>
hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 30
- -import qualified Data.ByteString as B ( ByteString, empty, null, concat )
hunk ./src/Darcs/Patch/Prim/V1/Show.hs 28
- - ($$), (<+>), (<>),
+ ($$), (<+>)
conflictor [
hunk ./src/Darcs/Patch/Summary.hs 25
- -
- -import Darcs.Util.Printer ( Doc, empty, vcat,
- - text,
- - minus, plus, ($$), (<+>), (<>),
- - )
- -
+import Darcs.Patch.Witnesses.Show
+
+import Darcs.Util.Path ( AnchoredPath, anchorPath )
+import Darcs.Util.Printer
+ ( Doc
+ , ($$)
+ , (<+>)
+ , (<>)
+ , empty
+ , minus
+ , plus
+ , text
+ , vcat
+ )
+
+-- | This type tags a patch with a 'ConflictState' and also hides the context
+-- witnesses (as in 'Sealed2'), so we can put them in a list.
+data IsConflictedPrim prim where
+ IsC :: !ConflictState -> !(prim wX wY) -> IsConflictedPrim prim
+data ConflictState = Okay | Conflicted | Duplicated deriving ( Eq, Ord, Show, Read)
+
+class PrimPatchBase p => Summary p where
+ conflictedEffect :: p wX wY -> [IsConflictedPrim (PrimOf p)]
+
+instance Summary p => Summary (FL p) where
+ conflictedEffect = concat . mapFL conflictedEffect
+
+instance Show2 prim => Show (IsConflictedPrim prim) where
+ showsPrec d (IsC cs prim) + showParen (d > appPrec) $
+ showString "IsC " . showsPrec (appPrec + 1) cs .
+ showString " " . showsPrec2 (appPrec + 1) prim
+
+listConflictedFiles :: (PatchInspect p, Summary p) => p wX wY -> [AnchoredPath]
+listConflictedFiles + nubSort . concat . catMaybes . map conflictedFiles . \
conflictedEffect + where
+ conflictedFiles (IsC Conflicted p) = Just (listTouchedFiles p)
+ conflictedFiles _ = Nothing
hunk ./src/Darcs/Patch/Summary.hs 58
- -listConflictedFiles :: (PatchInspect p, Summary p) => p wX wY -> [AnchoredPath]
+listConflictedFiles :: Summary p => p wX wY -> [AnchoredPath]
hunk ./src/Darcs/Patch/Summary.hs 46
- -class PrimPatchBase p => Summary p where
+class Summary p where
hunk ./src/Darcs/Patch/Summary.hs 58
- -listConflictedFiles :: Summary p => p wX wY -> [AnchoredPath]
+listConflictedFiles
+ :: (Summary p, PatchInspect (PrimOf p)) => p wX wY -> [AnchoredPath]
]
>
hunk ./src/Darcs/Patch/Summary.hs 28
- - minus, plus, ($$), (<+>), (<>),
+ minus, plus, ($$), (<+>)
conflictor [
hunk ./src/Darcs/Prelude.hs 24
- -
+{-# LANGUAGE CPP #-}
]
>
hunk ./src/Darcs/Prelude.hs 25
+{-# LANGUAGE CPP #-}
hunk ./src/Darcs/Prelude.hs 29
- - , module Data.Semigroup
+ , Semigroup(..)
hunk ./src/Darcs/Prelude.hs 46
+#if MIN_VERSION_base(4,11,0)
hunk ./src/Darcs/Prelude.hs 51
+#endif
hunk ./src/Darcs/Repository/Inventory.hs 40
- - ( Doc, (<>), (<+>), ($$), hcat, text, invisiblePS, packedString, renderPS )
+ ( Doc, (<+>), ($$), hcat, text, invisiblePS, packedString, renderPS )
conflictor [
hunk ./src/Darcs/Repository/PatchIndex.hs 55
- -import System.Directory ( createDirectory, renameDirectory, doesFileExist, \
doesDirectoryExist ) +import System.Directory
+ ( createDirectory
+ , doesDirectoryExist
+ , doesFileExist
+ , removeFile
+ , renameDirectory
+ )
hunk ./src/Darcs/Repository/PatchIndex.hs 51
- -import Control.Exception ( catch )
- -import Control.Monad ( forM_, unless, when )
- -import Control.Monad.State.Strict ( evalState, execState, State, gets, modify )
- -import Control.Applicative ( (<$>) )
+import Data.Word ( Word32 )
+
hunk ./src/Darcs/Repository/PatchIndex.hs 57
+ , removeDirectoryRecursive
]
>
hunk ./src/Darcs/Repository/PatchIndex.hs 54
- -import Control.Applicative ( (<$>) )
conflictor [
hunk ./src/Darcs/Repository/Pending.hs 74
- -import Darcs.Util.Printer ( Doc, ($$), (<>), text, vcat, (<+>) )
+import Darcs.Util.Exception ( catchall )
+import Darcs.Util.Global ( darcsdir )
+import Darcs.Util.Lock ( writeDocBinFile, removeFileMayNotExist )
+import Darcs.Util.Printer ( Doc, ($$), (<>), text, vcat, (<+>), errorDoc )
hunk ./src/Darcs/Repository/Pending.hs 75
- -import Darcs.Util.Global ( darcsdir )
hunk ./src/Darcs/Repository/Pending.hs 74
- -import Darcs.Util.Exception ( catchall )
+import Darcs.Util.Exception ( catchNonExistence )
hunk ./src/Darcs/Repository/Pending.hs 76
- -import Darcs.Util.Printer ( Doc, ($$), (<>), text, vcat, (<+>), errorDoc )
+import Darcs.Util.Printer ( Doc, ($$), (<>), text, vcat, (<+>), renderString )
]
>
hunk ./src/Darcs/Repository/Pending.hs 74
- -import Darcs.Util.Printer ( Doc, ($$), (<>), text, vcat, (<+>) )
+import Darcs.Util.Printer ( Doc, ($$), text, vcat, (<+>) )
duplicate
hunk ./src/Darcs/Repository/State.hs 57
- -import System.IO ( hPutStrLn, stderr )
- -import System.IO.Error ( catchIOError )
- -
hunk ./src/Darcs/Repository/State.hs 57
+import System.IO.Error ( catchIOError, isPermissionError )
+
hunk ./src/Darcs/Repository/State.hs 57
- -import System.IO.Error ( catchIOError, isPermissionError )
- -
hunk ./src/Darcs/Repository/State.hs 51
- -import System.FilePath
- - ( (</>)
- -#if mingw32_HOST_OS
- - , (<.>)
- -#endif
- - )
+import System.FilePath ( (</>), (<.>) )
>
hunk ./src/Darcs/Repository/State.hs 51
- -import System.FilePath ( (</>), (<.>) )
+import System.FilePath
+ ( (</>)
+#if mingw32_HOST_OS
+ , (<.>)
+#endif
+ )
conflictor [
hunk ./src/Darcs/UI/Commands/Log.hs 91
- - vsep, (<>), ($$), errorDoc, insertBeforeLastline, empty )
+ vsep, (<>), ($$), insertBeforeLastline, empty )
hunk ./src/Darcs/UI/Commands/Log.hs 90
- -import Darcs.Util.Printer ( Doc, simplePrinters, (<+>), prefix, text, vcat,
- - vsep, (<>), ($$), insertBeforeLastline, empty )
+import Darcs.Util.Printer
+ ( Doc
+ , ($$)
+ , (<+>)
+ , (<>)
+ , hsep
+ , insertBeforeLastline
+ , prefix
+ , simplePrinters
+ , text
+ , vcat
+ , vsep
+ )
]
>
hunk ./src/Darcs/UI/Commands/Log.hs 91
- - vsep, (<>), ($$), errorDoc, insertBeforeLastline, empty )
+ vsep, ($$), errorDoc, insertBeforeLastline, empty )
hunk ./src/Darcs/UI/Commands/MarkConflicts.hs 32
- - ( Doc, putDocLnWith, text, redText, debugDocLn, vsep, (<>), (<+>), ($$) )
+ ( Doc, putDocLnWith, text, redText, debugDocLn, vsep, (<+>), ($$) )
hunk ./src/Darcs/UI/Commands/Send.hs 137
- - ( Doc, vsep, text, ($$), (<+>), (<>), putDoc, putDocLn
+ ( Doc, vsep, text, ($$), (<+>), putDoc, putDocLn
duplicate
hunk ./src/Darcs/UI/Commands/Unrecord.hs 74
- -import Darcs.Util.English ( presentParticiple )
- -import Darcs.Util.Printer ( text, putDoc )
+import Darcs.Util.English ( presentParticiple, anyOfClause, itemizeVertical )
+import Darcs.Util.Printer ( text, putDoc, (<+>), ($$) )
hunk ./src/Darcs/UI/Commands/Unrecord.hs 74
- -import Darcs.Util.English ( presentParticiple, anyOfClause, itemizeVertical )
- -import Darcs.Util.Printer ( text, putDoc, (<+>), ($$) )
+import Darcs.Util.English ( presentParticiple )
+import Darcs.Util.Printer ( text, putDoc, vcat, (<+>), ($$) )
hunk ./src/Darcs/UI/Commands/Unrecord.hs 75
- -import Darcs.Util.Printer ( text, putDoc, vcat, (<+>), ($$) )
+import Darcs.Util.Printer ( text, putDoc, vcat, (<>), (<+>), ($$) )
>
hunk ./src/Darcs/UI/Commands/Unrecord.hs 75
- -import Darcs.Util.Printer ( text, putDoc, vcat, (<>), (<+>), ($$) )
+import Darcs.Util.Printer ( text, putDoc, vcat, (<+>), ($$) )
hunk ./src/Darcs/UI/Commands/Util.hs 81
- - ( text, (<>), (<+>), hsep, ($$), vcat, vsep
+ ( text, (<+>), hsep, ($$), vcat, vsep
hunk ./src/Darcs/UI/Email.hs 14
- - ( Doc, ($$), (<+>), (<>), text, empty, packedString, renderPS )
+ ( Doc, ($$), (<+>), text, empty, packedString, renderPS )
hunk ./src/Darcs/Util/Printer/Color.hs 12
- - , invisiblePrinter, (<>), (<?>), Doc(Doc,unDoc), unsafeBothText, \
simplePrinter, hcat + , invisiblePrinter, (<?>), Doc(Doc,unDoc), unsafeBothText, \
simplePrinter, hcat hunk ./src/Darcs/Util/Text.hs 24
- -import Darcs.Util.Printer ( Doc, (<>), renderString, quoted, hsep )
+import Darcs.Util.Printer ( Doc, renderString, quoted, hsep )
hunk ./src/Darcs/Util/Tree.hs 54
- -import Control.Applicative( (<$>) )
[import shelly-1.7.1 as a new subdirectory
Ben Franksen <ben.franksen@online.de>**20200427190300
Ignore-this: 48490484d96b32b4219cbae3caf61b67c775ede3f17c21a8b3d8561aa3adbb2f9f1d8f9b05aa2a7e
] adddir ./shelly
addfile ./shelly/ChangeLog.md
hunk ./shelly/ChangeLog.md 1
+# 1.7.2
+
+* Support exceptions-0.9
+
+# 1.7.0.1
+
+* Fix FindSpec.hs tests. Fixes \
[#150](https://github.com/yesodweb/Shelly.hs/issues/150), \
[#162](https://github.com/yesodweb/Shelly.hs/issues/162) +
+# 1.6.8.7
+
+* Relax unix-compat constraints
+
+# 1.6.8.6
+
+* Fix Build issue [#156](https://github.com/yesodweb/Shelly.hs/issues/156)
+
+# 1.6.8.5
+
+* Fix Windows build [#155](https://github.com/yesodweb/Shelly.hs/pull/155)
+
+# 1.6.8
+
+* added sshPairsWithOptions function
+
+# 1.6.7
+
+* flush stdout when using `echo`, not just `echo_n`
+* fix should be able to silence stderr when using `runHandle`
+* expose RunFailed
+
+# 1.6.6
+
+* add prependToPath function
+
+# 1.6.5
+
+* expose MonadShControl
+
+# 1.6.4.1
+
+* add writeBinary function
addfile ./shelly/LICENSE
hunk ./shelly/LICENSE 1
+Copyright (c) 2017, Petr Rockai <me@mornfall.net>
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Petr Rockai nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
addfile ./shelly/README.md
hunk ./shelly/README.md 1
+# Shelly
+
+[](https://travis-ci.org/yesodweb/Shelly.hs)
+[](https://hackage.haskell.org/package/shelly)
+[](http://stackage.org/nightly/package/shelly)
+[](http://stackage.org/lts/package/shelly)
+
+Shelly provides a single module for convenient systems programming in Haskell.
+
+* is aimed at convenience and getting things done rather than being a demonstration \
of elegance. +* has detailed and useful error messages
+* maintains its own environment, making it thread-safe
+* is modern, using Text and system-filepath/system-fileio
+* has low memory usage
+ * `run_` and other underscore variants that don't return stdout
+ * `runFoldLines` to run a fold operation over each line rather than loading all of \
stdout into memory + * `runHandle` and `runHandles` for complete control over \
handles +
+Looking to put your Haskell learning to immediate practical use? You don't have to \
create artifical intelligence, try just automating some of your boring tasks. +
+The focus of this library on convenience combined with good error messages should \
make shelly approachable for newer users of Haskell. +I have published [an \
introductory article to scripting with shelly, targeted towards those not familiar \
with Haskell](http://www.linux-magazin.de/Online-Artikel/Shell-scripting-with-type-safety-using-Haskell/). \
There is a paid version in German from Linux Magazin. +That article uses the version \
`shelly < 1.0` which uses lazy text. `shelly > 1.0` uses strict text. +
+
+
+## More shelly packages
+
+The [shelly-extra](http://hackage.haskell.org/package/shelly-extra) package has some \
additional functionality that requires additional dependencies, currently including a \
convenient concurrency/futures implementation. If you are following along the above \
article you need to install it. +
+
+## Examples
+
+* [A small deployment \
script](http://www.alfredodinapoli.com/posts/2015-11-03-how-i-deploy-haskell-code.html)
+* [Yesod development \
installer](https://github.com/yesodweb/scripts/blob/master/install.hs) +* \
[cabal-meta, a haskell install \
tool](https://github.com/yesodweb/cabal-meta/blob/master/main.hs) +* [antigen-hs, a \
zsh plugin manager](https://github.com/Tarrasch/antigen-hs) +
+
+### Blog Posts
+
+* [Shelly automation with Literate \
Haskell](http://www.scholarslab.org/dh-developer/shell-programming-in-haskell-converting-s5-slides-to-pdf/)
+
+
+### Testimonials
+
+* [a beginning Haskeller does \
automation](http://www.reddit.com/r/haskell/comments/w86gu/my_current_job_task_is_boring_so_i_wrote_a_simple/)
+
+### Help
+
+* [google group for Haskell shell \
scripting](https://groups.google.com/forum/#!forum/haskell-shell-scripting) +
+## Alternatives
+
+### Haskell shell scripting libraries
+
+
+* [HSH](http://hackage.haskell.org/package/HSH) - A good alternative if you want to \
mixup usage of String and ByteString rather than just use Text. +* \
[HsShellScript](http://hackage.haskell.org/packages/archive/hsshellscript/3.1.0/doc/html/HsShellScript.html) \
- Has extensive low-level shell capabilities. +* \
[shell-conduit](http://hackage.haskell.org/package/shell-conduit) - efficient \
streaming via conduits. Makes some portability sacrifices by + * encouraging one to \
just use the shell instead of cross-platform Haskell code + * encouraging one to use \
a convenience function that searches the PATH at compile-time +* \
[shell-monad](http://hackage.haskell.org/package/shell-monad) - compile Haskell code \
down to shell script. This is a different approach from all the rest of the \
libraries. Writing your script is not as user-friendly as the other Haskell \
libraries, but it nicely solves the deployment issue. +* \
[turtle](http://hackage.haskell.org/package/turtle) - In some sense a [redesign of \
Shelly designed for beginner-friendliness](http://www.reddit.com/r/haskell/comments/2u6b8m/use_haskell_for_shell_scripting/co5ucq9)
+
+HSH and HsShellScript (unlike Shelly currently) implement very efficient mechanisms \
for piping/redirecting in the system. +turtle, like Shelly offers folding as a way to \
efficiently deal with a stream. +
+None of the alternatives to Shelly offer command tracing.
+For some this is an absolutely critical feature, particularly given that Haskell \
does not yet offer up stack traces. +
+
+### Haskell file-finding supplements
+
+* [find-conduit](http://hackage.haskell.org/package/find-conduit) - uses conduits, \
similar speed to GNU find +* [FileManip](hackage.haskell.org/package/FileManip) - \
uses Lazy IO +
+Shelly's finders load all files into memory. This is simpler to use if you control \
the filesystem structure and know the system is bounded in size. However, if the \
filesystem structure is unbounded it consumes unbounded memory. +
+
+### Shell commands with richer input/output
+
+Shelly does not change the nature of shell scripting (text in, text out).
+If you want something more revolutionary you might try these:
+
+* PowerShell is probably the best known.
+* [Haskell project](https://github.com/pkamenarsky/ytools) using typed JSON
+* [RecordStream](https://github.com/benbernard/RecordStream) untyped JSON]
+
+
+## Usage
+
+Shelly's main goal is ease of use.
+There should be a primitive for every shell operation you need so you can easily \
build abstractions, so there are many of the usual file and environment operations. +
+There are 2 main entry points for running arbitrary commands: `run` and `cmd`.
+They take a FilePath as their first argument. `run` takes a [Text] as its second \
argument. +`cmd` takes a variadic number of arguments, and they can be either Text or \
FilePath. +
+Fun Example: shows an infectious script: it uploads itself to a server and runs \
itself over ssh. +Of course, the development machine may need to be exactly the same \
OS as the server. +
+I recommend using the boilerplate at the top of this example in your projects.
+This includes setting line buffering if you are dealing with text and not binary \
data. +
+~~~~~ {.haskell}
+ {-# LANGUAGE OverloadedStrings #-}
+ {-# LANGUAGE ExtendedDefaultRules #-}
+ {-# OPTIONS_GHC -fno-warn-type-defaults #-}
+ import Shelly
+ import Data.Text as T
+ default (T.Text)
+
+ main = do
+ hSetBuffering stdout LineBuffering
+ shelly $ verbosely $ do
+ host <- run "uname" ["-n"]
+ if T.stripEnd host === "local-machine"
+ then do d <- cmd "date"
+ c <- escaping False $ cmd "git" "log -1 | head -1 | awk '{print \
$2}'" + appendfile "log/deploy.log" $ T.intercalate " - " \
[T.stripEnd d, c] + uploads "my-server:/remote/path/" ["deploy"]
+ sshPairs_ "my-server" [("cd", ["/remote/path"]), ("./deploy", [])]
+ else do
+ cmd "./script/angel"
+
+ -- same path on remote host
+ -- will create directories
+ uploads :: Text -> [Text] -> Sh ()
+ uploads remote locals = rsync $ ["--relative"] ++ locals ++ [remote]
+
+ rsync args = run_ "rsync" $ ["--delete", "-avz", "--no-g"] ++ args
+~~~~~
+
+### Variadic arguments to cmd
+
+Yes, as seen above you can write variadic functions in Haskell quite easily, you \
just can't compose them as easily. +I find `cmd` to be more convenient, but I often \
use `run` and `command` variants when I am building up abstractions. +Building up \
abstractions with cmd will require type signatures. +
+ -- easy signature, but only allows one argument
+ let cabal = cmd "cabal" :: Text -> Sh Text
+
+ -- more complex signature that allows partial application of cmd
+ let cabal = cmd "cabal" :: Shelly.ShellCmd result => result
+
+
+
+### Escaping
+
+By default, all commands are shell escaped.
+If you want the shell to interpret special characters such as `*`, just use \
`escaping False $ do ...` +
+### Using Text and FilePath together
+
+Shelly's usage of system-filepath means you may need to convert between Text and \
FilePath sometimes. +This should be infrequent though because
+
+* `cmd` will convert FilePath to Text
+* The `</>` and `<.>` combinators convert String/Text into a FilePath automatically
+
+Manual conversion is done through `toTextIgnore` or `toTextWarn`.
+
+
+### Thread-safe working directory and relative paths
+
+`cd` does not change the process working directory (essentially a global variable), \
but instead changes the shelly state (which is thread safe). +All of the Shelly API \
takes this into account, internally shelly converts all paths to absolute paths. You \
can turn a relative path into an absolute with `absPath` or `canonic` or you can make \
a path relative to the Shelly working directory with `relPath`. +
+
+### Good error messages
+
+Haskell's #1 weakness for IO code is a lack of stack traces.
+Shelly gives you something different: detailed logging.
+In most cases this should be more useful than a stack trace.
+Shelly keeps a log of API usage and saves it to a .shelly directory on failure.
+If you use `shellyNoDir`, the log will instead be printed to stderr.
+This is in addition to the `verbosely` settings that will print out commands and \
their output as the program is running. +Shelly's own error messages are detailed and \
in some cases it will catch Haskell exceptions and re-throw them with better \
messages. +
+If you make your own primitive functions that don't use the existing Shelly API, you \
can create a wrapper in the Sh monad that use `trace` or `tag` to log what they are \
doing. +You can turn tracing off (not generally recommended) by setting `tracing \
False`. +
+
+## Future plans
+
+* Don't use the filepath library
addfile ./shelly/Setup.hs
hunk ./shelly/Setup.hs 1
+import Distribution.Simple
+main = defaultMain
addfile ./shelly/shelly.cabal
hunk ./shelly/shelly.cabal 1
+Name: shelly
+
+Version: 1.7.1
+x-revision: 1
+Synopsis: shell-like (systems) programming in Haskell
+
+Description: Shelly provides convenient systems programming in Haskell,
+ similar in spirit to POSIX shells. Shelly:
+ .
+ * is aimed at convenience and getting things done rather than
+ being a demonstration of elegance.
+ .
+ * has detailed and useful error messages
+ .
+ * maintains its own environment, making it thread-safe.
+ .
+ * is modern, using Text and system-filepath/system-fileio
+ .
+ Shelly is originally forked from the Shellish package.
+ .
+ See the shelly-extra package for additional functionality.
+ .
+ An overview is available in the README: \
<https://github.com/yesodweb/Shelly.hs/blob/master/README.md> +
+
+Homepage: https://github.com/yesodweb/Shelly.hs
+License: BSD3
+License-file: LICENSE
+Author: Greg Weber, Petr Rockai
+Maintainer: Greg Weber <greg@gregweber.info>
+Category: Development
+Build-type: Simple
+Cabal-version: >=1.8
+
+-- for the sdist of the test suite
+extra-source-files: test/src/*.hs
+ test/examples/*.sh
+ test/examples/*.hs
+ test/data/zshrc
+ test/data/nonascii.txt
+ test/data/symlinked_dir/hoge_file
+ test/testall
+ README.md
+ ChangeLog.md
+
+Library
+ Exposed-modules: Shelly, Shelly.Lifted, Shelly.Pipe, Shelly.Unix
+ other-modules: Shelly.Base, Shelly.Find
+ hs-source-dirs: src
+ other-extensions: InstanceSigs
+
+ Build-depends:
+ containers >= 0.4.2.0,
+ time >= 1.3 && < 1.9,
+ directory >= 1.1.0.0 && < 1.4.0.0,
+ mtl >= 2,
+ process >= 1.0,
+ unix-compat < 0.6,
+ system-filepath >= 0.4.7 && < 0.5,
+ system-fileio < 0.4,
+ monad-control >= 0.3.2 && < 1.1,
+ lifted-base,
+ lifted-async,
+ exceptions >= 0.6,
+ enclosed-exceptions,
+ text, bytestring, async, transformers, transformers-base
+
+ if impl(ghc >= 7.6.1)
+ build-depends:
+ base >= 4.6 && < 5
+ else
+ build-depends:
+ base >= 4 && < 5
+
+ ghc-options: -Wall
+
+ if impl(ghc >= 7.6.1)
+ CPP-Options: -DNO_PRELUDE_CATCH
+
+ extensions:
+ CPP
+
+source-repository head
+ type: git
+ location: https://github.com/yesodweb/Shelly.hs
+
+Flag lifted
+ Description: run the tests against Shelly.Lifted
+ Default: False
+
+Test-Suite shelly-testsuite
+ type: exitcode-stdio-1.0
+ hs-source-dirs: src test/src
+ main-is: TestMain.hs
+ other-modules:
+ CopySpec
+ EnvSpec
+ FailureSpec
+ FindSpec
+ Help
+ LiftedSpec
+ MoveSpec
+ ReadFileSpec
+ RmSpec
+ RunSpec
+ SshSpec
+ Shelly
+ Shelly.Base
+ Shelly.Find
+ Shelly.Lifted
+ TestInit
+ WhichSpec
+ WriteSpec
+
+ ghc-options: -O2 -Wall -fwarn-tabs -funbox-strict-fields -threaded
+ -fno-warn-unused-do-bind -fno-warn-type-defaults
+
+
+ extensions: OverloadedStrings, ExtendedDefaultRules
+
+ if flag(lifted)
+ cpp-options: -DLIFTED
+
+ build-depends:
+ base >= 4.6,
+ text >= 0.11,
+ async,
+ bytestring >= 0.10,
+ containers >= 0.5.0.0,
+ directory >= 1.1.0.0 && < 1.4.0.0,
+ process >= 1.1.0,
+ unix-compat < 0.6,
+ system-filepath >= 0.4.7 && < 0.5,
+ system-fileio < 0.4,
+ time >= 1.3 && < 1.9,
+ mtl >= 2,
+ HUnit >= 1.2,
+ hspec >= 1.5,
+ transformers,
+ transformers-base,
+ filepath,
+ monad-control,
+ lifted-base,
+ lifted-async,
+ enclosed-exceptions,
+ exceptions
+
+ extensions:
+ CPP
+
+Flag build-examples
+ Description: build some example programs
+ Default: False
+ Manual: True
+
+-- demonstarated that command output in Shellish was not shown until after the \
command finished +-- not necessary anymore
+Executable drain
+ hs-source-dirs: test/examples
+ main-is: drain.hs
+ if flag(build-examples)
+ buildable: True
+
+ build-depends: base >= 4.6
+ , shelly
+ , text
+
+ extensions:
+ CPP
+ else
+ buildable: False
+
+Executable run-handles
+ hs-source-dirs: test/examples
+ main-is: run-handles.hs
+ if flag(build-examples)
+ buildable: True
+
+ build-depends: base >= 4.6
+ , shelly
+ , text
+
+ extensions:
+ CPP
+ else
+ buildable: False
+
+Executable Color
+ hs-source-dirs: test/examples
+ main-is: color.hs
+ if flag(build-examples)
+ buildable: True
+
+ build-depends: base >= 4.6
+ , process
+ , shelly
+ , text
+ else
+ buildable: False
adddir ./shelly/src
adddir ./shelly/src/Shelly
addfile ./shelly/src/Shelly/Base.hs
hunk ./shelly/src/Shelly/Base.hs 1
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE InstanceSigs#-}
+-- | I started exposing multiple module (starting with one for finding)
+-- Base prevented circular dependencies
+-- However, Shelly went back to exposing a single module
+module Shelly.Base
+ (
+ Sh(..), ShIO, runSh, State(..), ReadOnlyState(..), StdHandle(..),
+ HandleInitializer, StdInit(..),
+ FilePath, Text,
+ relPath, path, absPath, canonic, canonicalize,
+ test_d, test_s,
+ unpack, gets, get, modify, trace,
+ ls, lsRelAbs,
+ toTextIgnore,
+ echo, echo_n, echo_err, echo_n_err, inspect, inspect_err,
+ catchany,
+ liftIO, (>=>),
+ eitherRelativeTo, relativeTo, maybeRelativeTo,
+ whenM
+ -- * utilities not yet exported
+ , addTrailingSlash
+ ) where
+
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706
+import Prelude hiding (FilePath, catch)
+#else
+import Prelude hiding (FilePath)
+#endif
+
+import Data.Text (Text)
+import System.Process( ProcessHandle, StdStream(..) )
+import System.IO ( Handle, hFlush, stderr, stdout )
+
+import Control.Monad (when, (>=>),
+ liftM
+ )
+import Control.Monad.Base
+import Control.Monad.Trans.Control
+import Control.Applicative (Applicative, (<$>))
+import Filesystem (isDirectory, listDirectory)
+import System.PosixCompat.Files( getSymbolicLinkStatus, isSymbolicLink )
+import Filesystem.Path.CurrentOS (FilePath, encodeString, relative)
+import qualified Filesystem.Path.CurrentOS as FP
+import qualified Filesystem as FS
+import Data.IORef (readIORef, modifyIORef, IORef)
+import Data.Monoid (mappend)
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+import Control.Exception (SomeException, catch, throwIO, Exception)
+import Data.Maybe (fromMaybe)
+import qualified Control.Monad.Catch as Catch
+import Control.Monad.Trans ( MonadIO, liftIO )
+import Control.Monad.Reader.Class (MonadReader, ask)
+import Control.Monad.Trans.Reader (runReaderT, ReaderT(..))
+import qualified Data.Set as S
+import Data.Typeable (Typeable)
+
+-- | ShIO is Deprecated in favor of 'Sh', which is easier to type.
+type ShIO a = Sh a
+{-# DEPRECATED ShIO "Use Sh instead of ShIO" #-}
+
+newtype Sh a = Sh {
+ unSh :: ReaderT (IORef State) IO a
+ } deriving (Applicative, Monad, MonadIO, MonadReader (IORef State), Functor, \
Catch.MonadMask) +
+instance MonadBase IO Sh where
+ liftBase = Sh . ReaderT . const
+
+instance MonadBaseControl IO Sh where
+#if MIN_VERSION_monad_control(1,0,0)
+ type StM Sh a = StM (ReaderT (IORef State) IO) a
+ liftBaseWith f + Sh $ liftBaseWith $ \runInBase -> f $ \k ->
+ runInBase $ unSh k
+ restoreM = Sh . restoreM
+#else
+ newtype StM Sh a = StMSh (StM (ReaderT (IORef State) IO) a)
+ liftBaseWith f + Sh $ liftBaseWith $ \runInBase -> f $ \k ->
+ liftM StMSh $ runInBase $ unSh k
+ restoreM (StMSh m) = Sh . restoreM $ m
+#endif
+
+instance Catch.MonadThrow Sh where
+ throwM = liftIO . Catch.throwM
+
+instance Catch.MonadCatch Sh where
+ catch (Sh (ReaderT m)) c + Sh $ ReaderT $ \r -> m r `Catch.catch` \e -> runSh \
(c e) r +
+runSh :: Sh a -> IORef State -> IO a
+runSh = runReaderT . unSh
+
+data ReadOnlyState = ReadOnlyState { rosFailToDir :: Bool }
+data State = State
+ { sCode :: Int -- ^ exit code for command that ran
+ , sStdin :: Maybe Text -- ^ stdin for the command to be run
+ , sStderr :: Text -- ^ stderr for command that ran
+ , sDirectory :: FilePath -- ^ working directory
+ , sPutStdout :: Text -> IO () -- ^ by default, hPutStrLn stdout
+ , sPrintStdout :: Bool -- ^ print stdout of command that is executed
+ , sPutStderr :: Text -> IO () -- ^ by default, hPutStrLn stderr
+ , sPrintStderr :: Bool -- ^ print stderr of command that is executed
+ , sPrintCommands :: Bool -- ^ print command that is executed
+ , sInitCommandHandles :: StdInit -- ^ initializers for the standard process \
handles + -- when running a command
+ , sCommandEscaping :: Bool -- ^ when running a command, escape shell characters \
such as '*' rather + -- than passing to the shell for \
expansion + , sEnvironment :: [(String, String)]
+ , sPathExecutables :: Maybe [(FilePath, S.Set FilePath)] -- ^ cache of \
executables in the PATH + , sTracing :: Bool -- ^ should we trace command execution
+ , sTrace :: Text -- ^ the trace of command execution
+ , sErrExit :: Bool -- ^ should we exit immediately on any error
+ , sReadOnly :: ReadOnlyState
+ , sFollowSymlink :: Bool -- ^ 'find'-command follows symlinks.
+ }
+
+data StdHandle = InHandle StdStream
+ | OutHandle StdStream
+ | ErrorHandle StdStream
+
+-- | Initialize a handle before using it
+type HandleInitializer = Handle -> IO ()
+
+-- | A collection of initializers for the three standard process handles
+data StdInit + StdInit {
+ inInit :: HandleInitializer,
+ outInit :: HandleInitializer,
+ errInit :: HandleInitializer
+ }
+
+-- | A monadic-conditional version of the "when" guard.
+whenM :: Monad m => m Bool -> m () -> m ()
+whenM c a = c >>= \res -> when res a
+
+-- | Makes a relative path relative to the current Sh working directory.
+-- An absolute path is returned as is.
+-- To create an absolute path, use 'absPath'
+relPath :: FilePath -> Sh FilePath
+relPath fp = do
+ wd <- gets sDirectory
+ rel <- eitherRelativeTo wd fp
+ return $ case rel of
+ Right p -> p
+ Left p -> p
+
+eitherRelativeTo :: FilePath -- ^ anchor path, the prefix
+ -> FilePath -- ^ make this relative to anchor path
+ -> Sh (Either FilePath FilePath) -- ^ Left is canonic of second \
path +eitherRelativeTo relativeFP fp = do
+ let fullFp = relativeFP FP.</> fp
+ let relDir = addTrailingSlash relativeFP
+ stripIt relativeFP fp $
+ stripIt relativeFP fullFp $
+ stripIt relDir fp $
+ stripIt relDir fullFp $ do
+ relCan <- canonic relDir
+ fpCan <- canonic fullFp
+ stripIt relCan fpCan $ return $ Left fpCan
+ where
+ stripIt rel toStrip nada + case FP.stripPrefix rel toStrip of
+ Just stripped ->
+ if stripped == toStrip then nada
+ else return $ Right stripped
+ Nothing -> nada
+
+-- | make the second path relative to the first
+-- Uses 'Filesystem.stripPrefix', but will canonicalize the paths if necessary
+relativeTo :: FilePath -- ^ anchor path, the prefix
+ -> FilePath -- ^ make this relative to anchor path
+ -> Sh FilePath
+relativeTo relativeFP fp + fmap (fromMaybe fp) $ maybeRelativeTo relativeFP fp
+
+maybeRelativeTo :: FilePath -- ^ anchor path, the prefix
+ -> FilePath -- ^ make this relative to anchor path
+ -> Sh (Maybe FilePath)
+maybeRelativeTo relativeFP fp = do
+ epath <- eitherRelativeTo relativeFP fp
+ return $ case epath of
+ Right p -> Just p
+ Left _ -> Nothing
+
+
+-- | add a trailing slash to ensure the path indicates a directory
+addTrailingSlash :: FilePath -> FilePath
+addTrailingSlash p + if FP.null (FP.filename p) then p else
+ p FP.</> FP.empty
+
+-- | makes an absolute path.
+-- Like 'canonicalize', but on an exception returns 'absPath'
+canonic :: FilePath -> Sh FilePath
+canonic fp = do
+ p <- absPath fp
+ liftIO $ canonicalizePath p `catchany` \_ -> return p
+
+-- | Obtain a (reasonably) canonic file path to a filesystem object. Based on
+-- "canonicalizePath" in system-fileio.
+canonicalize :: FilePath -> Sh FilePath
+canonicalize = absPath >=> liftIO . canonicalizePath
+
+-- | bugfix older version of canonicalizePath (system-fileio <= 0.3.7) loses \
trailing slash +canonicalizePath :: FilePath -> IO FilePath
+canonicalizePath p = let was_dir = FP.null (FP.filename p) in
+ if not was_dir then FS.canonicalizePath p
+ else addTrailingSlash `fmap` FS.canonicalizePath p
+
+data EmptyFilePathError = EmptyFilePathError deriving Typeable
+instance Show EmptyFilePathError where
+ show _ = "Empty filepath"
+instance Exception EmptyFilePathError
+
+-- | Make a relative path absolute by combining with the working directory.
+-- An absolute path is returned as is.
+-- To create a relative path, use 'relPath'.
+absPath :: FilePath -> Sh FilePath
+absPath p | FP.null p = liftIO $ throwIO EmptyFilePathError
+ | relative p = (FP.</> p) <$> gets sDirectory
+ | otherwise = return p
+
+-- | deprecated
+path :: FilePath -> Sh FilePath
+path = absPath
+{-# DEPRECATED path "use absPath, canonic, or relPath instead" #-}
+
+-- | Does a path point to an existing directory?
+test_d :: FilePath -> Sh Bool
+test_d = absPath >=> liftIO . isDirectory
+
+-- | Does a path point to a symlink?
+test_s :: FilePath -> Sh Bool
+test_s = absPath >=> liftIO . \f -> do
+ stat <- getSymbolicLinkStatus (encodeString f)
+ return $ isSymbolicLink stat
+
+unpack :: FilePath -> String
+unpack = encodeString
+
+gets :: (State -> a) -> Sh a
+gets f = f <$> get
+
+get :: Sh State
+get = do
+ stateVar <- ask
+ liftIO (readIORef stateVar)
+
+modify :: (State -> State) -> Sh ()
+modify f = do
+ state <- ask
+ liftIO (modifyIORef state f)
+
+-- | internally log what occurred.
+-- Log will be re-played on failure.
+trace :: Text -> Sh ()
+trace msg + whenM (gets sTracing) $ modify $
+ \st -> st { sTrace = sTrace st `mappend` msg `mappend` "\n" }
+
+-- | List directory contents. Does *not* include \".\" and \"..\", but it does
+-- include (other) hidden files.
+ls :: FilePath -> Sh [FilePath]
+-- it is important to use path and not absPath so that the listing can remain \
relative +ls fp = do
+ trace $ "ls " `mappend` toTextIgnore fp
+ fmap fst $ lsRelAbs fp
+
+lsRelAbs :: FilePath -> Sh ([FilePath], [FilePath])
+lsRelAbs f = absPath f >>= \fp -> do
+ filt <- if not (relative f) then return return
+ else do
+ wd <- gets sDirectory
+ return (relativeTo wd)
+ absolute <- liftIO $ listDirectory fp
+ relativized <- mapM filt absolute
+ return (relativized, absolute)
+
+-- | silently uses the Right or Left value of "Filesystem.Path.CurrentOS.toText"
+toTextIgnore :: FilePath -> Text
+toTextIgnore fp = case FP.toText fp of
+ Left f -> f
+ Right f -> f
+
+-- | a print lifted into 'Sh'
+inspect :: (Show s) => s -> Sh ()
+inspect x = do
+ (trace . T.pack . show) x
+ liftIO $ print x
+
+-- | a print lifted into 'Sh' using stderr
+inspect_err :: (Show s) => s -> Sh ()
+inspect_err x = do
+ let shown = T.pack $ show x
+ trace shown
+ echo_err shown
+
+-- | Echo text to standard (error, when using _err variants) output. The _n
+-- variants do not print a final newline.
+echo, echo_n, echo_err, echo_n_err :: Text -> Sh ()
+echo msg = traceEcho msg >> liftIO (TIO.putStrLn msg >> hFlush stdout)
+echo_n msg = traceEcho msg >> liftIO (TIO.putStr msg >> hFlush stdout)
+echo_err msg = traceEcho msg >> liftIO (TIO.hPutStrLn stderr msg >> hFlush stdout)
+echo_n_err msg = traceEcho msg >> liftIO (TIO.hPutStr stderr msg >> hFlush stderr)
+
+traceEcho :: Text -> Sh ()
+traceEcho msg = trace ("echo " `mappend` "'" `mappend` msg `mappend` "'")
+
+-- | A helper to catch any exception (same as
+-- @... `catch` \(e :: SomeException) -> ...@).
+catchany :: IO a -> (SomeException -> IO a) -> IO a
+catchany = catch
+
addfile ./shelly/src/Shelly/Find.hs
hunk ./shelly/src/Shelly/Find.hs 1
+{-# LANGUAGE OverloadedStrings #-}
+-- | File finding utiliites for Shelly
+-- The basic 'find' takes a dir and gives back a list of files.
+-- If you don't just want a list, use the folding variants like 'findFold'.
+-- If you want to avoid traversing certain directories, use the directory filtering \
variants like 'findDirFilter' +module Shelly.Find
+ (
+ find, findWhen, findFold, findDirFilter, findDirFilterWhen, findFoldDirFilter
+ ) where
+
+import Prelude hiding (FilePath)
+import Shelly.Base
+import Control.Monad (foldM)
+import Data.Monoid (mappend)
+import System.PosixCompat.Files( getSymbolicLinkStatus, isSymbolicLink )
+import Filesystem (isDirectory)
+import Filesystem.Path.CurrentOS (encodeString)
+
+-- | List directory recursively (like the POSIX utility "find").
+-- listing is relative if the path given is relative.
+-- If you want to filter out some results or fold over them you can do that with the \
returned files. +-- A more efficient approach is to use one of the other find \
functions. +find :: FilePath -> Sh [FilePath]
+find = findFold (\paths fp -> return $ paths ++ [fp]) []
+
+-- | 'find' that filters the found files as it finds.
+-- Files must satisfy the given filter to be returned in the result.
+findWhen :: (FilePath -> Sh Bool) -> FilePath -> Sh [FilePath]
+findWhen = findDirFilterWhen (const $ return True)
+
+-- | Fold an arbitrary folding function over files froma a 'find'.
+-- Like 'findWhen' but use a more general fold rather than a filter.
+findFold :: (a -> FilePath -> Sh a) -> a -> FilePath -> Sh a
+findFold folder startValue = findFoldDirFilter folder startValue (const $ return \
True) +
+-- | 'find' that filters out directories as it finds
+-- Filtering out directories can make a find much more efficient by avoiding entire \
trees of files. +findDirFilter :: (FilePath -> Sh Bool) -> FilePath -> Sh [FilePath]
+findDirFilter filt = findDirFilterWhen filt (const $ return True)
+
+-- | similar 'findWhen', but also filter out directories
+-- Alternatively, similar to 'findDirFilter', but also filter out files
+-- Filtering out directories makes the find much more efficient
+findDirFilterWhen :: (FilePath -> Sh Bool) -- ^ directory filter
+ -> (FilePath -> Sh Bool) -- ^ file filter
+ -> FilePath -- ^ directory
+ -> Sh [FilePath]
+findDirFilterWhen dirFilt fileFilter = findFoldDirFilter filterIt [] dirFilt
+ where
+ filterIt paths fp = do
+ yes <- fileFilter fp
+ return $ if yes then paths ++ [fp] else paths
+
+-- | like 'findDirFilterWhen' but use a folding function rather than a filter
+-- The most general finder: you likely want a more specific one
+findFoldDirFilter :: (a -> FilePath -> Sh a) -> a -> (FilePath -> Sh Bool) -> \
FilePath -> Sh a +findFoldDirFilter folder startValue dirFilter dir = do
+ absDir <- absPath dir
+ trace ("find " `mappend` toTextIgnore absDir)
+ filt <- dirFilter absDir
+ if not filt then return startValue
+ -- use possible relative path, not absolute so that listing will remain relative
+ else do
+ (rPaths, aPaths) <- lsRelAbs dir
+ foldM traverse startValue (zip rPaths aPaths)
+ where
+ traverse acc (relativePath, absolutePath) = do
+ -- optimization: don't use Shelly API since our path is already good
+ isDir <- liftIO $ isDirectory absolutePath
+ sym <- liftIO $ fmap isSymbolicLink $ getSymbolicLinkStatus (encodeString \
absolutePath) + newAcc <- folder acc relativePath
+ follow <- fmap sFollowSymlink get
+ if isDir && (follow || not sym)
+ then findFoldDirFilter folder newAcc
+ dirFilter relativePath
+ else return newAcc
addfile ./shelly/src/Shelly/Lifted.hs
hunk ./shelly/src/Shelly/Lifted.hs 1
+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, OverloadedStrings,
+ FlexibleInstances, FlexibleContexts, IncoherentInstances,
+ TypeFamilies, ExistentialQuantification, RankNTypes,
+ ImpredicativeTypes #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-- | A module for shell-like programming in Haskell.
+-- Shelly's focus is entirely on ease of use for those coming from shell scripting.
+-- However, it also tries to use modern libraries and techniques to keep things \
efficient. +--
+-- The functionality provided by
+-- this module is (unlike standard Haskell filesystem functionality)
+-- thread-safe: each Sh maintains its own environment and its own working
+-- directory.
+--
+-- Recommended usage includes putting the following at the top of your program,
+-- otherwise you will likely need either type annotations or type conversions
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > {-# LANGUAGE ExtendedDefaultRules #-}
+-- > {-# OPTIONS_GHC -fno-warn-type-defaults #-}
+-- > import Shelly
+-- > import qualified Data.Text as T
+-- > default (T.Text)
+module Shelly.Lifted
+ (
+ MonadSh(..),
+ MonadShControl(..),
+
+ -- This is copied from Shelly.hs, so that we are sure to export the
+ -- exact same set of symbols. Whenever that export list is updated,
+ -- please make the same updates here and implements the corresponding
+ -- lifted functions.
+
+ -- * Entering Sh.
+ Sh, ShIO, S.shelly, S.shellyNoDir, S.shellyFailDir, sub
+ , silently, verbosely, escaping, print_stdout, print_stderr, print_commands
+ , tracing, errExit
+ , log_stdout_with, log_stderr_with
+
+ -- * Running external commands.
+ , run, run_, runFoldLines, S.cmd, S.FoldCallback
+ , (-|-), lastStderr, setStdin, lastExitCode
+ , command, command_, command1, command1_
+ , sshPairs, sshPairs_
+ , S.ShellCmd(..), S.CmdArg (..)
+
+ -- * Running commands Using handles
+ , runHandle, runHandles, transferLinesAndCombine, S.transferFoldHandleLines
+ , S.StdHandle(..), S.StdStream(..)
+
+
+ -- * Modifying and querying environment.
+ , setenv, get_env, get_env_text, get_env_all, appendToPath, prependToPath
+
+ -- * Environment directory
+ , cd, chdir, chdir_p, pwd
+
+ -- * Printing
+ , echo, echo_n, echo_err, echo_n_err, inspect, inspect_err
+ , tag, trace, S.show_command
+
+ -- * Querying filesystem.
+ , ls, lsT, test_e, test_f, test_d, test_s, test_px, which
+
+ -- * Filename helpers
+ , absPath, (S.</>), (S.<.>), canonic, canonicalize, relPath, relativeTo
+ , S.hasExt
+
+ -- * Manipulating filesystem.
+ , mv, rm, rm_f, rm_rf, cp, cp_r, mkdir, mkdir_p, mkdirTree
+
+ -- * reading/writing Files
+ , readfile, readBinary, writefile, appendfile, touchfile, withTmpDir
+
+ -- * exiting the program
+ , exit, errorExit, quietExit, terror
+
+ -- * Exceptions
+ , bracket_sh, catchany, catch_sh, handle_sh, handleany_sh, finally_sh, \
catches_sh, catchany_sh +
+ -- * convert between Text and FilePath
+ , S.toTextIgnore, toTextWarn, FP.fromText
+
+ -- * Utility Functions
+ , S.whenM, S.unlessM, time, sleep
+
+ -- * Re-exported for your convenience
+ , liftIO, S.when, S.unless, FilePath, (S.<$>)
+
+ -- * internal functions for writing extensions
+ , Shelly.Lifted.get, Shelly.Lifted.put
+
+ -- * find functions
+ , S.find, S.findWhen, S.findFold, S.findDirFilter, S.findDirFilterWhen, \
S.findFoldDirFilter + , followSymlink
+ ) where
+
+import qualified Shelly as S
+import Shelly.Base (Sh(..), ShIO, Text, (>=>), FilePath)
+import qualified Shelly.Base as S
+import Control.Monad ( liftM )
+import Prelude hiding ( FilePath )
+import Data.ByteString ( ByteString )
+import Data.Monoid
+import System.IO ( Handle )
+import Data.Tree ( Tree )
+import qualified Filesystem.Path.CurrentOS as FP
+
+import Control.Exception.Lifted
+import Control.Exception.Enclosed
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Control
+import Control.Monad.Trans.Identity
+import Control.Monad.Trans.List
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Cont
+import Control.Monad.Trans.Error
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.State
+import qualified Control.Monad.Trans.State.Strict as Strict
+import Control.Monad.Trans.Writer
+import qualified Control.Monad.Trans.Writer.Strict as Strict
+import qualified Control.Monad.Trans.RWS as RWS
+import qualified Control.Monad.Trans.RWS.Strict as Strict
+
+class Monad m => MonadSh m where
+ liftSh :: Sh a -> m a
+
+instance MonadSh Sh where
+ liftSh = id
+
+instance MonadSh m => MonadSh (IdentityT m) where
+ liftSh = IdentityT . liftSh
+instance MonadSh m => MonadSh (ListT m) where
+ liftSh m = ListT $ do
+ a <- liftSh m
+ return [a]
+instance MonadSh m => MonadSh (MaybeT m) where
+ liftSh = MaybeT . liftM Just . liftSh
+instance MonadSh m => MonadSh (ContT r m) where
+ liftSh m = ContT (liftSh m >>=)
+instance (Error e, MonadSh m) => MonadSh (ErrorT e m) where
+ liftSh m = ErrorT $ do
+ a <- liftSh m
+ return (Right a)
+instance MonadSh m => MonadSh (ReaderT r m) where
+ liftSh = ReaderT . const . liftSh
+instance MonadSh m => MonadSh (StateT s m) where
+ liftSh m = StateT $ \s -> do
+ a <- liftSh m
+ return (a, s)
+instance MonadSh m => MonadSh (Strict.StateT s m) where
+ liftSh m = Strict.StateT $ \s -> do
+ a <- liftSh m
+ return (a, s)
+instance (Monoid w, MonadSh m) => MonadSh (WriterT w m) where
+ liftSh m = WriterT $ do
+ a <- liftSh m
+ return (a, mempty :: w)
+instance (Monoid w, MonadSh m) => MonadSh (Strict.WriterT w m) where
+ liftSh m = Strict.WriterT $ do
+ a <- liftSh m
+ return (a, mempty :: w)
+instance (Monoid w, MonadSh m) => MonadSh (RWS.RWST r w s m) where
+ liftSh m = RWS.RWST $ \_ s -> do
+ a <- liftSh m
+ return (a, s, mempty :: w)
+instance (Monoid w, MonadSh m) => MonadSh (Strict.RWST r w s m) where
+ liftSh m = Strict.RWST $ \_ s -> do
+ a <- liftSh m
+ return (a, s, mempty :: w)
+
+instance MonadSh m => S.ShellCmd (m Text) where
+ cmdAll = (liftSh .) . S.run
+
+instance (MonadSh m, s ~ Text, Show s) => S.ShellCmd (m s) where
+ cmdAll = (liftSh .) . S.run
+
+instance MonadSh m => S.ShellCmd (m ()) where
+ cmdAll = (liftSh .) . S.run_
+
+class Monad m => MonadShControl m where
+ data ShM m a :: *
+ liftShWith :: ((forall x. m x -> Sh (ShM m x)) -> Sh a) -> m a
+ restoreSh :: ShM m a -> m a
+
+instance MonadShControl Sh where
+ newtype ShM Sh a = ShSh a
+ liftShWith f = f $ liftM ShSh
+ restoreSh (ShSh x) = return x
+ {-# INLINE liftShWith #-}
+ {-# INLINE restoreSh #-}
+
+instance MonadShControl m => MonadShControl (ListT m) where
+ newtype ShM (ListT m) a = ListTShM (ShM m [a])
+ liftShWith f + ListT $ liftM return $ liftShWith $ \runInSh -> f $ \k ->
+ liftM ListTShM $ runInSh $ runListT k
+ restoreSh (ListTShM m) = ListT . restoreSh $ m
+ {-# INLINE liftShWith #-}
+ {-# INLINE restoreSh #-}
+
+instance MonadShControl m => MonadShControl (MaybeT m) where
+ newtype ShM (MaybeT m) a = MaybeTShM (ShM m (Maybe a))
+ liftShWith f + MaybeT $ liftM return $ liftShWith $ \runInSh -> f $ \k ->
+ liftM MaybeTShM $ runInSh $ runMaybeT k
+ restoreSh (MaybeTShM m) = MaybeT . restoreSh $ m
+ {-# INLINE liftShWith #-}
+ {-# INLINE restoreSh #-}
+
+instance MonadShControl m
+ => MonadShControl (IdentityT m) where
+ newtype ShM (IdentityT m) a = IdentityTShM (ShM m a)
+ liftShWith f + IdentityT $ liftM id $ liftShWith $ \runInSh -> f $ \k ->
+ liftM IdentityTShM $ runInSh $ runIdentityT k
+ restoreSh (IdentityTShM m) = IdentityT . restoreSh $ m
+ {-# INLINE liftShWith #-}
+ {-# INLINE restoreSh #-}
+
+instance (MonadShControl m, Monoid w)
+ => MonadShControl (WriterT w m) where
+ newtype ShM (WriterT w m) a = WriterTShM (ShM m (a, w))
+ liftShWith f + WriterT $ liftM (\x -> (x, mempty :: w)) $ liftShWith $ \
\runInSh -> f $ \k -> + liftM WriterTShM $ runInSh $ runWriterT k
+ restoreSh (WriterTShM m) = WriterT . restoreSh $ m
+ {-# INLINE liftShWith #-}
+ {-# INLINE restoreSh #-}
+
+instance (MonadShControl m, Monoid w)
+ => MonadShControl (Strict.WriterT w m) where
+ newtype ShM (Strict.WriterT w m) a = StWriterTShM (ShM m (a, w))
+ liftShWith f + Strict.WriterT $ liftM (\x -> (x, mempty :: w)) $ \
liftShWith $ \runInSh -> f $ \k -> + liftM StWriterTShM $ runInSh $ \
Strict.runWriterT k + restoreSh (StWriterTShM m) = Strict.WriterT . restoreSh $ m
+ {-# INLINE liftShWith #-}
+ {-# INLINE restoreSh #-}
+
+instance (MonadShControl m, Error e)
+ => MonadShControl (ErrorT e m) where
+ newtype ShM (ErrorT e m) a = ErrorTShM (ShM m (Either e a))
+ liftShWith f + ErrorT $ liftM return $ liftShWith $ \runInSh -> f $ \k ->
+ liftM ErrorTShM $ runInSh $ runErrorT k
+ restoreSh (ErrorTShM m) = ErrorT . restoreSh $ m
+ {-# INLINE liftShWith #-}
+ {-# INLINE restoreSh #-}
+
+instance MonadShControl m => MonadShControl (StateT s m) where
+ newtype ShM (StateT s m) a = StateTShM (ShM m (a, s))
+ liftShWith f = StateT $ \s ->
+ liftM (\x -> (x,s)) $ liftShWith $ \runInSh -> f $ \k ->
+ liftM StateTShM $ runInSh $ runStateT k s
+ restoreSh (StateTShM m) = StateT . const . restoreSh $ m
+ {-# INLINE liftShWith #-}
+ {-# INLINE restoreSh #-}
+
+instance MonadShControl m => MonadShControl (Strict.StateT s m) where
+ newtype ShM (Strict.StateT s m) a = StStateTShM (ShM m (a, s))
+ liftShWith f = Strict.StateT $ \s ->
+ liftM (\x -> (x,s)) $ liftShWith $ \runInSh -> f $ \k ->
+ liftM StStateTShM $ runInSh $ Strict.runStateT k s
+ restoreSh (StStateTShM m) = Strict.StateT . const . restoreSh $ m
+ {-# INLINE liftShWith #-}
+ {-# INLINE restoreSh #-}
+
+instance MonadShControl m => MonadShControl (ReaderT r m) where
+ newtype ShM (ReaderT r m) a = ReaderTShM (ShM m a)
+ liftShWith f = ReaderT $ \r ->
+ liftM id $ liftShWith $ \runInSh -> f $ \k ->
+ liftM ReaderTShM $ runInSh $ runReaderT k r
+ restoreSh (ReaderTShM m) = ReaderT . const . restoreSh $ m
+ {-# INLINE liftShWith #-}
+ {-# INLINE restoreSh #-}
+
+instance (MonadShControl m, Monoid w)
+ => MonadShControl (RWS.RWST r w s m) where
+ newtype ShM (RWS.RWST r w s m) a = RWSTShM (ShM m (a, s ,w))
+ liftShWith f = RWS.RWST $ \r s ->
+ liftM (\x -> (x,s,mempty :: w)) $ liftShWith $ \runInSh -> f $ \k ->
+ liftM RWSTShM $ runInSh $ RWS.runRWST k r s
+ restoreSh (RWSTShM m) = RWS.RWST . const . const . restoreSh $ m
+ {-# INLINE liftShWith #-}
+ {-# INLINE restoreSh #-}
+
+instance (MonadShControl m, Monoid w)
+ => MonadShControl (Strict.RWST r w s m) where
+ newtype ShM (Strict.RWST r w s m) a = StRWSTShM (ShM m (a, s, w))
+ liftShWith f = Strict.RWST $ \r s ->
+ liftM (\x -> (x,s,mempty :: w)) $ liftShWith $ \runInSh -> f $ \k ->
+ liftM StRWSTShM $ runInSh $ Strict.runRWST k r s
+ restoreSh (StRWSTShM m) = Strict.RWST . const . const . restoreSh $ m
+ {-# INLINE liftShWith #-}
+ {-# INLINE restoreSh #-}
+
+controlSh :: MonadShControl m => ((forall x. m x -> Sh (ShM m x)) -> Sh (ShM m a)) \
-> m a +controlSh = liftShWith >=> restoreSh
+{-# INLINE controlSh #-}
+
+tag :: (MonadShControl m, MonadSh m) => m a -> Text -> m a
+tag action msg = controlSh $ \runInSh -> S.tag (runInSh action) msg
+
+chdir :: MonadShControl m => FilePath -> m a -> m a
+chdir dir action = controlSh $ \runInSh -> S.chdir dir (runInSh action)
+
+chdir_p :: MonadShControl m => FilePath -> m a -> m a
+chdir_p dir action = controlSh $ \runInSh -> S.chdir_p dir (runInSh action)
+
+silently :: MonadShControl m => m a -> m a
+silently a = controlSh $ \runInSh -> S.silently (runInSh a)
+
+verbosely :: MonadShControl m => m a -> m a
+verbosely a = controlSh $ \runInSh -> S.verbosely (runInSh a)
+
+log_stdout_with :: MonadShControl m => (Text -> IO ()) -> m a -> m a
+log_stdout_with logger a = controlSh $ \runInSh -> S.log_stdout_with logger (runInSh \
a) +
+log_stderr_with :: MonadShControl m => (Text -> IO ()) -> m a -> m a
+log_stderr_with logger a = controlSh $ \runInSh -> S.log_stderr_with logger (runInSh \
a) +
+print_stdout :: MonadShControl m => Bool -> m a -> m a
+print_stdout shouldPrint a = controlSh $ \runInSh -> S.print_stdout shouldPrint \
(runInSh a) +
+print_stderr :: MonadShControl m => Bool -> m a -> m a
+print_stderr shouldPrint a = controlSh $ \runInSh -> S.print_stderr shouldPrint \
(runInSh a) +
+print_commands :: MonadShControl m => Bool -> m a -> m a
+print_commands shouldPrint a = controlSh $ \runInSh -> S.print_commands shouldPrint \
(runInSh a) +
+sub :: MonadShControl m => m a -> m a
+sub a = controlSh $ \runInSh -> S.sub (runInSh a)
+
+trace :: MonadSh m => Text -> m ()
+trace = liftSh . S.trace
+
+tracing :: MonadShControl m => Bool -> m a -> m a
+tracing shouldTrace action = controlSh $ \runInSh -> S.tracing shouldTrace (runInSh \
action) +
+escaping :: MonadShControl m => Bool -> m a -> m a
+escaping shouldEscape action = controlSh $ \runInSh -> S.escaping shouldEscape \
(runInSh action) +
+errExit :: MonadShControl m => Bool -> m a -> m a
+errExit shouldExit action = controlSh $ \runInSh -> S.errExit shouldExit (runInSh \
action) +
+followSymlink :: MonadShControl m => Bool -> m a -> m a
+followSymlink enableFollowSymlink action = controlSh $ \runInSh -> S.followSymlink \
enableFollowSymlink (runInSh action) +
+(-|-) :: (MonadShControl m, MonadSh m) => m Text -> m b -> m b
+one -|- two = controlSh $ \runInSh -> do
+ x <- runInSh one
+ runInSh $ restoreSh x >>= \x' ->
+ controlSh $ \runInSh' -> return x' S.-|- runInSh' two
+
+withTmpDir :: MonadShControl m => (FilePath -> m a) -> m a
+withTmpDir action = controlSh $ \runInSh -> S.withTmpDir (fmap runInSh action)
+
+time :: MonadShControl m => m a -> m (Double, a)
+time what = controlSh $ \runInSh -> do
+ (d, a) <- S.time (runInSh what)
+ runInSh $ restoreSh a >>= \x -> return (d, x)
+
+toTextWarn :: MonadSh m => FilePath -> m Text
+toTextWarn = liftSh . toTextWarn
+
+transferLinesAndCombine :: MonadIO m => Handle -> (Text -> IO ()) -> m Text
+transferLinesAndCombine = (liftIO .) . S.transferLinesAndCombine
+
+get :: MonadSh m => m S.State
+get = liftSh S.get
+
+put :: MonadSh m => S.State -> m ()
+put = liftSh . S.put
+
+catch_sh :: (Exception e) => Sh a -> (e -> Sh a) -> Sh a
+catch_sh = Control.Exception.Lifted.catch
+{-# DEPRECATED catch_sh "use Control.Exception.Lifted.catch instead" #-}
+
+handle_sh :: (Exception e) => (e -> Sh a) -> Sh a -> Sh a
+handle_sh = handle
+{-# DEPRECATED handle_sh "use Control.Exception.Lifted.handle instead" #-}
+
+finally_sh :: Sh a -> Sh b -> Sh a
+finally_sh = finally
+{-# DEPRECATED finally_sh "use Control.Exception.Lifted.finally instead" #-}
+
+bracket_sh :: Sh a -> (a -> Sh b) -> (a -> Sh c) -> Sh c
+bracket_sh = bracket
+{-# DEPRECATED bracket_sh "use Control.Exception.Lifted.bracket instead" #-}
+
+catches_sh :: Sh a -> [Handler Sh a] -> Sh a
+catches_sh = catches
+{-# DEPRECATED catches_sh "use Control.Exception.Lifted.catches instead" #-}
+
+catchany_sh :: Sh a -> (SomeException -> Sh a) -> Sh a
+catchany_sh = catchAny
+{-# DEPRECATED catchany_sh "use Control.Exception.Enclosed.catchAny instead" #-}
+
+handleany_sh :: (SomeException -> Sh a) -> Sh a -> Sh a
+handleany_sh = handleAny
+{-# DEPRECATED handleany_sh "use Control.Exception.Enclosed.handleAny instead" #-}
+
+cd :: MonadSh m => FilePath -> m ()
+cd = liftSh . S.cd
+
+mv :: MonadSh m => FilePath -> FilePath -> m ()
+mv = (liftSh .) . S.mv
+
+lsT :: MonadSh m => FilePath -> m [Text]
+lsT = liftSh . S.lsT
+
+pwd :: MonadSh m => m FilePath
+pwd = liftSh S.pwd
+
+exit :: MonadSh m => Int -> m a
+exit = liftSh . S.exit
+
+errorExit :: MonadSh m => Text -> m a
+errorExit = liftSh . S.errorExit
+
+quietExit :: MonadSh m => Int -> m a
+quietExit = liftSh . S.quietExit
+
+terror :: MonadSh m => Text -> m a
+terror = liftSh . S.terror
+
+mkdir :: MonadSh m => FilePath -> m ()
+mkdir = liftSh . S.mkdir
+
+mkdir_p :: MonadSh m => FilePath -> m ()
+mkdir_p = liftSh . S.mkdir_p
+
+mkdirTree :: MonadSh m => Tree FilePath -> m ()
+mkdirTree = liftSh . S.mkdirTree
+
+which :: MonadSh m => FilePath -> m (Maybe FilePath)
+which = liftSh . S.which
+
+test_e :: MonadSh m => FilePath -> m Bool
+test_e = liftSh . S.test_e
+
+test_f :: MonadSh m => FilePath -> m Bool
+test_f = liftSh . S.test_f
+
+test_px :: MonadSh m => FilePath -> m Bool
+test_px = liftSh . S.test_px
+
+rm_rf :: MonadSh m => FilePath -> m ()
+rm_rf = liftSh . S.rm_rf
+
+rm_f :: MonadSh m => FilePath -> m ()
+rm_f = liftSh . S.rm_f
+
+rm :: MonadSh m => FilePath -> m ()
+rm = liftSh . S.rm
+
+setenv :: MonadSh m => Text -> Text -> m ()
+setenv = (liftSh .) . S.setenv
+
+appendToPath :: MonadSh m => FilePath -> m ()
+appendToPath = liftSh . S.appendToPath
+
+prependToPath :: MonadSh m => FilePath -> m ()
+prependToPath = liftSh . S.prependToPath
+
+get_env_all :: MonadSh m => m [(String, String)]
+get_env_all = liftSh S.get_env_all
+
+get_env :: MonadSh m => Text -> m (Maybe Text)
+get_env = liftSh . S.get_env
+
+get_env_text :: MonadSh m => Text -> m Text
+get_env_text = liftSh . S.get_env_text
+
+sshPairs_ :: MonadSh m => Text -> [(FilePath, [Text])] -> m ()
+sshPairs_ = (liftSh .) . S.sshPairs_
+
+sshPairs :: MonadSh m => Text -> [(FilePath, [Text])] -> m Text
+sshPairs = (liftSh .) . S.sshPairs
+
+run :: MonadSh m => FilePath -> [Text] -> m Text
+run = (liftSh .) . S.run
+
+command :: MonadSh m => FilePath -> [Text] -> [Text] -> m Text
+command com args more_args + liftSh $ S.command com args more_args
+
+command_ :: MonadSh m => FilePath -> [Text] -> [Text] -> m ()
+command_ com args more_args + liftSh $ S.command_ com args more_args
+
+command1 :: MonadSh m => FilePath -> [Text] -> Text -> [Text] -> m Text
+command1 com args one_arg more_args + liftSh $ S.command1 com args one_arg \
more_args +
+command1_ :: MonadSh m => FilePath -> [Text] -> Text -> [Text] -> m ()
+command1_ com args one_arg more_args + liftSh $ S.command1_ com args one_arg \
more_args +
+run_ :: MonadSh m => FilePath -> [Text] -> m ()
+run_ = (liftSh .) . S.run_
+
+runHandle :: MonadShControl m => FilePath -- ^ command
+ -> [Text] -- ^ arguments
+ -> (Handle -> m a) -- ^ stdout handle
+ -> m a
+runHandle exe args withHandle + controlSh $ \runInSh -> S.runHandle exe args \
(fmap runInSh withHandle) +
+runHandles :: MonadShControl m => FilePath -- ^ command
+ -> [Text] -- ^ arguments
+ -> [S.StdHandle] -- ^ optionally connect process i/o handles to existing \
handles + -> (Handle -> Handle -> Handle -> m a) -- ^ stdin, stdout and \
stderr + -> m a
+runHandles exe args reusedHandles withHandles + controlSh $ \runInSh ->
+ S.runHandles exe args reusedHandles (fmap (fmap (fmap runInSh)) withHandles)
+
+runFoldLines :: MonadSh m => a -> S.FoldCallback a -> FilePath -> [Text] -> m a
+runFoldLines start cb exe args = liftSh $ S.runFoldLines start cb exe args
+
+lastStderr :: MonadSh m => m Text
+lastStderr = liftSh S.lastStderr
+
+lastExitCode :: MonadSh m => m Int
+lastExitCode = liftSh S.lastExitCode
+
+setStdin :: MonadSh m => Text -> m ()
+setStdin = liftSh . S.setStdin
+
+cp_r :: MonadSh m => FilePath -> FilePath -> m ()
+cp_r = (liftSh .) . S.cp_r
+
+cp :: MonadSh m => FilePath -> FilePath -> m ()
+cp = (liftSh .) . S.cp
+
+writefile :: MonadSh m => FilePath -> Text -> m ()
+writefile = (liftSh .) . S.writefile
+
+touchfile :: MonadSh m => FilePath -> m ()
+touchfile = liftSh . S.touchfile
+
+appendfile :: MonadSh m => FilePath -> Text -> m ()
+appendfile = (liftSh .) . S.appendfile
+
+readfile :: MonadSh m => FilePath -> m Text
+readfile = liftSh . S.readfile
+
+readBinary :: MonadSh m => FilePath -> m ByteString
+readBinary = liftSh . S.readBinary
+
+sleep :: MonadSh m => Int -> m ()
+sleep = liftSh . S.sleep
+
+echo, echo_n, echo_err, echo_n_err :: MonadSh m => Text -> m ()
+echo = liftSh . S.echo
+echo_n = liftSh . S.echo_n
+echo_err = liftSh . S.echo_err
+echo_n_err = liftSh . S.echo_n_err
+
+relPath :: MonadSh m => FilePath -> m FilePath
+relPath = liftSh . S.relPath
+
+relativeTo :: MonadSh m => FilePath -- ^ anchor path, the prefix
+ -> FilePath -- ^ make this relative to anchor path
+ -> m FilePath
+relativeTo = (liftSh .) . S.relativeTo
+
+canonic :: MonadSh m => FilePath -> m FilePath
+canonic = liftSh . canonic
+
+-- | Obtain a (reasonably) canonic file path to a filesystem object. Based on
+-- "canonicalizePath" in system-fileio.
+canonicalize :: MonadSh m => FilePath -> m FilePath
+canonicalize = liftSh . S.canonicalize
+
+absPath :: MonadSh m => FilePath -> m FilePath
+absPath = liftSh . S.absPath
+
+test_d :: MonadSh m => FilePath -> m Bool
+test_d = liftSh . S.test_d
+
+test_s :: MonadSh m => FilePath -> m Bool
+test_s = liftSh . S.test_s
+
+ls :: MonadSh m => FilePath -> m [FilePath]
+ls = liftSh . S.ls
+
+inspect :: (Show s, MonadSh m) => s -> m ()
+inspect = liftSh . S.inspect
+
+inspect_err :: (Show s, MonadSh m) => s -> m ()
+inspect_err = liftSh . S.inspect_err
+
+catchany :: MonadBaseControl IO m => m a -> (SomeException -> m a) -> m a
+catchany = Control.Exception.Lifted.catch
addfile ./shelly/src/Shelly/Pipe.hs
hunk ./shelly/src/Shelly/Pipe.hs 1
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances,
+ TypeFamilies, ExistentialQuantification #-}
+-- | This module is a wrapper for the module "Shelly".
+-- The only difference is a main type 'Sh'. In this module
+-- 'Sh' contains a list of results. Actual definition of the type 'Sh' is:
+--
+-- > import qualified Shelly as S
+-- >
+-- > newtype Sh a = Sh { unSh :: S.Sh [a] }
+--
+-- This definition can simplify some filesystem commands.
+-- A monad bind operator becomes a pipe operator and we can write
+--
+-- > findExt ext = findWhen (pure . hasExt ext)
+-- >
+-- > main :: IO ()
+-- > main = shs $ do
+-- > mkdir "new"
+-- > findExt "hs" "." >>= flip cp "new"
+-- > findExt "cpp" "." >>= rm_f
+-- > liftIO $ putStrLn "done"
+--
+-- Monad methods "return" and ">>=" behave like methods for
+-- @ListT Shelly.Sh@, but ">>" forgets the number of
+-- the empty effects. So the last line prints @\"done\"@ only once.
+--
+-- Documentation in this module mostly just reference documentation from
+-- the main "Shelly" module.
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > {-# LANGUAGE ExtendedDefaultRules #-}
+-- > {-# OPTIONS_GHC -fno-warn-type-defaults #-}
+-- > import Shelly
+-- > import Data.Text as T
+-- > default (T.Text)
+module Shelly.Pipe
+ (
+ -- * Entering Sh.
+ Sh, shs, shelly, shellyFailDir, shsFailDir, sub, silently, verbosely, \
escaping, print_stdout, print_commands, tracing, errExit, log_stdout_with, \
log_stderr_with + -- * List functions
+ , roll, unroll, liftSh
+ -- * Running external commands.
+ , FoldCallback
+ , run, run_, runFoldLines, cmd
+ , (-|-), lastStderr, setStdin, lastExitCode
+ , command, command_, command1, command1_
+ , sshPairs, sshPairs_
+
+ -- * Modifying and querying environment.
+ , setenv, get_env, get_env_text, get_env_def, appendToPath, prependToPath
+
+ -- * Environment directory
+ , cd, chdir, pwd
+
+ -- * Printing
+ , echo, echo_n, echo_err, echo_n_err, inspect, inspect_err
+ , tag, trace, show_command
+
+ -- * Querying filesystem.
+ , ls, lsT, test_e, test_f, test_d, test_s, which
+
+ -- * Filename helpers
+ , absPath, (</>), (<.>), canonic, canonicalize, relPath, relativeTo
+ , hasExt
+
+ -- * Manipulating filesystem.
+ , mv, rm, rm_f, rm_rf, cp, cp_r, mkdir, mkdir_p, mkdirTree
+
+ -- * reading/writing Files
+ , readfile, readBinary, writefile, appendfile, touchfile, withTmpDir
+
+ -- * exiting the program
+ , exit, errorExit, quietExit, terror
+
+ -- * Exceptions
+ , catchany, catch_sh, finally_sh
+ , ShellyHandler(..), catches_sh
+ , catchany_sh
+
+ -- * convert between Text and FilePath
+ , toTextIgnore, toTextWarn, fromText
+
+ -- * Utilities.
+ , (<$>), whenM, unlessM, time
+
+ -- * Re-exported for your convenience
+ , liftIO, when, unless, FilePath
+
+ -- * internal functions for writing extensions
+ , get, put
+
+ -- * find functions
+ , find, findWhen, findFold
+ , findDirFilter, findDirFilterWhen, findFoldDirFilter
+ , followSymlink
+ ) where
+
+import Prelude hiding (FilePath)
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Trans
+import Control.Exception hiding (handle)
+
+import Filesystem.Path(FilePath)
+
+import qualified Shelly as S
+
+import Shelly(
+ (</>), (<.>), hasExt
+ , whenM, unlessM, toTextIgnore
+ , fromText, catchany
+ , FoldCallback)
+
+import Data.Maybe(fromMaybe)
+import Shelly.Base(State)
+import Data.ByteString (ByteString)
+
+import Data.Tree(Tree)
+
+import Data.Text as T hiding (concat, all, find, cons)
+
+
+-- | This type is a simple wrapper for a type @Shelly.Sh@.
+-- 'Sh' contains a list of results.
+newtype Sh a = Sh { unSh :: S.Sh [a] }
+
+instance Functor Sh where
+ fmap f = Sh . fmap (fmap f) . unSh
+
+instance Monad Sh where
+ return = Sh . return . return
+ a >>= f = Sh $ fmap concat $ mapM (unSh . f) =<< unSh a
+ a >> b = Sh $ unSh a >> unSh b
+
+instance Applicative Sh where
+ pure = return
+ (<*>) = ap
+
+instance Alternative Sh where
+ empty = mzero
+ (<|>) = mplus
+
+instance MonadPlus Sh where
+ mzero = Sh $ return []
+ mplus a b = Sh $ liftA2 (++) (unSh a) (unSh b)
+
+instance MonadIO Sh where
+ liftIO = sh1 liftIO
+
+-------------------------------------------------------
+-- converters
+
+sh0 :: S.Sh a -> Sh a
+sh0 = Sh . fmap return
+
+sh1 :: (a -> S.Sh b) -> (a -> Sh b)
+sh1 f = \a -> sh0 (f a)
+
+sh2 :: (a1 -> a2 -> S.Sh b) -> (a1 -> a2 -> Sh b)
+sh2 f = \a b -> sh0 (f a b)
+
+sh3 :: (a1 -> a2 -> a3 -> S.Sh b) -> (a1 -> a2 -> a3 -> Sh b)
+sh3 f = \a b c -> sh0 (f a b c)
+
+sh4 :: (a1 -> a2 -> a3 -> a4 -> S.Sh b) -> (a1 -> a2 -> a3 -> a4 -> Sh b)
+sh4 f = \a b c d -> sh0 (f a b c d)
+
+sh0s :: S.Sh [a] -> Sh a
+sh0s = Sh
+
+sh1s :: (a -> S.Sh [b]) -> (a -> Sh b)
+sh1s f = \a -> sh0s (f a)
+
+{- Just in case ...
+sh2s :: (a1 -> a2 -> S.Sh [b]) -> (a1 -> a2 -> Sh b)
+sh2s f = \a b -> sh0s (f a b)
+
+sh3s :: (a1 -> a2 -> a3 -> S.Sh [b]) -> (a1 -> a2 -> a3 -> Sh b)
+sh3s f = \a b c -> sh0s (f a b c)
+-}
+
+lift1 :: (S.Sh a -> S.Sh b) -> (Sh a -> Sh b)
+lift1 f = Sh . (mapM (f . return) =<< ) . unSh
+
+lift2 :: (S.Sh a -> S.Sh b -> S.Sh c) -> (Sh a -> Sh b -> Sh c)
+lift2 f a b = Sh $ join $ liftA2 (mapM2 f') (unSh a) (unSh b)
+ where f' = \x y -> f (return x) (return y)
+
+mapM2 :: Monad m => (a -> b -> m c)-> [a] -> [b] -> m [c]
+mapM2 f as bs = sequence $ liftA2 f as bs
+
+-----------------------------------------------------------
+
+-- | Unpack list of results.
+unroll :: Sh a -> Sh [a]
+unroll = Sh . fmap return . unSh
+
+-- | Pack list of results. It performs @concat@ inside 'Sh'.
+roll :: Sh [a] -> Sh a
+roll = Sh . fmap concat . unSh
+
+-- | Transform result as list. It can be useful for filtering.
+liftSh :: ([a] -> [b]) -> Sh a -> Sh b
+liftSh f = Sh . fmap f . unSh
+
+------------------------------------------------------------------
+-- Entering Sh
+
+-- | see 'S.shelly'
+shelly :: MonadIO m => Sh a -> m [a]
+shelly = S.shelly . unSh
+
+-- | Performs 'shelly' and then an empty action @return ()@.
+shs :: MonadIO m => Sh () -> m ()
+shs x = shelly x >> return ()
+
+-- | see 'S.shellyFailDir'
+shellyFailDir :: MonadIO m => Sh a -> m [a]
+shellyFailDir = S.shellyFailDir . unSh
+
+-- | Performs 'shellyFailDir' and then an empty action @return ()@.
+shsFailDir :: MonadIO m => Sh () -> m ()
+shsFailDir x = shellyFailDir x >> return ()
+
+-- | see 'S.sub'
+sub :: Sh a -> Sh a
+sub = lift1 S.sub
+
+-- See 'S.siliently'
+silently :: Sh a -> Sh a
+silently = lift1 S.silently
+
+-- See 'S.verbosely
+verbosely :: Sh a -> Sh a
+verbosely = lift1 S.verbosely
+
+-- | see 'S.escaping'
+escaping :: Bool -> Sh a -> Sh a
+escaping b = lift1 (S.escaping b)
+
+-- | see 'S.log_stdout_with'
+log_stdout_with :: (Text -> IO ()) -> Sh a -> Sh a
+log_stdout_with logger = lift1 (S.log_stdout_with logger)
+
+-- | see 'S.log_stderr_with'
+log_stderr_with :: (Text -> IO ()) -> Sh a -> Sh a
+log_stderr_with logger = lift1 (S.log_stdout_with logger)
+
+-- | see 'S.print_stdout'
+print_stdout :: Bool -> Sh a -> Sh a
+print_stdout b = lift1 (S.print_stdout b)
+
+-- | see 'S.print_commands
+print_commands :: Bool -> Sh a -> Sh a
+print_commands b = lift1 (S.print_commands b)
+
+-- | see 'S.tracing'
+tracing :: Bool -> Sh a -> Sh a
+tracing b = lift1 (S.tracing b)
+
+-- | see 'S.errExit'
+errExit :: Bool -> Sh a -> Sh a
+errExit b = lift1 (S.errExit b)
+
+-- | see 'S.followSymlink'
+followSymlink :: Bool -> Sh a -> Sh a
+followSymlink b = lift1 (S.followSymlink b)
+
+-- | see 'S.run'
+run :: FilePath -> [Text] -> Sh Text
+run a b = sh0 $ S.run a b
+
+-- | see 'S.run_'
+run_ :: FilePath -> [Text] -> Sh ()
+run_ a b = sh0 $ S.run_ a b
+
+-- | see 'S.runFoldLines'
+runFoldLines :: a -> FoldCallback a -> FilePath -> [Text] -> Sh a
+runFoldLines a cb fp ts = sh0 $ S.runFoldLines a cb fp ts
+
+-- | see 'S.-|-'
+(-|-) :: Sh Text -> Sh b -> Sh b
+(-|-) = lift2 (S.-|-)
+
+-- | see 'S.lastStderr'
+lastStderr :: Sh Text
+lastStderr = sh0 S.lastStderr
+
+-- | see 'S.setStdin'
+setStdin :: Text -> Sh ()
+setStdin = sh1 S.setStdin
+
+-- | see 'S.lastExitCode'
+lastExitCode :: Sh Int
+lastExitCode = sh0 S.lastExitCode
+
+-- | see 'S.command'
+command :: FilePath -> [Text] -> [Text] -> Sh Text
+command = sh3 S.command
+
+-- | see 'S.command_'
+command_ :: FilePath -> [Text] -> [Text] -> Sh ()
+command_ = sh3 S.command_
+
+
+-- | see 'S.command1'
+command1 :: FilePath -> [Text] -> Text -> [Text] -> Sh Text
+command1 = sh4 S.command1
+
+-- | see 'S.command1_'
+command1_ :: FilePath -> [Text] -> Text -> [Text] -> Sh ()
+command1_ = sh4 S.command1_
+
+-- | see 'S.sshPairs'
+sshPairs :: Text -> [(FilePath, [Text])] -> Sh Text
+sshPairs = sh2 S.sshPairs
+
+-- | see 'S.sshPairs_'
+sshPairs_ :: Text -> [(FilePath, [Text])] -> Sh ()
+sshPairs_ = sh2 S.sshPairs_
+
+-- | see 'S.setenv'
+setenv :: Text -> Text -> Sh ()
+setenv = sh2 S.setenv
+
+-- | see 'S.get_env'
+get_env :: Text -> Sh (Maybe Text)
+get_env = sh1 S.get_env
+
+-- | see 'S.get_env_text'
+get_env_text :: Text -> Sh Text
+get_env_text = sh1 S.get_env_text
+
+-- | see 'S.get_env_def'
+get_env_def :: Text -> Text -> Sh Text
+get_env_def a d = sh0 $ fmap (fromMaybe d) $ S.get_env a
+{-# DEPRECATED get_env_def "use fromMaybe DEFAULT get_env" #-}
+
+-- | see 'S.appendToPath'
+appendToPath :: FilePath -> Sh ()
+appendToPath = sh1 S.appendToPath
+
+-- | see 'S.prependToPath'
+prependToPath :: FilePath -> Sh ()
+prependToPath = sh1 S.prependToPath
+
+-- | see 'S.cd'
+cd :: FilePath -> Sh ()
+cd = sh1 S.cd
+
+-- | see 'S.chdir'
+chdir :: FilePath -> Sh a -> Sh a
+chdir p = lift1 (S.chdir p)
+
+-- | see 'S.pwd'
+pwd :: Sh FilePath
+pwd = sh0 S.pwd
+
+-----------------------------------------------------------------
+-- Printing
+
+-- | Echo text to standard (error, when using _err variants) output. The _n
+-- variants do not print a final newline.
+echo, echo_n_err, echo_err, echo_n :: Text -> Sh ()
+
+echo = sh1 S.echo
+echo_n_err = sh1 S.echo_n_err
+echo_err = sh1 S.echo_err
+echo_n = sh1 S.echo_n
+
+-- | see 'S.inspect'
+inspect :: Show s => s -> Sh ()
+inspect = sh1 S.inspect
+
+-- | see 'S.inspect_err'
+inspect_err :: Show s => s -> Sh ()
+inspect_err = sh1 S.inspect_err
+
+-- | see 'S.tag'
+tag :: Sh a -> Text -> Sh a
+tag a t = lift1 (flip S.tag t) a
+
+-- | see 'S.trace'
+trace :: Text -> Sh ()
+trace = sh1 S.trace
+
+-- | see 'S.show_command'
+show_command :: FilePath -> [Text] -> Text
+show_command = S.show_command
+
+------------------------------------------------------------------
+-- Querying filesystem
+
+-- | see 'S.ls'
+ls :: FilePath -> Sh FilePath
+ls = sh1s S.ls
+
+-- | see 'S.lsT'
+lsT :: FilePath -> Sh Text
+lsT = sh1s S.lsT
+
+-- | see 'S.test_e'
+test_e :: FilePath -> Sh Bool
+test_e = sh1 S.test_e
+
+-- | see 'S.test_f'
+test_f :: FilePath -> Sh Bool
+test_f = sh1 S.test_f
+
+-- | see 'S.test_d'
+test_d :: FilePath -> Sh Bool
+test_d = sh1 S.test_d
+
+-- | see 'S.test_s'
+test_s :: FilePath -> Sh Bool
+test_s = sh1 S.test_s
+
+-- | see 'S.which
+which :: FilePath -> Sh (Maybe FilePath)
+which = sh1 S.which
+
+---------------------------------------------------------------------
+-- Filename helpers
+
+-- | see 'S.absPath'
+absPath :: FilePath -> Sh FilePath
+absPath = sh1 S.absPath
+
+-- | see 'S.canonic'
+canonic :: FilePath -> Sh FilePath
+canonic = sh1 S.canonic
+
+-- | see 'S.canonicalize'
+canonicalize :: FilePath -> Sh FilePath
+canonicalize = sh1 S.canonicalize
+
+-- | see 'S.relPath'
+relPath :: FilePath -> Sh FilePath
+relPath = sh1 S.relPath
+
+-- | see 'S.relativeTo'
+relativeTo :: FilePath -- ^ anchor path, the prefix
+ -> FilePath -- ^ make this relative to anchor path
+ -> Sh FilePath
+relativeTo = sh2 S.relativeTo
+
+-------------------------------------------------------------
+-- Manipulating filesystem
+
+-- | see 'S.mv'
+mv :: FilePath -> FilePath -> Sh ()
+mv = sh2 S.mv
+
+-- | see 'S.rm'
+rm :: FilePath -> Sh ()
+rm = sh1 S.rm
+
+-- | see 'S.rm_f'
+rm_f :: FilePath -> Sh ()
+rm_f = sh1 S.rm_f
+
+-- | see 'S.rm_rf'
+rm_rf :: FilePath -> Sh ()
+rm_rf = sh1 S.rm_rf
+
+-- | see 'S.cp'
+cp :: FilePath -> FilePath -> Sh ()
+cp = sh2 S.cp
+
+-- | see 'S.cp_r'
+cp_r :: FilePath -> FilePath -> Sh ()
+cp_r = sh2 S.cp_r
+
+-- | see 'S.mkdir'
+mkdir :: FilePath -> Sh ()
+mkdir = sh1 S.mkdir
+
+-- | see 'S.mkdir_p'
+mkdir_p :: FilePath -> Sh ()
+mkdir_p = sh1 S.mkdir_p
+
+-- | see 'S.mkdirTree'
+mkdirTree :: Tree FilePath -> Sh ()
+mkdirTree = sh1 S.mkdirTree
+
+-- | see 'S.readFile'
+readfile :: FilePath -> Sh Text
+readfile = sh1 S.readfile
+
+-- | see 'S.readBinary'
+readBinary :: FilePath -> Sh ByteString
+readBinary = sh1 S.readBinary
+
+-- | see 'S.writeFile'
+writefile :: FilePath -> Text -> Sh ()
+writefile = sh2 S.writefile
+
+-- | see 'S.touchFile'
+touchfile :: FilePath -> Sh ()
+touchfile = sh1 S.touchfile
+
+-- | see 'S.appendFile'
+appendfile :: FilePath -> Text -> Sh ()
+appendfile = sh2 S.appendfile
+
+-- | see 'S.withTmpDir'
+withTmpDir :: (FilePath -> Sh a) -> Sh a
+withTmpDir f = Sh $ S.withTmpDir (unSh . f)
+
+-----------------------------------------------------------------
+-- find
+
+-- | see 'S.find'
+find :: FilePath -> Sh FilePath
+find = sh1s S.find
+
+-- | see 'S.findWhen'
+findWhen :: (FilePath -> Sh Bool) -> FilePath -> Sh FilePath
+findWhen p a = Sh $ S.findWhen (fmap and . unSh . p) a
+
+-- | see 'S.findFold'
+findFold :: (a -> FilePath -> Sh a) -> a -> FilePath -> Sh a
+findFold cons nil a = Sh $ S.findFold cons' nil' a
+ where nil' = return nil
+ cons' as dir = unSh $ roll $ mapM (flip cons dir) as
+
+-- | see 'S.findDirFilter'
+findDirFilter :: (FilePath -> Sh Bool) -> FilePath -> Sh FilePath
+findDirFilter p a = Sh $ S.findDirFilter (fmap and . unSh . p) a
+
+-- | see 'S.findDirFilterWhen'
+findDirFilterWhen :: (FilePath -> Sh Bool) -- ^ directory filter
+ -> (FilePath -> Sh Bool) -- ^ file filter
+ -> FilePath -- ^ directory
+ -> Sh FilePath
+findDirFilterWhen dirPred filePred a + Sh $ S.findDirFilterWhen
+ (fmap and . unSh . dirPred)
+ (fmap and . unSh . filePred)
+ a
+
+
+-- | see 'S.findFoldDirFilterWhen'
+findFoldDirFilter :: (a -> FilePath -> Sh a) -> a -> (FilePath -> Sh Bool) -> \
FilePath -> Sh a +findFoldDirFilter cons nil p a = Sh $ S.findFoldDirFilter cons' \
nil' p' a + where p' = fmap and . unSh . p
+ nil' = return nil
+ cons' as dir = unSh $ roll $ mapM (flip cons dir) as
+
+-----------------------------------------------------------
+-- exiting the program
+
+-- | see 'S.exit'
+exit :: Int -> Sh ()
+exit = sh1 S.exit
+
+-- | see 'S.errorExit'
+errorExit :: Text -> Sh ()
+errorExit = sh1 S.errorExit
+
+-- | see 'S.quietExit'
+quietExit :: Int -> Sh ()
+quietExit = sh1 S.quietExit
+
+-- | see 'S.terror'
+terror :: Text -> Sh a
+terror = sh1 S.terror
+
+------------------------------------------------------------
+-- Utilities
+
+-- | see 'S.catch_sh'
+catch_sh :: (Exception e) => Sh a -> (e -> Sh a) -> Sh a
+catch_sh a f = Sh $ S.catch_sh (unSh a) (unSh . f)
+
+-- | see 'S.catchany_sh'
+catchany_sh :: Sh a -> (SomeException -> Sh a) -> Sh a
+catchany_sh = catch_sh
+
+
+-- | see 'S.finally_sh'
+finally_sh :: Sh a -> Sh b -> Sh a
+finally_sh = lift2 S.finally_sh
+
+-- | see 'S.time'
+time :: Sh a -> Sh (Double, a)
+time = lift1 S.time
+
+-- | see 'S.ShellyHandler'
+data ShellyHandler a = forall e . Exception e => ShellyHandler (e -> Sh a)
+
+-- | see 'S.catches_sh'
+catches_sh :: Sh a -> [ShellyHandler a] -> Sh a
+catches_sh a hs = Sh $ S.catches_sh (unSh a) (fmap convert hs)
+ where convert :: ShellyHandler a -> S.ShellyHandler [a]
+ convert (ShellyHandler f) = S.ShellyHandler (unSh . f)
+
+------------------------------------------------------------
+-- convert between Text and FilePath
+
+-- | see 'S.toTextWarn'
+toTextWarn :: FilePath -> Sh Text
+toTextWarn = sh1 S.toTextWarn
+
+-------------------------------------------------------------
+-- internal functions for writing extension
+
+get :: Sh State
+get = sh0 S.get
+
+put :: State -> Sh ()
+put = sh1 S.put
+
+--------------------------------------------------------
+-- polyvariadic vodoo
+
+-- | Converter for the variadic argument version of 'run' called 'cmd'.
+class ShellArg a where toTextArg :: a -> Text
+instance ShellArg Text where toTextArg = id
+instance ShellArg FilePath where toTextArg = toTextIgnore
+
+
+-- Voodoo to create the variadic function 'cmd'
+class ShellCommand t where
+ cmdAll :: FilePath -> [Text] -> t
+
+instance ShellCommand (Sh Text) where
+ cmdAll fp args = run fp args
+
+instance (s ~ Text, Show s) => ShellCommand (Sh s) where
+ cmdAll fp args = run fp args
+
+-- note that Sh () actually doesn't work for its case (_<- cmd) when there is no \
type signature +instance ShellCommand (Sh ()) where
+ cmdAll fp args = run_ fp args
+
+instance (ShellArg arg, ShellCommand result) => ShellCommand (arg -> result) where
+ cmdAll fp acc = \x -> cmdAll fp (acc ++ [toTextArg x])
+
+-- | see 'S.cmd'
+cmd :: (ShellCommand result) => FilePath -> result
+cmd fp = cmdAll fp []
addfile ./shelly/src/Shelly/Unix.hs
hunk ./shelly/src/Shelly/Unix.hs 1
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | commands that only work on Unix
+module Shelly.Unix
+ ( kill
+ ) where
+
+import Shelly
+import qualified Data.Text as T
+
+kill :: Int -> Sh ()
+kill pid = run_ "kill" ["-15", T.pack $ show pid]
addfile ./shelly/src/Shelly.hs
hunk ./shelly/src/Shelly.hs 1
+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, OverloadedStrings,
+ FlexibleInstances, IncoherentInstances,
+ TypeFamilies, ExistentialQuantification #-}
+
+-- | A module for shell-like programming in Haskell.
+-- Shelly's focus is entirely on ease of use for those coming from shell scripting.
+-- However, it also tries to use modern libraries and techniques to keep things \
efficient. +--
+-- The functionality provided by
+-- this module is (unlike standard Haskell filesystem functionality)
+-- thread-safe: each Sh maintains its own environment and its own working
+-- directory.
+--
+-- Recommended usage includes putting the following at the top of your program,
+-- otherwise you will likely need either type annotations or type conversions
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > {-# LANGUAGE ExtendedDefaultRules #-}
+-- > {-# OPTIONS_GHC -fno-warn-type-defaults #-}
+-- > import Shelly
+-- > import qualified Data.Text as T
+-- > default (T.Text)
+module Shelly
+ (
+ -- * Entering Sh.
+ Sh, ShIO, shelly, shellyNoDir, shellyFailDir, asyncSh, sub
+ , silently, verbosely, escaping, print_stdout, print_stderr, print_commands
+ , onCommandHandles
+ , tracing, errExit
+ , log_stdout_with, log_stderr_with
+
+ -- * Running external commands.
+ , run, run_, runFoldLines, cmd, FoldCallback
+ , bash, bash_, bashPipeFail
+ , (-|-), lastStderr, setStdin, lastExitCode
+ , command, command_, command1, command1_
+ , sshPairs,sshPairsPar, sshPairs_,sshPairsPar_, sshPairsWithOptions
+ , sshCommandText, SshMode(..)
+ , ShellCmd(..), CmdArg (..)
+
+ -- * Running commands Using handles
+ , runHandle, runHandles, transferLinesAndCombine, transferFoldHandleLines
+ , StdHandle(..), StdStream(..)
+
+ -- * Handle manipulation
+ , HandleInitializer, StdInit(..), initOutputHandles, initAllHandles
+
+ -- * Modifying and querying environment.
+ , setenv, get_env, get_env_text, getenv, get_env_def, get_env_all, \
get_environment, appendToPath, prependToPath +
+ -- * Environment directory
+ , cd, chdir, chdir_p, pwd
+
+ -- * Printing
+ , echo, echo_n, echo_err, echo_n_err, inspect, inspect_err
+ , tag, trace, show_command
+
+ -- * Querying filesystem.
+ , ls, lsT, test_e, test_f, test_d, test_s, test_px, which
+
+ -- * Filename helpers
+ , absPath, (</>), (<.>), canonic, canonicalize, relPath, relativeTo, path
+ , hasExt
+
+ -- * Manipulating filesystem.
+ , mv, rm, rm_f, rm_rf, cp, cp_r, mkdir, mkdir_p, mkdirTree
+
+ -- * reading/writing Files
+ , readfile, readBinary, writefile, writeBinary, appendfile, touchfile, \
withTmpDir +
+ -- * exiting the program
+ , exit, errorExit, quietExit, terror
+
+ -- * Exceptions
+ , bracket_sh, catchany, catch_sh, handle_sh, handleany_sh, finally_sh, \
ShellyHandler(..), catches_sh, catchany_sh + , ReThrownException(..)
+ , RunFailed(..)
+
+ -- * convert between Text and FilePath
+ , toTextIgnore, toTextWarn, FP.fromText
+
+ -- * Utility Functions
+ , whenM, unlessM, time, sleep
+
+ -- * Re-exported for your convenience
+ , liftIO, when, unless, FilePath, (<$>)
+
+ -- * internal functions for writing extensions
+ , get, put
+
+ -- * find functions
+ , find, findWhen, findFold, findDirFilter, findDirFilterWhen, \
findFoldDirFilter + , followSymlink
+ ) where
+
+import Shelly.Base
+import Shelly.Find
+import Control.Monad ( when, unless, void, forM, filterM, liftM2 )
+import Control.Monad.Trans ( MonadIO )
+import Control.Monad.Reader (ask)
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706
+import Prelude hiding ( readFile, FilePath, catch)
+#else
+import Prelude hiding ( readFile, FilePath)
+#endif
+import Data.Char ( isAlphaNum, isSpace )
+import Data.Typeable
+import Data.IORef
+import Data.Sequence (Seq, (|>))
+import Data.Foldable (toList)
+import Data.Maybe
+import System.IO ( hClose, stderr, stdout, openTempFile)
+import System.IO.Error (isPermissionError, catchIOError, isEOFError, \
isIllegalOperation) +import System.Exit
+import System.Environment
+import Control.Applicative
+import Control.Exception
+import Control.Concurrent
+import Control.Concurrent.Async (async, wait, Async)
+import Data.Time.Clock( getCurrentTime, diffUTCTime )
+
+import qualified Data.Text.IO as TIO
+import qualified Data.Text.Encoding as TE
+import qualified Data.Text.Encoding.Error as TE
+import System.Process( CmdSpec(..), StdStream(CreatePipe, UseHandle), \
CreateProcess(..), createProcess, waitForProcess, terminateProcess, ProcessHandle, \
StdStream(..) ) +
+import qualified Data.Text as T
+import qualified Data.ByteString as BS
+import Data.ByteString (ByteString)
+
+import Data.Monoid (Monoid, mempty, mappend)
+#if __GLASGOW_HASKELL__ < 704
+infixr 5 <>
+(<>) :: Monoid m => m -> m -> m
+(<>) = mappend
+#else
+import Data.Monoid ((<>))
+#endif
+
+import Filesystem.Path.CurrentOS hiding (concat, fromText, (</>), (<.>))
+import Filesystem hiding (canonicalizePath)
+import qualified Filesystem.Path.CurrentOS as FP
+
+import System.Directory ( setPermissions, getPermissions, Permissions(..), \
getTemporaryDirectory ) +import Data.Char (isDigit)
+
+import Data.Tree(Tree(..))
+import qualified Data.Set as S
+import qualified Data.List as L
+
+searchPathSeparator :: Char
+#if defined(mingw32_HOST_OS)
+searchPathSeparator = ';'
+#else
+searchPathSeparator = ':'
+#endif
+
+{- GHC won't default to Text with this, even with extensions!
+ - see: http://hackage.haskell.org/trac/ghc/ticket/6030
+class CmdArgs a where
+ toTextArgs :: a -> [Text]
+
+instance CmdArgs Text where toTextArgs t = [t]
+instance CmdArgs FilePath where toTextArgs t = [toTextIgnore t]
+instance CmdArgs [Text] where toTextArgs = id
+instance CmdArgs [FilePath] where toTextArgs = map toTextIgnore
+
+instance CmdArgs (Text, Text) where
+ toTextArgs (t1,t2) = [t1, t2]
+instance CmdArgs (FilePath, FilePath) where
+ toTextArgs (fp1,fp2) = [toTextIgnore fp1, toTextIgnore fp2]
+instance CmdArgs (Text, FilePath) where
+ toTextArgs (t1, fp1) = [t1, toTextIgnore fp1]
+instance CmdArgs (FilePath, Text) where
+ toTextArgs (fp1,t1) = [toTextIgnore fp1, t1]
+
+cmd :: (CmdArgs args) => FilePath -> args -> Sh Text
+cmd fp args = run fp $ toTextArgs args
+-}
+
+-- | Argument converter for the variadic argument version of 'run' called 'cmd'.
+-- Useful for a type signature of a function that uses 'cmd'
+class CmdArg a where toTextArg :: a -> Text
+instance CmdArg Text where toTextArg = id
+instance CmdArg FilePath where toTextArg = toTextIgnore
+instance CmdArg String where toTextArg = T.pack
+
+-- | For the variadic function 'cmd'
+--
+-- partially applied variadic functions require type signatures
+class ShellCmd t where
+ cmdAll :: FilePath -> [Text] -> t
+
+instance ShellCmd (Sh Text) where
+ cmdAll = run
+
+instance (s ~ Text, Show s) => ShellCmd (Sh s) where
+ cmdAll = run
+
+-- note that Sh () actually doesn't work for its case (_<- cmd) when there is no \
type signature +instance ShellCmd (Sh ()) where
+ cmdAll = run_
+
+instance (CmdArg arg, ShellCmd result) => ShellCmd (arg -> result) where
+ cmdAll fp acc x = cmdAll fp (acc ++ [toTextArg x])
+
+instance (CmdArg arg, ShellCmd result) => ShellCmd ([arg] -> result) where
+ cmdAll fp acc x = cmdAll fp (acc ++ map toTextArg x)
+
+
+
+-- | variadic argument version of 'run'.
+-- Please see the documenation for 'run'.
+--
+-- The syntax is more convenient, but more importantly it also allows the use of a \
FilePath as a command argument. +-- So an argument can be a Text or a FilePath \
without manual conversions. +-- a FilePath is automatically converted to Text with \
'toTextIgnore'. +--
+-- Convenient usage of 'cmd' requires the following:
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > {-# LANGUAGE ExtendedDefaultRules #-}
+-- > {-# OPTIONS_GHC -fno-warn-type-defaults #-}
+-- > import Shelly
+-- > import qualified Data.Text as T
+-- > default (T.Text)
+--
+cmd :: (ShellCmd result) => FilePath -> result
+cmd fp = cmdAll fp []
+
+-- | Helper to convert a Text to a FilePath. Used by '(</>)' and '(<.>)'
+class ToFilePath a where
+ toFilePath :: a -> FilePath
+
+instance ToFilePath FilePath where toFilePath = id
+instance ToFilePath Text where toFilePath = FP.fromText
+instance ToFilePath String where toFilePath = FP.fromText . T.pack
+
+
+-- | uses System.FilePath.CurrentOS, but can automatically convert a Text
+(</>) :: (ToFilePath filepath1, ToFilePath filepath2) => filepath1 -> filepath2 -> \
FilePath +x </> y = toFilePath x FP.</> toFilePath y
+
+-- | uses System.FilePath.CurrentOS, but can automatically convert a Text
+(<.>) :: (ToFilePath filepath) => filepath -> Text -> FilePath
+x <.> y = toFilePath x FP.<.> y
+
+
+toTextWarn :: FilePath -> Sh Text
+toTextWarn efile = case toText efile of
+ Left f -> encodeError f >> return f
+ Right f -> return f
+ where
+ encodeError f = echo ("non-unicode file name: " <> f)
+
+-- | Transfer from one handle to another
+-- For example, send contents of a process output to stdout.
+-- does not close the write handle.
+--
+-- Also, return the complete contents being streamed line by line.
+transferLinesAndCombine :: Handle -> (Text -> IO ()) -> IO Text
+transferLinesAndCombine readHandle putWrite + transferFoldHandleLines mempty (|>) \
readHandle putWrite >>+ return . lineSeqToText +
+lineSeqToText :: Seq Text -> Text
+-- extra append puts a newline at the end
+lineSeqToText = T.intercalate "\n" . toList . flip (|>) ""
+
+type FoldCallback a = (a -> Text -> a)
+
+-- | Transfer from one handle to another
+-- For example, send contents of a process output to stdout.
+-- does not close the write handle.
+--
+-- Also, fold over the contents being streamed line by line
+transferFoldHandleLines :: a -> FoldCallback a -> Handle -> (Text -> IO ()) -> IO a
+transferFoldHandleLines start foldLine readHandle putWrite = go start
+ where
+ go acc = do
+ mLine <- filterIOErrors $ TIO.hGetLine readHandle
+ case mLine of
+ Nothing -> return acc
+ Just line -> putWrite line >> go (foldLine acc line)
+
+filterIOErrors :: IO a -> IO (Maybe a)
+filterIOErrors action = catchIOError
+ (fmap Just action)
+ (\e -> if isEOFError e || isIllegalOperation e -- handle was closed
+ then return Nothing
+ else ioError e)
+
+foldHandleLines :: a -> FoldCallback a -> Handle -> IO a
+foldHandleLines start foldLine readHandle = go start
+ where
+ go acc = do
+ mLine <- filterIOErrors $ TIO.hGetLine readHandle
+ case mLine of
+ Nothing -> return acc
+ Just line -> go $ foldLine acc line
+
+-- | same as 'trace', but use it combinator style
+tag :: Sh a -> Text -> Sh a
+tag action msg = do
+ trace msg
+ action
+
+put :: State -> Sh ()
+put newState = do
+ stateVar <- ask
+ liftIO (writeIORef stateVar newState)
+
+runCommandNoEscape :: [StdHandle] -> State -> FilePath -> [Text] -> Sh (Handle, \
Handle, Handle, ProcessHandle) +runCommandNoEscape handles st exe args = liftIO $ \
shellyProcess handles st $ + ShellCommand $ T.unpack $ T.intercalate " " \
(toTextIgnore exe : args) +
+runCommand :: [StdHandle] -> State -> FilePath -> [Text] -> Sh (Handle, Handle, \
Handle, ProcessHandle) +runCommand handles st exe args = findExe exe >>= \fullExe ->
+ liftIO $ shellyProcess handles st $
+ RawCommand (encodeString fullExe) (map T.unpack args)
+ where
+ findExe :: FilePath -> Sh FilePath
+ findExe
+#if defined(mingw32_HOST_OS) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ \
< 708) + fp
+#else
+ _fp
+#endif
+ = do
+ mExe <- whichEith exe
+ case mExe of
+ Right execFp -> return execFp
+ -- windows looks in extra places besides the PATH, so just give
+ -- up even if the behavior is not properly specified anymore
+ --
+ -- non-Windows < 7.8 has a bug for read-only file systems
+ -- https://github.com/yesodweb/Shelly.hs/issues/56
+ -- it would be better to specifically detect that bug
+#if defined(mingw32_HOST_OS) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ \
< 708) + Left _ -> return fp
+#else
+ Left err -> liftIO $ throwIO $ userError err
+#endif
+
+
+
+
+shellyProcess :: [StdHandle] -> State -> CmdSpec -> IO (Handle, Handle, Handle, \
ProcessHandle) +shellyProcess reusedHandles st cmdSpec = do
+ (createdInH, createdOutH, createdErrorH, pHandle) <- createProcess CreateProcess \
{ + cmdspec = cmdSpec
+ , cwd = Just $ encodeString $ sDirectory st
+ , env = Just $ sEnvironment st
+ , std_in = createUnless mInH
+ , std_out = createUnless mOutH
+ , std_err = createUnless mErrorH
+ , close_fds = False
+#if MIN_VERSION_process(1,1,0)
+ , create_group = False
+#endif
+#if MIN_VERSION_process(1,2,0)
+ , delegate_ctlc = False
+#endif
+#if MIN_VERSION_process(1,3,0)
+ , detach_console = False
+ , create_new_console = False
+ , new_session = False
+#endif
+#if MIN_VERSION_process(1,4,0)
+ , child_group = Nothing
+ , child_user = Nothing
+#endif
+#if MIN_VERSION_process(1,5,0)
+ , use_process_jobs = False
+#endif
+ }
+ return ( just $ createdInH <|> toHandle mInH
+ , just $ createdOutH <|> toHandle mOutH
+ , just $ createdErrorH <|> toHandle mErrorH
+ , pHandle
+ )
+ where
+ just :: Maybe a -> a
+ just Nothing = error "error in shelly creating process"
+ just (Just j) = j
+
+ toHandle (Just (UseHandle h)) = Just h
+ toHandle (Just CreatePipe) = error "shelly process creation failure \
CreatePipe" + toHandle (Just Inherit) = error "cannot access an inherited \
pipe" + toHandle Nothing = error "error in shelly creating process"
+
+ createUnless Nothing = CreatePipe
+ createUnless (Just stream) = stream
+
+ mInH = getStream mIn reusedHandles
+ mOutH = getStream mOut reusedHandles
+ mErrorH = getStream mError reusedHandles
+
+ getStream :: (StdHandle -> Maybe StdStream) -> [StdHandle] -> Maybe StdStream
+ getStream _ [] = Nothing
+ getStream mHandle (h:hs) = mHandle h <|> getStream mHandle hs
+
+ mIn, mOut, mError :: (StdHandle -> Maybe StdStream)
+ mIn (InHandle h) = Just h
+ mIn _ = Nothing
+ mOut (OutHandle h) = Just h
+ mOut _ = Nothing
+ mError (ErrorHandle h) = Just h
+ mError _ = Nothing
+
+{-
+-- | use for commands requiring usage of sudo. see 'run_sudo'.
+-- Use this pattern for priveledge separation
+newtype Sudo a = Sudo { sudo :: Sh a }
+
+-- | require that the caller explicitly state 'sudo'
+run_sudo :: Text -> [Text] -> Sudo Text
+run_sudo cmd args = Sudo $ run "/usr/bin/sudo" (cmd:args)
+-}
+
+-- | Same as a normal 'catch' but specialized for the Sh monad.
+catch_sh :: (Exception e) => Sh a -> (e -> Sh a) -> Sh a
+catch_sh action handler = do
+ ref <- ask
+ liftIO $ catch (runSh action ref) (\e -> runSh (handler e) ref)
+
+-- | Same as a normal 'handle' but specialized for the Sh monad.
+handle_sh :: (Exception e) => (e -> Sh a) -> Sh a -> Sh a
+handle_sh handler action = do
+ ref <- ask
+ liftIO $ handle (\e -> runSh (handler e) ref) (runSh action ref)
+
+
+-- | Same as a normal 'finally' but specialized for the 'Sh' monad.
+finally_sh :: Sh a -> Sh b -> Sh a
+finally_sh action handler = do
+ ref <- ask
+ liftIO $ finally (runSh action ref) (runSh handler ref)
+
+bracket_sh :: Sh a -> (a -> Sh b) -> (a -> Sh c) -> Sh c
+bracket_sh acquire release main = do
+ ref <- ask
+ liftIO $ bracket (runSh acquire ref)
+ (\resource -> runSh (release resource) ref)
+ (\resource -> runSh (main resource) ref)
+
+
+
+-- | You need to wrap exception handlers with this when using 'catches_sh'.
+data ShellyHandler a = forall e . Exception e => ShellyHandler (e -> Sh a)
+
+-- | Same as a normal 'catches', but specialized for the 'Sh' monad.
+catches_sh :: Sh a -> [ShellyHandler a] -> Sh a
+catches_sh action handlers = do
+ ref <- ask
+ let runner a = runSh a ref
+ liftIO $ catches (runner action) $ map (toHandler runner) handlers
+ where
+ toHandler :: (Sh a -> IO a) -> ShellyHandler a -> Handler a
+ toHandler runner (ShellyHandler handler) = Handler (\e -> runner (handler e))
+
+-- | Catch any exception in the Sh monad.
+catchany_sh :: Sh a -> (SomeException -> Sh a) -> Sh a
+catchany_sh = catch_sh
+
+-- | Handle any exception in the Sh monad.
+handleany_sh :: (SomeException -> Sh a) -> Sh a -> Sh a
+handleany_sh = handle_sh
+
+-- | Change current working directory of Sh. This does *not* change the
+-- working directory of the process we are running it. Instead, Sh keeps
+-- track of its own working directory and builds absolute paths internally
+-- instead of passing down relative paths.
+cd :: FilePath -> Sh ()
+cd = traceCanonicPath ("cd " <>) >=> cd'
+ where
+ cd' dir = do
+ unlessM (test_d dir) $ errorExit $ "not a directory: " <> tdir
+ modify $ \st -> st { sDirectory = dir, sPathExecutables = Nothing }
+ where
+ tdir = toTextIgnore dir
+
+-- | 'cd', execute a Sh action in the new directory and then pop back to the \
original directory +chdir :: FilePath -> Sh a -> Sh a
+chdir dir action = do
+ d <- gets sDirectory
+ cd dir
+ action `finally_sh` cd d
+
+-- | 'chdir', but first create the directory if it does not exit
+chdir_p :: FilePath -> Sh a -> Sh a
+chdir_p d action = mkdir_p d >> chdir d action
+
+
+-- | apply a String IO operations to a Text FilePath
+{-
+liftStringIO :: (String -> IO String) -> FilePath -> Sh FilePath
+liftStringIO f = liftIO . f . unpack >=> return . pack
+
+-- | @asString f = pack . f . unpack@
+asString :: (String -> String) -> FilePath -> FilePath
+asString f = pack . f . unpack
+-}
+
+pack :: String -> FilePath
+pack = decodeString
+
+-- | Move a file. The second path could be a directory, in which case the
+-- original file is moved into that directory.
+-- wraps system-fileio 'FileSystem.rename', which may not work across FS boundaries
+mv :: FilePath -> FilePath -> Sh ()
+mv from' to' = do
+ trace $ "mv " <> toTextIgnore from' <> " " <> toTextIgnore to'
+ from <- absPath from'
+ to <- absPath to'
+ to_dir <- test_d to
+ let to_loc = if not to_dir then to else to FP.</> filename from
+ liftIO $ rename from to_loc
+ `catchany` (\e -> throwIO $
+ ReThrownException e (extraMsg to_loc from)
+ )
+ where
+ extraMsg t f = "during copy from: " ++ encodeString f ++ " to: " ++ encodeString \
t +
+-- | Get back [Text] instead of [FilePath]
+lsT :: FilePath -> Sh [Text]
+lsT = ls >=> mapM toTextWarn
+
+-- | Obtain the current (Sh) working directory.
+pwd :: Sh FilePath
+pwd = gets sDirectory `tag` "pwd"
+
+-- | exit 0 means no errors, all other codes are error conditions
+exit :: Int -> Sh a
+exit 0 = liftIO exitSuccess `tag` "exit 0"
+exit n = liftIO (exitWith (ExitFailure n)) `tag` ("exit " <> T.pack (show n))
+
+-- | echo a message and exit with status 1
+errorExit :: Text -> Sh a
+errorExit msg = echo msg >> exit 1
+
+-- | for exiting with status > 0 without printing debug information
+quietExit :: Int -> Sh a
+quietExit 0 = exit 0
+quietExit n = throw $ QuietExit n
+
+-- | fail that takes a Text
+terror :: Text -> Sh a
+terror = fail . T.unpack
+
+-- | Create a new directory (fails if the directory exists).
+mkdir :: FilePath -> Sh ()
+mkdir = traceAbsPath ("mkdir " <>) >=>
+ liftIO . createDirectory False
+
+-- | Create a new directory, including parents (succeeds if the directory
+-- already exists).
+mkdir_p :: FilePath -> Sh ()
+mkdir_p = traceAbsPath ("mkdir -p " <>) >=>
+ liftIO . createTree
+
+-- | Create a new directory tree. You can describe a bunch of directories as
+-- a tree and this function will create all subdirectories. An example:
+--
+-- > exec = mkTree $
+-- > "package" # [
+-- > "src" # [
+-- > "Data" # leaves ["Tree", "List", "Set", "Map"]
+-- > ],
+-- > "test" # leaves ["QuickCheck", "HUnit"],
+-- > "dist/doc/html" # []
+-- > ]
+-- > where (#) = Node
+-- > leaves = map (# [])
+--
+mkdirTree :: Tree FilePath -> Sh ()
+mkdirTree = mk . unrollPath
+ where mk :: Tree FilePath -> Sh ()
+ mk (Node a ts) = do
+ b <- test_d a
+ unless b $ mkdir a
+ chdir a $ mapM_ mkdirTree ts
+
+ unrollPath :: Tree FilePath -> Tree FilePath
+ unrollPath (Node v ts) = unrollRoot v $ map unrollPath ts
+ where unrollRoot x = foldr1 phi $ map Node $ splitDirectories x
+ phi a b = a . return . b
+
+
+isExecutable :: FilePath -> IO Bool
+isExecutable f = (executable `fmap` getPermissions (encodeString f)) `catch` (\(_ :: \
IOError) -> return False) +
+-- | Get a full path to an executable by looking at the @PATH@ environement
+-- variable. Windows normally looks in additional places besides the
+-- @PATH@: this does not duplicate that behavior.
+which :: FilePath -> Sh (Maybe FilePath)
+which fp = either (const Nothing) Just <$> whichEith fp
+
+-- | Get a full path to an executable by looking at the @PATH@ environement
+-- variable. Windows normally looks in additional places besides the
+-- @PATH@: this does not duplicate that behavior.
+whichEith :: FilePath -> Sh (Either String FilePath)
+whichEith originalFp = whichFull
+#if defined(mingw32_HOST_OS)
+ $ case extension originalFp of
+ Nothing -> originalFp <.> "exe"
+ Just _ -> originalFp
+#else
+ originalFp
+#endif
+ where
+ whichFull fp = do
+ (trace . mappend "which " . toTextIgnore) fp >> whichUntraced
+ where
+ whichUntraced | absolute fp = checkFile
+ | dotSlash splitOnDirs = checkFile
+ | length splitOnDirs > 0 = lookupPath >>= leftPathError
+ | otherwise = lookupCache >>= leftPathError
+
+ splitOnDirs = splitDirectories fp
+ dotSlash ("./":_) = True
+ dotSlash _ = False
+
+ checkFile :: Sh (Either String FilePath)
+ checkFile = do
+ exists <- liftIO $ isFile fp
+ return $ if exists then Right fp else
+ Left $ "did not find file: " <> encodeString fp
+
+ leftPathError :: Maybe FilePath -> Sh (Either String FilePath)
+ leftPathError Nothing = Left <$> pathLookupError
+ leftPathError (Just x) = return $ Right x
+
+ pathLookupError :: Sh String
+ pathLookupError = do
+ pATH <- get_env_text "PATH"
+ return $
+ "shelly did not find " `mappend` encodeString fp `mappend`
+ " in the PATH: " `mappend` T.unpack pATH
+
+ lookupPath :: Sh (Maybe FilePath)
+ lookupPath = (pathDirs >>=) $ findMapM $ \dir -> do
+ let fullFp = dir </> fp
+ res <- liftIO $ isExecutable fullFp
+ return $ if res then Just fullFp else Nothing
+
+ lookupCache :: Sh (Maybe FilePath)
+ lookupCache = do
+ pathExecutables <- cachedPathExecutables
+ return $ fmap (flip (</>) fp . fst) $
+ L.find (S.member fp . snd) pathExecutables
+
+
+ pathDirs = mapM absPath =<< ((map FP.fromText . filter (not . T.null) . \
T.split (== searchPathSeparator)) `fmap` get_env_text "PATH") +
+ cachedPathExecutables :: Sh [(FilePath, S.Set FilePath)]
+ cachedPathExecutables = do
+ mPathExecutables <- gets sPathExecutables
+ case mPathExecutables of
+ Just pExecutables -> return pExecutables
+ Nothing -> do
+ dirs <- pathDirs
+ executables <- forM dirs (\dir -> do
+ files <- (liftIO . listDirectory) dir `catch_sh` (\(_ :: \
IOError) -> return []) + exes <- fmap (map snd) $ liftIO $ filterM \
(isExecutable . fst) $ + map (\f -> (f, filename f)) files
+ return $ S.fromList exes
+ )
+ let cachedExecutables = zip dirs executables
+ modify $ \x -> x { sPathExecutables = Just cachedExecutables }
+ return $ cachedExecutables
+
+
+-- | A monadic findMap, taken from MissingM package
+findMapM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
+findMapM _ [] = return Nothing
+findMapM f (x:xs) = do
+ mb <- f x
+ if (isJust mb)
+ then return mb
+ else findMapM f xs
+
+-- | A monadic-conditional version of the 'unless' guard.
+unlessM :: Monad m => m Bool -> m () -> m ()
+unlessM c a = c >>= \res -> unless res a
+
+-- | Does a path point to an existing filesystem object?
+test_e :: FilePath -> Sh Bool
+test_e = absPath >=> \f ->
+ liftIO $ do
+ file <- isFile f
+ if file then return True else isDirectory f
+
+-- | Does a path point to an existing file?
+test_f :: FilePath -> Sh Bool
+test_f = absPath >=> liftIO . isFile
+
+-- | Test that a file is in the PATH and also executable
+test_px :: FilePath -> Sh Bool
+test_px exe = do
+ mFull <- which exe
+ case mFull of
+ Nothing -> return False
+ Just full -> liftIO $ isExecutable full
+
+-- | A swiss army cannon for removing things. Actually this goes farther than a
+-- normal rm -rf, as it will circumvent permission problems for the files we
+-- own. Use carefully.
+-- Uses 'removeTree'
+rm_rf :: FilePath -> Sh ()
+rm_rf infp = do
+ f <- traceAbsPath ("rm -rf " <>) infp
+ isDir <- (test_d f)
+ if not isDir then whenM (test_f f) $ rm_f f
+ else
+ (liftIO_ $ removeTree f) `catch_sh` (\(e :: IOError) ->
+ when (isPermissionError e) $ do
+ find f >>= mapM_ (\file -> liftIO_ $ fixPermissions (encodeString file) \
`catchany` \_ -> return ()) + liftIO $ removeTree f
+ )
+ where fixPermissions file + do permissions <- liftIO $ getPermissions \
file + let deletable = permissions { readable = True, writable = True, \
executable = True } + liftIO $ setPermissions file deletable
+
+-- | Remove a file. Does not fail if the file does not exist.
+-- Does fail if the file is not a file.
+rm_f :: FilePath -> Sh ()
+rm_f = traceAbsPath ("rm -f " <>) >=> \f ->
+ whenM (test_e f) $ liftIO $ removeFile f
+
+-- | Remove a file.
+-- Does fail if the file does not exist (use 'rm_f' instead) or is not a file.
+rm :: FilePath -> Sh ()
+rm = traceAbsPath ("rm " <>) >=>
+ -- TODO: better error message for removeFile (give filename)
+ liftIO . removeFile
+
+-- | Set an environment variable. The environment is maintained in Sh
+-- internally, and is passed to any external commands to be executed.
+setenv :: Text -> Text -> Sh ()
+setenv k v = if k == path_env then setPath v else setenvRaw k v
+
+setenvRaw :: Text -> Text -> Sh ()
+setenvRaw k v = modify $ \x -> x { sEnvironment = wibble $ sEnvironment x }
+ where
+ (kStr, vStr) = (T.unpack k, T.unpack v)
+ wibble environment = (kStr, vStr) : filter ((/=kStr) . fst) environment
+
+setPath :: Text -> Sh ()
+setPath newPath = do
+ modify $ \x -> x{ sPathExecutables = Nothing }
+ setenvRaw path_env newPath
+
+path_env :: Text
+path_env = "PATH"
+
+-- | add the filepath onto the PATH env variable
+appendToPath :: FilePath -> Sh ()
+appendToPath = traceAbsPath ("appendToPath: " <>) >=> \filepath -> do
+ tp <- toTextWarn filepath
+ pe <- get_env_text path_env
+ setPath $ pe <> T.singleton searchPathSeparator <> tp
+
+-- | prepend the filepath to the PATH env variable
+-- similar to `appendToPath` but gives high priority to the filepath instead of low \
priority. +prependToPath :: FilePath -> Sh ()
+prependToPath = traceAbsPath ("prependToPath: " <>) >=> \filepath -> do
+ tp <- toTextWarn filepath
+ pe <- get_env_text path_env
+ setPath $ tp <> T.singleton searchPathSeparator <> pe
+
+get_environment :: Sh [(String, String)]
+get_environment = gets sEnvironment
+{-# DEPRECATED get_environment "use get_env_all" #-}
+
+-- | get the full environment
+get_env_all :: Sh [(String, String)]
+get_env_all = gets sEnvironment
+
+-- | Fetch the current value of an environment variable.
+-- if non-existant or empty text, will be Nothing
+get_env :: Text -> Sh (Maybe Text)
+get_env k = do
+ mval <- return . fmap T.pack . lookup (T.unpack k) =<< gets sEnvironment
+ return $ case mval of
+ Nothing -> Nothing
+ Just val -> if (not $ T.null val) then Just val else Nothing
+
+-- | deprecated
+getenv :: Text -> Sh Text
+getenv k = get_env_def k ""
+{-# DEPRECATED getenv "use get_env or get_env_text" #-}
+
+-- | Fetch the current value of an environment variable. Both empty and
+-- non-existent variables give empty string as a result.
+get_env_text :: Text -> Sh Text
+get_env_text = get_env_def ""
+
+-- | Fetch the current value of an environment variable. Both empty and
+-- non-existent variables give the default Text value as a result
+get_env_def :: Text -> Text -> Sh Text
+get_env_def d = get_env >=> return . fromMaybe d
+{-# DEPRECATED get_env_def "use fromMaybe DEFAULT get_env" #-}
+
+-- | Apply a single initializer to the two output process handles (stdout and \
stderr) +initOutputHandles :: HandleInitializer -> StdInit
+initOutputHandles f = StdInit (const $ return ()) f f
+
+-- | Apply a single initializer to all three standard process handles (stdin, stdout \
and stderr) +initAllHandles :: HandleInitializer -> StdInit
+initAllHandles f = StdInit f f f
+
+-- | When running an external command, apply the given initializers to
+-- the specified handles for that command.
+-- This can for example be used to change the encoding of the
+-- handles or set them into binary mode.
+onCommandHandles :: StdInit -> Sh a -> Sh a
+onCommandHandles initHandles a + sub $ modify (\x -> x { sInitCommandHandles = \
initHandles }) >> a +
+-- | Create a sub-Sh in which external command outputs are not echoed and
+-- commands are not printed.
+-- See 'sub'.
+silently :: Sh a -> Sh a
+silently a = sub $ modify (\x -> x
+ { sPrintStdout = False
+ , sPrintStderr = False
+ , sPrintCommands = False
+ }) >> a
+
+-- | Create a sub-Sh in which external command outputs are echoed and
+-- Executed commands are printed
+-- See 'sub'.
+verbosely :: Sh a -> Sh a
+verbosely a = sub $ modify (\x -> x
+ { sPrintStdout = True
+ , sPrintStderr = True
+ , sPrintCommands = True
+ }) >> a
+
+-- | Create a sub-Sh in which stdout is sent to the user-defined
+-- logger. When running with 'silently' the given log will not be
+-- called for any output. Likewise the log will also not be called for
+-- output from 'run_' and 'bash_' commands.
+log_stdout_with :: (Text -> IO ()) -> Sh a -> Sh a
+log_stdout_with logger a = sub $ modify (\s -> s { sPutStdout = logger })
+ >> a
+
+-- | Create a sub-Sh in which stderr is sent to the user-defined
+-- logger. When running with 'silently' the given log will not be
+-- called for any output. However, unlike 'log_stdout_with' the log
+-- will be called for output from 'run_' and 'bash_' commands.
+log_stderr_with :: (Text -> IO ()) -> Sh a -> Sh a
+log_stderr_with logger a = sub $ modify (\s -> s { sPutStderr = logger })
+ >> a
+
+-- | Create a sub-Sh with stdout printing on or off
+-- Defaults to True.
+print_stdout :: Bool -> Sh a -> Sh a
+print_stdout shouldPrint a + sub $ modify (\x -> x { sPrintStdout = shouldPrint }) \
>> a +
+-- | Create a sub-Sh with stderr printing on or off
+-- Defaults to True.
+print_stderr :: Bool -> Sh a -> Sh a
+print_stderr shouldPrint a + sub $ modify (\x -> x { sPrintStderr = shouldPrint }) \
>> a +
+
+-- | Create a sub-Sh with command echoing on or off
+-- Defaults to False, set to True by 'verbosely'
+print_commands :: Bool -> Sh a -> Sh a
+print_commands shouldPrint a = sub $ modify (\st -> st { sPrintCommands = \
shouldPrint }) >> a +
+-- | Enter a sub-Sh that inherits the environment
+-- The original state will be restored when the sub-Sh completes.
+-- Exceptions are propagated normally.
+sub :: Sh a -> Sh a
+sub a = do
+ oldState <- get
+ modify $ \st -> st { sTrace = T.empty }
+ a `finally_sh` restoreState oldState
+ where
+ restoreState oldState = do
+ newState <- get
+ put oldState {
+ -- avoid losing the log
+ sTrace = sTrace oldState <> sTrace newState
+ -- latest command execution: not make sense to restore these to old \
settings + , sCode = sCode newState
+ , sStderr = sStderr newState
+ -- it is questionable what the behavior of stdin should be
+ , sStdin = sStdin newState
+ }
+
+-- | Create a sub-Sh where commands are not traced
+-- Defaults to True.
+-- You should only set to False temporarily for very specific reasons
+tracing :: Bool -> Sh a -> Sh a
+tracing shouldTrace action = sub $ do
+ modify $ \st -> st { sTracing = shouldTrace }
+ action
+
+-- | Create a sub-Sh with shell character escaping on or off.
+-- Defaults to @True@.
+--
+-- Setting to @False@ allows for shell wildcard such as * to be expanded by the \
shell along with any other special shell characters. +-- As a side-effect, setting to \
@False@ causes changes to @PATH@ to be ignored: +-- see the 'run' documentation.
+escaping :: Bool -> Sh a -> Sh a
+escaping shouldEscape action = sub $ do
+ modify $ \st -> st { sCommandEscaping = shouldEscape }
+ action
+
+-- | named after bash -e errexit. Defaults to @True@.
+-- When @True@, throw an exception on a non-zero exit code.
+-- When @False@, ignore a non-zero exit code.
+-- Not recommended to set to @False@ unless you are specifically checking the error \
code with 'lastExitCode'. +errExit :: Bool -> Sh a -> Sh a
+errExit shouldExit action = sub $ do
+ modify $ \st -> st { sErrExit = shouldExit }
+ action
+
+-- | 'find'-command follows symbolic links. Defaults to @False@.
+-- When @True@, follow symbolic links.
+-- When @False@, never follow symbolic links.
+followSymlink :: Bool -> Sh a -> Sh a
+followSymlink enableFollowSymlink action = sub $ do
+ modify $ \st -> st { sFollowSymlink = enableFollowSymlink }
+ action
+
+
+defReadOnlyState :: ReadOnlyState
+defReadOnlyState = ReadOnlyState { rosFailToDir = False }
+
+-- | Deprecated now, just use 'shelly', whose default has been changed.
+-- Using this entry point does not create a @.shelly@ directory in the case
+-- of failure. Instead it logs directly into the standard error stream (@stderr@).
+shellyNoDir :: MonadIO m => Sh a -> m a
+shellyNoDir = shelly' ReadOnlyState { rosFailToDir = False }
+{-# DEPRECATED shellyNoDir "Just use shelly. The default settings have changed" #-}
+
+-- | Using this entry point creates a @.shelly@ directory in the case
+-- of failure where errors are recorded.
+shellyFailDir :: MonadIO m => Sh a -> m a
+shellyFailDir = shelly' ReadOnlyState { rosFailToDir = True }
+
+-- | Enter a Sh from (Monad)IO. The environment and working directories are
+-- inherited from the current process-wide values. Any subsequent changes in
+-- processwide working directory or environment are not reflected in the
+-- running Sh.
+shelly :: MonadIO m => Sh a -> m a
+shelly = shelly' defReadOnlyState
+
+shelly' :: MonadIO m => ReadOnlyState -> Sh a -> m a
+shelly' ros action = do
+ environment <- liftIO getEnvironment
+ dir <- liftIO getWorkingDirectory
+ let def = State { sCode = 0
+ , sStdin = Nothing
+ , sStderr = T.empty
+ , sPutStdout = TIO.hPutStrLn stdout
+ , sPutStderr = TIO.hPutStrLn stderr
+ , sPrintStdout = True
+ , sPrintStderr = True
+ , sPrintCommands = False
+ , sInitCommandHandles = initAllHandles (const $ return ())
+ , sCommandEscaping = True
+ , sEnvironment = environment
+ , sTracing = True
+ , sTrace = T.empty
+ , sDirectory = dir
+ , sPathExecutables = Nothing
+ , sErrExit = True
+ , sReadOnly = ros
+ , sFollowSymlink = False
+ }
+ stref <- liftIO $ newIORef def
+ let caught + action `catches_sh` [
+ ShellyHandler (\ex ->
+ case ex of
+ ExitSuccess -> liftIO $ throwIO ex
+ ExitFailure _ -> throwExplainedException ex
+ )
+ , ShellyHandler (\ex -> case ex of
+ QuietExit n -> liftIO $ throwIO $ ExitFailure \
n) + , ShellyHandler (\(ex::SomeException) -> throwExplainedException ex)
+ ]
+ liftIO $ runSh caught stref
+ where
+ throwExplainedException :: Exception exception => exception -> Sh a
+ throwExplainedException ex = get >>= errorMsg >>= liftIO . throwIO . \
ReThrownException ex +
+ errorMsg st + if not (rosFailToDir $ sReadOnly st) then ranCommands else do
+ d <- pwd
+ sf <- shellyFile
+ let logFile = d</>shelly_dir</>sf
+ (writefile logFile trc >> return ("log of commands saved to: " <> \
encodeString logFile)) + `catchany_sh` (\_ -> ranCommands)
+
+ where
+ trc = sTrace st
+ ranCommands = return . mappend "Ran commands: \n" . T.unpack $ trc
+
+ shelly_dir = ".shelly"
+ shellyFile = chdir_p shelly_dir $ do
+ fs <- ls "."
+ return $ pack $ show (nextNum fs) <> ".txt"
+
+ nextNum :: [FilePath] -> Int
+ nextNum [] = 1
+ nextNum fs = (+ 1) . maximum . map (readDef 1 . filter isDigit . encodeString . \
filename) $ fs +
+-- from safe package
+readDef :: Read a => a -> String -> a
+readDef def = fromMaybe def . readMay
+ where
+ readMay :: Read a => String -> Maybe a
+ readMay s = case [x | (x,t) <- reads s, ("","") <- lex t] of
+ [x] -> Just x
+ _ -> Nothing
+
+data RunFailed = RunFailed FilePath [Text] Int Text deriving (Typeable)
+
+instance Show RunFailed where
+ show (RunFailed exe args code errs) + let codeMsg = case code of
+ 127 -> ". exit code 127 usually means the command does not exist (in the \
PATH)" + _ -> ""
+ in "error running: " ++ T.unpack (show_command exe args) ++
+ "\nexit status: " ++ show code ++ codeMsg ++ "\nstderr: " ++ T.unpack errs
+
+instance Exception RunFailed
+
+show_command :: FilePath -> [Text] -> Text
+show_command exe args + T.intercalate " " $ map quote (toTextIgnore exe : args)
+ where
+ quote t | T.any (== '\'') t = t
+ quote t | T.any isSpace t = surround '\'' t
+ quote t | otherwise = t
+
+-- quote one argument
+quoteOne :: Text -> Text
+quoteOne t + surround '\'' $ T.replace "'" "'\\''" t
+
+
+-- returns a string that can be executed by a shell.
+-- NOTE: all parts are treated literally, which means that
+-- things like variable expansion will not be available.
+quoteCommand :: FilePath -> [Text] -> Text
+quoteCommand exe args + T.intercalate " " $ map quoteOne (toTextIgnore exe : \
args) +
+surround :: Char -> Text -> Text
+surround c t = T.cons c $ T.snoc t c
+
+data SshMode = ParSsh | SeqSsh
+
+-- | same as 'sshPairs', but returns ()
+sshPairs_ :: Text -> [(FilePath, [Text])] -> Sh ()
+sshPairs_ _ [] = return ()
+sshPairs_ server cmds = sshPairs' run_ server cmds
+
+-- | same as 'sshPairsP', but returns ()
+
+sshPairsPar_ :: Text -> [(FilePath, [Text])] -> Sh ()
+sshPairsPar_ _ [] = return ()
+sshPairsPar_ server cmds = sshPairsPar' run_ server cmds
+
+-- | run commands over SSH.
+-- An ssh executable is expected in your path.
+-- Commands are in the same form as 'run', but given as pairs
+--
+-- > sshPairs "server-name" [("cd", "dir"), ("rm",["-r","dir2"])]
+--
+-- This interface is crude, but it works for now.
+--
+-- Please note this sets 'escaping' to False, and the remote commands are
+-- quoted with single quotes, in a way such that the remote commands will see
+-- the literal values you passed, this means that no variable expansion and
+-- alike will done on either the local shell or the remote shell, and that
+-- if there are a single or double quotes in your arguments, they need not
+-- to be quoted manually.
+--
+-- Internally the list of commands are combined with the string @&&@ before given to \
ssh. +sshPairs :: Text -> [(FilePath, [Text])] -> Sh Text
+sshPairs _ [] = return ""
+sshPairs server cmds = sshPairsWithOptions' run server [] cmds SeqSsh
+
+-- | Same as sshPairs, but combines commands with the string @&@, so they will be \
started in parallell. +sshPairsPar :: Text -> [(FilePath, [Text])] -> Sh Text
+sshPairsPar _ [] = return ""
+sshPairsPar server cmds = sshPairsWithOptions' run server [] cmds ParSsh
+
+sshPairsPar' :: (FilePath -> [Text] -> Sh a) -> Text -> [(FilePath, [Text])] -> Sh a
+sshPairsPar' run' server actions = sshPairsWithOptions' run' server [] actions \
ParSsh +
+sshPairs' :: (FilePath -> [Text] -> Sh a) -> Text -> [(FilePath, [Text])] -> Sh a
+sshPairs' run' server actions = sshPairsWithOptions' run' server [] actions SeqSsh
+
+-- | Like 'sshPairs', but allows for arguments to the call to ssh.
+sshPairsWithOptions :: Text -- ^ Server name.
+ -> [Text] -- ^ Arguments to ssh (e.g. \
["-p","22"]). + -> [(FilePath, [Text])] -- ^ Pairs of commands to \
run on the remote. + -> Sh Text -- ^ Returns the \
standard output. +sshPairsWithOptions _ _ [] = return ""
+sshPairsWithOptions server sshargs cmds = sshPairsWithOptions' run server sshargs \
cmds SeqSsh +
+sshPairsWithOptions' :: (FilePath -> [Text] -> Sh a) -> Text -> [Text] -> \
[(FilePath, [Text])] -> SshMode -> Sh a +sshPairsWithOptions' run' server sshargs \
actions mode = escaping False $ do + run' "ssh" ([server] ++ sshargs ++ \
[sshCommandText actions mode]) +
+sshCommandText :: [(FilePath, [Text])] -> SshMode -> Text
+sshCommandText actions mode + quoteOne (foldl1 joiner (map (uncurry quoteCommand) \
actions)) + where
+ joiner memo next = case mode of
+ SeqSsh -> memo <> " && " <> next
+ ParSsh -> memo <> " & " <> next
+
+data QuietExit = QuietExit Int deriving (Show, Typeable)
+instance Exception QuietExit
+
+-- | Shelly's wrapper around exceptions thrown in its monad
+data ReThrownException e = ReThrownException e String deriving (Typeable)
+instance Exception e => Exception (ReThrownException e)
+instance Exception e => Show (ReThrownException e) where
+ show (ReThrownException ex msg) = "\n" ++
+ msg ++ "\n" ++ "Exception: " ++ show ex
+
+-- | Execute an external command.
+-- Takes the command name and arguments.
+--
+-- You may prefer using 'cmd' instead, which is a variadic argument version
+-- of this function.
+--
+-- 'stdout' and 'stderr' are collected. The 'stdout' is returned as
+-- a result of 'run', and complete stderr output is available after the fact using
+-- 'lastStderr'
+--
+-- All of the stdout output will be loaded into memory.
+-- You can avoid this if you don't need stdout by using 'run_',
+-- If you want to avoid the memory and need to process the output then use \
'runFoldLines' or 'runHandle' or 'runHandles'. +--
+-- By default shell characters are escaped and
+-- the command name is a name of a program that can be found via @PATH@.
+-- Shelly will look through the @PATH@ itself to find the command.
+--
+-- When 'escaping' is set to @False@, shell characters are allowed.
+-- Since there is no longer a guarantee that a single program name is
+-- given, Shelly cannot look in the @PATH@ for it.
+-- a @PATH@ modified by setenv is not taken into account when finding the exe name.
+-- Instead the original Haskell program @PATH@ is used.
+-- On a Posix system the @env@ command can be used to make the 'setenv' PATH used \
when 'escaping' is set to False. @env echo hello@ instead of @echo hello@ +--
+run :: FilePath -> [Text] -> Sh Text
+run fp args = return . lineSeqToText =<< runFoldLines mempty (|>) fp args
+
+-- | Like `run`, but it invokes the user-requested program with _bash_.
+bash :: FilePath -> [Text] -> Sh Text
+bash fp args = escaping False $ run "bash" $ bashArgs fp args
+
+bash_ :: FilePath -> [Text] -> Sh ()
+bash_ fp args = escaping False $ run_ "bash" $ bashArgs fp args
+
+bashArgs :: FilePath -> [Text] -> [Text]
+bashArgs fp args = ["-c", "'" <> sanitise (toTextIgnore fp : args) <> "'"]
+ where
+ sanitise = T.replace "'" "\'" . T.intercalate " "
+
+-- | Use this with `bash` to set _pipefail_
+--
+-- > bashPipeFail $ bash "echo foo | echo"
+bashPipeFail :: (FilePath -> [Text] -> Sh a) -> FilePath -> [Text] -> Sh a
+bashPipeFail runner fp args = runner "set -o pipefail;" (toTextIgnore fp : args)
+
+-- | bind some arguments to run for re-use. Example:
+--
+-- > monit = command "monit" ["-c", "monitrc"]
+-- > monit ["stop", "program"]
+command :: FilePath -> [Text] -> [Text] -> Sh Text
+command com args more_args = run com (args ++ more_args)
+
+-- | bind some arguments to 'run_' for re-use. Example:
+--
+-- > monit_ = command_ "monit" ["-c", "monitrc"]
+-- > monit_ ["stop", "program"]
+command_ :: FilePath -> [Text] -> [Text] -> Sh ()
+command_ com args more_args = run_ com (args ++ more_args)
+
+-- | bind some arguments to run for re-use, and require 1 argument. Example:
+--
+-- > git = command1 "git" []; git "pull" ["origin", "master"]
+command1 :: FilePath -> [Text] -> Text -> [Text] -> Sh Text
+command1 com args one_arg more_args = run com (args ++ [one_arg] ++ more_args)
+
+-- | bind some arguments to run for re-use, and require 1 argument. Example:
+--
+-- > git_ = command1_ "git" []; git "pull" ["origin", "master"]
+command1_ :: FilePath -> [Text] -> Text -> [Text] -> Sh ()
+command1_ com args one_arg more_args = run_ com (args ++ [one_arg] ++ more_args)
+
+-- | the same as 'run', but return @()@ instead of the stdout content
+-- stdout will be read and discarded line-by-line
+run_ :: FilePath -> [Text] -> Sh ()
+run_ exe args = do
+ state <- get
+ if sPrintStdout state
+ then runWithColor_
+ else runFoldLines () (\_ _ -> ()) exe args
+ where
+ -- same a runFoldLines except Inherit Stdout
+ -- That allows color to show up
+ runWithColor_ + runHandles exe args [OutHandle Inherit] $ \inH _ errH -> \
do + state <- get
+ errs <- liftIO $ do
+ hClose inH -- setStdin was taken care of before the process even ran
+ errVar <- (putHandleIntoMVar mempty (|>) errH (sPutStderr state) \
(sPrintStderr state)) + lineSeqToText `fmap` wait errVar
+ modify $ \state' -> state' { sStderr = errs }
+ return ()
+
+liftIO_ :: IO a -> Sh ()
+liftIO_ = void . liftIO
+
+-- | Similar to 'run' but gives the raw stdout handle in a callback.
+-- If you want even more control, use 'runHandles'.
+runHandle :: FilePath -- ^ command
+ -> [Text] -- ^ arguments
+ -> (Handle -> Sh a) -- ^ stdout handle
+ -> Sh a
+runHandle exe args withHandle = runHandles exe args [] $ \_ outH errH -> do
+ state <- get
+ errVar <- liftIO $
+ (putHandleIntoMVar mempty (|>) errH (sPutStderr state) (sPrintStderr state))
+ res <- withHandle outH
+ errs <- liftIO $ lineSeqToText `fmap` wait errVar
+ modify $ \state' -> state' { sStderr = errs }
+ return res
+
+-- | Similar to 'run' but gives direct access to all input and output handles.
+--
+-- Be careful when using the optional input handles.
+-- If you specify Inherit for a handle then attempting to access the handle in your
+-- callback is an error
+runHandles :: FilePath -- ^ command
+ -> [Text] -- ^ arguments
+ -> [StdHandle] -- ^ optionally connect process i/o handles to existing \
handles + -> (Handle -> Handle -> Handle -> Sh a) -- ^ stdin, stdout and \
stderr + -> Sh a
+runHandles exe args reusedHandles withHandles = do
+ -- clear stdin before beginning command execution
+ origstate <- get
+ let mStdin = sStdin origstate
+ put $ origstate { sStdin = Nothing, sCode = 0, sStderr = T.empty }
+ state <- get
+
+ let cmdString = show_command exe args
+ when (sPrintCommands state) $ echo cmdString
+ trace cmdString
+
+ let doRun = if sCommandEscaping state then runCommand else runCommandNoEscape
+
+ bracket_sh
+ (doRun reusedHandles state exe args)
+ (\(_,_,_,procH) -> (liftIO $ terminateProcess procH))
+ (\(inH,outH,errH,procH) -> do
+
+ liftIO $ do
+ inInit (sInitCommandHandles state) inH
+ outInit (sInitCommandHandles state) outH
+ errInit (sInitCommandHandles state) errH
+
+ liftIO $ case mStdin of
+ Just input -> TIO.hPutStr inH input
+ Nothing -> return ()
+
+ result <- withHandles inH outH errH
+
+ (ex, code) <- liftIO $ do
+ ex' <- waitForProcess procH
+
+ -- TODO: specifically catch our own error for Inherit pipes
+ hClose outH `catchany` (const $ return ())
+ hClose errH `catchany` (const $ return ())
+ hClose inH `catchany` (const $ return ())
+
+ return $ case ex' of
+ ExitSuccess -> (ex', 0)
+ ExitFailure n -> (ex', n)
+
+ modify $ \state' -> state' { sCode = code }
+
+ case (sErrExit state, ex) of
+ (True, ExitFailure n) -> do
+ newState <- get
+ liftIO $ throwIO $ RunFailed exe args n (sStderr newState)
+ _ -> return result
+ )
+
+
+-- | used by 'run'. fold over stdout line-by-line as it is read to avoid keeping it \
in memory +-- stderr is still being placed in memory under the assumption it is \
always relatively small +runFoldLines :: a -> FoldCallback a -> FilePath -> [Text] -> \
Sh a +runFoldLines start cb exe args + runHandles exe args [] $ \inH outH errH -> do
+ state <- get
+ (errVar, outVar) <- liftIO $ do
+ hClose inH -- setStdin was taken care of before the process even ran
+ liftM2 (,)
+ (putHandleIntoMVar mempty (|>) errH (sPutStderr state) (sPrintStderr \
state)) + (putHandleIntoMVar start cb outH (sPutStdout state) (sPrintStdout \
state)) + errs <- liftIO $ lineSeqToText `fmap` wait errVar
+ modify $ \state' -> state' { sStderr = errs }
+ liftIO $ wait outVar
+
+
+putHandleIntoMVar :: a -> FoldCallback a
+ -> Handle -- ^ out handle
+ -> (Text -> IO ()) -- ^ in handle
+ -> Bool -- ^ should it be printed while transfered?
+ -> IO (Async a)
+putHandleIntoMVar start cb outH putWrite shouldPrint = liftIO $ async $ do
+ if shouldPrint
+ then transferFoldHandleLines start cb outH putWrite
+ else foldHandleLines start cb outH
+
+
+-- | The output of last external command. See 'run'.
+lastStderr :: Sh Text
+lastStderr = gets sStderr
+
+-- | The exit code from the last command.
+-- Unless you set 'errExit' to False you won't get a chance to use this: a non-zero \
exit code will throw an exception. +lastExitCode :: Sh Int
+lastExitCode = gets sCode
+
+-- | set the stdin to be used and cleared by the next 'run'.
+setStdin :: Text -> Sh ()
+setStdin input = modify $ \st -> st { sStdin = Just input }
+
+-- | Pipe operator. set the stdout the first command as the stdin of the second.
+-- This does not create a shell-level pipe, but hopefully it will in the future.
+-- To create a shell level pipe you can set @escaping False@ and use a pipe @|@ \
character in a command. +(-|-) :: Sh Text -> Sh b -> Sh b
+one -|- two = do
+ res <- print_stdout False one
+ setStdin res
+ two
+
+-- | Copy a file, or a directory recursively.
+-- uses 'cp'
+cp_r :: FilePath -> FilePath -> Sh ()
+cp_r from' to' = do
+ from <- absPath from'
+ fromIsDir <- (test_d from)
+ if not fromIsDir then cp from' to' else do
+ trace $ "cp -r " <> toTextIgnore from <> " " <> toTextIgnore to'
+ to <- absPath to'
+ toIsDir <- test_d to
+
+ when (from == to) $ liftIO $ throwIO $ userError $ show $ "cp_r: " <>
+ toTextIgnore from <> " and " <> toTextIgnore to <> " are identical"
+
+ finalTo <- if not toIsDir then mkdir to >> return to else do
+ let d = to </> dirname (addTrailingSlash from)
+ mkdir_p d >> return d
+
+ ls from >>= mapM_ (\item -> cp_r (from FP.</> filename item) (finalTo FP.</> \
filename item)) +
+-- | Copy a file. The second path could be a directory, in which case the
+-- original file name is used, in that directory.
+cp :: FilePath -> FilePath -> Sh ()
+cp from' to' = do
+ from <- absPath from'
+ to <- absPath to'
+ trace $ "cp " <> toTextIgnore from <> " " <> toTextIgnore to
+ to_dir <- test_d to
+ let to_loc = if to_dir then to FP.</> filename from else to
+ liftIO $ copyFile from to_loc `catchany` (\e -> throwIO $
+ ReThrownException e (extraMsg to_loc from)
+ )
+ where
+ extraMsg t f = "during copy from: " ++ encodeString f ++ " to: " ++ encodeString \
t +
+
+
+-- | Create a temporary directory and pass it as a parameter to a Sh
+-- computation. The directory is nuked afterwards.
+withTmpDir :: (FilePath -> Sh a) -> Sh a
+withTmpDir act = do
+ trace "withTmpDir"
+ dir <- liftIO getTemporaryDirectory
+ tid <- liftIO myThreadId
+ (pS, fhandle) <- liftIO $ openTempFile dir ("tmp" ++ filter isAlphaNum (show tid))
+ let p = pack pS
+ liftIO $ hClose fhandle -- required on windows
+ rm_f p
+ mkdir p
+ act p `finally_sh` rm_rf p
+
+-- | Write a Text to a file.
+writefile :: FilePath -> Text -> Sh ()
+writefile f' bits = do
+ f <- traceAbsPath ("writefile " <>) f'
+ liftIO (TIO.writeFile (encodeString f) bits)
+
+writeBinary :: FilePath -> ByteString -> Sh ()
+writeBinary f' bytes = do
+ f <- traceAbsPath ("writeBinary " <>) f'
+ liftIO (BS.writeFile (encodeString f) bytes)
+
+-- | Update a file, creating (a blank file) if it does not exist.
+touchfile :: FilePath -> Sh ()
+touchfile = traceAbsPath ("touch " <>) >=> flip appendfile ""
+
+-- | Append a Text to a file.
+appendfile :: FilePath -> Text -> Sh ()
+appendfile f' bits = do
+ f <- traceAbsPath ("appendfile " <>) f'
+ liftIO (TIO.appendFile (encodeString f) bits)
+
+readfile :: FilePath -> Sh Text
+readfile = traceAbsPath ("readfile " <>) >=> \fp ->
+ readBinary fp >>+ return . TE.decodeUtf8With TE.lenientDecode
+
+-- | wraps ByteSting readFile
+readBinary :: FilePath -> Sh ByteString
+readBinary = traceAbsPath ("readBinary " <>)
+ >=> liftIO . BS.readFile . encodeString
+
+-- | flipped hasExtension for Text
+hasExt :: Text -> FilePath -> Bool
+hasExt = flip hasExtension
+
+-- | Run a Sh computation and collect timing information.
+-- The value returned is the amount of _real_ time spent running the computation
+-- in seconds, as measured by the system clock.
+-- The precision is determined by the resolution of `getCurrentTime`.
+time :: Sh a -> Sh (Double, a)
+time what = sub $ do
+ trace "time"
+ t <- liftIO getCurrentTime
+ res <- what
+ t' <- liftIO getCurrentTime
+ return (realToFrac $ diffUTCTime t' t, res)
+
+-- | threadDelay wrapper that uses seconds
+sleep :: Int -> Sh ()
+sleep = liftIO . threadDelay . (1000 * 1000 *)
+
+-- | spawn an asynchronous action with a copy of the current state
+asyncSh :: Sh a -> Sh (Async a)
+asyncSh proc = do
+ state <- get
+ liftIO $ async $ shelly (put state >> proc)
+
+-- helper because absPath can throw exceptions
+-- This helps give clear tracing messages
+tracePath :: (FilePath -> Sh FilePath) -- ^ filepath conversion
+ -> (Text -> Text) -- ^ tracing statement
+ -> FilePath
+ -> Sh FilePath -- ^ converted filepath
+tracePath convert tracer infp + (convert infp >>= \fp -> traceIt fp >> return fp)
+ `catchany_sh` (\e -> traceIt infp >> liftIO (throwIO e))
+ where traceIt = trace . tracer . toTextIgnore
+
+traceAbsPath :: (Text -> Text) -> FilePath -> Sh FilePath
+traceAbsPath = tracePath absPath
+
+traceCanonicPath :: (Text -> Text) -> FilePath -> Sh FilePath
+traceCanonicPath = tracePath canonic
adddir ./shelly/test
adddir ./shelly/test/data
addfile ./shelly/test/data/nonascii.txt
hunk ./shelly/test/data/nonascii.txt 1
+Selbstverständlich überraschend
adddir ./shelly/test/data/symlinked_dir
addfile ./shelly/test/data/symlinked_dir/hoge_file
addfile ./shelly/test/data/zshrc
hunk ./shelly/test/data/zshrc 1
+# Filename: /etc/zsh/zshrc
+# Purpose: config file for zsh (z shell)
+# Authors: grml-team (grml.org), (c) Michael Prokop <mika@grml.org>
+# Bug-Reports: see http://grml.org/bugs/
+# License: This file is licensed under the GPL v2.
+################################################################################
+# This file is sourced only for interactive shells. It
+# should contain commands to set up aliases, functions,
+# options, key bindings, etc.
+#
+# Global Order: zshenv, zprofile, zshrc, zlogin
+################################################################################
+
+# USAGE
+# If you are using this file as your ~/.zshrc file, please use ~/.zshrc.pre
+# and ~/.zshrc.local for your own customisations. The former file is read
+# before ~/.zshrc, the latter is read after it. Also, consider reading the
+# refcard and the reference manual for this setup, both available from:
+# <http://grml.org/zsh/>
+
+# Contributing:
+# If you want to help to improve grml's zsh setup, clone the grml-etc-core
+# repository from git.grml.org:
+# git clone git://git.grml.org/grml-etc-core.git
+#
+# Make your changes, commit them; use 'git format-patch' to create a series
+# of patches and send those to the following address via 'git send-email':
+# grml-etc-core@grml.org
+#
+# Doing so makes sure the right people get your patches for review and
+# possibly inclusion.
+
+# zsh-refcard-tag documentation:
+# You may notice strange looking comments in this file.
+# These are there for a purpose. grml's zsh-refcard can now be
+# automatically generated from the contents of the actual configuration
+# file. However, we need a little extra information on which comments
+# and what lines of code to take into account (and for what purpose).
+#
+# Here is what they mean:
+#
+# List of tags (comment types) used:
+# #a# Next line contains an important alias, that should
+# be included in the grml-zsh-refcard.
+# (placement tag: @@INSERT-aliases@@)
+# #f# Next line contains the beginning of an important function.
+# (placement tag: @@INSERT-functions@@)
+# #v# Next line contains an important variable.
+# (placement tag: @@INSERT-variables@@)
+# #k# Next line contains an important keybinding.
+# (placement tag: @@INSERT-keybindings@@)
+# #d# Hashed directories list generation:
+# start denotes the start of a list of 'hash -d'
+# definitions.
+# end denotes its end.
+# (placement tag: @@INSERT-hasheddirs@@)
+# #A# Abbreviation expansion list generation:
+# start denotes the beginning of abbreviations.
+# end denotes their end.
+# Lines within this section that end in '#d .*' provide
+# extra documentation to be included in the refcard.
+# (placement tag: @@INSERT-abbrev@@)
+# #m# This tag allows you to manually generate refcard entries
+# for code lines that are hard/impossible to parse.
+# Example:
+# #m# k ESC-h Call the run-help function
+# That would add a refcard entry in the keybindings table
+# for 'ESC-h' with the given comment.
+# So the syntax is: #m# <section> <argument> <comment>
+# #o# This tag lets you insert entries to the 'other' hash.
+# Generally, this should not be used. It is there for
+# things that cannot be done easily in another way.
+# (placement tag: @@INSERT-other-foobar@@)
+#
+# All of these tags (except for m and o) take two arguments, the first
+# within the tag, the other after the tag:
+#
+# #<tag><section># <comment>
+#
+# Where <section> is really just a number, which are defined by the
+# @secmap array on top of 'genrefcard.pl'. The reason for numbers
+# instead of names is, that for the reader, the tag should not differ
+# much from a regular comment. For zsh, it is a regular comment indeed.
+# The numbers have got the following meanings:
+# 0 -> "default"
+# 1 -> "system"
+# 2 -> "user"
+# 3 -> "debian"
+# 4 -> "search"
+# 5 -> "shortcuts"
+# 6 -> "services"
+#
+# So, the following will add an entry to the 'functions' table in the
+# 'system' section, with a (hopefully) descriptive comment:
+# #f1# Edit an alias via zle
+# edalias() {
+#
+# It will then show up in the @@INSERT-aliases-system@@ replacement tag
+# that can be found in 'grml-zsh-refcard.tex.in'.
+# If the section number is omitted, the 'default' section is assumed.
+# Furthermore, in 'grml-zsh-refcard.tex.in' @@INSERT-aliases@@ is
+# exactly the same as @@INSERT-aliases-default@@. If you want a list of
+# *all* aliases, for example, use @@INSERT-aliases-all@@.
+
+# zsh profiling
+# just execute 'ZSH_PROFILE_RC=1 zsh' and run 'zprof' to get the details
+if [[ $ZSH_PROFILE_RC -gt 0 ]] ; then
+ zmodload zsh/zprof
+fi
+
+# load .zshrc.pre to give the user the chance to overwrite the defaults
+[[ -r ${HOME}/.zshrc.pre ]] && source ${HOME}/.zshrc.pre
+
+# check for version/system
+# check for versions (compatibility reasons)
+is4(){
+ [[ $ZSH_VERSION == <4->* ]] && return 0
+ return 1
+}
+
+is41(){
+ [[ $ZSH_VERSION == 4.<1->* || $ZSH_VERSION == <5->* ]] && return 0
+ return 1
+}
+
+is42(){
+ [[ $ZSH_VERSION == 4.<2->* || $ZSH_VERSION == <5->* ]] && return 0
+ return 1
+}
+
+is425(){
+ [[ $ZSH_VERSION == 4.2.<5->* || $ZSH_VERSION == 4.<3->* || $ZSH_VERSION == <5->* \
]] && return 0 + return 1
+}
+
+is43(){
+ [[ $ZSH_VERSION == 4.<3->* || $ZSH_VERSION == <5->* ]] && return 0
+ return 1
+}
+
+is433(){
+ [[ $ZSH_VERSION == 4.3.<3->* || $ZSH_VERSION == 4.<4->* \
+ || $ZSH_VERSION == <5->* ]] && return 0
+ return 1
+}
+
+is439(){
+ [[ $ZSH_VERSION == 4.3.<9->* || $ZSH_VERSION == 4.<4->* \
+ || $ZSH_VERSION == <5->* ]] && return 0
+ return 1
+}
+
+#f1# Checks whether or not you're running grml
+isgrml(){
+ [[ -f /etc/grml_version ]] && return 0
+ return 1
+}
+
+#f1# Checks whether or not you're running a grml cd
+isgrmlcd(){
+ [[ -f /etc/grml_cd ]] && return 0
+ return 1
+}
+
+if isgrml ; then
+#f1# Checks whether or not you're running grml-small
+ isgrmlsmall() {
+ if [[ ${${${(f)"$(</etc/grml_version)"}%% *}##*-} == 'small' ]]; then
+ return 0
+ fi
+ return 1
+ }
+else
+ isgrmlsmall() { return 1 }
+fi
+
+isdarwin(){
+ [[ $OSTYPE == darwin* ]] && return 0
+ return 1
+}
+
+#f1# are we running within an utf environment?
+isutfenv() {
+ case "$LANG $CHARSET $LANGUAGE" in
+ *utf*) return 0 ;;
+ *UTF*) return 0 ;;
+ *) return 1 ;;
+ esac
+}
+
+# check for user, if not running as root set $SUDO to sudo
+(( EUID != 0 )) && SUDO='sudo' || SUDO=''
+
+# change directory to home on first invocation of zsh
+# important for rungetty -> autologin
+# Thanks go to Bart Schaefer!
+isgrml && checkhome() {
+ if [[ -z "$ALREADY_DID_CD_HOME" ]] ; then
+ export ALREADY_DID_CD_HOME=$HOME
+ cd
+ fi
+}
+
+# check for zsh v3.1.7+
+
+if ! [[ ${ZSH_VERSION} == 3.1.<7->* \
+ || ${ZSH_VERSION} == 3.<2->.<->* \
+ || ${ZSH_VERSION} == <4->.<->* ]] ; then
+
+ printf '-!-\n'
+ printf '-!- In this configuration we try to make use of features, that only\n'
+ printf '-!- require version 3.1.7 of the shell; That way this setup can be\n'
+ printf '-!- used with a wide range of zsh versions, while using fairly\n'
+ printf '-!- advanced features in all supported versions.\n'
+ printf '-!-\n'
+ printf '-!- However, you are running zsh version %s.\n' "$ZSH_VERSION"
+ printf '-!-\n'
+ printf '-!- While this *may* work, it might as well fail.\n'
+ printf '-!- Please consider updating to at least version 3.1.7 of zsh.\n'
+ printf '-!-\n'
+ printf '-!- DO NOT EXPECT THIS TO WORK FLAWLESSLY!\n'
+ printf '-!- If it does today, you'\''ve been lucky.\n'
+ printf '-!-\n'
+ printf '-!- Ye been warned!\n'
+ printf '-!-\n'
+
+ function zstyle() { : }
+fi
+
+# autoload wrapper - use this one instead of autoload directly
+# We need to define this function as early as this, because autoloading
+# 'is-at-least()' needs it.
+function zrcautoload() {
+ emulate -L zsh
+ setopt extended_glob
+ local fdir ffile
+ local -i ffound
+
+ ffile=$1
+ (( found = 0 ))
+ for fdir in ${fpath} ; do
+ [[ -e ${fdir}/${ffile} ]] && (( ffound = 1 ))
+ done
+
+ (( ffound == 0 )) && return 1
+ if [[ $ZSH_VERSION == 3.1.<6-> || $ZSH_VERSION == <4->* ]] ; then
+ autoload -U ${ffile} || return 1
+ else
+ autoload ${ffile} || return 1
+ fi
+ return 0
+}
+
+# Load is-at-least() for more precise version checks Note that this test will
+# *always* fail, if the is-at-least function could not be marked for
+# autoloading.
+zrcautoload is-at-least || is-at-least() { return 1 }
+
+# set some important options (as early as possible)
+
+# append history list to the history file; this is the default but we make sure
+# because it's required for share_history.
+setopt append_history
+
+# import new commands from the history file also in other zsh-session
+is4 && setopt share_history
+
+# save each command's beginning timestamp and the duration to the history file
+setopt extended_history
+
+# If a new command line being added to the history list duplicates an older
+# one, the older command is removed from the list
+is4 && setopt histignorealldups
+
+# remove command lines from the history list when the first character on the
+# line is a space
+setopt histignorespace
+
+# if a command is issued that can't be executed as a normal command, and the
+# command is the name of a directory, perform the cd command to that directory.
+setopt auto_cd
+
+# in order to use #, ~ and ^ for filename generation grep word
+# *~(*.gz|*.bz|*.bz2|*.zip|*.Z) -> searches for word not in compressed files
+# don't forget to quote '^', '~' and '#'!
+setopt extended_glob
+
+# display PID when suspending processes as well
+setopt longlistjobs
+
+# try to avoid the 'zsh: no matches found...'
+setopt nonomatch
+
+# report the status of backgrounds jobs immediately
+setopt notify
+
+# whenever a command completion is attempted, make sure the entire command path
+# is hashed first.
+setopt hash_list_all
+
+# not just at the end
+setopt completeinword
+
+# Don't send SIGHUP to background processes when the shell exits.
+setopt nohup
+
+# make cd push the old directory onto the directory stack.
+setopt auto_pushd
+
+# avoid "beep"ing
+setopt nobeep
+
+# don't push the same dir twice.
+setopt pushd_ignore_dups
+
+# * shouldn't match dotfiles. ever.
+setopt noglobdots
+
+# use zsh style word splitting
+setopt noshwordsplit
+
+# don't error out when unset parameters are used
+setopt unset
+
+# setting some default values
+NOCOR=${NOCOR:-0}
+NOMENU=${NOMENU:-0}
+NOPRECMD=${NOPRECMD:-0}
+COMMAND_NOT_FOUND=${COMMAND_NOT_FOUND:-0}
+GRML_ZSH_CNF_HANDLER=${GRML_ZSH_CNF_HANDLER:-/usr/share/command-not-found/command-not-found}
+BATTERY=${BATTERY:-0}
+GRMLSMALL_SPECIFIC=${GRMLSMALL_SPECIFIC:-1}
+ZSH_NO_DEFAULT_LOCALE=${ZSH_NO_DEFAULT_LOCALE:-0}
+
+typeset -ga ls_options
+typeset -ga grep_options
+if ls --help 2> /dev/null | grep -q GNU; then
+ ls_options=( --color=auto )
+elif [[ $OSTYPE == freebsd* ]]; then
+ ls_options=( -G )
+fi
+if grep --help 2> /dev/null | grep -q GNU || \
+ [[ $OSTYPE == freebsd* ]]; then
+ grep_options=( --color=auto )
+fi
+
+# utility functions
+# this function checks if a command exists and returns either true
+# or false. This avoids using 'which' and 'whence', which will
+# avoid problems with aliases for which on certain weird systems. :-)
+# Usage: check_com [-c|-g] word
+# -c only checks for external commands
+# -g does the usual tests and also checks for global aliases
+check_com() {
+ emulate -L zsh
+ local -i comonly gatoo
+
+ if [[ $1 == '-c' ]] ; then
+ (( comonly = 1 ))
+ shift
+ elif [[ $1 == '-g' ]] ; then
+ (( gatoo = 1 ))
+ else
+ (( comonly = 0 ))
+ (( gatoo = 0 ))
+ fi
+
+ if (( ${#argv} != 1 )) ; then
+ printf 'usage: check_com [-c] <command>\n' >&2
+ return 1
+ fi
+
+ if (( comonly > 0 )) ; then
+ [[ -n ${commands[$1]} ]] && return 0
+ return 1
+ fi
+
+ if [[ -n ${commands[$1]} ]] \
+ || [[ -n ${functions[$1]} ]] \
+ || [[ -n ${aliases[$1]} ]] \
+ || [[ -n ${reswords[(r)$1]} ]] ; then
+
+ return 0
+ fi
+
+ if (( gatoo > 0 )) && [[ -n ${galiases[$1]} ]] ; then
+ return 0
+ fi
+
+ return 1
+}
+
+# creates an alias and precedes the command with
+# sudo if $EUID is not zero.
+salias() {
+ emulate -L zsh
+ local only=0 ; local multi=0
+ while [[ $1 == -* ]] ; do
+ case $1 in
+ (-o) only=1 ;;
+ (-a) multi=1 ;;
+ (--) shift ; break ;;
+ (-h)
+ printf 'usage: salias [-h|-o|-a] <alias-expression>\n'
+ printf ' -h shows this help text.\n'
+ printf ' -a replace '\'' ; '\'' sequences with '\'' ; sudo \
'\''.\n' + printf ' be careful using this option.\n'
+ printf ' -o only sets an alias if a preceding sudo would be \
needed.\n' + return 0
+ ;;
+ (*) printf "unkown option: '%s'\n" "$1" ; return 1 ;;
+ esac
+ shift
+ done
+
+ if (( ${#argv} > 1 )) ; then
+ printf 'Too many arguments %s\n' "${#argv}"
+ return 1
+ fi
+
+ key="${1%%\=*}" ; val="${1#*\=}"
+ if (( EUID == 0 )) && (( only == 0 )); then
+ alias -- "${key}=${val}"
+ elif (( EUID > 0 )) ; then
+ (( multi > 0 )) && val="${val// ; / ; sudo }"
+ alias -- "${key}=sudo ${val}"
+ fi
+
+ return 0
+}
+
+# a "print -l ${(u)foo}"-workaround for pre-4.2.0 shells
+# usage: uprint foo
+# Where foo is the *name* of the parameter you want printed.
+# Note that foo is no typo; $foo would be wrong here!
+if ! is42 ; then
+ uprint () {
+ emulate -L zsh
+ local -a u
+ local w
+ local parameter=$1
+
+ if [[ -z ${parameter} ]] ; then
+ printf 'usage: uprint <parameter>\n'
+ return 1
+ fi
+
+ for w in ${(P)parameter} ; do
+ [[ -z ${(M)u:#$w} ]] && u=( $u $w )
+ done
+
+ builtin print -l $u
+ }
+fi
+
+# Check if we can read given files and source those we can.
+xsource() {
+ if (( ${#argv} < 1 )) ; then
+ printf 'usage: xsource FILE(s)...\n' >&2
+ return 1
+ fi
+
+ while (( ${#argv} > 0 )) ; do
+ [[ -r "$1" ]] && source "$1"
+ shift
+ done
+ return 0
+}
+
+# Check if we can read a given file and 'cat(1)' it.
+xcat() {
+ emulate -L zsh
+ if (( ${#argv} != 1 )) ; then
+ printf 'usage: xcat FILE\n' >&2
+ return 1
+ fi
+
+ [[ -r $1 ]] && cat $1
+ return 0
+}
+
+# Remove these functions again, they are of use only in these
+# setup files. This should be called at the end of .zshrc.
+xunfunction() {
+ emulate -L zsh
+ local -a funcs
+ funcs=(salias xcat xsource xunfunction zrcautoload)
+
+ for func in $funcs ; do
+ [[ -n ${functions[$func]} ]] \
+ && unfunction $func
+ done
+ return 0
+}
+
+# this allows us to stay in sync with grml's zshrc and put own
+# modifications in ~/.zshrc.local
+zrclocal() {
+ xsource "/etc/zsh/zshrc.local"
+ xsource "${HOME}/.zshrc.local"
+ return 0
+}
+
+# locale setup
+if (( ZSH_NO_DEFAULT_LOCALE == 0 )); then
+ xsource "/etc/default/locale"
+fi
+
+for var in LANG LC_ALL LC_MESSAGES ; do
+ [[ -n ${(P)var} ]] && export $var
+done
+
+xsource "/etc/sysconfig/keyboard"
+
+TZ=$(xcat /etc/timezone)
+
+# set some variables
+if check_com -c vim ; then
+#v#
+ export EDITOR=${EDITOR:-vim}
+else
+ export EDITOR=${EDITOR:-vi}
+fi
+
+#v#
+export PAGER=${PAGER:-less}
+
+#v#
+export MAIL=${MAIL:-/var/mail/$USER}
+
+# if we don't set $SHELL then aterm, rxvt,.. will use /bin/sh or /bin/bash :-/
+export SHELL='/bin/zsh'
+
+# color setup for ls:
+check_com -c dircolors && eval $(dircolors -b)
+# color setup for ls on OS X:
+isdarwin && export CLICOLOR=1
+
+# do MacPorts setup on darwin
+if isdarwin && [[ -d /opt/local ]]; then
+ # Note: PATH gets set in /etc/zprofile on Darwin, so this can't go into
+ # zshenv.
+ PATH="/opt/local/bin:/opt/local/sbin:$PATH"
+ MANPATH="/opt/local/share/man:$MANPATH"
+fi
+# do Fink setup on darwin
+isdarwin && xsource /sw/bin/init.sh
+
+# load our function and completion directories
+for fdir in /usr/share/grml/zsh/completion /usr/share/grml/zsh/functions; do
+ fpath=( ${fdir} ${fdir}/**/*(/N) ${fpath} )
+ if [[ ${fpath} == '/usr/share/grml/zsh/functions' ]] ; then
+ for func in ${fdir}/**/[^_]*[^~](N.) ; do
+ zrcautoload ${func:t}
+ done
+ fi
+done
+unset fdir func
+
+# support colors in less
+export LESS_TERMCAP_mb=$'\E[01;31m'
+export LESS_TERMCAP_md=$'\E[01;31m'
+export LESS_TERMCAP_me=$'\E[0m'
+export LESS_TERMCAP_se=$'\E[0m'
+export LESS_TERMCAP_so=$'\E[01;44;33m'
+export LESS_TERMCAP_ue=$'\E[0m'
+export LESS_TERMCAP_us=$'\E[01;32m'
+
+# mailchecks
+MAILCHECK0
+
+# report about cpu-/system-/user-time of command if running longer than
+# 5 seconds
+REPORTTIME=5
+
+# watch for everyone but me and root
+watch=(notme root)
+
+# automatically remove duplicates from these arrays
+typeset -U path cdpath fpath manpath
+
+# keybindings
+if [[ "$TERM" != emacs ]] ; then
+ [[ -z "$terminfo[kdch1]" ]] || bindkey -M emacs "$terminfo[kdch1]" delete-char
+ [[ -z "$terminfo[khome]" ]] || bindkey -M emacs "$terminfo[khome]" \
beginning-of-line + [[ -z "$terminfo[kend]" ]] || bindkey -M emacs \
"$terminfo[kend]" end-of-line + [[ -z "$terminfo[kdch1]" ]] || bindkey -M vicmd \
"$terminfo[kdch1]" vi-delete-char + [[ -z "$terminfo[khome]" ]] || bindkey -M \
vicmd "$terminfo[khome]" vi-beginning-of-line + [[ -z "$terminfo[kend]" ]] || \
bindkey -M vicmd "$terminfo[kend]" vi-end-of-line + [[ -z "$terminfo[cuu1]" ]] \
|| bindkey -M viins "$terminfo[cuu1]" vi-up-line-or-history + [[ -z \
"$terminfo[cuf1]" ]] || bindkey -M viins "$terminfo[cuf1]" vi-forward-char + [[ \
-z "$terminfo[kcuu1]" ]] || bindkey -M viins "$terminfo[kcuu1]" vi-up-line-or-history \
+ [[ -z "$terminfo[kcud1]" ]] || bindkey -M viins "$terminfo[kcud1]" \
vi-down-line-or-history + [[ -z "$terminfo[kcuf1]" ]] || bindkey -M viins \
"$terminfo[kcuf1]" vi-forward-char + [[ -z "$terminfo[kcub1]" ]] || bindkey -M \
viins "$terminfo[kcub1]" vi-backward-char + # ncurses stuff:
+ [[ "$terminfo[kcuu1]" == $'\eO'* ]] && bindkey -M viins "${terminfo[kcuu1]/O/[}" \
vi-up-line-or-history + [[ "$terminfo[kcud1]" == $'\eO'* ]] && bindkey -M viins \
"${terminfo[kcud1]/O/[}" vi-down-line-or-history + [[ "$terminfo[kcuf1]" == \
$'\eO'* ]] && bindkey -M viins "${terminfo[kcuf1]/O/[}" vi-forward-char + [[ \
"$terminfo[kcub1]" == $'\eO'* ]] && bindkey -M viins "${terminfo[kcub1]/O/[}" \
vi-backward-char + [[ "$terminfo[khome]" == $'\eO'* ]] && bindkey -M viins \
"${terminfo[khome]/O/[}" beginning-of-line + [[ "$terminfo[kend]" == $'\eO'* ]] \
&& bindkey -M viins "${terminfo[kend]/O/[}" end-of-line + [[ "$terminfo[khome]" \
== $'\eO'* ]] && bindkey -M emacs "${terminfo[khome]/O/[}" beginning-of-line + [[ \
"$terminfo[kend]" == $'\eO'* ]] && bindkey -M emacs "${terminfo[kend]/O/[}" \
end-of-line +fi
+
+## keybindings (run 'bindkeys' for details, more details via man zshzle)
+# use emacs style per default:
+bindkey -e
+# use vi style:
+# bindkey -v
+
+## beginning-of-line OR beginning-of-buffer OR beginning of history
+## by: Bart Schaefer <schaefer@brasslantern.com>, Bernhard Tittelbach
+beginning-or-end-of-somewhere() {
+ local hno=$HISTNO
+ if [[ ( "${LBUFFER[-1]}" == $'\n' && "${WIDGET}" == beginning-of* ) || \
+ ( "${RBUFFER[1]}" == $'\n' && "${WIDGET}" == end-of* ) ]]; then
+ zle .${WIDGET:s/somewhere/buffer-or-history/} "$@"
+ else
+ zle .${WIDGET:s/somewhere/line-hist/} "$@"
+ if (( HISTNO != hno )); then
+ zle .${WIDGET:s/somewhere/buffer-or-history/} "$@"
+ fi
+ fi
+}
+zle -N beginning-of-somewhere beginning-or-end-of-somewhere
+zle -N end-of-somewhere beginning-or-end-of-somewhere
+
+
+#if [[ "$TERM" == screen ]] ; then
+
+## with HOME/END, move to beginning/end of line (on multiline) on first keypress
+## to beginning/end of buffer on second keypress
+## and to beginning/end of history on (at most) the third keypress
+# terminator & non-debian xterm
+bindkey '\eOH' beginning-of-somewhere # home
+bindkey '\eOF' end-of-somewhere # end
+# freebsd console
+bindkey '\e[H' beginning-of-somewhere # home
+bindkey '\e[F' end-of-somewhere # end
+# xterm,gnome-terminal,quake,etc
+bindkey '^[[1~' beginning-of-somewhere # home
+bindkey '^[[4~' end-of-somewhere # end
+# if terminal type is set to 'rxvt':
+bindkey '\e[7~' beginning-of-somewhere # home
+bindkey '\e[8~' end-of-somewhere # end
+#fi
+
+bindkey '\e[A' up-line-or-search # cursor up
+bindkey '\e[B' down-line-or-search # <ESC>-
+
+## use Ctrl-left-arrow and Ctrl-right-arrow for jumping to word-beginnings on the CL
+bindkey "\e[5C" forward-word
+bindkey "\e[5D" backward-word
+bindkey "\e[1;5C" forward-word
+bindkey "\e[1;5D" backward-word
+## the same for alt-left-arrow and alt-right-arrow
+bindkey '^[[1;3C' forward-word
+bindkey '^[[1;3D' backward-word
+
+# Search backward in the history for a line beginning with the current
+# line up to the cursor and move the cursor to the end of the line then
+zle -N history-beginning-search-backward-end history-search-end
+zle -N history-beginning-search-forward-end history-search-end
+#k# search history backward for entry beginning with typed text
+bindkey '^xp' history-beginning-search-backward-end
+#k# search history forward for entry beginning with typed text
+bindkey '^xP' history-beginning-search-forward-end
+#k# search history backward for entry beginning with typed text
+bindkey "\e[5~" history-beginning-search-backward-end # PageUp
+#k# search history forward for entry beginning with typed text
+bindkey "\e[6~" history-beginning-search-forward-end # PageDown
+
+# bindkey -s '^l' "|less\n" # ctrl-L pipes to less
+# bindkey -s '^b' " &\n" # ctrl-B runs it in the background
+
+# insert unicode character
+# usage example: 'ctrl-x i' 00A7 'ctrl-x i' will give you an §
+# See for example http://unicode.org/charts/ for unicode characters code
+zrcautoload insert-unicode-char
+zle -N insert-unicode-char
+#k# Insert Unicode character
+bindkey '^xi' insert-unicode-char
+
+#m# k Shift-tab Perform backwards menu completion
+if [[ -n "$terminfo[kcbt]" ]]; then
+ bindkey "$terminfo[kcbt]" reverse-menu-complete
+elif [[ -n "$terminfo[cbt]" ]]; then # required for GNU screen
+ bindkey "$terminfo[cbt]" reverse-menu-complete
+fi
+
+## toggle the ,. abbreviation feature on/off
+# NOABBREVIATION: default abbreviation-state
+# 0 - enabled (default)
+# 1 - disabled
+NOABBREVIATION=${NOABBREVIATION:-0}
+
+grml_toggle_abbrev() {
+ if (( ${NOABBREVIATION} > 0 )) ; then
+ NOABBREVIATION=0
+ else
+ NOABBREVIATION=1
+ fi
+}
+
+#k# Toggle abbreviation expansion on/off
+zle -N grml_toggle_abbrev
+bindkey '^xA' grml_toggle_abbrev
+
+# add a command line to the shells history without executing it
+commit-to-history() {
+ print -s ${(z)BUFFER}
+ zle send-break
+}
+zle -N commit-to-history
+bindkey "^x^h" commit-to-history
+
+# only slash should be considered as a word separator:
+slash-backward-kill-word() {
+ local WORDCHARS="${WORDCHARS:s@/@}"
+ # zle backward-word
+ zle backward-kill-word
+}
+zle -N slash-backward-kill-word
+
+#k# Kill left-side word or everything up to next slash
+bindkey '\ev' slash-backward-kill-word
+#k# Kill left-side word or everything up to next slash
+bindkey '\e^h' slash-backward-kill-word
+#k# Kill left-side word or everything up to next slash
+bindkey '\e^?' slash-backward-kill-word
+
+# use the new *-pattern-* widgets for incremental history search
+if is439 ; then
+ bindkey '^r' history-incremental-pattern-search-backward
+ bindkey '^s' history-incremental-pattern-search-forward
+fi
+
+# a generic accept-line wrapper
+
+# This widget can prevent unwanted autocorrections from command-name
+# to _command-name, rehash automatically on enter and call any number
+# of builtin and user-defined widgets in different contexts.
+#
+# For a broader description, see:
+# <http://bewatermyfriend.org/posts/2007/12-26.11-50-38-tooltime.html>
+#
+# The code is imported from the file 'zsh/functions/accept-line' from
+# <http://ft.bewatermyfriend.org/comp/zsh/zsh-dotfiles.tar.bz2>, which
+# distributed under the same terms as zsh itself.
+
+# A newly added command will may not be found or will cause false
+# correction attempts, if you got auto-correction set. By setting the
+# following style, we force accept-line() to rehash, if it cannot
+# find the first word on the command line in the $command[] hash.
+zstyle ':acceptline:*' rehash true
+
+function Accept-Line() {
+ setopt localoptions noksharrays
+ local -a subs
+ local -xi aldone
+ local sub
+ local alcontext=${1:-$alcontext}
+
+ zstyle -a ":acceptline:${alcontext}" actions subs
+
+ (( ${#subs} < 1 )) && return 0
+
+ (( aldone = 0 ))
+ for sub in ${subs} ; do
+ [[ ${sub} == 'accept-line' ]] && sub='.accept-line'
+ zle ${sub}
+
+ (( aldone > 0 )) && break
+ done
+}
+
+function Accept-Line-getdefault() {
+ emulate -L zsh
+ local default_action
+
+ zstyle -s ":acceptline:${alcontext}" default_action default_action
+ case ${default_action} in
+ ((accept-line|))
+ printf ".accept-line"
+ ;;
+ (*)
+ printf ${default_action}
+ ;;
+ esac
+}
+
+function Accept-Line-HandleContext() {
+ zle Accept-Line
+
+ default_action=$(Accept-Line-getdefault)
+ zstyle -T ":acceptline:${alcontext}" call_default \
+ && zle ${default_action}
+}
+
+function accept-line() {
+ setopt localoptions noksharrays
+ local -ax cmdline
+ local -x alcontext
+ local buf com fname format msg default_action
+
+ alcontext='default'
+ buf="${BUFFER}"
+ cmdline=(${(z)BUFFER})
+ com="${cmdline[1]}"
+ fname="_${com}"
+
+ Accept-Line 'preprocess'
+
+ zstyle -t ":acceptline:${alcontext}" rehash \
+ && [[ -z ${commands[$com]} ]] \
+ && rehash
+
+ if [[ -n ${com} ]] \
+ && [[ -n ${reswords[(r)$com]} ]] \
+ || [[ -n ${aliases[$com]} ]] \
+ || [[ -n ${functions[$com]} ]] \
+ || [[ -n ${builtins[$com]} ]] \
+ || [[ -n ${commands[$com]} ]] ; then
+
+ # there is something sensible to execute, just do it.
+ alcontext='normal'
+ Accept-Line-HandleContext
+
+ return
+ fi
+
+ if [[ -o correct ]] \
+ || [[ -o correctall ]] \
+ && [[ -n ${functions[$fname]} ]] ; then
+
+ # nothing there to execute but there is a function called
+ # _command_name; a completion widget. Makes no sense to
+ # call it on the commandline, but the correct{,all} options
+ # will ask for it nevertheless, so warn the user.
+ if [[ ${LASTWIDGET} == 'accept-line' ]] ; then
+ # Okay, we warned the user before, he called us again,
+ # so have it his way.
+ alcontext='force'
+ Accept-Line-HandleContext
+
+ return
+ fi
+
+ if zstyle -t ":acceptline:${alcontext}" nocompwarn ; then
+ alcontext='normal'
+ Accept-Line-HandleContext
+ else
+ # prepare warning message for the user, configurable via zstyle.
+ zstyle -s ":acceptline:${alcontext}" compwarnfmt msg
+
+ if [[ -z ${msg} ]] ; then
+ msg="%c will not execute and completion %f exists."
+ fi
+
+ zformat -f msg "${msg}" "c:${com}" "f:${fname}"
+
+ zle -M -- "${msg}"
+ fi
+ return
+ elif [[ -n ${buf//[$' \t\n']##/} ]] ; then
+ # If we are here, the commandline contains something that is not
+ # executable, which is neither subject to _command_name correction
+ # and is not empty. might be a variable assignment
+ alcontext='misc'
+ Accept-Line-HandleContext
+
+ return
+ fi
+
+ # If we got this far, the commandline only contains whitespace, or is empty.
+ alcontext='empty'
+ Accept-Line-HandleContext
+}
+
+zle -N accept-line
+zle -N Accept-Line
+zle -N Accept-Line-HandleContext
+
+# power completion - abbreviation expansion
+# power completion / abbreviation expansion / buffer expansion
+# see http://zshwiki.org/home/examples/zleiab for details
+# less risky than the global aliases but powerful as well
+# just type the abbreviation key and afterwards ',.' to expand it
+declare -A abk
+setopt extendedglob
+setopt interactivecomments
+abk=(
+# key # value (#d additional doc string)
+#A# start
+ '...' '../..'
+ '....' '../../..'
+ 'BG' '& exit'
+ 'C' '| wc -l'
+ 'G' '|& grep '${grep_options:+"${grep_options[*]} "}
+ 'H' '| head'
+ 'Hl' ' --help |& less -r' #d (Display help in pager)
+ 'L' '| less'
+ 'LL' '|& less -r'
+ 'M' '| most'
+ 'N' '&>/dev/null' #d (No Output)
+ 'R' '| tr A-z N-za-m' #d (ROT13)
+ 'SL' '| sort | less'
+ 'S' '| sort -u'
+ 'T' '| tail'
+ 'V' '|& vim -'
+#A# end
+ 'co' './configure && make && sudo make install'
+)
+
+zleiab() {
+ emulate -L zsh
+ setopt extendedglob
+ local MATCH
+
+ if (( NOABBREVIATION > 0 )) ; then
+ LBUFFER="${LBUFFER},."
+ return 0
+ fi
+
+ matched_chars='[.-|_a-zA-Z0-9]#'
+ LBUFFER=${LBUFFER%%(#m)[.-|_a-zA-Z0-9]#}
+ LBUFFER+=${abk[$MATCH]:-$MATCH}
+}
+
+zle -N zleiab && bindkey ",." zleiab
+
+#f# display contents of assoc array $abk
+help-show-abk()
+{
+ zle -M "$(print "Type ,. after these abbreviations to expand them:"; print -a -C 2 \
${(kv)abk})" +}
+#k# Display list of abbreviations that expand when followed by ,.
+zle -N help-show-abk && bindkey '^xb' help-show-abk
+
+# autoloading
+zrcautoload zmv # who needs mmv or rename?
+zrcautoload history-search-end
+
+# we don't want to quote/espace URLs on our own...
+# if autoload -U url-quote-magic ; then
+# zle -N self-insert url-quote-magic
+# zstyle ':url-quote-magic:*' url-metas '*?[]^()~#{}='
+# else
+# print 'Notice: no url-quote-magic available :('
+# fi
+alias url-quote='autoload -U url-quote-magic ; zle -N self-insert url-quote-magic'
+
+#m# k ESC-h Call \kbd{run-help} for the 1st word on the command line
+alias run-help >&/dev/null && unalias run-help
+for rh in run-help{,-git,-svk,-svn}; do
+ zrcautoload $rh
+done; unset rh
+
+# completion system
+if zrcautoload compinit ; then
+ compinit || print 'Notice: no compinit available :('
+else
+ print 'Notice: no compinit available :('
+ function zstyle { }
+ function compdef { }
+fi
+
+is4 && zrcautoload zed # use ZLE editor to edit a file or function
+
+is4 && \
+for mod in complist deltochar mathfunc ; do
+ zmodload -i zsh/${mod} 2>/dev/null || print "Notice: no ${mod} available :("
+done
+
+# autoload zsh modules when they are referenced
+if is4 ; then
+ zmodload -a zsh/stat zstat
+ zmodload -a zsh/zpty zpty
+ zmodload -ap zsh/mapfile mapfile
+fi
+
+if is4 && zrcautoload insert-files && zle -N insert-files ; then
+ #k# Insert files and test globbing
+ bindkey "^xf" insert-files # C-x-f
+fi
+
+bindkey ' ' magic-space # also do history expansion on space
+#k# Trigger menu-complete
+bindkey '\ei' menu-complete # menu completion via esc-i
+
+# press esc-e for editing command line in $EDITOR or $VISUAL
+if is4 && zrcautoload edit-command-line && zle -N edit-command-line ; then
+ #k# Edit the current line in \kbd{\$EDITOR}
+ bindkey '\ee' edit-command-line
+fi
+
+if is4 && [[ -n ${(k)modules[zsh/complist]} ]] ; then
+ #k# menu selection: pick item but stay in the menu
+ bindkey -M menuselect '\e^M' accept-and-menu-complete
+ # also use + and INSERT since it's easier to press repeatedly
+ bindkey -M menuselect "+" accept-and-menu-complete
+ bindkey -M menuselect "^[[2~" accept-and-menu-complete
+
+ # accept a completion and try to complete again by using menu
+ # completion; very useful with completing directories
+ # by using 'undo' one's got a simple file browser
+ bindkey -M menuselect '^o' accept-and-infer-next-history
+fi
+
+# press "ctrl-e d" to insert the actual date in the form yyyy-mm-dd
+insert-datestamp() { LBUFFER+=${(%):-'%D{%Y-%m-%d}'}; }
+zle -N insert-datestamp
+
+#k# Insert a timestamp on the command line (yyyy-mm-dd)
+bindkey '^ed' insert-datestamp
+
+# press esc-m for inserting last typed word again (thanks to caphuso!)
+insert-last-typed-word() { zle insert-last-word -- 0 -1 };
+zle -N insert-last-typed-word;
+
+#k# Insert last typed word
+bindkey "\em" insert-last-typed-word
+
+function grml-zsh-fg() {
+ if (( ${#jobstates} )); then
+ zle .push-input
+ [[ -o hist_ignore_space ]] && BUFFER=' ' || BUFFER=''
+ BUFFER="${BUFFER}fg"
+ zle .accept-line
+ else
+ zle -M 'No background jobs. Doing nothing.'
+ fi
+}
+zle -N grml-zsh-fg
+#k# A smart shortcut for \kbd{fg<enter>}
+bindkey '^z' grml-zsh-fg
+
+# run command line as user root via sudo:
+sudo-command-line() {
+ [[ -z $BUFFER ]] && zle up-history
+ if [[ $BUFFER != sudo\ * ]]; then
+ BUFFER="sudo $BUFFER"
+ CURSOR=$(( CURSOR+5 ))
+ fi
+}
+zle -N sudo-command-line
+
+#k# prepend the current command with "sudo"
+bindkey "^os" sudo-command-line
+
+### jump behind the first word on the cmdline.
+### useful to add options.
+function jump_after_first_word() {
+ local words
+ words=(${(z)BUFFER})
+
+ if (( ${#words} <= 1 )) ; then
+ CURSOR=${#BUFFER}
+ else
+ CURSOR=${#${words[1]}}
+ fi
+}
+zle -N jump_after_first_word
+#k# jump to after first word (for adding options)
+bindkey '^x1' jump_after_first_word
+
+# complete word from history with menu (from Book: ZSH, OpenSource-Press)
+zle -C hist-complete complete-word _generic
+zstyle ':completion:hist-complete:*' completer _history
+#k# complete word from history with menu
+bindkey "^x^x" hist-complete
+
+## complete word from currently visible Screen or Tmux buffer.
+if check_com -c screen || check_com -c tmux; then
+ _complete_screen_display() {
+ [[ "$TERM" != "screen" ]] && return 1
+
+ local TMPFILE=$(mktemp)
+ local -U -a _screen_display_wordlist
+ trap "rm -f $TMPFILE" EXIT
+
+ # fill array with contents from screen hardcopy
+ if ((${+TMUX})); then
+ #works, but crashes tmux below version 1.4
+ #luckily tmux -V option to ask for version, was also added in 1.4
+ tmux -V &>/dev/null || return
+ tmux -q capture-pane \; save-buffer -b 0 $TMPFILE \; delete-buffer -b 0
+ else
+ screen -X hardcopy $TMPFILE
+ # screen sucks, it dumps in latin1, apparently always. so recode it
+ # to system charset
+ check_com recode && recode latin1 $TMPFILE
+ fi
+ _screen_display_wordlist=( ${(QQ)$(<$TMPFILE)} )
+ # remove PREFIX to be completed from that array
+ _screen_display_wordlist[${_screen_display_wordlist[(i)$PREFIX]}]=""
+ compadd -a _screen_display_wordlist
+ }
+ #k# complete word from currently visible GNU screen buffer
+ bindkey -r "^xS"
+ compdef -k _complete_screen_display complete-word '^xS'
+fi
+
+# history
+
+ZSHDIR=$HOME/.zsh
+
+#v#
+HISTFILE=$HOME/.zsh_history
+isgrmlcd && HISTSIZEP0 || HISTSIZEP00
+isgrmlcd && SAVEHIST00 || SAVEHIST000 # useful for setopt append_history
+
+# dirstack handling
+
+DIRSTACKSIZE=${DIRSTACKSIZE:-20}
+DIRSTACKFILE=${DIRSTACKFILE:-${HOME}/.zdirs}
+
+if [[ -f ${DIRSTACKFILE} ]] && [[ ${#dirstack[*]} -eq 0 ]] ; then
+ dirstack=( ${(f)"$(< $DIRSTACKFILE)"} )
+ # "cd -" won't work after login by just setting $OLDPWD, so
+ [[ -d $dirstack[1] ]] && cd $dirstack[1] && cd $OLDPWD
+fi
+
+chpwd() {
+ local -ax my_stack
+ my_stack=( ${PWD} ${dirstack} )
+ if is42 ; then
+ builtin print -l ${(u)my_stack} >! ${DIRSTACKFILE}
+ else
+ uprint my_stack >! ${DIRSTACKFILE}
+ fi
+}
+
+# directory based profiles
+
+if is433 ; then
+
+CHPWD_PROFILE='default'
+function chpwd_profiles() {
+ # Say you want certain settings to be active in certain directories.
+ # This is what you want.
+ #
+ # zstyle ':chpwd:profiles:/usr/src/grml(|/|/*)' profile grml
+ # zstyle ':chpwd:profiles:/usr/src/debian(|/|/*)' profile debian
+ #
+ # When that's done and you enter a directory that matches the pattern
+ # in the third part of the context, a function called chpwd_profile_grml,
+ # for example, is called (if it exists).
+ #
+ # If no pattern matches (read: no profile is detected) the profile is
+ # set to 'default', which means chpwd_profile_default is attempted to
+ # be called.
+ #
+ # A word about the context (the ':chpwd:profiles:*' stuff in the zstyle
+ # command) which is used: The third part in the context is matched against
+ # ${PWD}. That's why using a pattern such as /foo/bar(|/|/*) makes sense.
+ # Because that way the profile is detected for all these values of ${PWD}:
+ # /foo/bar
+ # /foo/bar/
+ # /foo/bar/baz
+ # So, if you want to make double damn sure a profile works in /foo/bar
+ # and everywhere deeper in that tree, just use (|/|/*) and be happy.
+ #
+ # The name of the detected profile will be available in a variable called
+ # 'profile' in your functions. You don't need to do anything, it'll just
+ # be there.
+ #
+ # Then there is the parameter $CHPWD_PROFILE is set to the profile, that
+ # was is currently active. That way you can avoid running code for a
+ # profile that is already active, by running code such as the following
+ # at the start of your function:
+ #
+ # function chpwd_profile_grml() {
+ # [[ ${profile} == ${CHPWD_PROFILE} ]] && return 1
+ # ...
+ # }
+ #
+ # The initial value for $CHPWD_PROFILE is 'default'.
+ #
+ # Version requirement:
+ # This feature requires zsh 4.3.3 or newer.
+ # If you use this feature and need to know whether it is active in your
+ # current shell, there are several ways to do that. Here are two simple
+ # ways:
+ #
+ # a) If knowing if the profiles feature is active when zsh starts is
+ # good enough for you, you can put the following snippet into your
+ # .zshrc.local:
+ #
+ # (( ${+functions[chpwd_profiles]} )) && print "directory profiles active"
+ #
+ # b) If that is not good enough, and you would prefer to be notified
+ # whenever a profile changes, you can solve that by making sure you
+ # start *every* profile function you create like this:
+ #
+ # function chpwd_profile_myprofilename() {
+ # [[ ${profile} == ${CHPWD_PROFILE} ]] && return 1
+ # print "chpwd(): Switching to profile: $profile"
+ # ...
+ # }
+ #
+ # That makes sure you only get notified if a profile is *changed*,
+ # not everytime you change directory, which would probably piss
+ # you off fairly quickly. :-)
+ #
+ # There you go. Now have fun with that.
+ local -x profile
+
+ zstyle -s ":chpwd:profiles:${PWD}" profile profile || profile='default'
+ if (( ${+functions[chpwd_profile_$profile]} )) ; then
+ chpwd_profile_${profile}
+ fi
+
+ CHPWD_PROFILE="${profile}"
+ return 0
+}
+chpwd_functions=( ${chpwd_functions} chpwd_profiles )
+
+fi # is433
+
+# display battery status on right side of prompt via running 'BATTERY=1 zsh'
+if [[ $BATTERY -gt 0 ]] ; then
+ if ! check_com -c acpi ; then
+ BATTERY=0
+ fi
+fi
+
+battery() {
+if [[ $BATTERY -gt 0 ]] ; then
+ PERCENT="${${"$(acpi 2>/dev/null)"}/(#b)[[:space:]]#Battery <->: [^0-9]##, \
(<->)%*/${match[1]}}" + if [[ -z "$PERCENT" ]] ; then
+ PERCENT='acpi not present'
+ else
+ if [[ "$PERCENT" -lt 20 ]] ; then
+ PERCENT="warning: ${PERCENT}%%"
+ else
+ PERCENT="${PERCENT}%%"
+ fi
+ fi
+fi
+}
+# set colors for use in prompts
+if zrcautoload colors && colors 2>/dev/null ; then
+ BLUE="%{${fg[blue]}%}"
+ RED="%{${fg_bold[red]}%}"
+ GREEN="%{${fg[green]}%}"
+ CYAN="%{${fg[cyan]}%}"
+ MAGENTA="%{${fg[magenta]}%}"
+ YELLOW="%{${fg[yellow]}%}"
+ WHITE="%{${fg[white]}%}"
+ NO_COLOUR="%{${reset_color}%}"
+else
+ BLUE=$'%{\e[1;34m%}'
+ RED=$'%{\e[1;31m%}'
+ GREEN=$'%{\e[1;32m%}'
+ CYAN=$'%{\e[1;36m%}'
+ WHITE=$'%{\e[1;37m%}'
+ MAGENTA=$'%{\e[1;35m%}'
+ YELLOW=$'%{\e[1;33m%}'
+ NO_COLOUR=$'%{\e[0m%}'
+fi
+
+# gather version control information for inclusion in a prompt
+
+if zrcautoload vcs_info; then
+ # `vcs_info' in zsh versions 4.3.10 and below have a broken `_realpath'
+ # function, which can cause a lot of trouble with our directory-based
+ # profiles. So:
+ if [[ ${ZSH_VERSION} == 4.3.<-10> ]] ; then
+ function VCS_INFO_realpath () {
+ setopt localoptions NO_shwordsplit chaselinks
+ ( builtin cd -q $1 2> /dev/null && pwd; )
+ }
+ fi
+
+ zstyle ':vcs_info:*' max-exports 2
+
+ if [[ -o restricted ]]; then
+ zstyle ':vcs_info:*' enable NONE
+ fi
+fi
+
+# Change vcs_info formats for the grml prompt. The 2nd format sets up
+# $vcs_info_msg_1_ to contain "zsh: repo-name" used to set our screen title.
+# TODO: The included vcs_info() version still uses $VCS_INFO_message_N_.
+# That needs to be the use of $VCS_INFO_message_N_ needs to be changed
+# to $vcs_info_msg_N_ as soon as we use the included version.
+if [[ "$TERM" == dumb ]] ; then
+ zstyle ':vcs_info:*' actionformats "(%s%)-[%b|%a] " "zsh: %r"
+ zstyle ':vcs_info:*' formats "(%s%)-[%b] " "zsh: %r"
+else
+ # these are the same, just with a lot of colours:
+ zstyle ':vcs_info:*' actionformats \
"${MAGENTA}(${NO_COLOUR}%s${MAGENTA})${YELLOW}-${MAGENTA}[${GREEN}%b${YELLOW}|${RED}%a${MAGENTA}]${NO_COLOUR} \
" \ + "zsh: %r"
+ zstyle ':vcs_info:*' formats \
"${MAGENTA}(${NO_COLOUR}%s${MAGENTA})${YELLOW}-${MAGENTA}[${GREEN}%b${MAGENTA}]${NO_COLOUR}%} \
" \ + "zsh: %r"
+ zstyle ':vcs_info:(sv[nk]|bzr):*' branchformat "%b${RED}:${YELLOW}%r"
+fi
+
+# command not found handling
+
+(( ${COMMAND_NOT_FOUND} == 1 )) &&
+function command_not_found_handler() {
+ emulate -L zsh
+ if [[ -x ${GRML_ZSH_CNF_HANDLER} ]] ; then
+ ${GRML_ZSH_CNF_HANDLER} $1
+ fi
+ return 1
+}
+
+# set prompt
+if zrcautoload promptinit && promptinit 2>/dev/null ; then
+ promptinit # people should be able to use their favourite prompt
+else
+ print 'Notice: no promptinit available :('
+fi
+
+setopt prompt_subst
+
+# make sure to use right prompt only when not running a command
+is41 && setopt transient_rprompt
+
+
+function ESC_print () {
+ info_print $'\ek' $'\e\\' "$@"
+}
+function set_title () {
+ info_print $'\e]0;' $'\a' "$@"
+}
+
+function info_print () {
+ local esc_begin esc_end
+ esc_begin="$1"
+ esc_end="$2"
+ shift 2
+ printf '%s' ${esc_begin}
+ printf '%s' "$*"
+ printf '%s' "${esc_end}"
+}
+
+# TODO: revise all these NO* variables and especially their documentation
+# in zsh-help() below.
+is4 && [[ $NOPRECMD -eq 0 ]] && precmd () {
+ [[ $NOPRECMD -gt 0 ]] && return 0
+ # update VCS information
+ (( ${+functions[vcs_info]} )) && vcs_info
+
+ if [[ $TERM == screen* ]] ; then
+ if [[ -n ${vcs_info_msg_1_} ]] ; then
+ ESC_print ${vcs_info_msg_1_}
+ else
+ ESC_print "zsh"
+ fi
+ fi
+ # just use DONTSETRPROMPT=1 to be able to overwrite RPROMPT
+ if [[ ${DONTSETRPROMPT:-} -eq 0 ]] ; then
+ if [[ $BATTERY -gt 0 ]] ; then
+ # update battery (dropped into $PERCENT) information
+ battery
+ RPROMPT="%(?..:() ${PERCENT}"
+ else
+ RPROMPT="%(?..:() "
+ fi
+ fi
+ # adjust title of xterm
+ # see http://www.faqs.org/docs/Linux-mini/Xterm-Title.html
+ [[ ${NOTITLE:-} -gt 0 ]] && return 0
+ case $TERM in
+ (xterm*|rxvt*)
+ set_title ${(%):-"%n@%m: %~"}
+ ;;
+ esac
+}
+
+# preexec() => a function running before every command
+is4 && [[ $NOPRECMD -eq 0 ]] && \
+preexec () {
+ [[ $NOPRECMD -gt 0 ]] && return 0
+# set hostname if not running on host with name 'grml'
+ if [[ -n "$HOSTNAME" ]] && [[ "$HOSTNAME" != $(hostname) ]] ; then
+ NAME="@$HOSTNAME"
+ fi
+# get the name of the program currently running and hostname of local machine
+# set screen window title if running in a screen
+ if [[ "$TERM" == screen* ]] ; then
+ # local CMD=${1[(wr)^(*=*|sudo|ssh|-*)]} # don't use hostname
+ local CMD="${1[(wr)^(*=*|sudo|ssh|-*)]}$NAME" # use hostname
+ ESC_print ${CMD}
+ fi
+# adjust title of xterm
+ [[ ${NOTITLE} -gt 0 ]] && return 0
+ case $TERM in
+ (xterm*|rxvt*)
+ set_title "${(%):-"%n@%m:"}" "$1"
+ ;;
+ esac
+}
+
+EXITCODE="%(?..%?%1v )"
+# secondary prompt, printed when the shell needs more information to complete a
+# command.
+PS2='\`%_> '
+# selection prompt used within a select loop.
+PS3='?# '
+# the execution trace prompt (setopt xtrace). default: '+%N:%i>'
+PS4='+%N:%i:%_> '
+
+# set variable debian_chroot if running in a chroot with /etc/debian_chroot
+if [[ -z "$debian_chroot" ]] && [[ -r /etc/debian_chroot ]] ; then
+ debian_chroot=$(cat /etc/debian_chroot)
+fi
+
+# don't use colors on dumb terminals (like emacs):
+if [[ "$TERM" == dumb ]] ; then
+ PROMPT="${EXITCODE}${debian_chroot:+($debian_chroot)}%n@%m %40<...<%B%~%b%<< "
+else
+ # only if $GRMLPROMPT is set (e.g. via 'GRMLPROMPT=1 zsh') use the extended
+ # prompt set variable identifying the chroot you work in (used in the
+ # prompt below)
+ if [[ $GRMLPROMPT -gt 0 ]] ; then
+ PROMPT="${RED}${EXITCODE}${CYAN}[%j running job(s)] ${GREEN}{history#%!} \
${RED}%(3L.+.) ${BLUE}%* %D +${BLUE}%n${NO_COLOUR}@%m %40<...<%B%~%b%<< "
+ else
+ # This assembles the primary prompt string
+ if (( EUID != 0 )); then
+ #PROMPT="${RED}${EXITCODE}${WHITE}${debian_chroot:+($debian_chroot)}${BLUE}%n${NO_COLOUR}@%m \
%40<...<%B%~%b%<< " + \
PROMPT="${RED}${EXITCODE}${WHITE}${debian_chroot:+($debian_chroot)}${GREEN}%n@%m${BLUE} \
%40<...<%B%~%b%<< " + else
+ PROMPT="${BLUE}${EXITCODE}${WHITE}${debian_chroot:+($debian_chroot)}${RED}%n${NO_COLOUR}@%m \
%40<...<%B%~%b%<< " + fi
+ fi
+fi
+
+PROMPT="${PROMPT}"'${vcs_info_msg_0_}'"%# "
+
+# if we are inside a grml-chroot set a specific prompt theme
+if [[ -n "$GRML_CHROOT" ]] ; then
+ PROMPT="%{$fg[red]%}(CHROOT) %{$fg_bold[red]%}%n%{$fg_no_bold[white]%}@%m \
%40<...<%B%~%b%<< %\# " +fi
+
+# 'hash' some often used directories
+#d# start
+hash -d deb=/var/cache/apt/archives
+hash -d doc=/usr/share/doc
+hash -d linux=/lib/modules/$(command uname -r)/build/
+hash -d log=/var/log
+hash -d slog=/var/log/syslog
+hash -d src=/usr/src
+hash -d templ=/usr/share/doc/grml-templates
+hash -d tt=/usr/share/doc/texttools-doc
+hash -d www=/var/www
+#d# end
+
+# some aliases
+if check_com -c screen ; then
+ if [[ $UID -eq 0 ]] ; then
+ if [[ -r /etc/grml/screenrc ]]; then
+ alias screen="${commands[screen]} -c /etc/grml/screenrc"
+ fi
+ elif [[ -r $HOME/.screenrc ]] ; then
+ alias screen="${commands[screen]} -c $HOME/.screenrc"
+ else
+ if [[ -r /etc/grml/screenrc_grml ]]; then
+ alias screen="${commands[screen]} -c /etc/grml/screenrc_grml"
+ else
+ if [[ -r /etc/grml/screenrc ]]; then
+ alias screen="${commands[screen]} -c /etc/grml/screenrc"
+ fi
+ fi
+ fi
+fi
+
+# do we have GNU ls with color-support?
+if [[ "$TERM" != dumb ]]; then
+ #a1# execute \kbd{@a@}:\quad ls with colors
+ alias ls='ls -b -CF '${ls_options:+"${ls_options[*]} "}
+ #a1# execute \kbd{@a@}:\quad list all files, with colors
+ alias la='ls -la '${ls_options:+"${ls_options[*]} "}
+ #a1# long colored list, without dotfiles (@a@)
+ alias ll='ls -l '${ls_options:+"${ls_options[*]} "}
+ #a1# long colored list, human readable sizes (@a@)
+ alias lh='ls -hAl '${ls_options:+"${ls_options[*]} "}
+ #a1# List files, append qualifier to filenames \\&\quad(\kbd{/} for directories, \
\kbd{@} for symlinks ...) + alias l='ls -lF '${ls_options:+"${ls_options[*]} "}
+else
+ alias ls='ls -b -CF'
+ alias la='ls -la'
+ alias ll='ls -l'
+ alias lh='ls -hAl'
+ alias l='ls -lF'
+fi
+
+alias mdstat='cat /proc/mdstat'
+alias ...='cd ../../'
+
+# generate alias named "$KERNELVERSION-reboot" so you can use boot with kexec:
+if [[ -x /sbin/kexec ]] && [[ -r /proc/cmdline ]] ; then
+ alias "$(uname -r)-reboot"="kexec -l --initrd=/boot/initrd.img-"$(uname -r)" \
--command-line=\"$(cat /proc/cmdline)\" /boot/vmlinuz-"$(uname -r)"" +fi
+
+# see http://www.cl.cam.ac.uk/~mgk25/unicode.html#term for details
+alias term2iso="echo 'Setting terminal to iso mode' ; print -n '\e%@'"
+alias term2utf="echo 'Setting terminal to utf-8 mode'; print -n '\e%G'"
+
+# make sure it is not assigned yet
+[[ -n ${aliases[utf2iso]} ]] && unalias utf2iso
+utf2iso() {
+ if isutfenv ; then
+ for ENV in $(env | command grep -i '.utf') ; do
+ eval export "$(echo $ENV | sed 's/UTF-8/iso885915/ ; \
s/utf8/iso885915/')" + done
+ fi
+}
+
+# make sure it is not assigned yet
+[[ -n ${aliases[iso2utf]} ]] && unalias iso2utf
+iso2utf() {
+ if ! isutfenv ; then
+ for ENV in $(env | command grep -i '\.iso') ; do
+ eval export "$(echo $ENV | sed 's/iso.*/UTF-8/ ; s/ISO.*/UTF-8/')"
+ done
+ fi
+}
+
+# especially for roadwarriors using GNU screen and ssh:
+if ! check_com asc &>/dev/null ; then
+ asc() { autossh -t "$@" 'screen -RdU' }
+ compdef asc=ssh
+fi
+
+#f1# Hints for the use of zsh on grml
+zsh-help() {
+ print "$bg[white]$fg[black]
+zsh-help - hints for use of zsh on grml
+=======================================$reset_color"
+
+ print '
+Main configuration of zsh happens in /etc/zsh/zshrc.
+That file is part of the package grml-etc-core, if you want to
+use them on a non-grml-system just get the tar.gz from
+http://deb.grml.org/ or (preferably) get it from the git repository:
+
+ http://git.grml.org/f/grml-etc-core/etc/zsh/zshrc
+
+This version of grml'\''s zsh setup does not use skel/.zshrc anymore.
+The file is still there, but it is empty for backwards compatibility.
+
+For your own changes use these two files:
+ $HOME/.zshrc.pre
+ $HOME/.zshrc.local
+
+The former is sourced very early in our zshrc, the latter is sourced
+very lately.
+
+System wide configuration without touching configuration files of grml
+can take place in /etc/zsh/zshrc.local.
+
+For information regarding zsh start at http://grml.org/zsh/
+
+Take a look at grml'\''s zsh refcard:
+% xpdf =(zcat /usr/share/doc/grml-docs/zsh/grml-zsh-refcard.pdf.gz)
+
+Check out the main zsh refcard:
+% '$BROWSER' http://www.bash2zsh.com/zsh_refcard/refcard.pdf
+
+And of course visit the zsh-lovers:
+% man zsh-lovers
+
+You can adjust some options through environment variables when
+invoking zsh without having to edit configuration files.
+Basically meant for bash users who are not used to the power of
+the zsh yet. :)
+
+ "NOCOR=1 zsh" => deactivate automatic correction
+ "NOMENU=1 zsh" => do not use auto menu completion
+ (note: use ctrl-d for completion instead!)
+ "NOPRECMD=1 zsh" => disable the precmd + preexec commands (set GNU screen title)
+ "NOTITLE=1 zsh" => disable setting the title of xterms without disabling
+ preexec() and precmd() completely
+ "BATTERY=1 zsh" => activate battery status (via acpi) on right side of prompt
+ "COMMAND_NOT_FOUND=1 zsh"
+ => Enable a handler if an external command was not found
+ The command called in the handler can be altered by setting
+ the GRML_ZSH_CNF_HANDLER variable, the default is:
+ "/usr/share/command-not-found/command-not-found"
+
+A value greater than 0 is enables a feature; a value equal to zero
+disables it. If you like one or the other of these settings, you can
+add them to ~/.zshrc.pre to ensure they are set when sourcing grml'\''s
+zshrc.'
+
+ print "
+$bg[white]$fg[black]
+Please report wishes + bugs to the grml-team: http://grml.org/bugs/
+Enjoy your grml system with the zsh!$reset_color"
+}
+
+# debian stuff
+if [[ -r /etc/debian_version ]] ; then
+ #a3# Execute \kbd{apt-cache search}
+ alias acs='apt-cache search'
+ #a3# Execute \kbd{apt-cache show}
+ alias acsh='apt-cache show'
+ #a3# Execute \kbd{apt-cache policy}
+ alias acp='apt-cache policy'
+ #a3# Execute \kbd{apt-get dist-upgrade}
+ salias adg="apt-get dist-upgrade"
+ #a3# Execute \kbd{apt-get install}
+ salias agi="apt-get install"
+ #a3# Execute \kbd{aptitude install}
+ salias ati="aptitude install"
+ #a3# Execute \kbd{apt-get upgrade}
+ salias ag="apt-get upgrade"
+ #a3# Execute \kbd{apt-get update}
+ salias au="apt-get update"
+ #a3# Execute \kbd{aptitude update ; aptitude safe-upgrade}
+ salias -a up="aptitude update ; aptitude safe-upgrade"
+ #a3# Execute \kbd{dpkg-buildpackage}
+ alias dbp='dpkg-buildpackage'
+ #a3# Execute \kbd{grep-excuses}
+ alias ge='grep-excuses'
+
+ # get a root shell as normal user in live-cd mode:
+ if isgrmlcd && [[ $UID -ne 0 ]] ; then
+ alias su="sudo su"
+ fi
+
+ #a1# Take a look at the syslog: \kbd{\$PAGER /var/log/syslog}
+ salias llog="$PAGER /var/log/syslog" # take a look at the syslog
+ #a1# Take a look at the syslog: \kbd{tail -f /var/log/syslog}
+ salias tlog="tail -f /var/log/syslog" # follow the syslog
+fi
+
+# sort installed Debian-packages by size
+if check_com -c dpkg-query ; then
+ #a3# List installed Debian-packages sorted by size
+ alias debs-by-size="dpkg-query -Wf 'x \${Installed-Size} \${Package} \
\${Status}\n' | sed -ne '/^x /d' -e '/^x \(.*\) install ok installed$/s//\1/p' | \
sort -nr" +fi
+
+# if cdrecord is a symlink (to wodim) or isn't present at all warn:
+if [[ -L /usr/bin/cdrecord ]] || ! check_com -c cdrecord; then
+ if check_com -c wodim; then
+ cdrecord() {
+ cat <<EOMESS
+cdrecord is not provided under its original name by Debian anymore.
+See #377109 in the BTS of Debian for more details.
+
+Please use the wodim binary instead
+EOMESS
+ return 1
+ }
+ fi
+fi
+
+# Use hard limits, except for a smaller stack and no core dumps
+unlimit
+is425 && limit stack 8192
+isgrmlcd && limit core 0 # important for a live-cd-system
+limit -s
+
+# completion system
+
+# called later (via is4 && grmlcomp)
+# note: use 'zstyle' for getting current settings
+# press ^xh (control-x h) for getting tags in context; ^x? (control-x ?) to \
run complete_debug with trace output +grmlcomp() {
+ # TODO: This could use some additional information
+
+ # allow one error for every three characters typed in approximate completer
+ zstyle ':completion:*:approximate:' max-errors 'reply=( \
$((($#PREFIX+$#SUFFIX)/3 )) numeric )' +
+ # don't complete backup files as executables
+ zstyle ':completion:*:complete:-command-::commands' ignored-patterns \
'(aptitude-*|*\~)' +
+ # start menu completion only if it could find no unambiguous initial string
+ zstyle ':completion:*:correct:*' insert-unambiguous true
+ zstyle ':completion:*:corrections' format $'%{\e[0;31m%}%d (errors: \
%e)%{\e[0m%}' + zstyle ':completion:*:correct:*' original true
+
+ # activate color-completion
+ zstyle ':completion:*:default' list-colors ${(s.:.)LS_COLORS}
+
+ # format on completion
+ zstyle ':completion:*:descriptions' format $'%{\e[0;31m%}completing \
%B%d%b%{\e[0m%}' +
+ # automatically complete 'cd -<tab>' and 'cd -<ctrl-d>' with menu
+ # zstyle ':completion:*:*:cd:*:directory-stack' menu yes select
+
+ # insert all expansions for expand completer
+ zstyle ':completion:*:expand:*' tag-order all-expansions
+ zstyle ':completion:*:history-words' list false
+
+ # activate menu
+ zstyle ':completion:*:history-words' menu yes
+
+ # ignore duplicate entries
+ zstyle ':completion:*:history-words' remove-all-dups yes
+ zstyle ':completion:*:history-words' stop yes
+
+ # match uppercase from lowercase
+ zstyle ':completion:*' matcher-list 'm:{a-z}={A-Z}'
+
+ # separate matches into groups
+ zstyle ':completion:*:matches' group 'yes'
+ zstyle ':completion:*' group-name ''
+
+ if [[ "$NOMENU" -eq 0 ]] ; then
+ # if there are more than 5 options allow selecting from a menu
+ zstyle ':completion:*' menu select=5
+ else
+ # don't use any menus at all
+ setopt no_auto_menu
+ fi
+
+ zstyle ':completion:*:messages' format '%d'
+ zstyle ':completion:*:options' auto-description '%d'
+
+ # describe options in full
+ zstyle ':completion:*:options' description 'yes'
+
+ # on processes completion complete all user processes
+ zstyle ':completion:*:processes' command 'ps -au$USER'
+
+ # offer indexes before parameters in subscripts
+ zstyle ':completion:*:*:-subscript-:*' tag-order indexes parameters
+
+ # provide verbose completion information
+ zstyle ':completion:*' verbose true
+
+ # recent (as of Dec 2007) zsh versions are able to provide descriptions
+ # for commands (read: 1st word in the line) that it will list for the user
+ # to choose from. The following disables that, because it's not exactly fast.
+ zstyle ':completion:*:-command-:*:' verbose false
+
+ # set format for warnings
+ zstyle ':completion:*:warnings' format $'%{\e[0;31m%}No matches \
for:%{\e[0m%} %d' +
+ # define files to ignore for zcompile
+ zstyle ':completion:*:*:zcompile:*' ignored-patterns '(*~|*.zwc)'
+ zstyle ':completion:correct:' prompt 'correct to: %e'
+
+ # Ignore completion functions for commands you don't have:
+ zstyle ':completion::(^approximate*):*:functions' ignored-patterns '_*'
+
+ # Provide more processes in completion of programs like killall:
+ zstyle ':completion:*:processes-names' command 'ps c -u ${USER} -o command | \
uniq' +
+ # complete manual by their section
+ zstyle ':completion:*:manuals' separate-sections true
+ zstyle ':completion:*:manuals.*' insert-sections true
+ zstyle ':completion:*:man:*' menu yes select
+
+ # provide .. as a completion
+ zstyle ':completion:*' special-dirs ..
+
+ # run rehash on completion so new installed program are found automatically:
+ _force_rehash() {
+ (( CURRENT == 1 )) && rehash
+ return 1
+ }
+
+ ## correction
+ # some people don't like the automatic correction - so run 'NOCOR=1 zsh' to \
deactivate it + if [[ "$NOCOR" -gt 0 ]] ; then
+ zstyle ':completion:*' completer _oldlist _expand _force_rehash _complete \
_files _ignored + setopt nocorrect
+ else
+ # try to be smart about when to use what completer...
+ setopt correct
+ zstyle -e ':completion:*' completer '
+ if [[ $_last_try != "$HISTNO$BUFFER$CURSOR" ]] ; then
+ _last_try="$HISTNO$BUFFER$CURSOR"
+ reply=(_complete _match _ignored _prefix _files)
+ else
+ if [[ $words[1] == (rm|mv) ]] ; then
+ reply=(_complete _files)
+ else
+ reply=(_oldlist _expand _force_rehash _complete _ignored \
_correct _approximate _files) + fi
+ fi'
+ fi
+
+ # command for process lists, the local web server details and host completion
+ zstyle ':completion:*:urls' local 'www' '/var/www/' 'public_html'
+
+ # caching
+ [[ -d $ZSHDIR/cache ]] && zstyle ':completion:*' use-cache yes && \
+ zstyle ':completion::complete:*' cache-path \
$ZSHDIR/cache/ +
+ # host completion
+ if is42 ; then
+ [[ -r ~/.ssh/known_hosts ]] && \
_ssh_hosts=(${${${${(f)"$(<$HOME/.ssh/known_hosts)"}:#[\|]*}%%\ *}%%,*}) || \
_ssh_hosts=() + [[ -r /etc/hosts ]] && : ${(A)_etc_hosts:=${(s: \
:)${(ps:\t:)${${(f)~~"$(</etc/hosts)"}%%\#*}##[:blank:]#[^[:blank:]]#}}} || \
_etc_hosts=() + else
+ _ssh_hosts=()
+ _etc_hosts=()
+ fi
+ hosts=(
+ $(hostname)
+ "$_ssh_hosts[@]"
+ "$_etc_hosts[@]"
+ grml.org
+ localhost
+ )
+ zstyle ':completion:*:hosts' hosts $hosts
+ # TODO: so, why is this here?
+ # zstyle '*' hosts $hosts
+
+ # use generic completion system for programs not yet defined; (_gnu_generic \
works + # with commands that provide a --help option with "standard" gnu-like \
output.) + for compcom in cp deborphan df feh fetchipac head hnb ipacsum mv \
+ pal stow tail uname ; do
+ [[ -z ${_comps[$compcom]} ]] && compdef _gnu_generic ${compcom}
+ done; unset compcom
+
+ # see upgrade function in this file
+ compdef _hosts upgrade
+}
+
+# grmlstuff
+grmlstuff() {
+# people should use 'grml-x'!
+ if check_com -c 915resolution; then
+ 855resolution() {
+ echo "Please use 915resolution as resolution modifying tool for Intel \
+graphic chipset."
+ return -1
+ }
+ fi
+
+ #a1# Output version of running grml
+ alias grml-version='cat /etc/grml_version'
+
+ if check_com -c rebuildfstab ; then
+ #a1# Rebuild /etc/fstab
+ alias grml-rebuildfstab='rebuildfstab -v -r -config'
+ fi
+
+ if check_com -c grml-debootstrap ; then
+ debian2hd() {
+ echo "Installing debian to harddisk is possible by using \
grml-debootstrap." + return 1
+ }
+ fi
+}
+
+# now run the functions
+isgrml && checkhome
+is4 && isgrml && grmlstuff
+is4 && grmlcomp
+
+# keephack
+is4 && xsource "/etc/zsh/keephack"
+
+# wonderful idea of using "e" glob qualifier by Peter Stephenson
+# You use it as follows:
+# $ NTREF=/reference/file
+# $ ls -l *(e:nt:)
+# This lists all the files in the current directory newer than the reference file.
+# You can also specify the reference file inline; note quotes:
+# $ ls -l *(e:'nt ~/.zshenv':)
+is4 && nt() {
+ if [[ -n $1 ]] ; then
+ local NTREF=${~1}
+ fi
+ [[ $REPLY -nt $NTREF ]]
+}
+
+# shell functions
+
+#f1# Reload an autoloadable function
+freload() { while (( $# )); do; unfunction $1; autoload -U $1; shift; done }
+compdef _functions freload
+
+#f1# List symlinks in detail (more detailed version of 'readlink -f' and 'whence \
-s') +sll() {
+ [[ -z "$1" ]] && printf 'Usage: %s <file(s)>\n' "$0" && return 1
+ for file in "$@" ; do
+ while [[ -h "$file" ]] ; do
+ ls -l $file
+ file=$(readlink "$file")
+ done
+ done
+}
+
+# TODO: Is it supported to use pager settings like this?
+# PAGER='less -Mr' - If so, the use of $PAGER here needs fixing
+# with respect to wordsplitting. (ie. ${=PAGER})
+if check_com -c $PAGER ; then
+ #f1# View Debian's changelog of a given package
+ dchange() {
+ emulate -L zsh
+ if [[ -r /usr/share/doc/$1/changelog.Debian.gz ]] ; then
+ $PAGER /usr/share/doc/$1/changelog.Debian.gz
+ elif [[ -r /usr/share/doc/$1/changelog.gz ]] ; then
+ $PAGER /usr/share/doc/$1/changelog.gz
+ else
+ if check_com -c aptitude ; then
+ echo "No changelog for package $1 found, using aptitude to retrieve \
it." + if isgrml ; then
+ aptitude -t unstable changelog $1
+ else
+ aptitude changelog $1
+ fi
+ else
+ echo "No changelog for package $1 found, sorry."
+ return 1
+ fi
+ fi
+ }
+ _dchange() { _files -W /usr/share/doc -/ }
+ compdef _dchange dchange
+
+ #f1# View Debian's NEWS of a given package
+ dnews() {
+ emulate -L zsh
+ if [[ -r /usr/share/doc/$1/NEWS.Debian.gz ]] ; then
+ $PAGER /usr/share/doc/$1/NEWS.Debian.gz
+ else
+ if [[ -r /usr/share/doc/$1/NEWS.gz ]] ; then
+ $PAGER /usr/share/doc/$1/NEWS.gz
+ else
+ echo "No NEWS file for package $1 found, sorry."
+ return 1
+ fi
+ fi
+ }
+ _dnews() { _files -W /usr/share/doc -/ }
+ compdef _dnews dnews
+
+ #f1# View upstream's changelog of a given package
+ uchange() {
+ emulate -L zsh
+ if [[ -r /usr/share/doc/$1/changelog.gz ]] ; then
+ $PAGER /usr/share/doc/$1/changelog.gz
+ else
+ echo "No changelog for package $1 found, sorry."
+ return 1
+ fi
+ }
+ _uchange() { _files -W /usr/share/doc -/ }
+ compdef _uchange uchange
+fi
+
+# zsh profiling
+profile() {
+ ZSH_PROFILE_RC=1 $SHELL "$@"
+}
+
+#f1# Edit an alias via zle
+edalias() {
+ [[ -z "$1" ]] && { echo "Usage: edalias <alias_to_edit>" ; return 1 } || vared \
aliases'[$1]' ; +}
+compdef _aliases edalias
+
+#f1# Edit a function via zle
+edfunc() {
+ [[ -z "$1" ]] && { echo "Usage: edfunc <function_to_edit>" ; return 1 } || zed \
-f "$1" ; +}
+compdef _functions edfunc
+
+# use it e.g. via 'Restart apache2'
+#m# f6 Start() \kbd{/etc/init.d/\em{process}}\quad\kbd{start}
+#m# f6 Restart() \kbd{/etc/init.d/\em{process}}\quad\kbd{restart}
+#m# f6 Stop() \kbd{/etc/init.d/\em{process}}\quad\kbd{stop}
+#m# f6 Reload() \kbd{/etc/init.d/\em{process}}\quad\kbd{reload}
+#m# f6 Force-Reload() \kbd{/etc/init.d/\em{process}}\quad\kbd{force-reload}
+if [[ -d /etc/init.d || -d /etc/service ]] ; then
+ __start_stop() {
+ local action_="${1:l}" # e.g Start/Stop/Restart
+ local service_="$2"
+ local param_="$3"
+
+ local service_target_="$(readlink /etc/init.d/$service_)"
+ if [[ $service_target_ == "/usr/bin/sv" ]]; then
+ # runit
+ case "${action_}" in
+ start) if [[ ! -e /etc/service/$service_ ]]; then
+ $SUDO ln -s "/etc/sv/$service_" "/etc/service/"
+ else
+ $SUDO "/etc/init.d/$service_" "${action_}" "$param_"
+ fi ;;
+ # there is no reload in runits sysv emulation
+ reload) $SUDO "/etc/init.d/$service_" "force-reload" "$param_" ;;
+ *) $SUDO "/etc/init.d/$service_" "${action_}" "$param_" ;;
+ esac
+ else
+ # sysvinit
+ $SUDO "/etc/init.d/$service_" "${action_}" "$param_"
+ fi
+ }
+
+ _grmlinitd() {
+ local -a scripts
+ scripts=( /etc/init.d/*(x:t) )
+ _describe "service startup script" scripts
+ }
+
+ for i in Start Restart Stop Force-Reload Reload ; do
+ eval "$i() { __start_stop $i \"\$1\" \"\$2\" ; }"
+ compdef _grmlinitd $i
+ done
+fi
+
+#f1# Provides useful information on globbing
+H-Glob() {
+ echo -e "
+ / directories
+ . plain files
+ @ symbolic links
+ = sockets
+ p named pipes (FIFOs)
+ * executable plain files (0100)
+ % device files (character or block special)
+ %b block special files
+ %c character special files
+ r owner-readable files (0400)
+ w owner-writable files (0200)
+ x owner-executable files (0100)
+ A group-readable files (0040)
+ I group-writable files (0020)
+ E group-executable files (0010)
+ R world-readable files (0004)
+ W world-writable files (0002)
+ X world-executable files (0001)
+ s setuid files (04000)
+ S setgid files (02000)
+ t files with the sticky bit (01000)
+
+ print *(m-1) # Files modified up to a day ago
+ print *(a1) # Files accessed a day ago
+ print *(@) # Just symlinks
+ print *(Lk+50) # Files bigger than 50 kilobytes
+ print *(Lk-50) # Files smaller than 50 kilobytes
+ print **/*.c # All *.c files recursively starting in \$PWD
+ print **/*.c~file.c # Same as above, but excluding 'file.c'
+ print (foo|bar).* # Files starting with 'foo' or 'bar'
+ print *~*.* # All Files that do not contain a dot
+ chmod 644 *(.^x) # make all plain non-executable files publically readable
+ print -l *(.c|.h) # Lists *.c and *.h
+ print **/*(g:users:) # Recursively match all files that are owned by group \
'users' + echo /proc/*/cwd(:h:t:s/self//) # Analogous to >ps ax | awk '{print $1}'<"
+}
+alias help-zshglob=H-Glob
+
+#v1# set number of lines to display per page
+HELP_LINES_PER_PAGE
+#v1# set location of help-zle cache file
+HELP_ZLE_CACHE_FILE=~/.cache/zsh_help_zle_lines.zsh
+#f1# helper function for help-zle, actually generates the help text
+help_zle_parse_keybindings()
+{
+ emulate -L zsh
+ setopt extendedglob
+ unsetopt ksharrays #indexing starts at 1
+
+ #v1# choose files that help-zle will parse for keybindings
+ ((${+HELPZLE_KEYBINDING_FILES})) || HELPZLE_KEYBINDING_FILES=( /etc/zsh/zshrc \
~/.zshrc.pre ~/.zshrc ~/.zshrc.local ) +
+ if [[ -r $HELP_ZLE_CACHE_FILE ]]; then
+ local load_cache=0
+ for f ($HELPZLE_KEYBINDING_FILES) [[ $f -nt $HELP_ZLE_CACHE_FILE ]] && \
load_cache=1 + [[ $load_cache -eq 0 ]] && . $HELP_ZLE_CACHE_FILE && return
+ fi
+
+ #fill with default keybindings, possibly to be overwriten in a file later
+ #Note that due to zsh inconsistency on escaping assoc array keys, we encase the \
key in '' which we will remove later + local -A help_zle_keybindings
+ help_zle_keybindings['<Ctrl>@']="set MARK"
+ help_zle_keybindings['<Ctrl>x<Ctrl>j']="vi-join lines"
+ help_zle_keybindings['<Ctrl>x<Ctrl>b']="jump to matching brace"
+ help_zle_keybindings['<Ctrl>x<Ctrl>u']="undo"
+ help_zle_keybindings['<Ctrl>_']="undo"
+ help_zle_keybindings['<Ctrl>x<Ctrl>f<c>']="find <c> in cmdline"
+ help_zle_keybindings['<Ctrl>a']="goto beginning of line"
+ help_zle_keybindings['<Ctrl>e']="goto end of line"
+ help_zle_keybindings['<Ctrl>t']="transpose charaters"
+ help_zle_keybindings['<Alt>t']="transpose words"
+ help_zle_keybindings['<Alt>s']="spellcheck word"
+ help_zle_keybindings['<Ctrl>k']="backward kill buffer"
+ help_zle_keybindings['<Ctrl>u']="forward kill buffer"
+ help_zle_keybindings['<Ctrl>y']="insert previously killed word/string"
+ help_zle_keybindings["<Alt>'"]="quote line"
+ help_zle_keybindings['<Alt>"']="quote from mark to cursor"
+ help_zle_keybindings['<Alt><arg>']="repeat next cmd/char <arg> times \
(<Alt>-<Alt>1<Alt>0a -> -10 times 'a')" + help_zle_keybindings['<Alt>u']="make \
next word Uppercase" + help_zle_keybindings['<Alt>l']="make next word lowercase"
+ help_zle_keybindings['<Ctrl>xd']="preview expansion under cursor"
+ help_zle_keybindings['<Alt>q']="push current CL into background, freeing it. \
Restore on next CL" + help_zle_keybindings['<Alt>.']="insert (and interate \
through) last word from prev CLs" + help_zle_keybindings['<Alt>,']="complete word \
from newer history (consecutive hits)" + help_zle_keybindings['<Alt>m']="repeat \
last typed word on current CL" + help_zle_keybindings['<Ctrl>v']="insert next \
keypress symbol literally (e.g. for bindkey)" + \
help_zle_keybindings['!!:n*<Tab>']="insert last n arguments of last command" + \
help_zle_keybindings['!!:n-<Tab>']="insert arguments n..N-2 of last command (e.g. mv \
s s d)" + help_zle_keybindings['<Alt>h']="show help/manpage for current command"
+
+ #init global variables
+ unset help_zle_lines help_zle_sln
+ typeset -g -a help_zle_lines
+ typeset -g help_zle_sln=1
+
+ local k v
+ local lastkeybind_desc contents #last description starting with #k# that we \
found + local num_lines_elapsed=0 #number of lines between last \
description and keybinding + #search config files in the order they a called (and \
thus the order in which they overwrite keybindings) + for f in \
$HELPZLE_KEYBINDING_FILES; do + [[ -r "$f" ]] || continue #not readable ? \
skip it + contents="$(<$f)"
+ for cline in "${(f)contents}"; do
+ #zsh pattern: matches lines like: #k# ..............
+ if [[ "$cline" == \
(#s)[[:space:]]#\#k\#[[:space:]]##(#b)(*)[[:space:]]#(#e) ]]; then + \
lastkeybind_desc="$match[*]" + num_lines_elapsed=0
+ #zsh pattern: matches lines that set a keybinding using bindkey or \
compdef -k + # ignores lines that are commentend out
+ # grabs first in '' or "" enclosed string with length \
between 1 and 6 characters + elif [[ "$cline" == [^#]#(bindkey|compdef \
-k)[[:space:]](*)(#b)(\"((?)(#c1,6))\"|\'((?)(#c1,6))\')(#B)(*) ]]; then + \
#description prevously found ? description not more than 2 lines away ? keybinding \
not empty ? + if [[ -n $lastkeybind_desc && $num_lines_elapsed -lt 2 \
&& -n $match[1] ]]; then + #substitute keybinding string with \
something readable + \
k=${${${${${${${match[1]/\\e\^h/<Alt><BS>}/\\e\^\?/<Alt><BS>}/\\e\[5~/<PageUp>}/\\e\[6~/<PageDown>}//(\\e|\^\[)/<Alt>}//\^/<Ctrl>}/3~/<Alt><Del>}
+ #put keybinding in assoc array, possibly overwriting defaults \
or stuff found in earlier files + #Note that we are extracting the \
keybinding-string including the quotes (see Note at beginning) + \
help_zle_keybindings[${k}]=$lastkeybind_desc + fi
+ lastkeybind_desc=""
+ else
+ ((num_lines_elapsed++))
+ fi
+ done
+ done
+ unset contents
+ #calculate length of keybinding column
+ local kstrlen=0
+ for k (${(k)help_zle_keybindings[@]}) ((kstrlen < ${#k})) && kstrlen=${#k}
+ #convert the assoc array into preformated lines, which we are able to sort
+ for k v in ${(kv)help_zle_keybindings[@]}; do
+ #pad keybinding-string to kstrlen chars and remove outermost characters \
(i.e. the quotes) + help_zle_lines+=("${(r:kstrlen:)k[2,-2]}${v}")
+ done
+ #sort lines alphabetically
+ help_zle_lines=("${(i)help_zle_lines[@]}")
+ [[ -d ${HELP_ZLE_CACHE_FILE:h} ]] || mkdir -p "${HELP_ZLE_CACHE_FILE:h}"
+ echo "help_zle_lines=(${(q)help_zle_lines[@]})" >| $HELP_ZLE_CACHE_FILE
+ zcompile $HELP_ZLE_CACHE_FILE
+}
+typeset -g help_zle_sln
+typeset -g -a help_zle_lines
+
+#f1# Provides (partially autogenerated) help on keybindings and the zsh line editor
+help-zle()
+{
+ emulate -L zsh
+ unsetopt ksharrays #indexing starts at 1
+ #help lines already generated ? no ? then do it
+ [[ ${+functions[help_zle_parse_keybindings]} -eq 1 ]] && \
{help_zle_parse_keybindings && unfunction help_zle_parse_keybindings} + #already \
displayed all lines ? go back to the start + [[ $help_zle_sln -gt \
${#help_zle_lines} ]] && help_zle_sln=1 + local sln=$help_zle_sln
+ #note that help_zle_sln is a global var, meaning we remember the last page we \
viewed + help_zle_sln=$((help_zle_sln + HELP_LINES_PER_PAGE))
+ zle -M "${(F)help_zle_lines[sln,help_zle_sln-1]}"
+}
+#k# display help for keybindings and ZLE (cycle pages with consecutive use)
+zle -N help-zle && bindkey '^xz' help-zle
+
+# grep for running process, like: 'any vim'
+any() {
+ emulate -L zsh
+ unsetopt KSH_ARRAYS
+ if [[ -z "$1" ]] ; then
+ echo "any - grep for process(es) by keyword" >&2
+ echo "Usage: any <keyword>" >&2 ; return 1
+ else
+ ps xauwww | grep -i "${grep_options[@]}" "[${1[1]}]${1[2,-1]}"
+ fi
+}
+
+
+# After resuming from suspend, system is paging heavily, leading to very bad \
interactivity. +# taken from $LINUX-KERNELSOURCE/Documentation/power/swsusp.txt
+[[ -r /proc/1/maps ]] && \
+deswap() {
+ print 'Reading /proc/[0-9]*/maps and sending output to /dev/null, this might \
take a while.' + cat $(sed -ne 's:.* /:/:p' /proc/[0-9]*/maps | sort -u | grep -v \
'^/dev/') > /dev/null + print 'Finished, running "swapoff -a; swapon -a" may also \
be useful.' +}
+
+# a wrapper for vim, that deals with title setting
+# VIM_OPTIONS
+# set this array to a set of options to vim you always want
+# to have set when calling vim (in .zshrc.local), like:
+# VIM_OPTIONS=( -p )
+# This will cause vim to send every file given on the
+# commandline to be send to it's own tab (needs vim7).
+vim() {
+ VIM_PLEASE_SET_TITLE='yes' command vim ${VIM_OPTIONS} "$@"
+}
+
+# make a backup of a file
+bk() {
+ cp -a "$1" "${1}_$(date --iso-8601=seconds)"
+}
+
+ssl_hashes=( sha512 sha256 sha1 md5 )
+
+for sh in ${ssl_hashes}; do
+ eval 'ssl-cert-'${sh}'() {
+ emulate -L zsh
+ if [[ -z $1 ]] ; then
+ printf '\''usage: %s <file>\n'\'' "ssh-cert-'${sh}'"
+ return 1
+ fi
+ openssl x509 -noout -fingerprint -'${sh}' -in $1
+ }'
+done; unset sh
+
+ssl-cert-fingerprints() {
+ emulate -L zsh
+ local i
+ if [[ -z $1 ]] ; then
+ printf 'usage: ssl-cert-fingerprints <file>\n'
+ return 1
+ fi
+ for i in ${ssl_hashes}
+ do ssl-cert-$i $1;
+ done
+}
+
+ssl-cert-info() {
+ emulate -L zsh
+ if [[ -z $1 ]] ; then
+ printf 'usage: ssl-cert-info <file>\n'
+ return 1
+ fi
+ openssl x509 -noout -text -in $1
+ ssl-cert-fingerprints $1
+}
+
+# make sure our environment is clean regarding colors
+for color in BLUE RED GREEN CYAN YELLOW MAGENTA WHITE ; unset $color
+
+# "persistent history"
+# just write important commands you always need to ~/.important_commands
+if [[ -r ~/.important_commands ]] ; then
+ fc -R ~/.important_commands
+fi
+
+# load the lookup subsystem if it's available on the system
+zrcautoload lookupinit && lookupinit
+
+# variables
+
+# set terminal property (used e.g. by msgid-chooser)
+export COLORTERM="yes"
+
+# aliases
+
+# general
+#a2# Execute \kbd{du -sch}
+alias da='du -sch'
+#a2# Execute \kbd{jobs -l}
+alias j='jobs -l'
+
+# listing stuff
+#a2# Execute \kbd{ls -lSrah}
+alias dir="ls -lSrah"
+#a2# Only show dot-directories
+alias lad='ls -d .*(/)' # only show dot-directories
+#a2# Only show dot-files
+alias lsa='ls -a .*(.)' # only show dot-files
+#a2# Only files with setgid/setuid/sticky flag
+alias lss='ls -l *(s,S,t)' # only files with setgid/setuid/sticky flag
+#a2# Only show 1st ten symlinks
+alias lsl='ls -l *(@)' # only symlinks
+#a2# Display only executables
+alias lsx='ls -l *(*)' # only executables
+#a2# Display world-{readable,writable,executable} files
+alias lsw='ls -ld *(R,W,X.^ND/)' # world-{readable,writable,executable} files
+#a2# Display the ten biggest files
+alias lsbig="ls -flh *(.OL[1,10])" # display the biggest files
+#a2# Only show directories
+alias lsd='ls -d *(/)' # only show directories
+#a2# Only show empty directories
+alias lse='ls -d *(/^F)' # only show empty directories
+#a2# Display the ten newest files
+alias lsnew="ls -rtlh *(D.om[1,10])" # display the newest files
+#a2# Display the ten oldest files
+alias lsold="ls -rtlh *(D.Om[1,10])" # display the oldest files
+#a2# Display the ten smallest files
+alias lssmall="ls -Srl *(.oL[1,10])" # display the smallest files
+#a2# Display the ten newest directories and ten newest .directories
+alias lsnewdir="ls -rthdl *(/om[1,10]) .*(D/om[1,10])"
+#a2# Display the ten oldest directories and ten oldest .directories
+alias lsolddir="ls -rthdl *(/Om[1,10]) .*(D/Om[1,10])"
+
+# some useful aliases
+#a2# Remove current empty directory. Execute \kbd{cd ..; rmdir $OLDCWD}
+alias rmcdir='cd ..; rmdir $OLDPWD || cd $OLDPWD'
+
+#a2# ssh with StrictHostKeyChecking=no \\&\quad and UserKnownHostsFile unset
+alias insecssh='ssh -o "StrictHostKeyChecking=no" -o "UserKnownHostsFile=/dev/null"'
+alias insecscp='scp -o "StrictHostKeyChecking=no" -o "UserKnownHostsFile=/dev/null"'
+
+# simple webserver
+check_com -c python && alias http="python -m SimpleHTTPServer"
+
+# work around non utf8 capable software in utf environment via $LANG and luit
+if check_com isutfenv && check_com luit ; then
+ if check_com -c mrxvt ; then
+ isutfenv && [[ -n "$LANG" ]] && \
+ alias mrxvt="LANG=${LANG/(#b)(*)[.@]*/$match[1].iso885915} luit mrxvt"
+ fi
+
+ if check_com -c aterm ; then
+ isutfenv && [[ -n "$LANG" ]] && \
+ alias aterm="LANG=${LANG/(#b)(*)[.@]*/$match[1].iso885915} luit aterm"
+ fi
+
+ if check_com -c centericq ; then
+ isutfenv && [[ -n "$LANG" ]] && \
+ alias centericq="LANG=${LANG/(#b)(*)[.@]*/$match[1].iso885915} luit \
centericq" + fi
+fi
+
+# useful functions
+
+#f5# Backup \kbd{file {\rm to} file\_timestamp}
+bk() {
+ emulate -L zsh
+ cp -b $1 $1_`date --iso-8601=m`
+}
+
+#f5# cd to directoy and list files
+cl() {
+ emulate -L zsh
+ cd $1 && ls -a
+}
+
+# smart cd function, allows switching to /etc when running 'cd /etc/fstab'
+cd() {
+ if (( ${#argv} == 1 )) && [[ -f ${1} ]]; then
+ [[ ! -e ${1:h} ]] && return 1
+ print "Correcting ${1} to ${1:h}"
+ builtin cd ${1:h}
+ else
+ builtin cd "$@"
+ fi
+}
+
+#f5# Create Directoy and \kbd{cd} to it
+mkcd() {
+ mkdir -p "$@" && cd "$@"
+}
+
+#f5# Create temporary directory and \kbd{cd} to it
+cdt() {
+ local t
+ t=$(mktemp -d)
+ echo "$t"
+ builtin cd "$t"
+}
+
+#f5# Create directory under cursor or the selected area
+# Press ctrl-xM to create the directory under the cursor or the selected area.
+# To select an area press ctrl-@ or ctrl-space and use the cursor.
+# Use case: you type "mv abc ~/testa/testb/testc/" and remember that the
+# directory does not exist yet -> press ctrl-XM and problem solved
+inplaceMkDirs() {
+ local PATHTOMKDIR
+ if ((REGION_ACTIVE==1)); then
+ local F=$MARK T=$CURSOR
+ if [[ $F -gt $T ]]; then
+ F=${CURSOR}
+ T=${MARK}
+ fi
+ # get marked area from buffer and eliminate whitespace
+ PATHTOMKDIR=${BUFFER[F+1,T]%%[[:space:]]##}
+ PATHTOMKDIR=${PATHTOMKDIR##[[:space:]]##}
+ else
+ local bufwords iword
+ bufwords=(${(z)LBUFFER})
+ iword=${#bufwords}
+ bufwords=(${(z)BUFFER})
+ PATHTOMKDIR="${(Q)bufwords[iword]}"
+ fi
+ [[ -z "${PATHTOMKDIR}" ]] && return 1
+ if [[ -e "${PATHTOMKDIR}" ]]; then
+ zle -M " path already exists, doing nothing"
+ else
+ zle -M "$(mkdir -p -v "${PATHTOMKDIR}")"
+ zle end-of-line
+ fi
+}
+#k# mkdir -p <dir> from string under cursor or marked area
+zle -N inplaceMkDirs && bindkey '^xM' inplaceMkDirs
+
+#f5# List files which have been accessed within the last {\it n} days, {\it n} \
defaults to 1 +accessed() {
+ emulate -L zsh
+ print -l -- *(a-${1:-1})
+}
+
+#f5# List files which have been changed within the last {\it n} days, {\it n} \
defaults to 1 +changed() {
+ emulate -L zsh
+ print -l -- *(c-${1:-1})
+}
+
+#f5# List files which have been modified within the last {\it n} days, {\it n} \
defaults to 1 +modified() {
+ emulate -L zsh
+ print -l -- *(m-${1:-1})
+}
+# modified() was named new() in earlier versions, add an alias for backwards \
compatibility +check_com new || alias new=modified
+
+# use colors when GNU grep with color-support
+#a2# Execute \kbd{grep -{}-color=auto}
+(( $#grep_options > 0 )) && alias grep='grep '${grep_options:+"${grep_options[*]} "}
+
+# Translate DE<=>EN
+# 'translate' looks up fot a word in a file with language-to-language
+# translations (field separator should be " : "). A typical wordlist looks
+# like at follows:
+# | english-word : german-transmission
+# It's also only possible to translate english to german but not reciprocal.
+# Use the following oneliner to turn back the sort order:
+# $ awk -F ':' '{ print $2" : "$1" "$3 }' \
+# /usr/local/lib/words/en-de.ISO-8859-1.vok > ~/.translate/de-en.ISO-8859-1.vok
+#f5# Translates a word
+trans() {
+ emulate -L zsh
+ case "$1" in
+ -[dD]*)
+ translate -l de-en $2
+ ;;
+ -[eE]*)
+ translate -l en-de $2
+ ;;
+ *)
+ echo "Usage: $0 { -D | -E }"
+ echo " -D == German to English"
+ echo " -E == English to German"
+ esac
+}
+
+# Usage: simple-extract <file>
+# Using option -d deletes the original archive file.
+#f5# Smart archive extractor
+simple-extract() {
+ emulate -L zsh
+ setopt extended_glob noclobber
+ local DELETE_ORIGINAL DECOMP_CMD USES_STDIN USES_STDOUT GZTARGET WGET_CMD
+ local RC=0
+ zparseopts -D -E "dÞLETE_ORIGINAL"
+ for ARCHIVE in "${@}"; do
+ case $ARCHIVE in
+ *.(tar.bz2|tbz2|tbz))
+ DECOMP_CMD="tar -xvjf -"
+ USES_STDIN=true
+ USES_STDOUTúlse
+ ;;
+ *.(tar.gz|tgz))
+ DECOMP_CMD="tar -xvzf -"
+ USES_STDIN=true
+ USES_STDOUTúlse
+ ;;
+ *.(tar.xz|txz|tar.lzma))
+ DECOMP_CMD="tar -xvJf -"
+ USES_STDIN=true
+ USES_STDOUTúlse
+ ;;
+ *.tar)
+ DECOMP_CMD="tar -xvf -"
+ USES_STDIN=true
+ USES_STDOUTúlse
+ ;;
+ *.rar)
+ DECOMP_CMD="unrar x"
+ USES_STDINúlse
+ USES_STDOUTúlse
+ ;;
+ *.lzh)
+ DECOMP_CMD="lha x"
+ USES_STDINúlse
+ USES_STDOUTúlse
+ ;;
+ *.7z)
+ DECOMP_CMD="7z x"
+ USES_STDINúlse
+ USES_STDOUTúlse
+ ;;
+ *.(zip|jar))
+ DECOMP_CMD="unzip"
+ USES_STDINúlse
+ USES_STDOUTúlse
+ ;;
+ *.deb)
+ DECOMP_CMD="ar -x"
+ USES_STDINúlse
+ USES_STDOUTúlse
+ ;;
+ *.bz2)
+ DECOMP_CMD="bzip2 -d -c -"
+ USES_STDIN=true
+ USES_STDOUT=true
+ ;;
+ *.(gz|Z))
+ DECOMP_CMD="gzip -d -c -"
+ USES_STDIN=true
+ USES_STDOUT=true
+ ;;
+ *.(xz|lzma))
+ DECOMP_CMD="xz -d -c -"
+ USES_STDIN=true
+ USES_STDOUT=true
+ ;;
+ *)
+ print "ERROR: '$ARCHIVE' has unrecognized archive type." >&2
+ RC=$((RC+1))
+ continue
+ ;;
+ esac
+
+ if ! check_com ${DECOMP_CMD[(w)1]}; then
+ echo "ERROR: ${DECOMP_CMD[(w)1]} not installed." >&2
+ RC=$((RC+2))
+ continue
+ fi
+
+ GZTARGET="${ARCHIVE:t:r}"
+ if [[ -f $ARCHIVE ]] ; then
+
+ print "Extracting '$ARCHIVE' ..."
+ if $USES_STDIN; then
+ if $USES_STDOUT; then
+ ${ÞCOMP_CMD} < "$ARCHIVE" > $GZTARGET
+ else
+ ${ÞCOMP_CMD} < "$ARCHIVE"
+ fi
+ else
+ if $USES_STDOUT; then
+ ${ÞCOMP_CMD} "$ARCHIVE" > $GZTARGET
+ else
+ ${ÞCOMP_CMD} "$ARCHIVE"
+ fi
+ fi
+ [[ $? -eq 0 && -n "$DELETE_ORIGINAL" ]] && rm -f "$ARCHIVE"
+
+ elif [[ "$ARCHIVE" == (#s)(https|http|ftp)://* ]] ; then
+ if check_com curl; then
+ WGET_CMD="curl -L -k -s -o -"
+ elif check_com wget; then
+ WGET_CMD="wget -q -O - --no-check-certificate"
+ else
+ print "ERROR: neither wget nor curl is installed" >&2
+ RC=$((RC+4))
+ continue
+ fi
+ print "Downloading and Extracting '$ARCHIVE' ..."
+ if $USES_STDIN; then
+ if $USES_STDOUT; then
+ ${=WGET_CMD} "$ARCHIVE" | ${ÞCOMP_CMD} > $GZTARGET
+ RC=$((RC+$?))
+ else
+ ${=WGET_CMD} "$ARCHIVE" | ${ÞCOMP_CMD}
+ RC=$((RC+$?))
+ fi
+ else
+ if $USES_STDOUT; then
+ ${ÞCOMP_CMD} =(${=WGET_CMD} "$ARCHIVE") > $GZTARGET
+ else
+ ${ÞCOMP_CMD} =(${=WGET_CMD} "$ARCHIVE")
+ fi
+ fi
+
+ else
+ print "ERROR: '$ARCHIVE' is neither a valid file nor a supported URI." \
>&2 + RC=$((RC+8))
+ fi
+ done
+ return $RC
+}
+
+__archive_or_uri()
+{
+ _alternative \
+ 'files:Archives:_files -g \
"*.(#l)(tar.bz2|tbz2|tbz|tar.gz|tgz|tar.xz|txz|tar.lzma|tar|rar|lzh|7z|zip|jar|deb|bz2|gz|Z|xz|lzma)"' \
\ + '_urls:Remote Archives:_urls'
+}
+
+_simple_extract()
+{
+ _arguments \
+ '-d[delete original archivefile after extraction]' \
+ '*:Archive Or Uri:__archive_or_uri'
+}
+compdef _simple_extract simple-extract
+alias se=simple-extract
+
+#f5# Set all ulimit parameters to \kbd{unlimited}
+allulimit() {
+ ulimit -c unlimited
+ ulimit -d unlimited
+ ulimit -f unlimited
+ ulimit -l unlimited
+ ulimit -n unlimited
+ ulimit -s unlimited
+ ulimit -t unlimited
+}
+
+#f5# Change the xterm title from within GNU-screen
+xtrename() {
+ emulate -L zsh
+ if [[ $1 != "-f" ]] ; then
+ if [[ -z ${DISPLAY} ]] ; then
+ printf 'xtrename only makes sense in X11.\n'
+ return 1
+ fi
+ else
+ shift
+ fi
+ if [[ -z $1 ]] ; then
+ printf 'usage: xtrename [-f] "title for xterm"\n'
+ printf ' renames the title of xterm from _within_ screen.\n'
+ printf ' also works without screen.\n'
+ printf ' will not work if DISPLAY is unset, use -f to override.\n'
+ return 0
+ fi
+ print -n "\eP\e]0;${1}\C-G\e\\"
+ return 0
+}
+
+# TODO:
+# Rewrite this by either using tinyurl.com's API
+# or using another shortening service to comply with
+# tinyurl.com's policy.
+#
+# Create small urls via http://tinyurl.com using wget(1).
+#function zurl() {
+# emulate -L zsh
+# [[ -z $1 ]] && { print "USAGE: zurl <URL>" ; return 1 }
+#
+# local PN url tiny grabber search result preview
+# PN=$0
+# url=$1
+## Check existence of given URL with the help of ping(1).
+## N.B. ping(1) only works without an eventual given protocol.
+# ping -c 1 ${${url#(ftp|http)://}%%/*} >& /dev/null || \
+# read -q "?Given host ${${url#http://*/}%/*} is not reachable by pinging. \
Proceed anyway? [y|n] " +#
+# if (( $? == 0 )) ; then
+## Prepend 'http://' to given URL where necessary for later output.
+# [[ ${url} != http(s|)://* ]] && url='http://'${url}
+# tiny='http://tinyurl.com/create.php?url='
+# if check_com -c wget ; then
+# grabber='wget -O- -o/dev/null'
+# else
+# print "wget is not available, but mandatory for ${PN}. Aborting."
+# fi
+## Looking for i.e.`copy('http://tinyurl.com/7efkze')' in TinyURL's HTML \
code. +# search='copy\(?http://tinyurl.com/[[:alnum:]]##*'
+# result=${(M)${${${(f)"$(${=grabber} \
${tiny}${url})"}[(fr)${search}*]}//[()\';]/}%%http:*} +## TinyURL provides \
the rather new feature preview for more confidence. <http://tinyurl.com/preview.php> \
+# preview='http://preview.'${result#http://} +#
+# printf '%s\n\n' "${PN} - Shrinking long URLs via webservice TinyURL \
<http://tinyurl.com>." +# printf '%s\t%s\n\n' 'Given URL:' ${url}
+# printf '%s\t%s\n\t\t%s\n' 'TinyURL:' ${result} ${preview}
+# else
+# return 1
+# fi
+#}
+
+#f2# Find history events by search pattern and list them by date.
+whatwhen() {
+ emulate -L zsh
+ local usage help ident format_l format_s first_char remain first last
+ usage='USAGE: whatwhen [options] <searchstring> <search range>'
+ help='Use `whatwhen -h'\'' for further explanations.'
+ ident=${(l,${#${:-Usage: }},, ,)}
+ format_l="${ident}%s\t\t\t%s\n"
+ format_s="${format_l//(\\t)##/\\t}"
+ # Make the first char of the word to search for case
+ # insensitive; e.g. [aA]
+ first_char=[${(L)1[1]}${(U)1[1]}]
+ remain=${1[2,-1]}
+ # Default search range is `-100'.
+ first=${2:-\-100}
+ # Optional, just used for `<first> <last>' given.
+ last=$3
+ case $1 in
+ ("")
+ printf '%s\n\n' 'ERROR: No search string specified. Aborting.'
+ printf '%s\n%s\n\n' ${usage} ${help} && return 1
+ ;;
+ (-h)
+ printf '%s\n\n' ${usage}
+ print 'OPTIONS:'
+ printf $format_l '-h' 'show help text'
+ print '\f'
+ print 'SEARCH RANGE:'
+ printf $format_l "'0'" 'the whole history,'
+ printf $format_l '-<n>' 'offset to the current history number; (default: \
-100)' + printf $format_s '<[-]first> [<last>]' 'just searching within a \
give range' + printf '\n%s\n' 'EXAMPLES:'
+ printf ${format_l/(\\t)/} 'whatwhen grml' '# Range is set to -100 by \
default.' + printf $format_l 'whatwhen zsh -250'
+ printf $format_l 'whatwhen foo 1 99'
+ ;;
+ (\?)
+ printf '%s\n%s\n\n' ${usage} ${help} && return 1
+ ;;
+ (*)
+ # -l list results on stout rather than invoking $EDITOR.
+ # -i Print dates as in YYYY-MM-DD.
+ # -m Search for a - quoted - pattern within the history.
+ fc -li -m "*${first_char}${remain}*" $first $last
+ ;;
+ esac
+}
+
+# mercurial related stuff
+if check_com -c hg ; then
+ # gnu like diff for mercurial
+ # http://www.selenic.com/mercurial/wiki/index.cgi/TipsAndTricks
+ #f5# GNU like diff for mercurial
+ hgdi() {
+ emulate -L zsh
+ for i in $(hg status -marn "$@") ; diff -ubwd <(hg cat "$i") "$i"
+ }
+
+ # build debian package
+ #a2# Alias for \kbd{hg-buildpackage}
+ alias hbp='hg-buildpackage'
+
+ # execute commands on the versioned patch-queue from the current repos
+ alias mq='hg -R $(readlink -f $(hg root)/.hg/patches)'
+
+ # diffstat for specific version of a mercurial repository
+ # hgstat => display diffstat between last revision and tip
+ # hgstat 1234 => display diffstat between revision 1234 and tip
+ #f5# Diffstat for specific version of a mercurial repos
+ hgstat() {
+ emulate -L zsh
+ [[ -n "$1" ]] && hg diff -r $1 -r tip | diffstat || hg export tip | diffstat
+ }
+
+fi # end of check whether we have the 'hg'-executable
+
+# grml-small cleanups
+
+# The following is used to remove zsh-config-items that do not work
+# in grml-small by default.
+# If you do not want these adjustments (for whatever reason), set
+# $GRMLSMALL_SPECIFIC to 0 in your .zshrc.pre file (which this configuration
+# sources if it is there).
+
+if (( GRMLSMALL_SPECIFIC > 0 )) && isgrmlsmall ; then
+
+ unset abk[V]
+ unalias 'V' &> /dev/null
+ unfunction vman &> /dev/null
+ unfunction viless &> /dev/null
+ unfunction 2html &> /dev/null
+
+ # manpages are not in grmlsmall
+ unfunction manzsh &> /dev/null
+ unfunction man2 &> /dev/null
+
+fi
+
+zrclocal
+
+## genrefcard.pl settings
+
+### doc strings for external functions from files
+#m# f5 grml-wallpaper() Sets a wallpaper (try completion for possible values)
+
+### example: split functions-search 8,16,24,32
+#@# split functions-search 8
+
+for file in $HOME/.zsh/*; do
+ source $file
+done
+
+## END OF FILE #################################################################
+# vim:filetype=zsh foldmethod=marker autoindent expandtab shiftwidth=4
+# Local variables:
+# mode: sh
+# End:
adddir ./shelly/test/examples
addfile ./shelly/test/examples/color.hs
hunk ./shelly/test/examples/color.hs 1
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ExtendedDefaultRules #-}
+import Shelly
+import System.Process (rawSystem)
+import Control.Monad (void)
+import Data.Text (Text)
+
+default (Text)
+
+main = shelly $ do
+ void $ liftIO $ rawSystem "ls" ["--color=auto", "../dist"]
+ run_ "ls" ["--color=auto", "../dist"]
addfile ./shelly/test/examples/drain.hs
hunk ./shelly/test/examples/drain.hs 1
+{-# Language OverloadedStrings, ExtendedDefaultRules #-}
+import Prelude hiding (FilePath)
+import Shelly
+import Control.Monad (void)
+import Data.Text (Text)
+
+default (Text)
+
+main :: IO ()
+main = do
+ let exDir = "./examples"
+ void $ shelly $ do
+ let strs = ["a", "b"] :: [String]
+ let texts = ["a", "b"] :: [Text]
+ let inferred = ["a", "b"]
+ res <- cmd (exDir </> "drain.sh") strs texts inferred
+ echo "haskell done"
+ echo res
+ cmd $ exDir </> "printer.sh"
addfile ./shelly/test/examples/drain.sh
hunk ./shelly/test/examples/drain.sh 1
+#!/bin/sh
+echo "starting"
+sleep 2
+echo "finished"
addfile ./shelly/test/examples/printer.sh
hunk ./shelly/test/examples/printer.sh 1
+#!/bin/sh
+
+while true; do
+ echo "hello"
+ sleep 1
+done
addfile ./shelly/test/examples/run-handles.hs
hunk ./shelly/test/examples/run-handles.hs 1
+{-# Language OverloadedStrings, ExtendedDefaultRules #-}
+import Shelly
+-- This test runs, but causes this error to show up:
+-- Exception: cannot access an inherited pipe
+main = shelly $
+ runHandles "bash" ["examples/test.sh"] handles doNothing
+ where handles = [InHandle Inherit, OutHandle Inherit, ErrorHandle Inherit]
+ doNothing _ _ _ = return ""
addfile ./shelly/test/examples/test.sh
hunk ./shelly/test/examples/test.sh 1
+#!/bin/bash
+echo hi
adddir ./shelly/test/src
addfile ./shelly/test/src/CopySpec.hs
hunk ./shelly/test/src/CopySpec.hs 1
+{-# Language CPP #-}
+module CopySpec ( copySpec ) where
+
+import TestInit
+
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706
+import Prelude hiding ( FilePath, catch)
+#else
+import Prelude hiding ( FilePath)
+#endif
+import Control.Monad (forM_)
+import System.IO.Error
+import Help
+
+copySpec :: Spec
+copySpec = do
+ let b = "b"
+ let c = "c"
+ describe "cp file" $ do
+ it "cp to same dir" $
+ forM_ [cp, cp_r] $ \copier -> do
+ res <- shelly $
+ within_dir "test/a" $ do
+ writefile b "testing"
+ copier b c
+ readfile c
+ res @?= "testing"
+
+ it "cp to other dir" $
+ forM_ [cp, cp_r] $ \copier -> do
+ res <- shelly $
+ within_dir "test/a" $ do
+ writefile b "testing"
+ mkdir c
+ copier b c
+ readfile "c/b"
+ res @?= "testing"
+
+ describe "cp dir" $ do
+ it "to dir does not exist: create the to dir" $ do
+ res <- shelly $
+ within_dir "test/a" $ do
+ mkdir b
+ writefile "b/d" ""
+ cp_r b c
+ cIsDir <- test_d c
+ liftIO $ assert $ cIsDir
+ test_f "c/d"
+ assert res
+
+ it "to dir exists: creates a nested directory, full to path given" $ do
+ res <- shelly $
+ within_dir "test/a" $ do
+ mkdir b
+ mkdir c
+ writefile "b/d" ""
+ cp_r b $ c</>b
+ cIsDir <- test_d c
+ liftIO $ assert $ cIsDir
+ bIsDir <- test_d $ c</>b
+ liftIO $ assert $ bIsDir
+ test_f "c/b/d"
+ assert res
+
+ it "to dir exists: creates a nested directory, partial to path given" $ do
+ res <- shelly $
+ within_dir "test/a" $ do
+ mkdir b
+ mkdir c
+ writefile "b/d" ""
+ cp_r b $ c
+ cIsDir <- test_d c
+ liftIO $ assert $ cIsDir
+ bIsDir <- test_d $ c</>b
+ liftIO $ assert $ bIsDir
+ test_f "c/b/d"
+ assert res
+
+ it "copies the same dir" $ do
+ shelly $
+ within_dir "test/a" $ do
+ mkdir b
+ writefile "b/d" ""
+ cp_r b b `catch_sh` (\e -> liftIO $ assert $ isUserError e)
+ assert True
addfile ./shelly/test/src/EnvSpec.hs
hunk ./shelly/test/src/EnvSpec.hs 1
+{-# LANGUAGE CPP #-}
+module EnvSpec ( envSpec ) where
+
+import TestInit
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706
+import Prelude hiding ( FilePath, catch)
+#else
+import Prelude hiding ( FilePath)
+#endif
+import Data.Maybe
+
+envSpec :: Spec
+envSpec = do
+ describe "getting unset env variables" $ do
+ it "get_env" $ do
+ res <- shelly $ get_env "FOOBARSHELLY"
+ assert $ isNothing res
+
+ it "get_env_text" $ do
+ res <- shelly $ get_env_text "FOOBARSHELLY"
+ assert $ res == ""
+
+ describe "with SHELLY var set" $ do
+ it "get_env" $ do
+ res <- shelly $ do
+ setenv "SHELLY" "test"
+ get_env "SHELLY"
+ assert $ res == Just "test"
+
+ it "get_env_text" $ do
+ res <- shelly $ do
+ setenv "SHELLY" "test"
+ get_env_text "SHELLY"
+ assert $ res == "test"
+
+
addfile ./shelly/test/src/FailureSpec.hs
hunk ./shelly/test/src/FailureSpec.hs 1
+module FailureSpec ( failureSpec ) where
+
+import TestInit
+
+failureSpec :: Spec
+failureSpec = do
+ let discardException action = shellyFailDir $ catchany_sh action (\_ -> return ())
+
+ describe "failure set to stderr" $
+ it "writes a failure message to stderr" $ do
+ shellyFailDir $ discardException $
+ liftIO $ shelly $ do
+ test_d ".shelly" >>= liftIO . assert . not
+ echo "testing"
+ error "bam!"
+ assert . not =<< shellyFailDir (test_d ".shelly")
+
+ describe "failure set to directory" $
+ it "writes a failure message to a .shelly directory" $ do
+ shellyFailDir $ discardException $
+ shellyFailDir $ do
+ test_d ".shelly" >>= liftIO . assert . not
+ echo "testing"
+ error "bam!"
+ assert =<< shellyFailDir ( do
+ exists <- test_d ".shelly"
+ rm_rf ".shelly"
+ return exists
+ )
addfile ./shelly/test/src/FindSpec.hs
hunk ./shelly/test/src/FindSpec.hs 1
+module FindSpec ( findSpec ) where
+
+import TestInit
+import Data.List (sort)
+import System.Directory (createDirectoryIfMissing)
+import System.PosixCompat.Files (createSymbolicLink, fileExist)
+import qualified System.FilePath as SF
+
+createSymlinkForTest :: IO ()
+createSymlinkForTest = do
+ createDirectoryIfMissing False symDir
+ fexist <- fileExist (symDir SF.</> "symlinked_dir")
+ if fexist
+ then return ()
+ else createSymbolicLink
+ (".." SF.</> "symlinked_dir")
+ (symDir SF.</> "symlinked_dir")
+ where
+ rootDir = "test" SF.</> "data"
+ symDir = rootDir SF.</> "dir"
+
+findSpec :: Spec
+findSpec = do
+ describe "relativeTo" $ do
+ it "relative to non-existent dir" $ do
+ res <- shelly $ relativeTo "rel/" "rel/foo"
+ res @?= "foo"
+ res2 <- shelly $ relativeTo "rel" "rel/foo"
+ res2 @?= "foo"
+
+ it "relative to existing dir" $ do
+ res <- shelly $ relativeTo "test/" "test/drain.hs"
+ res @?= "drain.hs"
+ res2 <- shelly $ relativeTo "test" "test/drain.hs"
+ res2 @?= "drain.hs"
+
+ it "abs path relative to existing dir" $ do
+ res <- shelly $ do
+ d <- pwd
+ relativeTo "test/" $ d </> "test/drain.hs"
+ res @?= "drain.hs"
+
+ describe "relative listing" $ do
+ it "lists relative files" $ do
+ res <- shelly $ cd "test/src" >> ls "."
+ sort res @?= ["./CopySpec.hs", "./EnvSpec.hs", "./FailureSpec.hs",
+ "./FindSpec.hs", "./Help.hs", "./LiftedSpec.hs", \
"./LogWithSpec.hs", "./MoveSpec.hs", + "./ReadFileSpec.hs", \
"./RmSpec.hs", "./RunSpec.hs", "./SshSpec.hs", + "./TestInit.hs", \
"./TestMain.hs", + "./WhichSpec.hs", "./WriteSpec.hs", \
"./sleep.hs"] +
+ it "finds relative files" $ do
+ res <- shelly $ cd "test/src" >> find "."
+ sort res @?= ["./CopySpec.hs", "./EnvSpec.hs", "./FailureSpec.hs",
+ "./FindSpec.hs", "./Help.hs", "./LiftedSpec.hs", \
"./LogWithSpec.hs", "./MoveSpec.hs", + "./ReadFileSpec.hs", \
"./RmSpec.hs", "./RunSpec.hs", "./SshSpec.hs", + "./TestInit.hs", \
"./TestMain.hs", + "./WhichSpec.hs", "./WriteSpec.hs", \
"./sleep.hs"] +
+ describe "find" $ do
+ it "empty list for empty dir" $ do
+ let d = "deleteme"
+ res <- shelly $ do
+ mkdir_p d
+ res <- find d
+ rm_rf d
+ return res
+ res @?= []
+
+ it "lists relative files" $ do
+ res <- shelly $ find "test/src"
+ sort res @?= ["test/src/CopySpec.hs", "test/src/EnvSpec.hs", \
"test/src/FailureSpec.hs", + "test/src/FindSpec.hs", \
"test/src/Help.hs", "test/src/LiftedSpec.hs", + \
"test/src/LogWithSpec.hs", "test/src/MoveSpec.hs", "test/src/ReadFileSpec.hs", + \
"test/src/RmSpec.hs", "test/src/RunSpec.hs", "test/src/SshSpec.hs", + \
"test/src/TestInit.hs", "test/src/TestMain.hs", "test/src/WhichSpec.hs", \
"test/src/WriteSpec.hs", + "test/src/sleep.hs"]
+
+ it "lists absolute files" $ do
+ res <- shelly $ relPath "test/src" >>= find >>= mapM (relativeTo "test/src")
+ sort res @?= ["CopySpec.hs", "EnvSpec.hs", "FailureSpec.hs", "FindSpec.hs",
+ "Help.hs", "LiftedSpec.hs", "LogWithSpec.hs", "MoveSpec.hs",
+ "ReadFileSpec.hs", "RmSpec.hs", "RunSpec.hs", "SshSpec.hs",
+ "TestInit.hs", "TestMain.hs",
+ "WhichSpec.hs", "WriteSpec.hs", "sleep.hs"]
+
+ before createSymlinkForTest $ do
+ it "follow symlinks" $
+ do res <-
+ shelly $
+ followSymlink True $
+ relPath "test/data" >>= find >>= mapM (relativeTo "test/data")
+ sort res @?+ [ "dir"
+ , "nonascii.txt"
+ , "symlinked_dir"
+ , "zshrc"
+ , "dir/symlinked_dir"
+ , "dir/symlinked_dir/hoge_file"
+ , "symlinked_dir/hoge_file"
+ ]
+ it "not follow symlinks" $
+ do res <-
+ shelly $
+ followSymlink False $
+ relPath "test/data" >>= find >>= mapM (relativeTo "test/data")
+ sort res @?+ [ "dir"
+ , "nonascii.txt"
+ , "symlinked_dir"
+ , "zshrc"
+ , "dir/symlinked_dir"
+ , "symlinked_dir/hoge_file"
+ ]
+
addfile ./shelly/test/src/Help.hs
hunk ./shelly/test/src/Help.hs 1
+module Help (
+ with_dir, within_dir,
+ (@==)
+) where
+
+import Shelly
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706
+import Prelude hiding ( catch, FilePath )
+#else
+import Prelude hiding ( FilePath )
+#endif
+import Test.HUnit
+import Control.Monad.Trans ( MonadIO )
+
+(@==) :: (Eq a, Show a, MonadIO m) => a -> a -> m ()
+(@==) a b = liftIO (a @?= b)
+
+with_dir :: FilePath -> Sh a -> Sh a
+with_dir d action + mkdir_p d >> (action `finally_sh` rm_rf d)
+
+within_dir :: FilePath -> Sh a -> Sh a
+within_dir d action + with_dir d $ chdir d action
addfile ./shelly/test/src/LiftedSpec.hs
hunk ./shelly/test/src/LiftedSpec.hs 1
+{-# LANGUAGE OverloadedStrings #-}
+
+module LiftedSpec ( liftedSpec ) where
+
+import Test.HUnit hiding (path)
+import Test.Hspec
+import Shelly.Lifted
+import Control.Concurrent.Async.Lifted
+import Control.Monad.Trans.Maybe
+import Test.Hspec.HUnit ()
+
+liftedSpec :: Spec
+liftedSpec + describe "basic actions" $
+ it "lifted sub" $ do
+ xs <- shelly $
+ runMaybeT $ do
+ echo "Hello!"
+ sub $ withTmpDir $ \p -> wait =<< (async $ do
+ writefile (p </> "test.txt") "hello"
+ readfile (p </> "test.txt")
+ )
+ xs @?= Just "hello"
addfile ./shelly/test/src/LogWithSpec.hs
hunk ./shelly/test/src/LogWithSpec.hs 1
+{-# LANGUAGE OverloadedStrings #-}
+module LogWithSpec ( logWithSpec ) where
+
+import TestInit
+import Prelude hiding (FilePath)
+
+import Control.Concurrent (newEmptyMVar, takeMVar, putMVar)
+import Data.Text (Text)
+default (Text)
+
+logWithSpec :: Spec
+logWithSpec + describe "withOutputWriter" $
+ it "calls writer function with handler and stdout output" $ do
+ outputVar <- newEmptyMVar
+ shelly $ log_stdout_with (putMVar outputVar)
+ $ run_ "echo" ["single line output"]
+ result <- takeMVar outputVar
+ assertEqual "expecting output" "single line output" result
addfile ./shelly/test/src/MoveSpec.hs
hunk ./shelly/test/src/MoveSpec.hs 1
+module MoveSpec (moveSpec) where
+
+import TestInit
+import Help
+
+moveSpec :: Spec
+moveSpec = do
+ let b = "b"
+ let c = "c"
+ describe "mv file" $ do
+ it "to same dir" $ do
+ res <- shelly $
+ within_dir "test/a" $ do
+ writefile b "testing"
+ mv b c
+ readfile c
+ res @?= "testing"
+
+ it "to other dir" $ do
+ res <- shelly $
+ within_dir "test/a" $ do
+ writefile b "testing"
+ mkdir c
+ mv b c
+ readfile "c/b"
+ res @?= "testing"
+
+ describe "mv dir" $ do
+ it "to dir does not exist: create the to dir" $ do
+ res <- shelly $
+ within_dir "test/a" $ do
+ mkdir b
+ writefile "b/d" ""
+ mv b c
+ cIsDir <- test_d c
+ liftIO $ assert cIsDir
+ test_f "c/d"
+ assert res
+
+ it "to dir exists: creates a nested directory, full to path given" $ do
+ res <- shelly $
+ within_dir "test/a" $ do
+ mkdir b
+ mkdir c
+ writefile "b/d" ""
+ mv b $ c</>b
+ cIsDir <- test_d c
+ liftIO $ assert cIsDir
+ bIsDir <- test_d $ c</>b
+ liftIO $ assert bIsDir
+ test_f "c/b/d"
+ assert res
+
+ it "to dir exists: creates a nested directory, partial to path given" $ do
+ res <- shelly $
+ within_dir "test/a" $ do
+ mkdir b
+ mkdir c
+ writefile "b/d" ""
+ mv b $ c
+ cIsDir <- test_d c
+ liftIO $ assert cIsDir
+ bIsDir <- test_d $ c</>b
+ liftIO $ assert bIsDir
+ test_f "c/b/d"
+ assert res
+
+ {-
+ it "mv the same dir" $ do
+ shelly $ do
+ within_dir "test/a" $ do
+ mkdir b
+ writefile "b/d" ""
+ mv b b `catch_sh` (\e -> liftIO $ assert $ isUserError e)
+ assert True
+ -}
addfile ./shelly/test/src/ReadFileSpec.hs
hunk ./shelly/test/src/ReadFileSpec.hs 1
+{-# LANGUAGE CPP #-}
+
+module ReadFileSpec (readFileSpec) where
+
+import TestInit
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706
+import Prelude hiding ( FilePath, catch)
+#else
+import Prelude hiding ( FilePath)
+#endif
+import qualified Data.ByteString as BS
+import qualified Data.Text as T
+
+readFileSpec :: Spec
+readFileSpec = describe "file with invalid encoding" $ do
+ it "readBinary" $ do
+ res <- shelly $ readBinary "test/data/zshrc"
+ assert (BS.length res > 0)
+
+ it "readfile" $ do
+ res <- shelly $ readfile "test/data/zshrc"
+ assert (T.length res > 0)
+
addfile ./shelly/test/src/RmSpec.hs
hunk ./shelly/test/src/RmSpec.hs 1
+module RmSpec (rmSpec) where
+
+import TestInit
+import Help
+
+rmSpec :: Spec
+rmSpec = do
+ let b = "b"
+ let d = "dir"
+ describe "rm file" $ do
+ it "rm" $ do
+ res <- shelly $ do
+ writefile b "testing"
+ (True @==) =<< test_f b
+ rm b
+ test_f b
+ assert (not res)
+
+ it "rm_r" $ do
+ res <- shelly $ do
+ writefile b "testing"
+ (True @==) =<< test_f b
+ rm b
+ test_f b
+ assert $ not res
+
+ it "rm_f" $ do
+ res <- shelly $ do
+ (False @==) =<< test_f b
+ rm_f b
+ test_f b
+ assert $ not res
+
+ describe "rm_rf dir" $ do
+ it "empty dir" $ do
+ res <- shelly $ do
+ mkdir d
+ rm_rf d
+ test_d d
+ assert $ not res
+
+ it "dir with file" $ do
+ res <- shelly $ do
+ mkdir d
+ rm d `catchany_sh` (\_ -> return ())
+ (True @==) =<< test_d d
+ writefile (d </> b) "testing"
+ rm d `catchany_sh` (\_ -> return ())
+ (True @==) =<< test_d d
+ rm_rf d
+ test_d d
+ assert $ not res
+
+ describe "rm symlink" $ do
+ let l = "l"
+ it "rm" $ do
+ res <- shelly $ do
+ writefile b "b"
+ cmd "ln" "-s" b l
+ rm l
+ test_f b
+ assert res
+ shelly $ rm b
+
+ it "rm_f" $ do
+ res <- shelly $ do
+ writefile b "b"
+ cmd "ln" "-s" b l
+ rm_f l
+ test_f b
+ assert res
+ shelly $ rm_f b
+
+ it "rm_rf" $ do
+ res <- shelly $ do
+ mkdir d
+ writefile (d</>b) "b"
+ cmd "ln" "-s" (d</>b) l
+ rm_rf l
+ test_f (d</>b)
+ assert res
+ shelly $ rm_rf d
addfile ./shelly/test/src/RunSpec.hs
hunk ./shelly/test/src/RunSpec.hs 1
+module RunSpec ( runSpec ) where
+
+import TestInit
+
+import qualified Data.Text as T
+import System.IO
+
+runSpec :: Spec
+runSpec = do
+ describe "run" $ do
+ it "simple command" $ do
+ res <- shelly $ run "echo" [ "wibble" ]
+ res @?= "wibble\n"
+
+ it "with escaping" $ do
+ res <- shelly $ run "echo" [ "*" ]
+ res @?= "*\n"
+
+ it "without escaping" $ do
+ res <- shelly $ escaping False $ run "echo" [ "*" ]
+ assert $ "README.md" `elem` T.words res
+
+ it "with binary handle mode" $ do
+ res <- shelly $ onCommandHandles (initOutputHandles (flip hSetBinaryMode \
True)) + $ run "cat" [ "test/data/nonascii.txt" ]
+ res @?= "Selbstverst\228ndlich \252berraschend\n"
+
+ -- Bash-related commands
+ describe "bash" $ do
+ it "simple command" $ do
+ res <- shelly $ bash "echo" [ "wibble" ]
+ res @?= "wibble\n"
+
+ it "without escaping" $ do
+ res <- shelly $ escaping False $ bash "echo" [ "*" ]
+ assert $ "README.md" `elem` T.words res
+
+ it "with binary handle mode" $ do
+ res <- shelly $ onCommandHandles (initOutputHandles (flip hSetBinaryMode \
True)) + $ bash "cat" [ "test/data/nonascii.txt" ]
+ res @?= "Selbstverst\228ndlich \252berraschend\n"
+
+ {- This throws spurious errors on some systems
+ it "can detect failing commands in pipes" $ do
+ eCode <- shelly $ escaping False $ errExit False $ do
+ bashPipeFail
+ bash_ "echo" ["'foo'", "|", "ls", "\"eoueouoe\"", "2>/dev/null", "|", \
"echo", "'bar'" ] + lastExitCode
+ eCode `shouldSatisfy` (/= 0)
+ -}
+
+ it "preserve pipe behaviour" $ do
+ (eCode, res) <- shelly $ escaping False $ errExit False $ do
+ res <- bash "echo" [ "'foo'", "|", "echo", "'bar'" ]
+ eCode <- lastExitCode
+ return (eCode, res)
+ res @?= "bar\n"
+ eCode @?= 0
addfile ./shelly/test/src/SshSpec.hs
hunk ./shelly/test/src/SshSpec.hs 1
+{-# LANGUAGE OverloadedStrings #-}
+module SshSpec ( sshSpec ) where
+
+import TestInit
+import qualified Data.Text as T
+
+sshSpec :: Spec
+sshSpec = do
+ let q = "'" -- a single quote
+ let qq = "'\\''" -- quote of a single quote
+ let qqq = T.concat [qq, "\\", qq, qq] -- quote of qq
+ describe "sshCommandText" $ do
+ it "simple command" $ do
+ let res = sshCommandText [("wibble", [])] SeqSsh
+ res @?= T.concat [q, qq, "wibble", qq, q]
+
+ it "space command" $ do
+ let res = sshCommandText [("to", ["outer space"])] SeqSsh
+ res @?= T.concat [q, qq, "to", qq, " ", qq, "outer space", qq ,q]
+
+ it "multiple space commands" $ do
+ let res = sshCommandText [("to", ["outer space"]), ("and", ["back again"])] \
SeqSsh + res @?= T.concat
+ [ q, qq, "to", qq, " ", qq, "outer space", qq
+ , " && "
+ , qq, "and", qq, " ", qq, "back again", qq, q
+ ]
+
+ it "commands with quotes and spaces" $ do
+ let res = sshCommandText [ ("echo", ["Godfater's brother, Tom says: \
\"huh??\""]) + , ("foo", ["--dir", "Tom's father/"])] \
SeqSsh + res @?= T.concat
+ [ q, qq, "echo", qq, " "
+ , qq, "Godfater", qqq, "s brother, Tom says: \"huh??\"", qq
+ , " && "
+ , qq, "foo", qq, " "
+ , qq, "--dir", qq, " "
+ , qq, "Tom", qqq, "s father/", qq, q
+ ]
addfile ./shelly/test/src/TestInit.hs
hunk ./shelly/test/src/TestInit.hs 1
+module TestInit (module Export) where
+
+import Test.HUnit as Export hiding (path)
+import Test.Hspec as Export
+#ifdef LIFTED
+import Shelly.Lifted as Export
+#else
+import Shelly as Export
+#endif
+import Test.Hspec.HUnit ()
addfile ./shelly/test/src/TestMain.hs
hunk ./shelly/test/src/TestMain.hs 1
+
+module Main where
+
+import ReadFileSpec
+import WhichSpec
+import WriteSpec
+import MoveSpec
+import RmSpec
+import FindSpec
+import EnvSpec
+import FailureSpec
+import CopySpec
+import LiftedSpec
+import RunSpec
+import SshSpec
+
+import Test.Hspec
+
+main :: IO ()
+main = hspec $ do
+ readFileSpec
+ whichSpec
+ writeSpec
+ moveSpec
+ rmSpec
+ findSpec
+ envSpec
+ failureSpec
+ copySpec
+ liftedSpec
+ runSpec
+ sshSpec
addfile ./shelly/test/src/WhichSpec.hs
hunk ./shelly/test/src/WhichSpec.hs 1
+module WhichSpec (whichSpec) where
+
+import TestInit
+
+whichSpec :: Spec
+whichSpec = describe "which" $ do
+ it "gives full path to cabal" $ do
+ Just _ <- shelly $ which "find"
+ assert True
+
+ it "recognizes cabal as a path executable" $ do
+ res <- shelly $ test_px "find"
+ True @?= res
+
+ it "cannot find missing exe" $ do
+ Nothing <- shelly $ which "alskjdf;ashlva;ousnva;nj"
+ assert True
addfile ./shelly/test/src/WriteSpec.hs
hunk ./shelly/test/src/WriteSpec.hs 1
+module WriteSpec ( writeSpec ) where
+
+import TestInit
+import Prelude hiding (FilePath)
+
+import Data.Text (Text)
+default (Text)
+
+createsFile :: FilePath -> (FilePath -> IO ()) -> IO ()
+createsFile f action = do
+ exists <- shelly $ test_e f
+ when exists $ error "cleanup after yourself!"
+ action f
+ shelly $ rm f
+ return ()
+
+
+writeSpec :: Spec
+writeSpec = do
+ describe "writefile" $
+ it "creates and overwrites a file" $ createsFile "foo" $ \f -> do
+ assert . (== "a") =<< (shelly $ writefile f "a" >> readfile f)
+ assert . (== "b") =<< (shelly $ writefile f "b" >> readfile f)
+
+ describe "writeBinary" $
+ it "creates and overwrites a file" $ createsFile "foo" $ \f -> do
+ assert . (== "a") =<< (shelly $ writeBinary f "a" >> readBinary f)
+ assert . (== "b") =<< (shelly $ writeBinary f "b" >> readBinary f)
+
+ describe "appendfile" $
+ it "creates and appends a file" $ createsFile "foo" $ \f -> do
+ assert . (== "a") =<< (shelly $ appendfile f "a" >> readfile f)
+ assert . (== "ab") =<< (shelly $ appendfile f "b" >> readfile f)
+
+ describe "touchfile" $
+ it "creates and updates a file" $ createsFile "foo" $ \f -> do
+ assert . (== "") =<< (shelly $ touchfile f >> readfile f)
+ assert . (== "") =<< (shelly $ touchfile f >> readfile f)
+
+ assert . (== "a") =<< (shelly $
+ writefile f "a" >> touchfile f >> readfile f)
addfile ./shelly/test/src/sleep.hs
hunk ./shelly/test/src/sleep.hs 1
+{-# Language OverloadedStrings #-}
+import Shelly
+
+main :: IO ()
+main + shelly $ do
+ echo "sleeping"
+ run "sleep" ["5"]
+ echo "all done"
addfile ./shelly/test/testall
hunk ./shelly/test/testall 1
+#!/bin/sh
+
+set -e
+
+if [ -z "$DEBUG" ]; then
+ export DEBUG=shelly-testsuite
+fi
+
+SUITE=./dist/build/shelly-testsuite/shelly-testsuite
+
+rm -f shelly-testsuite.tix
+cabal build
+
+if [ ! -f $SUITE ]; then
+ cat <<EOF
+Testsuite executable not found, please run:
+ cabal configure --enable-tests
+then
+ cabal build
+Note this script should be run from the root of the checkout
+EOF
+ exit;
+fi
+
+$SUITE $*
+
+DIR=dist/hpc
+
+rm -Rf $DIR
+mkdir -p $DIR
+
+EXCLUDES='TestMain
+CopySpec
+EnvSpec
+FailureSpec
+FindSpec
+Help
+Main
+MoveSpec
+ReadFileSpec
+WhichSpec
+WriteSpec
+RunSpec
+SshSpec
+'
+
+EXCL=""
+
+for m in $EXCLUDES; do
+ EXCL="$EXCL --exclude=$m"
+done
+
+hpc markup $EXCL --destdir=$DIR shelly-testsuite >/dev/null 2>&1
+
+cat <<EOF
+Test coverage report written to $DIR.
+EOF
[make shelly build w/o warning for all supported compilers
Ben Franksen <ben.franksen@online.de>**20200427200125
Ignore-this: d7003e3b712624d57e0ef15a9fab0f6f
] hunk ./shelly/shelly.cabal 54
- - time >= 1.3 && < 1.9,
+ time >= 1.3 && < 2,
hunk ./shelly/shelly.cabal 135
- - time >= 1.3 && < 1.9,
+ time >= 1.3 && < 2,
hunk ./shelly/src/Shelly.hs 131
- -import Data.Monoid (Monoid, mempty, mappend)
- -#if __GLASGOW_HASKELL__ < 704
- -infixr 5 <>
- -(<>) :: Monoid m => m -> m -> m
- -(<>) = mappend
- -#else
- -import Data.Monoid ((<>))
+#if !MIN_VERSION_base(4,13,0)
+import Data.Monoid (mempty, mappend, (<>))
hunk ./shelly/src/Shelly.hs 383
- - toHandle (Just CreatePipe) = error "shelly process creation failure \
CreatePipe"
- - toHandle (Just Inherit) = error "cannot access an inherited pipe"
- - toHandle Nothing = error "error in shelly creating process"
+ toHandle _ = error "shellyProcess/toHandle: internal error"
hunk ./shelly/src/Shelly/Base.hs 41
- -import System.Process( ProcessHandle, StdStream(..) )
+import System.Process( StdStream(..) )
hunk ./shelly/src/Shelly/Base.hs 44
- -import Control.Monad (when, (>=>),
- - liftM
- - )
+import Control.Monad (when, (>=>))
hunk ./shelly/src/Shelly/Base.hs 46
+#if MIN_VERSION_base(4,13,0) && !MIN_VERSION_base(4,14,0)
+import Control.Monad.Fail
+#endif
hunk ./shelly/src/Shelly/Base.hs 50
+#if !MIN_VERSION_base(4,13,0)
hunk ./shelly/src/Shelly/Base.hs 52
+#endif
hunk ./shelly/src/Shelly/Base.hs 59
+#if !MIN_VERSION_base(4,13,0)
hunk ./shelly/src/Shelly/Base.hs 61
+#endif
hunk ./shelly/src/Shelly/Base.hs 81
+#if MIN_VERSION_base(4,13,0)
+instance MonadFail Sh where
+ fail = liftIO . fail
+#endif
+
hunk ./shelly/src/Shelly/Find.hs 14
+#if !MIN_VERSION_base(4,13,0)
hunk ./shelly/src/Shelly/Find.hs 16
+#endif
hunk ./shelly/src/Shelly/Find.hs 67
- - foldM traverse startValue (zip rPaths aPaths)
+ foldM traverse' startValue (zip rPaths aPaths)
hunk ./shelly/src/Shelly/Find.hs 69
- - traverse acc (relativePath, absolutePath) = do
+ traverse' acc (relativePath, absolutePath) = do
hunk ./shelly/src/Shelly/Lifted.hs 105
- -import Data.Monoid
hunk ./shelly/src/Shelly/Lifted.hs 114
- -import Control.Monad.Trans.List
hunk ./shelly/src/Shelly/Lifted.hs 116
- -import Control.Monad.Trans.Error
+import Control.Monad.Trans.Except
hunk ./shelly/src/Shelly/Lifted.hs 133
- -instance MonadSh m => MonadSh (ListT m) where
- - liftSh m = ListT $ do
- - a <- liftSh m
- - return [a]
hunk ./shelly/src/Shelly/Lifted.hs 137
- -instance (Error e, MonadSh m) => MonadSh (ErrorT e m) where
- - liftSh m = ErrorT $ do
+instance MonadSh m => MonadSh (ExceptT e m) where
+ liftSh m = ExceptT $ do
hunk ./shelly/src/Shelly/Lifted.hs 189
- -instance MonadShControl m => MonadShControl (ListT m) where
- - newtype ShM (ListT m) a = ListTShM (ShM m [a])
- - liftShWith f - - ListT $ liftM return $ liftShWith $ \runInSh -> f $ \k \
->
- - liftM ListTShM $ runInSh $ runListT k
- - restoreSh (ListTShM m) = ListT . restoreSh $ m
- - {-# INLINE liftShWith #-}
- - {-# INLINE restoreSh #-}
- -
hunk ./shelly/src/Shelly/Lifted.hs 228
- -instance (MonadShControl m, Error e)
- - => MonadShControl (ErrorT e m) where
- - newtype ShM (ErrorT e m) a = ErrorTShM (ShM m (Either e a))
+instance MonadShControl m
+ => MonadShControl (ExceptT e m) where
+ newtype ShM (ExceptT e m) a = ErrorTShM (ShM m (Either e a))
hunk ./shelly/src/Shelly/Lifted.hs 232
- - ErrorT $ liftM return $ liftShWith $ \runInSh -> f $ \k ->
- - liftM ErrorTShM $ runInSh $ runErrorT k
- - restoreSh (ErrorTShM m) = ErrorT . restoreSh $ m
+ ExceptT $ liftM return $ liftShWith $ \runInSh -> f $ \k ->
+ liftM ErrorTShM $ runInSh $ runExceptT k
+ restoreSh (ErrorTShM m) = ExceptT . restoreSh $ m
[remove the special shelly upper bound for windows
Ben Franksen <ben.franksen@online.de>**20200427200230
Ignore-this: c91e5dc6e707d8ba635385ade5a7a66
This is no longer necessary as cabal will now always use our (fixed) copy of
shelly-1.7.1, at least when built from a clone. The cabal source distribution
won't be able to run the shell tests.
This is stop-gap-measure. We should eventually get rid of shelly.
] hunk ./darcs.cabal 583
- - -- note for windows we can't allow 1.9 or above until
- - -- https://github.com/gregwebs/Shelly.hs/issues/176
- - -- and possibly
- - -- https://github.com/gregwebs/Shelly.hs/issues/177
- - -- are dealt with
- - if os(windows)
- - build-depends: shelly < 1.7.2
- -
[resolve conflicts after 80223edc7108090f9c3231e36d4bdb94e1f52f6a
Ben Franksen <ben.franksen@online.de>**20200428060317
Ignore-this: d754c0799411a1c1ff9684717e11a8a9ca298be87c9b3b4c71cfea2c8e21b4875702b13b3a541908
] hunk ./harness/Darcs/Test/Patch/Arbitrary/PrimFileUUID.hs 23
- -import Darcs.Patch.FromPrim ( PrimOf )
- -
- -import Control.Applicative ( (<$>) )
hunk ./harness/Darcs/Test/Patch/Arbitrary/RepoPatchV1.hs 33
- - ( addfile, adddir, move
- - , hunk, tokreplace, binary
- - , changepref, invert, merge
- - )
- -import Darcs.Patch
hunk ./harness/Darcs/Test/Patch/Arbitrary/RepoPatchV1.hs 34
- -import Darcs.Patch.Prim ( PrimPatch )
hunk ./harness/Darcs/Test/Patch/Arbitrary/RepoPatchV2.hs 16
- -import Darcs.Patch.Prim.Class ( PrimPatch )
hunk ./harness/Darcs/Test/Patch/Examples/Set2Unwitnessed.hs 34
- -import Darcs.Patch.Invert ( Invert(..) )
+import Darcs.Patch.Commute ( Commute )
+import Darcs.Patch.Invert ( Invert )
hunk ./harness/Darcs/Test/Patch/RepoModel.hs 8
- -import Control.Monad.Fail ( MonadFail(fail) )
hunk ./harness/Darcs/Test/Patch/RepoModel.hs 27
- - fail = Failed
- -
- -instance MonadFail Fail where
- - fail = Failed
hunk ./src/Darcs/Patch/Bundle.hs 102
- -import Darcs.Util.Printer ( Doc, renderPS, newline, text, ($$),
- - (<>), vcat, vsep, renderString )
+import Darcs.Util.Parser
+ ( Parser
+ , lexString
+ , lexWord
+ , optional
+ , parse
+ )
+import Darcs.Util.Printer
+ ( Doc
+ , ($$)
+ , newline
+ , packedString
+ , renderPS
+ , renderString
+ , text
+ , vcat
+ , vsep
+ )
+import Darcs.Util.Tree( Tree )
+import Darcs.Util.Tree.Monad( virtualTreeIO )
+
hunk ./src/Darcs/Patch/Named/Wrapped.hs 38
- -import Darcs.Util.IsoDate ( getIsoDateTime )
- -import Darcs.Util.Text ( formatParas )
- -import Darcs.Util.Printer ( ($$), (<>), vcat, prefix )
- -
- -import Control.Applicative ( (<|>) )
hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 28
- -import qualified Data.ByteString as B
- -import qualified Data.ByteString.Internal as BI
- -import qualified Data.ByteString as B ( ByteString, empty, null, concat )
- -import qualified Data.ByteString.Char8 as BC (pack, unpack, unlines)
+import qualified Data.ByteString as B
+ ( ByteString
+ , drop
+ , empty
+ , null
+ , concat
+ , isPrefixOf
+ , length
+ , splitAt
+ )
+import qualified Data.ByteString.Char8 as BC (pack, unpack, unlines, elemIndices)
hunk ./src/Darcs/Patch/Summary.hs 25
+import Darcs.Patch.Witnesses.Show
hunk ./src/Darcs/Patch/Summary.hs 27
- -import Darcs.Util.Printer ( Doc, empty, vcat,
- - text,
- - minus, plus, ($$), (<+>), (<>),
- - )
+import Darcs.Util.Path ( AnchoredPath, anchorPath )
+import Darcs.Util.Printer
+ ( Doc
+ , ($$)
+ , (<+>)
+ , empty
+ , minus
+ , plus
+ , text
+ , vcat
+ )
hunk ./src/Darcs/Patch/Summary.hs 39
+-- | This type tags a patch with a 'ConflictState' and also hides the context
+-- witnesses (as in 'Sealed2'), so we can put them in a list.
+data IsConflictedPrim prim where
+ IsC :: !ConflictState -> !(prim wX wY) -> IsConflictedPrim prim
+data ConflictState = Okay | Conflicted | Duplicated deriving ( Eq, Ord, Show, Read)
+
+class Summary p where
+ conflictedEffect :: p wX wY -> [IsConflictedPrim (PrimOf p)]
+
+instance Summary p => Summary (FL p) where
+ conflictedEffect = concat . mapFL conflictedEffect
+
+instance Show2 prim => Show (IsConflictedPrim prim) where
+ showsPrec d (IsC cs prim) + showParen (d > appPrec) $
+ showString "IsC " . showsPrec (appPrec + 1) cs .
+ showString " " . showsPrec2 (appPrec + 1) prim
+
+listConflictedFiles
+ :: (Summary p, PatchInspect (PrimOf p)) => p wX wY -> [AnchoredPath]
+listConflictedFiles + nubSort . concat . catMaybes . map conflictedFiles . \
conflictedEffect + where
+ conflictedFiles (IsC Conflicted p) = Just (listTouchedFiles p)
+ conflictedFiles _ = Nothing
hunk ./src/Darcs/Prelude.hs 25
+{-# LANGUAGE CPP #-}
hunk ./src/Darcs/Prelude.hs 47
- -#if MIN_VERSION_base(4,11,0)
hunk ./src/Darcs/Prelude.hs 51
- -#endif
hunk ./src/Darcs/Repository/ApplyPatches.hs 34
- -import Control.Applicative (Applicative)
hunk ./src/Darcs/Repository/Merge.hs 34
- - , ioError
hunk ./src/Darcs/Repository/PatchIndex.hs 42
- -import Control.Applicative ( (<$>) )
hunk ./src/Darcs/Repository/PatchIndex.hs 50
- -import Control.Exception ( catch )
- -import Control.Monad ( forM_, unless, when )
- -import Control.Monad.State.Strict ( evalState, execState, State, gets, modify )
- -import Control.Applicative ( (<$>) )
- -import System.Directory ( createDirectory, renameDirectory, doesFileExist, \
doesDirectoryExist ) +import Data.Word ( Word32 )
+
+import System.Directory
+ ( createDirectory
+ , doesDirectoryExist
+ , doesFileExist
+ , removeDirectoryRecursive
+ , removeFile
+ , renameDirectory
+ )
hunk ./src/Darcs/Repository/Pending.hs 74
- -import Darcs.Util.Printer ( Doc, ($$), (<>), text, vcat, (<+>) )
+import Darcs.Util.Exception ( catchNonExistence )
+import Darcs.Util.Lock ( writeDocBinFile, removeFileMayNotExist )
+import Darcs.Util.Printer ( Doc, ($$), text, vcat, (<+>), renderString )
hunk ./src/Darcs/UI/Commands/Log.hs 90
- -import Darcs.Util.Printer ( Doc, simplePrinters, (<+>), prefix, text, vcat,
- - vsep, (<>), ($$), errorDoc, insertBeforeLastline, empty )
+import Darcs.Util.Printer
+ ( Doc
+ , ($$)
+ , (<+>)
+ , hsep
+ , insertBeforeLastline
+ , prefix
+ , simplePrinters
+ , text
+ , vcat
+ , vsep
+ )
hunk ./src/Darcs/Util/Index.hs 115
- -import Control.Applicative( (<$>) )
hunk ./src/Darcs/Util/Tree/Hashed.hs 36
- -import Control.Applicative( (<$>) )
hunk ./src/Darcs/Util/Tree/Monad.hs 29
- -import Control.Applicative( (<$>) )
- -
[unwind tests: use condition compilation for MonadFail instances and imports
Ben Franksen <ben.franksen@online.de>**20200428062530
Ignore-this: 4b45e1ddf837df7e1bceb602196e9da483a9873adbe02bc67592aa198438880c248cd63482d77e87
] hunk ./harness/Darcs/Test/Patch/Examples/Unwind.hs 11
+{-# LANGUAGE CPP #-}
hunk ./harness/Darcs/Test/Patch/Examples/Unwind.hs 39
+#if MIN_VERSION_base(4,12,0) && !MIN_VERSION_base(4,13,0)
hunk ./harness/Darcs/Test/Patch/Examples/Unwind.hs 41
+#endif
hunk ./harness/Darcs/Test/Patch/Examples/Unwind.hs 222
+#if MIN_VERSION_base(4,12,0)
hunk ./harness/Darcs/Test/Patch/Examples/Unwind.hs 224
+#endif
[avoid use of fail in Darcs.Patch.Depends.unwrapOneTagged
Ben Franksen <ben.franksen@online.de>**20200428062822
Ignore-this: 46c51dd72dbec9bc59c0ef7991a9d571efb94bb26d227f0596a1c95c44a56f399b5f62744781dcac
We specialize to monad Maybe and directly use Nothing.
] hunk ./src/Darcs/Patch/Depends.hs 211
- -unwrapOneTagged :: (Monad m) => PatchSet rt p wX wY -> m (PatchSet rt p wX wY)
+unwrapOneTagged :: PatchSet rt p wX wY -> Maybe (PatchSet rt p wX wY)
hunk ./src/Darcs/Patch/Depends.hs 213
- - return $ PatchSet ts (tps :<: t +<+ ps)
- -unwrapOneTagged _ = fail "called unwrapOneTagged with no Tagged's in the set"
+ Just $ PatchSet ts (tps :<: t +<+ ps)
+unwrapOneTagged _ = Nothing
[more consequently throw MatchFailure exception
Ben Franksen <ben.franksen@online.de>**20200428063000
Ignore-this: 1162a7507305626b9d980acebb1d54a5306b1f62c829199db878d0efa0aa49b9d0260d7b457ddc9b
This avoids two uses of fail in Darcs.Patch.Match in the context of a monad
tranformer that is not necessarily IO based.
] hunk ./src/Darcs/Patch/Match.hs 688
- - PatchSet NilRL _ -> fail $ "Couldn't find a tag matching " ++ show m
+ PatchSet NilRL _ -> throw $ MatchFailure $ show m
hunk ./src/Darcs/Patch/Match.hs 700
- - fail $ "Couldn't find patch matching " ++ show m
+ throw $ MatchFailure $ show m
[Darcs.Util.Prompt: add liftIO when calling fail
Ben Franksen <ben.franksen@online.de>**20200428063254
Ignore-this: ff566bc4b8867d39c503eb600de6dee1fe02a4ec90c62358687259c03a82c6415704da78f171dafe
] hunk ./src/Darcs/Util/Prompt.hs 16
+import Control.Monad.Trans ( liftIO )
hunk ./src/Darcs/Util/Prompt.hs 30
- - >>= maybe (fail "askUser: unexpected end of input") return
+ >>= maybe (liftIO $ fail "askUser: unexpected end of input") \
return hunk ./src/Darcs/Util/Prompt.hs 48
- - >>= maybe (fail "askUser: unexpected end of input") return
+ >>= maybe (liftIO $ fail "askUser: unexpected end of input") \
return hunk ./src/Darcs/Util/Prompt.hs 88
- - a <- getInputChar prompt >>= maybe (fail "promptChar: unexpected end of \
input") (return . toLower) + a <- getInputChar prompt >>= maybe (liftIO $ fail \
"promptChar: unexpected end of input") (return . toLower)
[replace fail with error in Darcs.Repository.Diff
Ben Franksen <ben.franksen@online.de>**20200428063838
Ignore-this: 2114564abb5af389c99800e6d6fbfb4986e1da8bdb7b181d444462005e26fb2db6b8ccd85657be2b
This is the /only/ case where the "quick fix" of replacing fail with error
is semantically valid. Here we clearly have a partial pattern match and it
would be a bug if we hit that case.
] hunk ./src/Darcs/Repository/Diff.hs 141
- - diff p _ = fail $ "Missing case at path " ++ show (anchorPath "" p)
+ diff p _ = error $ "Missing case at path " ++ show (anchorPath "" p)
[replace fail with throw.userError when applying a patch
Ben Franksen <ben.franksen@online.de>**20200428064127
Ignore-this: c77d3da077470dfb1e22da710847c77a7b3ee51d58b291d00953b5221c6abad5821eacd2e5b09360
There are several uses of apply (and its variants) where we catch
IOExceptions e.g. maybeApplyToTree. This makes sense: if we apply in the
context of IO (or a transformer over IO), then there may occur any kind of
IOException, not only the ones explicitly raised from our code, and we want
to catch them all.
] hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 6
+import Control.Exception ( throw )
+
hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 55
- - Nothing -> fail $ "replace patch to " ++ ap2fp f
+ Nothing -> throw $ userError $ "replace patch to " ++ ap2fp f
hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 61
- - else fail $ "binary patch to " ++ ap2fp f
+ else throw $ userError
+ $ "binary patch to " ++ ap2fp f
hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 139
- - fail $
+ throw $ userError $
[replace fail with throw.userError in Tree monads and index matching
Ben Franksen <ben.franksen@online.de>**20200428064916
Ignore-this: eb207177eb7b4f543975a8d7a5c0c8ce2ccdb5970523ad9b6c33ed60ee485726b0880536ea0c1fb5
The situation here is different from that of patch application. Here we want
the exception to percolate all the way up to the top level handler. In other
words, these are regular failures similar to IO exceptions.
] hunk ./src/Darcs/Patch/Match.hs 711
- -applyNInv _ (PatchSet NilRL NilRL) = fail "Index out of range"
+applyNInv _ (PatchSet NilRL NilRL) = throw $ userError "Index out of range"
hunk ./src/Darcs/Util/Tree/Monad.hs 26
+import Control.Exception ( throw )
+
hunk ./src/Darcs/Util/Tree/Monad.hs 224
- - Nothing -> fail $ "No such file " ++ show p'
+ Nothing -> throw $ userError $ "No such file " ++ show p'
hunk ./src/Darcs/Util/Tree/Monad.hs 259
- - fail $ "Error renaming: destination " ++ show to ++ " exists."
+ throw $ userError $ "Error renaming: destination " ++ show to ++ " \
exists."
[replace runhaskell with runghc in tests/renames.sh
Ben Franksen <ben.franksen@online.de>**20200428065421
Ignore-this: 751c373b0af77d48dd0383d56c23454f51185014eabb82dcf90329905e97c90f29c85636b88fe2b
It seems runghc is better supported by ghc packagers than runhaskell. This
is not a complete solution, though. If cabal is used with
--with-compiler=/path/to/ghc, there is no guarantee that we have a runghc or
a runhaskell in the PATH.
] hunk ./tests/renames.sh 29
- -runhaskell $TESTBIN/renameHelper.hs
+runghc $TESTBIN/renameHelper.hs
[darcs.cabal: remove containers from setup-depends
Ben Franksen <ben.franksen@online.de>**20200428074325
Ignore-this: 489af8f323553386ae837bd4c643d626225d9f2106ad808ce7ce4f3a0b8c31ac2692757396d22ff7
] hunk ./darcs.cabal 122
- - -- any version will do, we only need Map.lookup
- - containers,
[raise upper bounds for base and Cabal dependencies
Ben Franksen <ben.franksen@online.de>**20200428090037
Ignore-this: 3075cd07e9927135c729ecac634ae6e4b241a05413f8df9b0af836080d24fab84657e66d6107a9bb
This allows to build with ghc-8.8 and ghc-8.10.
] hunk ./darcs.cabal 121
- - setup-depends: base >= 4.10 && < 4.13,
- - Cabal >= 2.2 && < 3.0,
+ setup-depends: base >= 4.10 && < 4.15,
+ Cabal >= 2.2 && < 3.3,
hunk ./darcs.cabal 405
- - build-depends: base >= 4.10 && < 4.13,
+ build-depends: base >= 4.10 && < 4.15,
["loosen-upper-bound-for-haskeline-to-_0_9.dpatch" (application/x-darcs-patch)]
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic