├── .github └── workflows │ └── haskell-ci.yml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── Setup.hs ├── bench └── Main.hs ├── cabal.haskell-ci ├── default.nix ├── examples └── restoreBackup.hs ├── release.nix ├── shell.nix ├── slides ├── go ├── hackage.png └── slides.md ├── src ├── Turtle.hs └── Turtle │ ├── Bytes.hs │ ├── Format.hs │ ├── Internal.hs │ ├── Line.hs │ ├── Options.hs │ ├── Pattern.hs │ ├── Prelude.hs │ ├── Shell.hs │ └── Tutorial.hs ├── stack-lts-10.yaml ├── stack.yaml ├── test ├── Main.hs ├── RegressionBrokenPipe.hs ├── RegressionMaskingException.hs ├── cptree.hs └── system-filepath.hs └── turtle.cabal /.github/workflows/haskell-ci.yml: -------------------------------------------------------------------------------- 1 | # This GitHub workflow config has been generated by a script via 2 | # 3 | # haskell-ci 'github' 'turtle.cabal' 4 | # 5 | # To regenerate the script (for example after adjusting tested-with) run 6 | # 7 | # haskell-ci regenerate 8 | # 9 | # For more information, see https://github.com/haskell-CI/haskell-ci 10 | # 11 | # version: 0.15.20230321 12 | # 13 | # REGENDATA ("0.15.20230321",["github","turtle.cabal"]) 14 | # 15 | name: Haskell-CI 16 | on: 17 | push: 18 | branches: 19 | - main 20 | - ci-* 21 | pull_request: 22 | branches: 23 | - main 24 | - ci-* 25 | jobs: 26 | linux: 27 | name: Haskell-CI - Linux - ${{ matrix.compiler }} 28 | runs-on: ubuntu-20.04 29 | timeout-minutes: 30 | 60 31 | container: 32 | image: buildpack-deps:bionic 33 | continue-on-error: ${{ matrix.allow-failure }} 34 | strategy: 35 | matrix: 36 | include: 37 | - compiler: ghc-9.10.1 38 | compilerKind: ghc 39 | compilerVersion: 9.10.1 40 | setup-method: ghcup 41 | allow-failure: false 42 | - compiler: ghc-9.8.2 43 | compilerKind: ghc 44 | compilerVersion: 9.8.2 45 | setup-method: ghcup 46 | allow-failure: false 47 | - compiler: ghc-9.6.1 48 | compilerKind: ghc 49 | compilerVersion: 9.6.1 50 | setup-method: ghcup 51 | allow-failure: false 52 | - compiler: ghc-9.4.4 53 | compilerKind: ghc 54 | compilerVersion: 9.4.4 55 | setup-method: ghcup 56 | allow-failure: false 57 | - compiler: ghc-9.2.7 58 | compilerKind: ghc 59 | compilerVersion: 9.2.7 60 | setup-method: ghcup 61 | allow-failure: false 62 | - compiler: ghc-9.0.2 63 | compilerKind: ghc 64 | compilerVersion: 9.0.2 65 | setup-method: ghcup 66 | allow-failure: false 67 | - compiler: ghc-8.10.7 68 | compilerKind: ghc 69 | compilerVersion: 8.10.7 70 | setup-method: ghcup 71 | allow-failure: false 72 | - compiler: ghc-8.8.4 73 | compilerKind: ghc 74 | compilerVersion: 8.8.4 75 | setup-method: hvr-ppa 76 | allow-failure: false 77 | - compiler: ghc-8.6.5 78 | compilerKind: ghc 79 | compilerVersion: 8.6.5 80 | setup-method: hvr-ppa 81 | allow-failure: false 82 | - compiler: ghc-8.4.4 83 | compilerKind: ghc 84 | compilerVersion: 8.4.4 85 | setup-method: hvr-ppa 86 | allow-failure: false 87 | - compiler: ghc-8.2.2 88 | compilerKind: ghc 89 | compilerVersion: 8.2.2 90 | setup-method: hvr-ppa 91 | allow-failure: false 92 | - compiler: ghc-8.0.2 93 | compilerKind: ghc 94 | compilerVersion: 8.0.2 95 | setup-method: hvr-ppa 96 | allow-failure: false 97 | fail-fast: false 98 | steps: 99 | - name: apt 100 | run: | 101 | apt-get update 102 | apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 103 | if [ "${{ matrix.setup-method }}" = ghcup ]; then 104 | mkdir -p "$HOME/.ghcup/bin" 105 | curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup" 106 | chmod a+x "$HOME/.ghcup/bin/ghcup" 107 | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) 108 | "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 109 | else 110 | apt-add-repository -y 'ppa:hvr/ghc' 111 | apt-get update 112 | apt-get install -y "$HCNAME" 113 | mkdir -p "$HOME/.ghcup/bin" 114 | curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup" 115 | chmod a+x "$HOME/.ghcup/bin/ghcup" 116 | "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 117 | fi 118 | env: 119 | HCKIND: ${{ matrix.compilerKind }} 120 | HCNAME: ${{ matrix.compiler }} 121 | HCVER: ${{ matrix.compilerVersion }} 122 | - name: Set PATH and environment variables 123 | run: | 124 | echo "$HOME/.cabal/bin" >> $GITHUB_PATH 125 | echo "LANG=C.UTF-8" >> "$GITHUB_ENV" 126 | echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" 127 | echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" 128 | HCDIR=/opt/$HCKIND/$HCVER 129 | if [ "${{ matrix.setup-method }}" = ghcup ]; then 130 | HC=$HOME/.ghcup/bin/$HCKIND-$HCVER 131 | echo "HC=$HC" >> "$GITHUB_ENV" 132 | echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" 133 | echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" 134 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" 135 | else 136 | HC=$HCDIR/bin/$HCKIND 137 | echo "HC=$HC" >> "$GITHUB_ENV" 138 | echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" 139 | echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" 140 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" 141 | fi 142 | 143 | HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 144 | echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" 145 | if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" ; else echo "ARG_TESTS=--disable-tests" >> "$GITHUB_ENV" ; fi 146 | if [ $((HCNUMVER < 90400)) -ne 0 ] ; then echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" ; else echo "ARG_BENCH=--disable-benchmarks" >> "$GITHUB_ENV" ; fi 147 | echo "HEADHACKAGE=false" >> "$GITHUB_ENV" 148 | echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" 149 | echo "GHCJSARITH=0" >> "$GITHUB_ENV" 150 | env: 151 | HCKIND: ${{ matrix.compilerKind }} 152 | HCNAME: ${{ matrix.compiler }} 153 | HCVER: ${{ matrix.compilerVersion }} 154 | - name: env 155 | run: | 156 | env 157 | - name: write cabal config 158 | run: | 159 | mkdir -p $CABAL_DIR 160 | cat >> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz 193 | echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c - 194 | xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan 195 | rm -f cabal-plan.xz 196 | chmod a+x $HOME/.cabal/bin/cabal-plan 197 | cabal-plan --version 198 | - name: checkout 199 | uses: actions/checkout@v3 200 | with: 201 | path: source 202 | - name: initial cabal.project for sdist 203 | run: | 204 | touch cabal.project 205 | echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project 206 | cat cabal.project 207 | - name: sdist 208 | run: | 209 | mkdir -p sdist 210 | $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist 211 | - name: unpack 212 | run: | 213 | mkdir -p unpacked 214 | find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; 215 | - name: generate cabal.project 216 | run: | 217 | PKGDIR_turtle="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/turtle-[0-9.]*')" 218 | echo "PKGDIR_turtle=${PKGDIR_turtle}" >> "$GITHUB_ENV" 219 | rm -f cabal.project cabal.project.local 220 | touch cabal.project 221 | touch cabal.project.local 222 | echo "packages: ${PKGDIR_turtle}" >> cabal.project 223 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package turtle" >> cabal.project ; fi 224 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi 225 | cat >> cabal.project <= 80400)) -ne 0 ] ; then $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct ; fi 252 | - name: cabal check 253 | run: | 254 | cd ${PKGDIR_turtle} || false 255 | ${CABAL} -vnormal check 256 | - name: haddock 257 | run: | 258 | $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all 259 | - name: unconstrained build 260 | run: | 261 | rm -f cabal.project.local 262 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 263 | - name: save cache 264 | uses: actions/cache/save@v3 265 | if: always() 266 | with: 267 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 268 | path: ~/.cabal/store 269 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | .cabal-sandbox 3 | cabal.sandbox.config 4 | .stack-work 5 | tags 6 | dist-newstyle 7 | stack.yaml.lock -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | 1.6.2 2 | 3 | * Build against latest `ansi-wl-pprint` and `optparse-applicative` [[#445]](https://github.com/Gabriella439/turtle/pull/445) / [[#446]](https://github.com/Gabriella439/turtle/pull/446) / [[#447]](https://github.com/Gabriella439/turtle/pull/447) 4 | 5 | 1.6.1 6 | 7 | * BUG FIX: Fix `turtle` to build on Windows 8 | * BUG FIX: `stripPrefix` and `commonPrefix` now correctly handle files with 9 | extensions 10 | * For example, before this fix `stripPrefix "./" "./foo.bar"` would 11 | return `Just "foo/.bar"` 12 | 13 | 1.6.0 14 | 15 | * BREAKING CHANGE: Switch to the `FilePath` type from `base` instead of 16 | `system-filepath` 17 | * This is a breaking change for a couple of reasons: 18 | * The `FilePath` type has changed, so the API is not backwards-compatible 19 | * The thing most likely to break is if you directly imported utilities 20 | from the `system-filepath` or `system-fileio` packages to operate on 21 | `turtle`'s `FilePath`s 22 | * If that happens, you should first check if the `Turtle` module 23 | exports a utility of the same name. If so, then switch to that 24 | * If there is no equivalent substitute from the `Turtle` module then 25 | you will have to change your code to use the closest equivalent 26 | utility from the `filepath` or `directory` package 27 | * If you were previously using any of the `system-filepath` or 28 | `system-fileio` utilities re-exported from the `Turtle` module then 29 | those utilities will not break as they have been replaced with 30 | versions compatible with the `FilePath` type from `base` 31 | * The second thing most likely to break is any code that relies on 32 | typeclasses since because if you defined any instances for the 33 | `FilePath` type exported by `turtle` then those instances will now 34 | overlap with any instances defined for the `String` type 35 | * The conversion utilities (e.g. `toText`, `encodeString`) will still 36 | work, so code that used those conversion utilities should be less 37 | affected by this change 38 | * The behavior of the `collapse` utility is subtly different 39 | * `collapse` no longer interprets `..` in paths 40 | * This new behavior is more correct in the presence of symlinks, so the 41 | change is (hopefully) an improvement to downstream code 42 | * The new API strives to match the old behavior as closely as possible 43 | * … so this should (hopefully) not break too much code in practice 44 | * With the exception of the `collapse` function the new API should be 45 | bug-for-bug compatible with the old API 46 | * Most of the surprising behavior inherited from the old API is around 47 | how `.` and `..` are handled in paths 48 | * `parent ".." == "."` is an example of such surprising behavior 49 | * At some point in the future we may fix bugs in these utilities inherited 50 | from `system-filepath` / `system-fileio`, but no decision either way has 51 | been made, yet 52 | * Some old utilities are marked `DEPRECATED` if their behavior exactly matches 53 | the behavior of an existing utility from the `filepath` or `directory` 54 | package 55 | * These may be eventually removed at some point in the future or they 56 | remain in a deprecated state indefinitely. No decision either way has 57 | been made 58 | * The `Turtle` module also re-exports any utility suggested by a 59 | `DEPRECATED` pragma as a convenience 60 | * Other utilities are not deprecated if the old behavior significantly departs 61 | from any existing utility from the `filepath` or `directory` package 62 | * For example, the behavior of the `filename` utility differs from the 63 | behavior of `System.FilePath.takeFileName` for filenames that begin with a 64 | `.`, so we have to preserve the old behavior to avoid breaking downstream 65 | code 66 | * At some point in the future utilities like these may be deprecated in 67 | favor of their closest analogs in the `filepath` / `directory` packages or 68 | they may be supported indefinitely. No decision either way has been made 69 | * If you want to try to author code that is compatible with both the 70 | pre-1.6 and post-1.6 API: 71 | * If you add any instances to the `FilePath` type, import it qualified 72 | directly from the `system-filepath` package and use it only for instances 73 | * Otherwise, don't import anything else from the `system-filepath` / 74 | `system-fileio` packages if you can help it. Instead, restrict yourself 75 | entirely to the utilities and `FilePath` type exported by the `Turtle` 76 | module 77 | * Use the conversion utilities (e.g. `encodeStrings`, even if they are not 78 | necessary post-1.6) 79 | * If that's still not enough, use `CPP` and good luck! 80 | 81 | 1.5.25 82 | 83 | * Build against latest version of `Win32` package 84 | 85 | 1.5.24 86 | 87 | * Expose `Format` constructor 88 | 89 | 1.5.23 90 | 91 | * Add `fromIO` utility 92 | * Build against GHC 9.0 / 9.2 93 | 94 | 1.5.22 95 | 96 | * Add new `update` utility 97 | * Improve documentation for `limit` 98 | 99 | 1.5.21 100 | 101 | * Build against `optparse-applicative-0.16.0.0` 102 | 103 | 1.5.20 104 | 105 | * Build against `doctest-0.17` 106 | * Only depend on `semigroups` for GHC < 8.0 107 | 108 | 1.5.19 109 | 110 | * Add pattern synonyms for `Size` 111 | 112 | 1.5.18 113 | 114 | * Fix space leak 115 | 116 | 1.5.17 117 | 118 | * Add `optionsExt`: Extended version of `options` with header, footer, 119 | porgram-description and version information in `--help` flag 120 | * Add `readlink` 121 | 122 | 1.5.16 123 | 124 | * Add `cptreeL` 125 | 126 | 1.5.15 127 | 128 | * Add `toLines` 129 | * Add `Turtle.Bytes.{fromUTF8,toUTF8}` 130 | * Add `Turtle.Bytes.{compress,decompress}` 131 | * Always expose a `MonadFail` instance, relying on the `fail` package 132 | where needed. Related GHC 8.8 preparedness. 133 | 134 | 1.5.14 135 | 136 | * Fix `cptree` to copy symlinks instead of descending into them 137 | * See: https://github.com/Gabriel439/Haskell-Turtle-Library/pull/344 138 | * Build against newer versions of `Win32` package 139 | 140 | 1.5.13 141 | 142 | * Fix `chmod` bug 143 | * See: https://github.com/Gabriel439/Haskell-Turtle-Library/pull/337 144 | * Add `reduce` and re-export `(<&>)` 145 | * See: https://github.com/Gabriel439/Haskell-Turtle-Library/pull/332 146 | 147 | 1.5.12 148 | 149 | * Increase upper bound on `containers` 150 | 151 | 1.5.11 152 | 153 | * Don't forward broken pipe exceptions when using `inproc` 154 | * See: https://github.com/Gabriel439/Haskell-Turtle-Library/pull/321 155 | * Increase upper bound on `stm` 156 | * See: https://github.com/Gabriel439/Haskell-Turtle-Library/pull/321 157 | * Tutorial improvements: 158 | * See: https://github.com/Gabriel439/Haskell-Turtle-Library/pull/322 159 | 160 | 1.5.10 161 | 162 | * Increase upper bound on `doctest` and `criterion` 163 | 164 | 1.5.9 165 | 166 | * Add `symlink` 167 | 168 | 1.5.8 169 | 170 | * Bug fix: `invert` no longer rejects inputs where a prefix matches the inverted 171 | pattern 172 | * See: https://github.com/Gabriel439/Haskell-Turtle-Library/pull/297 173 | * Add lsdepth, findtree, cmin, and cmax 174 | * Increase upper bound on `temporary` and `foldl` 175 | 176 | 1.5.7 177 | 178 | * Increase upper bound on `doctest` 179 | 180 | 1.5.6 181 | 182 | * Increase upper bound on `exceptions` 183 | 184 | 1.5.5 185 | 186 | * Increase upper bound on `criterion` 187 | 188 | 1.5.4 189 | 190 | * Increase upper bound on `exceptions` 191 | 192 | 1.5.3 193 | 194 | * Increase upper bound on `doctest` 195 | 196 | 1.5.2 197 | 198 | * Increase upper bound on `async` 199 | 200 | 1.5.1 201 | 202 | * GHC 8.4 support 203 | * Re-export `encodeString`/`decodeString` 204 | * Update tutorial to use `stack script` 205 | * Increase upper bounds on dependencies 206 | 207 | 1.5.0 208 | 209 | * BREAKING CHANGE: Add `MonadCatch` instance for `Shell` 210 | * This requires a breaking change to the internal implementation of `Shell` 211 | * Most breaking changes can be fixed by replacing the `Shell` constructor 212 | with the newly added `_Shell` utility for ease of migration 213 | * If you don't use the `Shell` constructor then this change likely does not 214 | affect you 215 | * Add `eprintf` 216 | 217 | 1.4.5 218 | 219 | * Add `grepText`, `uniq`, `nub`, `sort` to `Turtle.Prelude` 220 | * Increase upper bound on `unix-compat` 221 | 222 | 1.4.4 223 | 224 | * Fix small mistake in tutorial 225 | 226 | 1.4.3 227 | 228 | * Increase upper bound on `doctest` 229 | 230 | 1.4.2 231 | 232 | * Add `sed{Prefix,Suffix,Entire}` and `inplace{Prefix,Suffix,Entire}` 233 | 234 | 1.4.1 235 | 236 | * Increase upper bound on `doctest` 237 | 238 | 1.4.0 239 | 240 | * BREAKING CHANGE: Remove unnecessary `Maybe` from type of `single` 241 | * BREAKING CHANGE: Consolidate `searchable` and `executable` 242 | * `stream{,WithErr}` now throws an `ExitCode` on failure 243 | 244 | 1.3.6 245 | 246 | * Build against `ghc-8.2` 247 | * Relax upper bound on `optparse-applicative` and `foldl` 248 | 249 | 1.3.5 250 | 251 | * Increase upper bound on `foldl` 252 | 253 | 1.3.4 254 | 255 | * Bug fix: `cptree` now correctly copies files instead of creating directories 256 | of the same name 257 | * Increase upper bound on `criterion` 258 | 259 | 1.3.3 260 | 261 | * Bug fix: Change `textToLines` to behave like `Data.Text.splitOn "\n"` 262 | instead of `Data.Text.unlines` 263 | * This fixes weird behavior around handling empty strings. `splitOn` does 264 | the right thing, but `unlines` does not. For example, this indirectly 265 | fixes a regression in `sed`, which would discard empty lines 266 | * Bug fix: `which`/`whichAll` now behave correctly on Windows 267 | * Add new `cptree`/`single` utilities 268 | * Documentation fixes 269 | 270 | 1.3.2 271 | 272 | * Fix bugs in subprocess management 273 | * Generalize type of `repr` to return any type that implements `IsString` 274 | * Add `optLine`, `argLine`, and `l` utilities to simplify working with `Line`s 275 | 276 | 1.3.1 277 | 278 | * `find` no longer follows symlinks 279 | * Increase upper bound on `directory` 280 | 281 | 1.3 282 | 283 | * BREAKING CHANGE: Several utilities now produce and consume `Line`s instead of 284 | `Text` 285 | * The purpose of this change is to fix a very common source of confusion for 286 | new users about which utilities are line-aware 287 | * Most of the impact on existing code is just changing the types by 288 | replacing `Text` with `Line` in the right places. The change at the 289 | term level should be small (based on the changes to the tutorial examples) 290 | * BREAKING CHANGE: `Description` now wraps a `Doc` instead of `Text` 291 | * In the most common case where users use string literals this has no effect 292 | * New `Turtle.Bytes` module that provides `ByteString` variations on subprocess 293 | runners 294 | * Fix `du` reporting incorrect sizes for directories 295 | * Add `pushd`, `stat`, `lstat`, `which`, `procStrictWithErr`, 296 | `shellStrictWithErr`, `onFiles`, `header`, `subcommandGroup`, and `parallel` 297 | * Backport `need` to GHC 7.6.3 298 | * Fix missing help text for option parsers 299 | * Fix bugs in subprocess management 300 | 301 | 1.2.8 302 | 303 | * Increase upper bound on `time` and `transformers` 304 | * Fix incorrect lower bound for `base` 305 | 306 | 1.2.7 307 | 308 | * Increase upper bound on `clock` dependency 309 | 310 | 1.2.6 311 | 312 | * Generalize several types to use `MonadManaged` 313 | * Generalize type of `printf` to use `MonadIO` 314 | * Add `system`, and `copymod` 315 | * Fix `rmtree` to more accurately match behavior of `rm -r` 316 | 317 | 1.2.5 318 | 319 | * Add `printf`, `utc`, `procs`, and `shells` 320 | 321 | 1.2.4 322 | 323 | * Generalize type of `d` format specifier to format any `Integral` type 324 | * Add `inprocWithErr`, `inShellWithErr`, `inplace`, and `sz` 325 | 326 | 1.2.3 327 | 328 | * Add `subcommand` and `testpath` 329 | * Use line buffering for `Text`-based subprocesses 330 | 331 | 1.2.2 332 | 333 | * Re-export `with` 334 | * Add `begins`, `ends`, `contains`, `lowerBounded`, `mktempfile`, `nl`, `paste` 335 | `endless`, `lsif`, and `cut` 336 | * Fix subprocess management bugs 337 | 338 | 1.2.1 339 | 340 | * Fix subprocess management bugs 341 | 342 | 1.2.0 343 | 344 | * BREAKING CHANGE: `du` now returns a `Size` instead of an `Integer` 345 | * New `Turtle.Options` module that provides convenient utilities for options 346 | parsing 347 | * Add `hostname`, `outhandle`, `stderr`, `cache`, `countChars`, `countWords`, 348 | and `countLines` 349 | * Fix subprocess management bugs 350 | 351 | 1.1.1 352 | 353 | * Add `bounded`, `upperBounded`, `procStrict`, `shellStrict`, `arguments` 354 | * Add several `Permissions`-related commands 355 | * Generalize several types to `MonadIO` 356 | 357 | 1.1.0 358 | 359 | * BREAKING CHANGE: Remove `Floating`/`Fractional` instances for `Pattern` and 360 | `Shell` 361 | * BREAKING CHANGE: Change behavior of `Num` instance for `Pattern` and `Shell` 362 | * Re-export `(&)` 363 | * Add `asciiCI`, `(.||.)`, `(.&&.)`, `strict` 364 | 365 | 1.0.2 366 | 367 | * Add `fp` format specifier 368 | * Add `chars`/`chars` high-efficiency parsing primitives 369 | * Fix bugs in path handling 370 | 371 | 1.0.1 372 | 373 | * Generalize type of `die` 374 | * Fix doctest 375 | 376 | 1.0.0 377 | 378 | * Initial release 379 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017 Gabriella Gonzalez 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without modification, 5 | are permitted provided that the following conditions are met: 6 | * Redistributions of source code must retain the above copyright notice, 7 | this list of conditions and the following disclaimer. 8 | * Redistributions in binary form must reproduce the above copyright notice, 9 | this list of conditions and the following disclaimer in the documentation 10 | and/or other materials provided with the distribution. 11 | * Neither the name of Gabriella Gonzalez nor the names of other contributors 12 | may be used to endorse or promote products derived from this software 13 | without specific prior written permission. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 22 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # `turtle` 2 | 3 | Turtle is a reimplementation of the Unix command line environment in Haskell so 4 | that you can use Haskell as a scripting language or a shell. Think of `turtle` 5 | as `coreutils` embedded within the Haskell language. 6 | 7 | ## Quick start 8 | 9 | * Install [Stack](https://github.com/commercialhaskell/stack) 10 | 11 | ``` 12 | $ stack ghci turtle 13 | Prelude> :set -XOverloadedStrings 14 | Prelude> import Turtle 15 | ``` 16 | 17 | ... and try out some basic filesystem operations: 18 | 19 | ``` 20 | Prelude Turtle> cd "/tmp" 21 | Prelude Turtle> mkdir "test" 22 | Prelude Turtle> touch "test/foo" 23 | Prelude Turtle> testfile "test/foo" 24 | True 25 | Prelude Turtle> rm "test/foo" 26 | Prelude Turtle> testfile "test/foo" 27 | False 28 | Prelude Turtle> rmdir "test" 29 | Prelude Turtle> view (lstree "/usr/lib") 30 | FilePath "/usr/lib/gnome-screensaver" 31 | FilePath "/usr/lib/gnome-screensaver/gnome-screensaver-dialog" 32 | FilePath "/usr/lib/libplist.so.1.1.8" 33 | FilePath "/usr/lib/tracker" 34 | FilePath "/usr/lib/tracker/tracker-miner-fs" 35 | FilePath "/usr/lib/tracker/tracker-extract" 36 | FilePath "/usr/lib/tracker/tracker-writeback" 37 | FilePath "/usr/lib/tracker/tracker-search-bar" 38 | FilePath "/usr/lib/tracker/tracker-store" 39 | FilePath "/usr/lib/libgif.so.4.1" 40 | ... 41 | ``` 42 | 43 | To learn more, read the [turtle tutorial](https://hackage.haskell.org/package/turtle/docs/Turtle-Tutorial.html). 44 | 45 | ## Goals 46 | 47 | The `turtle` library focuses on being a "better Bash" by providing a typed and 48 | light-weight shell scripting experience embedded within the Haskell language. 49 | If you have a large shell script that is difficult to maintain, consider 50 | translating it to a "`turtle` script" (i.e. a Haskell script using the `turtle` 51 | library). 52 | 53 | Among typed languages, Haskell possesses a unique combination of features that 54 | greatly assist scripting: 55 | 56 | * Haskell has global type inference, so all type annotations are optional 57 | * Haskell is functional and not object-oriented, so boilerplate is minimal 58 | * Haskell can be type-checked and interpreted quickly (< 1 second startup time) 59 | 60 | ## Features 61 | 62 | * *Batteries included:* Command an extended suite of predefined utilities 63 | 64 | * *Interoperability:* You can still run external shell commands 65 | 66 | * *Portability:* Works on Windows, OS X, and Linux 67 | 68 | * *Exception safety:* Safely acquire and release resources 69 | 70 | * *Streaming:* Transform or fold command output in constant space 71 | 72 | * *Patterns:* Use typed regular expressions that can parse structured values 73 | 74 | * *Formatting:* Type-safe `printf`-style text formatting 75 | 76 | * *Modern:* Supports `text` and `system-filepath` 77 | 78 | ## Caveats 79 | 80 | Unlike `shelly`, this package does not use a monad transformer to keep track of 81 | state like the current working directory or environment variables. Instead, all 82 | state changes are made to the process's global state. 83 | 84 | ## Development Status 85 | 86 | [![Build Status](https://github.com/Gabriella439/turtle/actions/workflows/haskell-ci.yml/badge.svg)](https://github.com/Gabriella439/turtle/actions/workflows/haskell-ci.yml) 87 | 88 | `turtle`'s types and idioms are reasonably complete and I don't expect there 89 | to be significant changes to the library's core API. The only major 90 | functionality that I might add in the future would be to wrap 91 | `optparse-applicative` in a simpler API. 92 | 93 | The set of available tools currently covers as many filesystem utilities as I 94 | could find across Hackage, but I would like to continue to add to the set of 95 | available tools to minimally match `coreutils`. 96 | 97 | ## Community Resources 98 | 99 | * The 100 | [haskell-turtle tag](http://stackoverflow.com/questions/tagged/haskell-turtle) 101 | on Stack Overflow 102 | 103 | ## How to contribute 104 | 105 | * Contribute more utilities 106 | 107 | * Write `turtle` tutorials 108 | 109 | ## License (BSD 3-clause) 110 | 111 | Copyright (c) 2017 Gabriella Gonzalez\ 112 | All rights reserved. 113 | 114 | Redistribution and use in source and binary forms, with or without modification, 115 | are permitted provided that the following conditions are met: 116 | 117 | * Redistributions of source code must retain the above copyright notice, 118 | this list of conditions and the following disclaimer. 119 | * Redistributions in binary form must reproduce the above copyright notice, 120 | this list of conditions and the following disclaimer in the documentation 121 | and/or other materials provided with the distribution. 122 | * Neither the name of Gabriella Gonzalez nor the names of other contributors 123 | may be used to endorse or promote products derived from this software 124 | without specific prior written permission. 125 | 126 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 127 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 128 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 129 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 130 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 131 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 132 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 133 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 134 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 135 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 136 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /bench/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Main where 3 | 4 | import qualified Data.Text as Text 5 | import Test.Tasty.Bench 6 | import Turtle 7 | 8 | boundedNaive :: Int -> Int -> Pattern a -> Pattern [a] 9 | boundedNaive m n p = do 10 | x <- choice (map pure [m..n]) 11 | count x p 12 | 13 | main :: IO () 14 | main = defaultMain 15 | [ bgroup "Pattern" 16 | [ let cats = Text.replicate 1000 "cat" 17 | furniture = Text.replicate 5 " " 18 | in bgroup "Cat Lady's House" 19 | [ bench "Basic" 20 | $ nf (match (many "cat")) cats 21 | , bench "Letters" 22 | $ nf (match (many (mconcat ["c", "a", "t"]))) cats 23 | , bench "Spaces" 24 | $ nf (match (many "cat" <* spaces)) (cats <> furniture) 25 | , bench "Prefix" 26 | $ nf (match (prefix (many "cat"))) (cats <> furniture) 27 | ] 28 | , let hearts n = Text.replicate n "heart" 29 | in bgroup "Love Knows No Bounds" 30 | [ bench "500-700:650 Naive" 31 | $ nf (match (boundedNaive 500 700 "heart")) (hearts 650) 32 | , bench "500-700:650" 33 | $ nf (match (bounded 500 700 "heart")) (hearts 650) 34 | , bench "5000-7000:6500 Naive" 35 | $ nf (match (boundedNaive 5000 7000 "heart")) (hearts 6500) 36 | , bench "5000-7000:6500" 37 | $ nf (match (bounded 5000 7000 "heart")) (hearts 6500) 38 | ] 39 | ] 40 | ] 41 | -------------------------------------------------------------------------------- /cabal.haskell-ci: -------------------------------------------------------------------------------- 1 | branches: main ci-* 2 | installed: -all 3 | tests: >= 8.4 4 | -- Can't build benchmark with GHC >= 9.4 as long as it has text < 1.3 5 | benchmarks: < 9.4 6 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | { compiler ? "ghc8107" }: 2 | 3 | let 4 | nixpkgs = builtins.fetchTarball { 5 | url = "https://github.com/NixOS/nixpkgs/archive/391f93a83c3a486475d60eb4a569bb6afbf306ad.tar.gz"; 6 | sha256 = "0s5f7j2akh3g0013880jfbigdaac1z76r9dv46yw6k254ba2r6nq"; 7 | }; 8 | 9 | config = {}; 10 | 11 | overlay = pkgsNew: pkgsOld: { 12 | haskell = pkgsOld.haskell // { 13 | packages = pkgsOld.haskell.packages // { 14 | "${compiler}" = pkgsOld.haskell.packages."${compiler}".override (old: { 15 | overrides = 16 | let 17 | packageSources = pkgsNew.haskell.lib.packageSourceOverrides { 18 | "turtle" = ./.; 19 | }; 20 | 21 | manualOverrides = haskellPackagesNew: haskellPackagesOld: { 22 | }; 23 | 24 | default = old.overrides or (_: _: {}); 25 | 26 | in 27 | pkgsNew.lib.fold pkgsNew.lib.composeExtensions default [ 28 | packageSources 29 | manualOverrides 30 | ]; 31 | }); 32 | }; 33 | }; 34 | }; 35 | 36 | pkgs = 37 | import nixpkgs { inherit config; overlays = [ overlay ]; }; 38 | 39 | in 40 | { inherit (pkgs.haskell.packages."${compiler}") turtle; 41 | 42 | shell = (pkgs.haskell.packages."${compiler}".turtle).env; 43 | 44 | inherit (pkgs.releaseTools) aggregate; 45 | } 46 | -------------------------------------------------------------------------------- /examples/restoreBackup.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | import Turtle 4 | 5 | import qualified Control.Foldl as Fold 6 | 7 | main = do 8 | -- Backup the old database 9 | inproc "mysqldump" ["-uroot", "myproject"] empty 10 | & output "revert.sql" 11 | 12 | let serverName = "lalala" 13 | let backupDir = "/backups/db/myproject/" 14 | 15 | -- Obtain newest filename from server 16 | let query :: Shell Line 17 | query = inproc "ssh" 18 | [ serverName 19 | , format ("ls -Art "%fp%" | tail -n 1") backupDir 20 | ] 21 | empty 22 | result <- fold query Fold.head 23 | newestFileName <- case result of 24 | Nothing -> die "Couldn't get backup path" 25 | Just text -> return (fromText (lineToText text)) 26 | 27 | let backupFilePath = backupDir newestFileName 28 | let localFilePath = "/tmp/" newestFileName 29 | 30 | -- Download the backup 31 | procs "rsync" 32 | [ "-avcz" 33 | , format (s%":"%fp) serverName backupFilePath 34 | , format fp localFilePath 35 | ] 36 | empty 37 | 38 | let dbName = "myproject-copy" 39 | 40 | -- Drop the old database 41 | shells ("mysqladmin -uroot drop -f " <> dbName) empty 42 | 43 | -- Restore the database from the downloaded backup 44 | inproc "zcat" [format fp localFilePath] empty 45 | & procs "mysql" ["-uroot", dbName] 46 | 47 | echo "Backup restored" 48 | -------------------------------------------------------------------------------- /release.nix: -------------------------------------------------------------------------------- 1 | let 2 | default = import ./default.nix { }; 3 | 4 | in 5 | { turtle = 6 | default.aggregate 7 | { name = "all"; 8 | 9 | constituents = [ 10 | default.turtle 11 | ]; 12 | }; 13 | } 14 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | ((import ./default.nix){}).shell 2 | -------------------------------------------------------------------------------- /slides/go: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | import Turtle 6 | 7 | main = do 8 | -- Add the `--self-contained` flag for slower but relocatable builds 9 | proc "pandoc" ["-t", "slidy", "-s", "slides.md", "-o", "slides.html"] empty 10 | 11 | -- This is for Firefox on OSX, replace this with your favorite browser 12 | proc "open" ["/Applications/Firefox.app", "slides.html"] empty 13 | -------------------------------------------------------------------------------- /slides/hackage.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Gabriella439/turtle/743f2f9b0dde50b8a20e7e883ee4daff6a612b29/slides/hackage.png -------------------------------------------------------------------------------- /slides/slides.md: -------------------------------------------------------------------------------- 1 | % Haskell for Shell Scripting 2 | % Gabriella Gonzalez 3 | % December 14, 2015 4 | 5 | # Before class 6 | 7 | If you haven't installed `stack`, visit: 8 | 9 | * [haskellstack.com](http://haskellstack.com) 10 | 11 | ... and install the `stack` build tool. Then run these commands: 12 | 13 | ```bash 14 | $ stack setup 15 | ... 16 | $ stack ghci turtle 17 | ... 18 | Prelude> :set -XOverloadedStrings 19 | Prelude> import Turtle 20 | Prelude Turtle> echo "Hello, world!" 21 | Hello, world!" 22 | ``` 23 | 24 | # Outline 25 | 26 | * **Haskell overview** 27 | * Subroutines 28 | * Types 29 | * Use `ghci` as a shell 30 | * Type signatures 31 | * String formatting 32 | * Streams 33 | * Pipes 34 | * Folds 35 | * Patterns 36 | 37 | I'm hosting slides on Github so that people can follow along locally 38 | 39 | # Overview of Haskell 40 | 41 | Haskell is a purely functional language with strong and static types 42 | 43 | * **Purely functional** means side effect order is not tied to evaluation order 44 | 45 | * **Strong** types are fine-grained (i.e. `FilePath`/`Time`/`Name` vs `String`) 46 | 47 | * **Static** types catch errors at compile time 48 | 49 | Haskell can be both **interpreted** or **compiled** to a native binary 50 | 51 | Haskell is a managed language, providing garbage collection, concurrency, and 52 | transactional shared memory: 53 | 54 | * **Garbage collection** is efficient (throughput measured in GB / s) 55 | * **Concurrency** uses efficient green-threads (even more efficient than Go) 56 | * **Transactional memory** simplifies race-free concurrent code 57 | 58 | # Big disadvantages of Haskell 59 | 60 | * No JVM backend 61 | * Beginners can't easily reason about performance 62 | * Built-in record syntax is clumsy 63 | * Most language features are libraries, which hampers discoverability 64 | * Culture of abstraction astronauts (myself included) 65 | 66 | # Comparing Haskell to Scala 67 | 68 | Similarities: 69 | 70 | * Static types 71 | * Strong types 72 | * Functional 73 | * Automatic memory management 74 | 75 | Differences: 76 | 77 | * Haskell is not object-oriented 78 | * Haskell is not a JVM language 79 | * Haskell has a faster startup time (10 ms compiled, < 1 second interpreted) 80 | * Haskell compiles to native code 81 | 82 | # Comparing Haskell to Python 83 | 84 | Similarities 85 | 86 | * Lightweight syntax 87 | * Significant whitespace (with optional curly braces) 88 | * Procedural 89 | * Automatic memory management 90 | 91 | Differences: 92 | 93 | * Haskell is statically typed (unless you enable `-fdefer-type-errors`) 94 | * Haskell is strongly typed 95 | * Haskell compiler/interpreter not pre-installed on most Unix-like systems 96 | * Haskell compiles to native code 97 | 98 | # Why use Haskell for shell scripting? 99 | 100 | Haskell has light-weight syntax and fast start-up times 101 | 102 | Haskell code is easy to refactor and maintain 103 | 104 | # Hello, world! 105 | 106 | Save this to: `example.hs`: 107 | 108 | ```haskell 109 | #!/usr/bin/env stack 110 | -- stack --resolver lts-10.2 script 111 | -- #!/bin/bash 112 | {-# LANGUAGE OverloadedStrings #-} -- 113 | -- 114 | import Turtle -- 115 | -- 116 | main = echo "Hello, world!" -- echo Hello, world! 117 | ``` 118 | 119 | ... then run the example script: 120 | 121 | ```bash 122 | $ chmod u+x example.hs 123 | $ ./example.hs 124 | Hello, world! 125 | ``` 126 | 127 | # Create a native binary 128 | 129 | ```bash 130 | $ stack ghc -- -O2 example.hs 131 | $ ./example 132 | Hello, world! 133 | ``` 134 | 135 | # Use Haskell interactively 136 | 137 | ```haskell 138 | $ stack ghci 139 | Prelude> :set -XOverloadedStrings 140 | Prelude> import Turtle 141 | Prelude Turtle> echo "Hello, world!" 142 | Hello, world! 143 | Prelude Turtle> 2 + 2 144 | 4 145 | Prelude Turtle> let f x = x + x 146 | Prelude Turtle> f 2 147 | 4 148 | Prelude Turtle> :quit 149 | ``` 150 | 151 | # Load code into the REPL 152 | 153 | ```haskell 154 | $ stack ghci 155 | Prelude> :load example.hs 156 | *Main> main 157 | Hello, world! 158 | *Main> :quit 159 | ``` 160 | 161 | # Exercise 162 | 163 | What do you think this code does? 164 | 165 | ```haskell 166 | #!/usr/bin/env stack 167 | -- stack --resolver lts-10.2 script 168 | 169 | {-# LANGUAGE OverloadedStrings #-} 170 | 171 | import Turtle 172 | 173 | say = echo 174 | 175 | main = say "Hello, world!" 176 | ``` 177 | 178 | # Questions? 179 | 180 | * Haskell overview 181 | * **Subroutines** 182 | * Types 183 | * Use `ghci` as a shell 184 | * Type signatures 185 | * String formatting 186 | * Streams 187 | * Pipes 188 | * Folds 189 | * Patterns 190 | 191 | # Values 192 | 193 | ```haskell 194 | #!/usr/bin/env stack 195 | -- stack --resolver lts-10.2 script 196 | -- #!/bin/bash 197 | {-# LANGUAGE OverloadedStrings #-} -- 198 | -- 199 | import Turtle -- 200 | -- 201 | str = "Hello, world!" -- STR='Hello, world!' 202 | -- 203 | main = echo str -- echo $STR 204 | ``` 205 | 206 | ```bash 207 | $ ./example.hs 208 | Hello, world! 209 | ``` 210 | 211 | `str` is immutable (analogous to Scala's `val`) 212 | 213 | Why do you think Haskell defaults to immutability? 214 | 215 | # Order of definitions does not matter 216 | 217 | ```haskell 218 | #!/usr/bin/env stack 219 | -- stack --resolver lts-10.2 script 220 | 221 | {-# LANGUAGE OverloadedStrings #-} 222 | 223 | import Turtle 224 | 225 | main = echo str 226 | 227 | str = "Hello, world!" 228 | ``` 229 | 230 | # You need `main` 231 | 232 | Modify your program to to eliminate `main`: 233 | 234 | ```haskell 235 | #!/usr/bin/env stack 236 | -- stack --resolver lts-10.2 script 237 | 238 | {-# LANGUAGE OverloadedStrings #-} 239 | 240 | import Turtle 241 | 242 | echo "Hello, world!" 243 | ``` 244 | 245 | You will get this error message if you run the program: 246 | 247 | ```bash 248 | example.hs:7:1: Parse error: naked expression at top level 249 | ``` 250 | 251 | The top level of a Haskell program is declarative and only allows definitions 252 | 253 | You cannot execute code at the top level 254 | 255 | The runtime only executes `main`! 256 | 257 | # Subroutines 258 | 259 | Use `do` to create a subroutine that runs more than one command: 260 | 261 | Using significant whitespace: 262 | 263 | ```haskell 264 | #!/usr/bin/env stack 265 | -- stack --resolver lts-10.2 script 266 | -- #!/bin/bash 267 | {-# LANGUAGE OverloadedStrings #-} -- 268 | -- 269 | import Turtle -- 270 | -- 271 | main = do -- 272 | echo "Line 1" -- echo Line 1 273 | echo "Line 2" -- echo Line 2 274 | ``` 275 | 276 | ```bash 277 | $ ./example.hs 278 | Line 1 279 | Line 2 280 | ``` 281 | 282 | # You can opt out of significant whitespace 283 | 284 | ```haskell 285 | main = do 286 | { echo "Line 1" 287 | ; echo "Line 2" 288 | } 289 | ``` 290 | 291 | ```haskell 292 | main = do { 293 | echo "Line 1"; 294 | echo "Line 2"; 295 | } 296 | ``` 297 | 298 | ```haskell 299 | main = do { echo "Line1"; echo "Line2" } 300 | ``` 301 | 302 | # Storing results 303 | 304 | ```haskell 305 | #!/usr/bin/env stack 306 | -- stack --resolver lts-10.2 script 307 | -- #!/bin/bash 308 | import Turtle -- 309 | -- 310 | main = do -- 311 | dir <- pwd -- DIR=$(pwd) 312 | time <- datefile dir -- TIME=$(date -r $DIR) 313 | print time -- echo $TIME 314 | ``` 315 | 316 | ```haskell 317 | $ ./example.hs 318 | 2015-09-01 23:56:03.245 UTC 319 | ``` 320 | 321 | Why not this? 322 | 323 | ```haskell 324 | main = print(datetime(pwd)) 325 | ``` 326 | 327 | 328 | # Difference between `(=)` and `(<-)` 329 | 330 | * `(<-)` is overloaded; in this context it means "store the subroutine's result" 331 | * `(=)` is not overloaded; equating two things means they are interchangeable 332 | 333 | Example of overloading `(<-)`: 334 | 335 | ```haskell 336 | Prelude> do { x <- [1, 2]; y <- [3, 4]; return (x, y) } 337 | [(1,3),(1,4),(2,3),(2,4)] 338 | ``` 339 | 340 | `do`/`(<-)`/`return` is analogous to `for`/`(<-)`/`yield` in Scala: 341 | 342 | ```scala 343 | scala> for { x <- Seq(1, 2); y <- Seq(3, 4) } yield (x, y) 344 | res0: Seq[(Int, Int)] = List((1,3), (1,4), (2,3), (2,4)) 345 | ``` 346 | 347 | ... or LINQ/`from`/`select` in C#: 348 | 349 | ```cs 350 | List xs = new List { 1, 2 } 351 | List ys = new List { 3, 4 } 352 | var result = 353 | from x in xs 354 | from y in ys 355 | select Tuple(x, y) 356 | ``` 357 | 358 | # Nesting subroutines 359 | 360 | ```haskell 361 | #!/usr/bin/env stack 362 | -- stack --resolver lts-10.2 script 363 | -- #!/bin/bash 364 | import Turtle -- 365 | -- 366 | datePwd = do -- datePwd() { 367 | dir <- pwd -- DIR=$(pwd) 368 | result <- datefile dir -- RESULT=$(date -r $DIR) 369 | return result -- echo $RESULT 370 | -- } 371 | main = do -- 372 | time <- datePwd -- TIME=$(datePwd) 373 | print time -- echo $TIME 374 | ``` 375 | 376 | Same result: 377 | 378 | ```haskell 379 | $ ./example.hs 380 | 2015-09-01 23:56:03.245 UTC 381 | ``` 382 | 383 | # Unnecessary `return` 384 | 385 | You can simplify this: 386 | 387 | ```haskell 388 | datePwd = do -- datePwd() { 389 | dir <- pwd -- DIR=$(pwd) 390 | result <- datefile dir -- RESULT=$(date -r $DIR) 391 | return result -- echo $RESULT 392 | -- } 393 | ``` 394 | 395 | ... to this: 396 | 397 | ```haskell 398 | datePwd = do -- datePwd() { 399 | dir <- pwd -- DIR=$(pwd) 400 | datefile dir -- date -r $DIR 401 | -- } 402 | ``` 403 | 404 | The return value of a subroutine is the return value of its last command 405 | 406 | # `return` 407 | 408 | `return` does not break from the surrounding subroutine 409 | 410 | `return` is just a command whose return value is its argument 411 | 412 | ```haskell 413 | do x <- return expr -- X=EXPR 414 | command x -- command $X 415 | 416 | -- Same as: 417 | do let x = expr -- X=EXPR 418 | command x -- command $X 419 | 420 | -- Same as: 421 | command expr -- command EXPR 422 | ``` 423 | 424 | `return` is the only case where `(<-)` and `(=)` behave the same way 425 | 426 | # Single-command subroutines 427 | 428 | ```haskell 429 | main = do echo "Hello, world!" 430 | 431 | -- Same as: 432 | main = echo "Hello, world!" 433 | ``` 434 | 435 | `do` is only necessary if you want to chain multiple commands together 436 | 437 | # Exercise 438 | 439 | What do you think this code does? 440 | 441 | ```haskell 442 | main = do 443 | let x = print 1 444 | print 2 445 | ``` 446 | 447 | # Questions? 448 | 449 | * Haskell overview 450 | * Subroutines 451 | * **Types** 452 | * Use `ghci` as a shell 453 | * Type signatures 454 | * String formatting 455 | * Streams 456 | * Pipes 457 | * Folds 458 | * Patterns 459 | 460 | # Types 461 | 462 | What happens if we use `print` instead of `echo`? 463 | 464 | ```haskell 465 | #!/usr/bin/env stack 466 | -- stack --resolver lts-10.2 script 467 | 468 | import Turtle 469 | 470 | main = do 471 | dir <- pwd 472 | time <- datefile dir 473 | echo time -- This used to be: print time 474 | ``` 475 | 476 | ``` 477 | $ ./example.hs 478 | 479 | example.hs:8:10: 480 | Couldn't match expected type `Text' with actual type `UTCTime' 481 | In the first argument of `echo', namely `time' 482 | In a stmt of a 'do' block: echo time 483 | In the expression: 484 | do { dir <- pwd; 485 | time <- datefile dir; 486 | echo time } 487 | ``` 488 | 489 | # Type-directed development - REPL 490 | 491 | ```haskell 492 | main = do 493 | dir <- pwd 494 | time <- datefile dir 495 | echo time -- This used to be: print time 496 | ``` 497 | 498 | ```haskell 499 | $ stack ghci 500 | Prelude> import Turtle 501 | ``` 502 | 503 | ```haskell 504 | Prelude Turtle> :type pwd 505 | pwd :: IO Turtle.FilePath 506 | ``` 507 | 508 | ```haskell 509 | Prelude Turtle> :type datefile 510 | datefile :: Turtle.FilePath -> IO UTCTime 511 | ``` 512 | 513 | ```haskell 514 | Prelude Turtle> :type echo 515 | echo :: Text -> IO () 516 | ``` 517 | 518 | ```haskell 519 | Prelude Turtle> :type print 520 | print :: Show a => a -> IO () 521 | ``` 522 | 523 | # Type-directed development - Documentation 524 | 525 | Visit: 526 | 527 | https://hackage.haskell.org/package/turtle 528 | 529 | ![](hackage.png) 530 | 531 | # `repr` 532 | 533 | Use `repr` to render a human-readable representation of a value as `Text`: 534 | 535 | ```haskell 536 | -- This behaves like Python's `repr` function 537 | repr :: Show a => a -> Text 538 | ``` 539 | 540 | `print` is (conceptually) the same as `echo` + `repr`: 541 | 542 | ```haskell 543 | print x = echo (repr x) 544 | ``` 545 | 546 | # Basic types 547 | 548 | * `Int` 549 | * `Double` 550 | * `Text` 551 | * `(a, b)` 552 | * `[a]` 553 | * `a -> b` 554 | * `IO a` 555 | * `FilePath` 556 | * `ExitCode` 557 | * `UTCTime` 558 | 559 | # Exercise 560 | 561 | What are the types of `x`, `y`, and `z`? 562 | 563 | (Assume all string literals are `Text` and all numeric literals are `Int`s) 564 | 565 | ```haskell 566 | x = ("123", 4) 567 | 568 | y = [2, 3] 569 | 570 | z a = 1 + a 571 | ``` 572 | 573 | # Answers 574 | 575 | ```haskell 576 | x :: (Text, Int) 577 | x = ("123", 4) 578 | 579 | y :: [Int] 580 | y = [2, 3] 581 | 582 | z :: Int -> Int 583 | z a = 1 + a 584 | ``` 585 | 586 | # Questions? 587 | 588 | * Haskell overview 589 | * Subroutines 590 | * Types 591 | * **Use `ghci` as a shell** 592 | * Type signatures 593 | * String formatting 594 | * Streams 595 | * Pipes 596 | * Folds 597 | * Patterns 598 | 599 | # Customize `ghci` 600 | 601 | Create a `.ghci` file in your current directory that looks like this: 602 | 603 | ``` 604 | :set -XOverloadedStrings 605 | import Turtle 606 | ``` 607 | 608 | This automatically runs the above two commands every time you run `ghci` 609 | 610 | `ghci` searches the current directory and your home directory for a `.ghci` file 611 | 612 | # Use `ghci` like a shell 613 | 614 | ```haskell 615 | $ stack ghci 616 | Prelude Turtle> view (ls ".") 617 | FilePath "/Users/ggonzalez/.bash_history" 618 | FilePath "/Users/ggonzalez/.bash_profile" 619 | FilePath "/Users/ggonzalez/.bashrc" 620 | ... 621 | FilePath "/Users/ggonzalez/workspace" 622 | Prelude Turtle> cd "/tmp" 623 | Prelude Turtle> pwd 624 | FilePath "/private/tmp" 625 | Prelude Turtle> touch "foo.txt" 626 | Prelude Turtle> testfile "foo.txt" 627 | True 628 | Prelude Turtle> rm "foo.txt" 629 | Prelude Turtle> testfile "foo.txt" 630 | False 631 | Prelude Turtle> test 632 | testdir testfile 633 | Prelude Turtle> testdir "/tmp/ 634 | .vbox-ggonzalez-ipc 635 | KSOutOfProcessFetcher.0.r55jifrBu08ZlGAfPLYXKgYad4c= 636 | launch-0kuyez 637 | ... 638 | sync-dottools.stdout.log 639 | ``` 640 | 641 | # `ghci` auto-`print` 642 | 643 | `ghci` implicitly `print`s any value that is not a subroutine 644 | 645 | ```haskell 646 | Prelude Turtle> 2 + 2 647 | 4 648 | Prelude Turtle> "123" <> "456" -- (<>) concatenates strings 649 | "123456" 650 | ``` 651 | 652 | The behavior is the same as if we had explicitly called `print`: 653 | 654 | ```haskell 655 | Prelude Turtle> print (2 + 2) 656 | 4 657 | Prelude Turtle> print ("123" <> "456") 658 | "123456" 659 | ``` 660 | 661 | # Shell commands 662 | 663 | ```haskell 664 | Prelude Turtle> shell "true" empty 665 | ExitSuccess 666 | Prelude Turtle> shell "false" empty 667 | ExitFailure 1 668 | Prelude Turtle> shell "ls | wc -l" empty 669 | 5 670 | ExitSuccess 671 | ``` 672 | 673 | Use `proc` if you want safer command templating: 674 | 675 | ```haskell 676 | Prelude Turtle> -- ls /tmp /usr 677 | Prelude Turtle> proc "ls" ["/tmp", "/usr"] empty 678 | /tmp: 679 | KSOutOfProcessFetcher.0.r55jifrBu08ZlGAfPLYXKgYad4c= 680 | ... 681 | 682 | /usr: 683 | X11 bin lib local share 684 | X11R6 include libexec sbin standalone 685 | ExitSuccess 686 | ``` 687 | 688 | # Exercise 689 | 690 | Within `ghci`: 691 | 692 | * Create a directory named `dir1` 693 | * Rename `dir1` to `dir2` 694 | * Delete `dir2` 695 | 696 | # Answers 697 | 698 | ```haskell 699 | Prelude Turtle> mkdir "dir1" 700 | Prelude Turtle> mv "dir1" "dir2" 701 | Prelude Turtle> rmdir "dir2" 702 | ``` 703 | 704 | # Questions? 705 | 706 | * Haskell overview 707 | * Subroutines 708 | * Types 709 | * Use `ghci` as a shell 710 | * **Type signatures** 711 | * String formatting 712 | * Streams 713 | * Pipes 714 | * Folds 715 | * Patterns 716 | 717 | # Type signatures 718 | 719 | ```haskell 720 | #!/usr/bin/env stack 721 | -- stack --resolver lts-10.2 script 722 | 723 | import Turtle 724 | 725 | -- +----- A subroutine ... 726 | -- | 727 | -- | +-- ... that returns `UTCTime` 728 | -- | | 729 | -- v v 730 | datePwd :: IO UTCTime 731 | datePwd = do 732 | dir <- pwd 733 | datefile dir 734 | 735 | -- +----- A subroutine ... 736 | -- | 737 | -- | +-- ... that returns an empty value (i.e. `()`) 738 | -- | | 739 | -- v v 740 | main :: IO () 741 | main = do 742 | time <- datePwd 743 | print time 744 | ``` 745 | 746 | # Machine-checked documentation 747 | 748 | ```haskell 749 | str :: Int -- Oops! 750 | str = "Hello!" 751 | 752 | main :: IO () 753 | main = echo str 754 | ``` 755 | 756 | ```bash 757 | $ ./example.hs 758 | 759 | example.hs:8:7: 760 | No instance for (IsString Int) 761 | arising from the literal `"Hello, world!"' 762 | Possible fix: add an instance declaration for (IsString Int) 763 | In the expression: "Hello, world!" 764 | In an equation for `str': str = "Hello, world!" 765 | 766 | example.hs:11:13: 767 | Couldn't match expected type `Text' with actual type `Int' 768 | In the first argument of `echo', namely `str' 769 | In the expression: echo str 770 | In an equation for `main': main = echo str 771 | ``` 772 | 773 | # `OverloadedStrings` 774 | 775 | Anything that implements `IsString` can be represented by a string literal 776 | 777 | Examples we've seen so far: 778 | 779 | * `FilePath` 780 | * `Text` 781 | * ??? 782 | 783 | # Reverse the error 784 | 785 | ```haskell 786 | str :: Text 787 | str = 4 788 | 789 | main :: IO () 790 | main = echo str 791 | ``` 792 | 793 | ```bash 794 | $ ./example.hs 795 | 796 | example.hs:8:7: 797 | No instance for (Num Text) 798 | arising from the literal `4' 799 | Possible fix: add an instance declaration for (Num Text) 800 | In the expression: 4 801 | In an equation for `str': str = 4 802 | ``` 803 | 804 | # `Num` 805 | 806 | Anything that implements `Num` can be represented by a numeric literal 807 | 808 | Examples we've seen so far: 809 | 810 | * `Int` 811 | * `Double` 812 | * ??? 813 | 814 | # Types clarify documentation 815 | 816 | ```haskell 817 | shell 818 | :: Text -- Command line 819 | -> Shell Text -- Standard input (as lines of `Text`) 820 | -> IO ExitCode -- Exit code of the shell command 821 | ``` 822 | 823 | ```haskell 824 | proc 825 | :: Text -- Program 826 | -> [Text] -- Arguments 827 | -> Shell Text -- Standard input (as lines of `Text`) 828 | -> IO ExitCode -- Exit code of the shell command 829 | ``` 830 | 831 | # Type inference 832 | 833 | Haskell (almost always) does not require type annotations 834 | 835 | Type signatures are for the benefit of the programmer, not the compiler 836 | 837 | Example: 838 | 839 | ```haskell 840 | Prelude Turtle> let addAsText x y = repr (x + y) 841 | Prelude Turtle> :type addAsText 842 | addAsText :: (Show a, Num a) => a -> a -> Text 843 | Prelude Turtle> addAsText 2 3 844 | "5" 845 | ``` 846 | 847 | No need to annotate argument types 848 | 849 | No need to specify interfaces 850 | 851 | No need to specify generic type parameters 852 | 853 | # Exercise 854 | 855 | Use the compiler to infer the type of this function: 856 | 857 | ```haskell 858 | swap (x, y) = (y, x) 859 | ``` 860 | 861 | # Answer 862 | 863 | ```haskell 864 | Prelude Turtle> :type swap 865 | swap :: (t1, t) -> (t, t1) 866 | ``` 867 | 868 | # Questions? 869 | 870 | * Haskell overview 871 | * Subroutines 872 | * Types 873 | * Use `ghci` as a shell 874 | * Type signatures 875 | * **String formatting** 876 | * Streams 877 | * Pipes 878 | * Folds 879 | * Patterns 880 | 881 | # Exit codes 882 | 883 | ```haskell 884 | #!/usr/bin/env stack 885 | -- stack --resolver lts-10.2 script 886 | 887 | {-# LANGUAGE OverloadedStrings #-} 888 | 889 | import Turtle 890 | 891 | main = do 892 | let cmd = "false" 893 | x <- shell cmd empty 894 | case x of 895 | ExitSuccess -> return () 896 | ExitFailure n -> die (cmd <> " failed with exit code: " <> repr n) 897 | ``` 898 | 899 | This always prints an error message since `false` always fails: 900 | 901 | ``` 902 | $ ./example.hs 903 | example.hs: user error (false failed with exit code: 1) 904 | ``` 905 | 906 | # String formatting 907 | 908 | We can replace this: 909 | 910 | ```haskell 911 | cmd <> " failed with exit code: " <> repr n 912 | ``` 913 | 914 | ... with `printf`-style formatting: 915 | 916 | ```haskell 917 | format (s%" failed with exit code: "%d) cmd n 918 | ``` 919 | 920 | The compiler infers the number and types of arguments from the format string: 921 | 922 | ```haskell 923 | Prelude Turtle> :type format (s%" failed with exit code: "%d) 924 | format (s%" failed with exit code: "%d) :: Text -> Int -> Text 925 | ``` 926 | 927 | # Exercise 928 | 929 | What do you think this prints out? 930 | 931 | ```haskell 932 | Prelude Turtle> format ("A "%s%" string that takes "%d%" arguments") "format" 2 933 | ``` 934 | 935 | # The `Format` type 936 | 937 | A format string is not `Text`! 938 | 939 | ```haskell 940 | Prelude Turtle> :type format 941 | format :: Format Text r -> r 942 | ``` 943 | 944 | So what is going on here? 945 | 946 | ```haskell 947 | Prelude Turtle> format "I take 0 arguments" 948 | "I take 0 arguments" 949 | ``` 950 | 951 | # `Format` implements `IsString` 952 | 953 | ```haskell 954 | (%) :: Format b c -> Format a b -> Format a c 955 | 956 | "A " :: Format a a 957 | s :: Format a (Text -> a) 958 | " string that takes " :: Format a a 959 | d :: Format a (Int -> a) 960 | " arguments" :: Format a a 961 | 962 | "A "%s%" string that takes "%d%" arguments" :: Format a (Text -> Int -> a) 963 | 964 | format ("A "%s%" string that takes "%d%" arguments") :: Text -> Int -> Text 965 | ``` 966 | 967 | You can build your own format specifiers! 968 | 969 | # `OverloadedStrings` 970 | 971 | Examples we've seen so far: 972 | 973 | * `FilePath` 974 | * `Text` 975 | * `Format` 976 | * ??? 977 | 978 | # Questions? 979 | 980 | * Haskell overview 981 | * Subroutines 982 | * Types 983 | * Use `ghci` as a shell 984 | * Type signatures 985 | * String formatting 986 | * **Streams** 987 | * Pipes 988 | * Folds 989 | * Patterns 990 | 991 | # Streams 992 | 993 | You've already encountered at least one stream: the `ls` command 994 | 995 | ```haskell 996 | Prelude Turtle> :type ls 997 | ls :: Turtle.FilePath -> Shell Turtle.FilePath 998 | ``` 999 | 1000 | A "`Shell a`" is a stream of "`a`"s 1001 | 1002 | Streams are not subroutines, so you can't run them directly within `ghci`: 1003 | 1004 | 1005 | ```haskell 1006 | Prelude Turtle> ls "/tmp" 1007 | 1008 | :2:1: 1009 | No instance for (Show (Shell Turtle.FilePath)) 1010 | arising from a use of `print' 1011 | Possible fix: 1012 | add an instance declaration for (Show (Shell Turtle.FilePath)) 1013 | In a stmt of an interactive GHCi command: print it 1014 | ``` 1015 | 1016 | `ghci` tries to `print` the `Shell` stream, but fails because `Shell` does not 1017 | implement `Show` 1018 | 1019 | # `view` 1020 | 1021 | The `view` command is the simplest way to display a `Shell` stream: 1022 | 1023 | ```haskell 1024 | view :: Show a => Shell a -> IO () 1025 | ``` 1026 | 1027 | `view` prints every element of the stream: 1028 | 1029 | ```haskell 1030 | Prelude Turtle> view (ls "/tmp") 1031 | FilePath "/tmp/.X11-unix" 1032 | FilePath "/tmp/.X0-lock" 1033 | FilePath "/tmp/pulse-PKdhtXMmr18n" 1034 | FilePath "/tmp/pulse-xHYcZ3zmN3Fv" 1035 | FilePath "/tmp/tracker-gabriella" 1036 | FilePath "/tmp/pulse-PYi1hSlWgNj2" 1037 | FilePath "/tmp/orbit-gabriella" 1038 | FilePath "/tmp/ssh-vREYGbWGpiCa" 1039 | FilePath "/tmp/.ICE-unix 1040 | ``` 1041 | 1042 | # The empty stream 1043 | 1044 | ```haskell 1045 | empty :: Shell a 1046 | ``` 1047 | 1048 | The empty stream emits nothing: 1049 | 1050 | ```haskell 1051 | Prelude Turtle> view empty -- Outputs nothing 1052 | Prelude Turtle> 1053 | ``` 1054 | 1055 | In other words: 1056 | 1057 | ```haskell 1058 | view empty = return () 1059 | ``` 1060 | 1061 | # The singleton stream 1062 | 1063 | ```haskell 1064 | return :: a -> Shell a 1065 | ``` 1066 | 1067 | `return` builds a singleton stream that emits exactly one element: 1068 | 1069 | ```haskell 1070 | 1 :: Int 1071 | return 1 :: Shell Int 1072 | ``` 1073 | 1074 | ```haskell 1075 | Prelude Turtle> view (return 1) 1076 | 1 1077 | ``` 1078 | 1079 | In other words: 1080 | 1081 | ```haskell 1082 | view (return x) = print x 1083 | ``` 1084 | 1085 | # Embedding subroutines 1086 | 1087 | ```haskell 1088 | liftIO :: IO a -> Shell a 1089 | ``` 1090 | 1091 | `liftIO` transforms a subroutine into a singleton stream: 1092 | 1093 | ```haskell 1094 | pwd :: IO Turtle.FilePath 1095 | liftIO pwd :: Shell Turtle.FilePath 1096 | ``` 1097 | 1098 | ```haskell 1099 | Prelude Turtle> view (liftIO pwd) 1100 | FilePath "/tmp" 1101 | ``` 1102 | 1103 | In other words: 1104 | 1105 | ```haskell 1106 | view (liftIO io) = do x <- io 1107 | print x 1108 | ``` 1109 | 1110 | # Concatenate streams 1111 | 1112 | ```haskell 1113 | (<|>) :: Shell a -> Shell a -> Shell a 1114 | ``` 1115 | 1116 | `(<|>)` concatenates two streams together to build a new stream: 1117 | 1118 | ```haskell 1119 | Prelude Turtle> view (return 1 <|> return 2) 1120 | 1 1121 | 2 1122 | ``` 1123 | 1124 | In other words: 1125 | 1126 | ```haskell 1127 | view (xs <|> ys) = do view xs 1128 | view ys 1129 | ``` 1130 | 1131 | # A more complex `Shell` stream 1132 | 1133 | ```haskell 1134 | Prelude Turtle> view (ls "/tmp" <|> liftIO home <|> ls "/usr" <|> return "/lib") 1135 | FilePath "/tmp/.X11-unix" 1136 | FilePath "/tmp/.X0-lock" 1137 | FilePath "/tmp/pulse-PKdhtXMmr18n" 1138 | FilePath "/tmp/pulse-xHYcZ3zmN3Fv" 1139 | FilePath "/tmp/tracker-gabriella" 1140 | FilePath "/tmp/pulse-PYi1hSlWgNj2" 1141 | FilePath "/tmp/orbit-gabriella" 1142 | FilePath "/tmp/ssh-vREYGbWGpiCa" 1143 | FilePath "/tmp/.ICE-unix" 1144 | FilePath "/Users/ggonzalez" 1145 | FilePath "/usr/lib" 1146 | FilePath "/usr/src" 1147 | FilePath "/usr/sbin" 1148 | FilePath "/usr/include" 1149 | FilePath "/usr/share" 1150 | FilePath "/usr/games" 1151 | FilePath "/usr/local" 1152 | FilePath "/usr/bin" 1153 | FilePath "/lib" 1154 | ``` 1155 | 1156 | # Reasoning about streams 1157 | 1158 | ```haskell 1159 | view (ls "/tmp" <|> liftIO home <|> ls "/usr" <|> return "/lib") 1160 | ``` 1161 | 1162 | ... is the same as: 1163 | 1164 | ```haskell 1165 | do view (ls "/tmp") 1166 | dir <- home 1167 | print dir 1168 | view (ls "/usr") 1169 | print "/lib" 1170 | ``` 1171 | 1172 | # `Shell` implements `IsString` 1173 | 1174 | ```haskell 1175 | Prelude Turtle> view "123" 1176 | "123" 1177 | Prelude Turtle> view (return "123") -- Same thing 1178 | "123" 1179 | Prelude Turtle> view ("123" <|> "456") 1180 | "123" 1181 | "456" 1182 | Prelude Turtle> view (return "123" <|> return "456") -- Same thing 1183 | "123" 1184 | "456" 1185 | ``` 1186 | 1187 | # `OverloadedStrings` 1188 | 1189 | Examples seen so far: 1190 | 1191 | * `FilePath` 1192 | * `Text` 1193 | * `Format` 1194 | * `Shell` 1195 | * ??? 1196 | 1197 | # `select` 1198 | 1199 | You can build a `Shell` stream from a list: 1200 | 1201 | ```haskell 1202 | select :: [a] -> Shell a 1203 | ``` 1204 | 1205 | Example: 1206 | 1207 | ```haskell 1208 | Prelude Turtle> view (select [1, 2, 3]) 1209 | 1 1210 | 2 1211 | 3 1212 | ``` 1213 | 1214 | # Loops 1215 | 1216 | We can use `select` to loop within a `Shell`: 1217 | 1218 | ```haskell 1219 | #!/usr/bin/env stack 1220 | -- stack --resolver lts-10.2 script 1221 | -- #!/bin/bash 1222 | {-# LANGUAGE OverloadedStrings #-} -- 1223 | -- 1224 | import Turtle -- 1225 | -- 1226 | example :: Shell () -- 1227 | example = do -- 1228 | x <- select [1, 2] -- for x in 1 2; do 1229 | y <- select [3, 4] -- for y in 3 4; do 1230 | liftIO (print (x, y)) -- echo \(${x},${y}\); 1231 | -- done; 1232 | main = sh example -- done 1233 | ``` 1234 | 1235 | This prints every permutation of `x` and `y`: 1236 | 1237 | ```haskell 1238 | $ ./example 1239 | (1,3) 1240 | (1,4) 1241 | (2,3) 1242 | (2,4) 1243 | ``` 1244 | 1245 | # The `sh` utility 1246 | 1247 | `sh` is like `view`, except that it doesn't print any elements: 1248 | 1249 | ```haskell 1250 | view :: Show a => Shell a -> IO () 1251 | sh :: Shell a -> IO () 1252 | ``` 1253 | 1254 | # Looping over arbitrary `Shell`s 1255 | 1256 | You can loop over things other than select: 1257 | 1258 | ```haskell 1259 | Prelude Turtle> -- for file in /tmp/*; do echo $file; done 1260 | Prelude Turtle> sh (do file <- ls "/tmp"; liftIO (print file)) 1261 | FilePath "/tmp/.X11-unix" 1262 | FilePath "/tmp/.X0-lock" 1263 | FilePath "/tmp/pulse-PKdhtXMmr18n" 1264 | FilePath "/tmp/pulse-xHYcZ3zmN3Fv" 1265 | FilePath "/tmp/tracker-gabriella" 1266 | FilePath "/tmp/pulse-PYi1hSlWgNj2" 1267 | FilePath "/tmp/orbit-gabriella" 1268 | FilePath "/tmp/ssh-vREYGbWGpiCa" 1269 | FilePath "/tmp/.ICE-unix" 1270 | ``` 1271 | 1272 | In fact, that is how `view` is implemented: 1273 | 1274 | ```haskell 1275 | view :: Show a => Shell a -> IO () 1276 | view s = sh (do { x <- s; liftIO (print x) }) 1277 | ``` 1278 | 1279 | # Questions? 1280 | 1281 | * Haskell overview 1282 | * Subroutines 1283 | * Types 1284 | * Use `ghci` as a shell 1285 | * Type signatures 1286 | * String formatting 1287 | * Streams 1288 | * **Pipes** 1289 | * Folds 1290 | * Patterns 1291 | 1292 | # `stdout` 1293 | 1294 | ```haskell 1295 | stdout :: Shell Text -> IO () 1296 | stdout s = sh (do 1297 | txt <- s 1298 | liftIO (echo txt) ) 1299 | ``` 1300 | 1301 | Standard out writes each `Text` element of the stream to a separate line: 1302 | 1303 | ```haskell 1304 | Prelude Turtle> stdout "Line 1" 1305 | Line 1 1306 | Prelude Turtle> stdout ("Line 1" <|> "Line 2") 1307 | Line 1 1308 | Line 2 1309 | ``` 1310 | 1311 | # `stdin` 1312 | 1313 | ```haskell 1314 | stdin :: Shell Text 1315 | ``` 1316 | 1317 | `stdin` streams lines from standard input: 1318 | 1319 | ```haskell 1320 | #!/usr/bin/env stack 1321 | -- stack --resolver lts-10.2 script 1322 | -- #!/bin/bash 1323 | {-# LANGUAGE OverloadedStrings #-} -- 1324 | -- 1325 | import Turtle -- 1326 | -- 1327 | main = stdout stdin -- cat 1328 | ``` 1329 | 1330 | `stdin` keeps producing lines until hitting EOF: 1331 | 1332 | ```bash 1333 | $ ./example.hs 1334 | ABC 1335 | ABC 1336 | Test 1337 | Test 1338 | 42 1339 | 42 1340 | 1341 | ``` 1342 | 1343 | # `(&)` 1344 | 1345 | If you prefer to read left-to-right, you can use the infix `(&)` operator: 1346 | 1347 | ``` 1348 | (&) :: a -> (a -> b) -> b 1349 | x & f = f x 1350 | ``` 1351 | 1352 | ```haskell 1353 | main = stdin & stdout 1354 | ``` 1355 | 1356 | # `input` and `output` 1357 | 1358 | ```haskell 1359 | input :: FilePath -> Shell Text 1360 | 1361 | output :: FilePath -> Shell Text -> IO () 1362 | ``` 1363 | 1364 | Run these examples: 1365 | 1366 | ```haskell 1367 | Prelude Turtle> output "file.txt" ("Test" <|> "ABC" <|> "42") 1368 | Prelude Turtle> stdout (input "file.txt") 1369 | Test 1370 | ABC 1371 | 42 1372 | ``` 1373 | 1374 | Or left-to-right: 1375 | 1376 | ```haskell 1377 | Prelude Turtle> "Test" <|> "ABC" <|> "42" & output "file.txt" 1378 | Prelude Turtle> input "file.txt" & stdout 1379 | Test 1380 | ABC 1381 | 42 1382 | ``` 1383 | 1384 | # `inshell` 1385 | 1386 | ```haskell 1387 | inshell 1388 | :: Text -- Command line 1389 | -> Shell Text -- Standard input to feed to program 1390 | -> Shell Text -- Standard output produced by program 1391 | ``` 1392 | 1393 | ```haskell 1394 | Prelude Turtle> output "ls.txt" (inshell "ls" empty) 1395 | Prelude Turtle> stdout (input "ls.txt") 1396 | .X11-unix 1397 | .X0-lock 1398 | ... 1399 | .ICE-unix 1400 | ``` 1401 | 1402 | ```haskell 1403 | Turtle Prelude> output "awk.txt" (inshell "awk '{ print $1 }'" "123 456") 1404 | Turtle Prelude> stdout (input "awk.txt") 1405 | 123 1406 | ``` 1407 | 1408 | # `inshell` (Left-to-right) 1409 | 1410 | ```haskell 1411 | Turtle Prelude> "123 456" & inshell "awk '{ print $1 }'" & output "awk.txt" 1412 | Turtle Prelude> input "awk.txt" & stdout 1413 | 123 1414 | ``` 1415 | 1416 | # `inproc` 1417 | 1418 | ```haskell 1419 | inproc 1420 | :: Text -- Program 1421 | -> [Text] -- Arguments 1422 | -> Shell Text -- Standard input to feed to program 1423 | -> Shell Text -- Standard output produced by program 1424 | ``` 1425 | 1426 | ```haskell 1427 | Turtle Prelude> stdout (inproc "awk" ["{ print $1 }"] "123 456") 1428 | 123 1429 | ``` 1430 | 1431 | # Exercise 1432 | 1433 | Translate this Bash command to Haskell: 1434 | 1435 | ```bash 1436 | $ nl < example.hs > numbered.txt 1437 | ``` 1438 | 1439 | # Answer 1440 | 1441 | ```haskell 1442 | Prelude Turtle> input "example.hs" & inproc "nl" [] & output "numbered.txt" 1443 | ``` 1444 | 1445 | # Questions? 1446 | 1447 | * Haskell overview 1448 | * Subroutines 1449 | * Types 1450 | * Use `ghci` as a shell 1451 | * Type signatures 1452 | * String formatting 1453 | * Streams 1454 | * Pipes 1455 | * **Folds** 1456 | * Patterns 1457 | 1458 | # Folds 1459 | 1460 | Use a `Fold` to reduce the stream to a single value: 1461 | 1462 | ```haskell 1463 | Prelude Turtle> import qualified Control.Foldl as Fold 1464 | Prelude Turtle Fold> fold (ls "/tmp") Fold.length 1465 | 9 1466 | ``` 1467 | 1468 | ```haskell 1469 | Prelude Turtle Fold> fold (ls "/tmp") Fold.head 1470 | Just (FilePath "/tmp/.X11-unix") 1471 | ``` 1472 | 1473 | You can combine folds: 1474 | 1475 | ```haskell 1476 | Prelude Turtle Fold> let minMax = (,) <$> Fold.minimum <*> Fold.maximum 1477 | Prelude Turtle Fold> fold (select [1..10]) minMax 1478 | (Just 1,Just 10) 1479 | ``` 1480 | 1481 | # Exercise 1482 | 1483 | What are the types of: 1484 | 1485 | * `fold` 1486 | * `Fold.length` 1487 | * `Fold.head` 1488 | 1489 | # Answer 1490 | 1491 | ```haskell 1492 | fold :: Shell a -> Fold a b -> IO b 1493 | 1494 | Fold.length :: Fold a Int 1495 | 1496 | Fold.head :: Fold a (Maybe a) 1497 | ``` 1498 | 1499 | ```haskell 1500 | ls "/tmp" :: Shell Turtle.FilePath 1501 | 1502 | fold :: Shell a -> Fold a b -> IO b 1503 | fold (ls "/tmp") :: Fold Turtle.FilePath b -> IO b 1504 | fold (ls "/tmp") Fold.length :: IO Int 1505 | ``` 1506 | 1507 | 1508 | # `Fold` implements `Num` 1509 | 1510 | ```haskell 1511 | >>> fold (select [1..10]) Fold.sum 1512 | 55 1513 | >>> fold (select [1..10]) (1 + 2 * Fold.sum) 1514 | 111 1515 | >>> fold (select [1..10]) (Fold.length + Fold.sum) 1516 | 65 1517 | >>> fold (select [1..10]) 5 1518 | 5 1519 | ``` 1520 | 1521 | Examples so far: 1522 | 1523 | * Int 1524 | * Double 1525 | * Fold 1526 | 1527 | # Questions? 1528 | 1529 | * Haskell overview 1530 | * Subroutines 1531 | * Types 1532 | * Use `ghci` as a shell 1533 | * Type signatures 1534 | * String formatting 1535 | * Streams 1536 | * Pipes 1537 | * Folds 1538 | * **Patterns** 1539 | 1540 | # Patterns 1541 | 1542 | You can transform streams using Unix-like utilities, like `grep`: 1543 | 1544 | ```haskell 1545 | Prelude Turtle> stdout (input "file.txt") 1546 | Test 1547 | ABC 1548 | 42 1549 | Prelude Turtle> stdout (grep "ABC" (input "file.txt")) 1550 | ABC 1551 | ``` 1552 | 1553 | However, the first argument of `grep` is not a string! 1554 | 1555 | ```haskell 1556 | grep :: Pattern a -> Shell Text -> Shell Text 1557 | ``` 1558 | 1559 | `grep` matches against a `Pattern`, which implements `IsString` 1560 | 1561 | # Comparison to regular expressions 1562 | 1563 | Here is how to translate regular expression idioms to patterns: 1564 | 1565 | ```haskell 1566 | Regex Pattern 1567 | ========= ========= 1568 | "string" "string" 1569 | . dot 1570 | e1 e2 e1 <> e2 1571 | e1 | e2 e1 <|> e2 1572 | e* star e 1573 | e+ plus e 1574 | e*? selfless (star e) 1575 | e+? selfless (plus e) 1576 | e{n} count n e 1577 | e? option e 1578 | [xyz] oneOf "xyz" 1579 | [^xyz] noneOf "xyz" 1580 | ``` 1581 | 1582 | # Pattern examples 1583 | 1584 | ```haskell 1585 | Prelude Turtle> -- grep '^[[:digit:]]\+$' file.txt 1586 | Prelude Turtle> stdout (grep (plus digit) (input "file.txt")) 1587 | 42 1588 | Prelude Turtle> -- grep '^[[:digit:]]\+\|Test$' file.txt 1589 | Prelude Turtle> stdout (grep (plus digit <|> "Test") (input "file.txt")) 1590 | Test 1591 | 42 1592 | ``` 1593 | 1594 | # Patterns match the entire string by default 1595 | 1596 | To match the interior of the string, use `has`: 1597 | 1598 | ```haskell 1599 | Prelude Turtle> -- grep B file.txt 1600 | Prelude Turtle> stdout (grep (has "B") (input "file.txt")) 1601 | ABC 1602 | ``` 1603 | 1604 | `prefix` and `suffix` match the beginning or end of a string, respectively: 1605 | 1606 | ```haskell 1607 | Prelude Turtle> -- grep '^A' file.txt 1608 | Prelude Turtle> stdout (grep (prefix "A") (input "file.txt")) 1609 | ABC 1610 | Prelude Turtle> -- grep 'C$' file.txt 1611 | Prelude Turtle> stdout (grep (suffix "C") (input "file.txt")) 1612 | ABC 1613 | ``` 1614 | 1615 | # `match` 1616 | 1617 | ```haskell 1618 | match :: Pattern a -> Text -> [a] 1619 | ``` 1620 | 1621 | ```haskell 1622 | Prelude Turtle> match ("can" <|> "cat") "cat" 1623 | ["cat"] 1624 | Prelude Turtle> match ("can" <|> "cat") "dog" 1625 | [] 1626 | Prelude Turtle> match (decimal `sepBy` ",") "1,2,3" 1627 | [[1,2,3]] 1628 | Prelude Turtle> match (prefix (decimal `sepBy` ",")) "1,2,3" 1629 | [[1,2,3],[1,2],[1],[]] 1630 | ``` 1631 | 1632 | # Patterns can do more than regular expressions 1633 | 1634 | ```haskell 1635 | bit :: Pattern Bool 1636 | bit = (do { "0"; return False }) <|> (do { "1"; return True }) 1637 | 1638 | portableBitMap :: Pattern [[Bool]] 1639 | portableBitMap = do 1640 | "P1" 1641 | spaces1 1642 | width <- decimal 1643 | spaces1 1644 | height <- decimal 1645 | count width (count height (do { spaces1; bit })) 1646 | ``` 1647 | 1648 | ``` 1649 | Prelude Turtle> match (prefix portableBitMap) "P1\n2 2\n0 0\n1 0\n" 1650 | [[[False,False],[True,False]]] 1651 | ``` 1652 | 1653 | ``` 1654 | P1 1655 | 2 2 1656 | 0 0 1657 | 1 0 1658 | ``` 1659 | 1660 | # Real parsing example 1661 | 1662 | ```haskell 1663 | {-# LANGUAGE OverloadedStrings #-} 1664 | 1665 | import Turtle 1666 | import Data.Time 1667 | 1668 | entry :: Text 1669 | entry = "2015-03-27 10:25:40+0000 [-] 10.45.209.121 ..." 1670 | 1671 | pattern = do 1672 | year <- decimal 1673 | "-" 1674 | month <- decimal 1675 | "-" 1676 | day <- decimal 1677 | " " 1678 | hour <- decimal 1679 | ":" 1680 | minute <- decimal 1681 | ":" 1682 | second <- decimal 1683 | let d = fromGregorian year month day 1684 | let t = TimeOfDay hour minute second 1685 | return (d, t) 1686 | ``` 1687 | 1688 | # Patterns are typed 1689 | 1690 | ```haskell 1691 | $ stack ghci 1692 | Prelude Turtle> :load pattern.hs 1693 | *Main Turtle> :type pattern 1694 | pattern :: Pattern (Day, TimeOfDay) 1695 | *Main Turtle> match (prefix pattern) entry 1696 | [(2015-03-27,10:25:40),(2015-03-27,10:25:04)] 1697 | ``` 1698 | 1699 | # Exercise 1700 | 1701 | Create a pattern that parses two integers stored in a string representation of a 1702 | tuple: 1703 | 1704 | ```haskell 1705 | tuple :: Pattern (Int, Int) 1706 | tuple = ??? 1707 | ``` 1708 | 1709 | Such that you get this result when you use it: 1710 | 1711 | ```haskell 1712 | >>> match tuple "(3,4)" 1713 | [(3,4)] 1714 | ``` 1715 | 1716 | # Answer 1717 | 1718 | ```haskell 1719 | tuple :: Pattern (Int, Int) 1720 | tuple = do 1721 | "(" 1722 | x <- decimal 1723 | "," 1724 | y <- decimal 1725 | ")" 1726 | return (x, y) 1727 | ``` 1728 | 1729 | # Questions? 1730 | 1731 | # Backup utility example 1732 | 1733 | ```haskell 1734 | {-# LANGUAGE OverloadedStrings #-} 1735 | 1736 | import Turtle 1737 | import Prelude hiding (FilePath) 1738 | 1739 | parser = (,) <$> argPath "src" "Source directory" 1740 | <*> argPath "dst" "Destination directory" 1741 | 1742 | backup file = do 1743 | exists <- testfile file 1744 | when exists (do 1745 | let backupFile = file <.> "bak" 1746 | backup backupFile 1747 | mv file backupFile ) 1748 | 1749 | main = do 1750 | (src, dest) <- options "Backup a directory" parser 1751 | sh (do 1752 | inFile <- lstree src 1753 | Just suffix <- return (stripPrefix src inFile) 1754 | let outFile = dest suffix 1755 | backup outFile 1756 | echo (format ("Copying "%fp%" to "%fp) inFile outFile) 1757 | cp inFile outFile ) 1758 | echo "Done!" 1759 | ``` 1760 | 1761 | # Command line usage 1762 | 1763 | ```bash 1764 | $ ./backup --help 1765 | Backup a directory 1766 | 1767 | Usage: backup SRC DST 1768 | 1769 | Available options: 1770 | -h,--help Show this help text 1771 | SRC Source directory 1772 | DST Destination directory 1773 | ``` 1774 | 1775 | ```bash 1776 | $ ./backup a/ b/ 1777 | Copying a/1 to b/1 1778 | Copying a/2 to b/2 1779 | $ ls b/ 1780 | 1 2 1781 | $ ./backup a/ b/ 1782 | Copying a/1 to b/1 1783 | Copying a/2 to b/2 1784 | $ ls b/ 1785 | 1 1.bak 2 2.bak 1786 | ``` 1787 | 1788 | # Conclusions 1789 | 1790 | You can use Haskell as a "better Bash", getting types for free without slow 1791 | startup times or heavyweight syntax. 1792 | 1793 | Visit https://hackage.haskell.org/package/turtle for more extensive documentation 1794 | on the shell scripting library we used today 1795 | -------------------------------------------------------------------------------- /src/Turtle.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# OPTIONS_GHC -fno-warn-name-shadowing #-} 3 | 4 | -- | See "Turtle.Tutorial" to learn how to use this library or "Turtle.Prelude" 5 | -- for a quick-start guide. 6 | -- 7 | -- Here is the recommended way to import this library: 8 | -- 9 | -- > {-# LANGUAGE OverloadedStrings #-} 10 | -- > 11 | -- > import Turtle 12 | -- > import Prelude hiding (FilePath) 13 | -- 14 | -- This module re-exports the rest of the library and also re-exports useful 15 | -- modules from @base@: 16 | -- 17 | -- "Turtle.Format" provides type-safe string formatting 18 | -- 19 | -- "Turtle.Pattern" provides `Pattern`s, which are like more powerful regular 20 | -- expressions 21 | -- 22 | -- "Turtle.Shell" provides a `Shell` abstraction for building streaming, 23 | -- exception-safe pipelines 24 | -- 25 | -- "Turtle.Prelude" provides a library of Unix-like utilities to get you 26 | -- started with basic shell-like programming within Haskell 27 | -- 28 | -- "Control.Applicative" provides two classes: 29 | -- 30 | -- * `Applicative`, which works with `Fold`, `Pattern`, `Managed`, and `Shell` 31 | -- 32 | -- * `Alternative`, which works with `Pattern` and `Shell` 33 | -- 34 | -- "Control.Monad" provides two classes: 35 | -- 36 | -- * `Monad`, which works with `Pattern`, `Managed` and `Shell` 37 | -- 38 | -- * `MonadPlus`, which works with `Pattern` and `Shell` 39 | -- 40 | -- "Control.Monad.IO.Class" provides one class: 41 | -- 42 | -- * `MonadIO`, which works with `Managed` and `Shell` 43 | -- 44 | -- "Data.Monoid" provides one class: 45 | -- 46 | -- * `Monoid`, which works with `Fold`, `Pattern`, `Managed`, and `Shell` 47 | -- 48 | -- "Control.Monad.Managed.Safe" provides `Managed` resources 49 | -- 50 | -- Additionally, you might also want to import the following modules qualified: 51 | -- 52 | -- * "Options.Applicative" from @optparse-applicative@ for command-line option 53 | -- parsing 54 | -- 55 | -- * "Control.Foldl" (for predefined folds) 56 | -- 57 | -- * "Control.Foldl.Text" (for `Text`-specific folds) 58 | -- 59 | -- * "Data.Text" (for `Text`-manipulation utilities) 60 | -- 61 | -- * "Data.Text.IO" (for reading and writing `Text`) 62 | 63 | module Turtle ( 64 | -- * Modules 65 | module Turtle.Format 66 | , module Turtle.Pattern 67 | , module Turtle.Options 68 | , module Turtle.Shell 69 | , module Turtle.Line 70 | , module Turtle.Prelude 71 | , module Control.Applicative 72 | , module Control.Monad 73 | , module Control.Monad.IO.Class 74 | , module Data.Monoid 75 | , module Control.Monad.Managed 76 | , module System.FilePath 77 | , module Turtle.Internal 78 | , Fold(..) 79 | , FoldM(..) 80 | , Text 81 | , UTCTime 82 | , NominalDiffTime 83 | , Handle 84 | , ExitCode(..) 85 | , IsString(..) 86 | , (&) 87 | , (<&>) 88 | ) where 89 | 90 | import Turtle.Format 91 | import Turtle.Pattern 92 | import Turtle.Options 93 | import Turtle.Shell 94 | import Turtle.Line 95 | import Turtle.Prelude 96 | import Control.Applicative 97 | ( Applicative(..) 98 | , Alternative(..) 99 | , (<$>) 100 | , liftA2 101 | , optional 102 | ) 103 | import Control.Monad 104 | ( MonadPlus(..) 105 | , forever 106 | , void 107 | , (>=>) 108 | , (<=<) 109 | , join 110 | , msum 111 | , mfilter 112 | , replicateM_ 113 | , guard 114 | , when 115 | , unless 116 | ) 117 | import Control.Monad.IO.Class (MonadIO(..)) 118 | import Data.Monoid (Monoid(..), (<>)) 119 | import Data.String (IsString(..)) 120 | import Control.Monad.Managed (Managed, managed, runManaged, with) 121 | import Control.Foldl (Fold(..), FoldM(..)) 122 | import Data.Text (Text) 123 | import Data.Time (NominalDiffTime, UTCTime) 124 | import System.FilePath 125 | ( FilePath 126 | , dropExtension 127 | , hasExtension 128 | , isAbsolute 129 | , isRelative 130 | , () 131 | , (<.>) 132 | ) 133 | import System.IO (Handle) 134 | import System.Exit (ExitCode(..)) 135 | import Turtle.Internal 136 | ( root 137 | , directory 138 | , parent 139 | , filename 140 | , dirname 141 | , basename 142 | , absolute 143 | , relative 144 | , commonPrefix 145 | , stripPrefix 146 | , collapse 147 | , splitDirectories 148 | , extension 149 | , splitExtension 150 | , splitExtensions 151 | , toText 152 | , fromText 153 | , encodeString 154 | , decodeString 155 | ) 156 | import Prelude hiding (FilePath) 157 | 158 | #if __GLASGOW_HASKELL__ >= 710 159 | import Data.Function ((&)) 160 | #else 161 | infixl 1 & 162 | 163 | -- | '&' is a reverse application operator. This provides notational 164 | -- convenience. Its precedence is one higher than that of the forward 165 | -- application operator '$', which allows '&' to be nested in '$'. 166 | (&) :: a -> (a -> b) -> b 167 | x & f = f x 168 | #endif 169 | 170 | #if __GLASGOW_HASKELL__ >= 821 171 | import Data.Functor ((<&>)) 172 | #else 173 | -- | Flipped version of '<$>'. 174 | -- 175 | -- @ 176 | -- ('<&>') = 'flip' 'fmap' 177 | -- @ 178 | -- 179 | -- @since 4.11.0.0 180 | -- 181 | -- ==== __Examples__ 182 | -- Apply @(+1)@ to a list, a 'Data.Maybe.Just' and a 'Data.Either.Right': 183 | -- 184 | -- >>> Just 2 <&> (+1) 185 | -- Just 3 186 | -- 187 | -- >>> [1,2,3] <&> (+1) 188 | -- [2,3,4] 189 | -- 190 | -- >>> Right 3 <&> (+1) 191 | -- Right 4 192 | -- 193 | (<&>) :: Functor f => f a -> (a -> b) -> f b 194 | as <&> f = f <$> as 195 | 196 | infixl 1 <&> 197 | #endif 198 | -------------------------------------------------------------------------------- /src/Turtle/Bytes.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | 3 | {-| This module provides `ByteString` analogs of several utilities in 4 | "Turtle.Prelude". The main difference is that the chunks of bytes read by 5 | these utilities are not necessarily aligned to line boundaries. 6 | -} 7 | 8 | module Turtle.Bytes ( 9 | -- * Byte operations 10 | stdin 11 | , input 12 | , inhandle 13 | , stdout 14 | , output 15 | , outhandle 16 | , append 17 | , stderr 18 | , strict 19 | , compress 20 | , decompress 21 | , WindowBits(..) 22 | , Zlib.defaultWindowBits 23 | , fromUTF8 24 | , toUTF8 25 | 26 | -- * Subprocess management 27 | , proc 28 | , shell 29 | , procs 30 | , shells 31 | , inproc 32 | , inshell 33 | , inprocWithErr 34 | , inshellWithErr 35 | , procStrict 36 | , shellStrict 37 | , procStrictWithErr 38 | , shellStrictWithErr 39 | 40 | , system 41 | , stream 42 | , streamWithErr 43 | , systemStrict 44 | , systemStrictWithErr 45 | ) where 46 | 47 | import Control.Applicative 48 | import Control.Concurrent.Async (Async, Concurrently(..)) 49 | import Control.Monad.IO.Class (MonadIO(..)) 50 | import Control.Monad.Managed (MonadManaged(..)) 51 | import Data.ByteString (ByteString) 52 | import Data.Monoid 53 | import Data.Streaming.Zlib (Inflate, Popper, PopperRes(..), WindowBits(..)) 54 | import Data.Text (Text) 55 | import Data.Text.Encoding (Decoding(..)) 56 | import System.Exit (ExitCode(..)) 57 | import System.IO (Handle) 58 | import Turtle.Internal (ignoreSIGPIPE) 59 | import Turtle.Prelude (ProcFailed(..), ShellFailed(..)) 60 | import Turtle.Shell (Shell(..), FoldShell(..), fold, sh) 61 | 62 | import qualified Control.Concurrent.Async as Async 63 | import qualified Control.Concurrent.STM as STM 64 | import qualified Control.Concurrent.MVar as MVar 65 | import qualified Control.Concurrent.STM.TQueue as TQueue 66 | import qualified Control.Exception as Exception 67 | import qualified Control.Foldl 68 | import qualified Control.Monad 69 | import qualified Control.Monad.Managed as Managed 70 | import qualified Data.ByteString 71 | import qualified Data.Streaming.Zlib as Zlib 72 | import qualified Data.Text 73 | import qualified Data.Text.Encoding as Encoding 74 | import qualified Data.Text.Encoding.Error as Encoding.Error 75 | import qualified Foreign 76 | import qualified System.IO 77 | import qualified System.Process as Process 78 | import qualified Turtle.Prelude 79 | 80 | {-| Read chunks of bytes from standard input 81 | 82 | The chunks are not necessarily aligned to line boundaries 83 | -} 84 | stdin :: Shell ByteString 85 | stdin = inhandle System.IO.stdin 86 | 87 | {-| Read chunks of bytes from a file 88 | 89 | The chunks are not necessarily aligned to line boundaries 90 | -} 91 | input :: FilePath -> Shell ByteString 92 | input file = do 93 | handle <- using (Turtle.Prelude.readonly file) 94 | inhandle handle 95 | 96 | {-| Read chunks of bytes from a `Handle` 97 | 98 | The chunks are not necessarily aligned to line boundaries 99 | -} 100 | inhandle :: Handle -> Shell ByteString 101 | inhandle handle = Shell (\(FoldShell step begin done) -> do 102 | let loop x = do 103 | eof <- System.IO.hIsEOF handle 104 | if eof 105 | then done x 106 | else do 107 | bytes <- Data.ByteString.hGetSome handle defaultChunkSize 108 | x' <- step x bytes 109 | loop $! x' 110 | loop $! begin ) 111 | where 112 | -- Copied from `Data.ByteString.Lazy.Internal` 113 | defaultChunkSize :: Int 114 | defaultChunkSize = 32 * 1024 - 2 * Foreign.sizeOf (undefined :: Int) 115 | 116 | {-| Stream chunks of bytes to standard output 117 | 118 | The chunks are not necessarily aligned to line boundaries 119 | -} 120 | stdout :: MonadIO io => Shell ByteString -> io () 121 | stdout s = sh (do 122 | bytes <- s 123 | liftIO (Data.ByteString.hPut System.IO.stdout bytes) ) 124 | 125 | {-| Stream chunks of bytes to a file 126 | 127 | The chunks do not need to be aligned to line boundaries 128 | -} 129 | output :: MonadIO io => FilePath -> Shell ByteString -> io () 130 | output file s = sh (do 131 | handle <- using (Turtle.Prelude.writeonly file) 132 | bytes <- s 133 | liftIO (Data.ByteString.hPut handle bytes) ) 134 | 135 | {-| Stream chunks of bytes to a `Handle` 136 | 137 | The chunks do not need to be aligned to line boundaries 138 | -} 139 | outhandle :: MonadIO io => Handle -> Shell ByteString -> io () 140 | outhandle handle s = sh (do 141 | bytes <- s 142 | liftIO (Data.ByteString.hPut handle bytes) ) 143 | 144 | {-| Append chunks of bytes to append to a file 145 | 146 | The chunks do not need to be aligned to line boundaries 147 | -} 148 | append :: MonadIO io => FilePath -> Shell ByteString -> io () 149 | append file s = sh (do 150 | handle <- using (Turtle.Prelude.appendonly file) 151 | bytes <- s 152 | liftIO (Data.ByteString.hPut handle bytes) ) 153 | 154 | {-| Stream chunks of bytes to standard error 155 | 156 | The chunks do not need to be aligned to line boundaries 157 | -} 158 | stderr :: MonadIO io => Shell ByteString -> io () 159 | stderr s = sh (do 160 | bytes <- s 161 | liftIO (Data.ByteString.hPut System.IO.stderr bytes) ) 162 | 163 | -- | Read in a stream's contents strictly 164 | strict :: MonadIO io => Shell ByteString -> io ByteString 165 | strict s = do 166 | listOfByteStrings <- fold s Control.Foldl.list 167 | return (Data.ByteString.concat listOfByteStrings) 168 | 169 | {-| Run a command using @execvp@, retrieving the exit code 170 | 171 | The command inherits @stdout@ and @stderr@ for the current process 172 | -} 173 | proc 174 | :: MonadIO io 175 | => Text 176 | -- ^ Command 177 | -> [Text] 178 | -- ^ Arguments 179 | -> Shell ByteString 180 | -- ^ Chunks of bytes written to process input 181 | -> io ExitCode 182 | -- ^ Exit code 183 | proc cmd args = 184 | system 185 | ( (Process.proc (Data.Text.unpack cmd) (map Data.Text.unpack args)) 186 | { Process.std_in = Process.CreatePipe 187 | , Process.std_out = Process.Inherit 188 | , Process.std_err = Process.Inherit 189 | } ) 190 | 191 | {-| Run a command line using the shell, retrieving the exit code 192 | 193 | This command is more powerful than `proc`, but highly vulnerable to code 194 | injection if you template the command line with untrusted input 195 | 196 | The command inherits @stdout@ and @stderr@ for the current process 197 | -} 198 | shell 199 | :: MonadIO io 200 | => Text 201 | -- ^ Command line 202 | -> Shell ByteString 203 | -- ^ Chunks of bytes written to process input 204 | -> io ExitCode 205 | -- ^ Exit code 206 | shell cmdline = 207 | system 208 | ( (Process.shell (Data.Text.unpack cmdline)) 209 | { Process.std_in = Process.CreatePipe 210 | , Process.std_out = Process.Inherit 211 | , Process.std_err = Process.Inherit 212 | } ) 213 | 214 | {-| This function is identical to `proc` except this throws `ProcFailed` for 215 | non-zero exit codes 216 | -} 217 | procs 218 | :: MonadIO io 219 | => Text 220 | -- ^ Command 221 | -> [Text] 222 | -- ^ Arguments 223 | -> Shell ByteString 224 | -- ^ Chunks of bytes written to process input 225 | -> io () 226 | procs cmd args s = do 227 | exitCode <- proc cmd args s 228 | case exitCode of 229 | ExitSuccess -> return () 230 | _ -> liftIO (Exception.throwIO (ProcFailed cmd args exitCode)) 231 | 232 | {-| This function is identical to `shell` except this throws `ShellFailed` for 233 | non-zero exit codes 234 | -} 235 | shells 236 | :: MonadIO io 237 | => Text 238 | -- ^ Command line 239 | -> Shell ByteString 240 | -- ^ Chunks of bytes written to process input 241 | -> io () 242 | -- ^ Exit code 243 | shells cmdline s = do 244 | exitCode <- shell cmdline s 245 | case exitCode of 246 | ExitSuccess -> return () 247 | _ -> liftIO (Exception.throwIO (ShellFailed cmdline exitCode)) 248 | 249 | {-| Run a command using @execvp@, retrieving the exit code and stdout as a 250 | non-lazy blob of Text 251 | 252 | The command inherits @stderr@ for the current process 253 | -} 254 | procStrict 255 | :: MonadIO io 256 | => Text 257 | -- ^ Command 258 | -> [Text] 259 | -- ^ Arguments 260 | -> Shell ByteString 261 | -- ^ Chunks of bytes written to process input 262 | -> io (ExitCode, ByteString) 263 | -- ^ Exit code and stdout 264 | procStrict cmd args = 265 | systemStrict (Process.proc (Data.Text.unpack cmd) (map Data.Text.unpack args)) 266 | 267 | {-| Run a command line using the shell, retrieving the exit code and stdout as a 268 | non-lazy blob of Text 269 | 270 | This command is more powerful than `proc`, but highly vulnerable to code 271 | injection if you template the command line with untrusted input 272 | 273 | The command inherits @stderr@ for the current process 274 | -} 275 | shellStrict 276 | :: MonadIO io 277 | => Text 278 | -- ^ Command line 279 | -> Shell ByteString 280 | -- ^ Chunks of bytes written to process input 281 | -> io (ExitCode, ByteString) 282 | -- ^ Exit code and stdout 283 | shellStrict cmdline = systemStrict (Process.shell (Data.Text.unpack cmdline)) 284 | 285 | {-| Run a command using @execvp@, retrieving the exit code, stdout, and stderr 286 | as a non-lazy blob of Text 287 | -} 288 | procStrictWithErr 289 | :: MonadIO io 290 | => Text 291 | -- ^ Command 292 | -> [Text] 293 | -- ^ Arguments 294 | -> Shell ByteString 295 | -- ^ Chunks of bytes written to process input 296 | -> io (ExitCode, ByteString, ByteString) 297 | -- ^ (Exit code, stdout, stderr) 298 | procStrictWithErr cmd args = 299 | systemStrictWithErr (Process.proc (Data.Text.unpack cmd) (map Data.Text.unpack args)) 300 | 301 | {-| Run a command line using the shell, retrieving the exit code, stdout, and 302 | stderr as a non-lazy blob of Text 303 | 304 | This command is more powerful than `proc`, but highly vulnerable to code 305 | injection if you template the command line with untrusted input 306 | -} 307 | shellStrictWithErr 308 | :: MonadIO io 309 | => Text 310 | -- ^ Command line 311 | -> Shell ByteString 312 | -- ^ Chunks of bytes written to process input 313 | -> io (ExitCode, ByteString, ByteString) 314 | -- ^ (Exit code, stdout, stderr) 315 | shellStrictWithErr cmdline = 316 | systemStrictWithErr (Process.shell (Data.Text.unpack cmdline)) 317 | 318 | -- | Halt an `Async` thread, re-raising any exceptions it might have thrown 319 | halt :: Async a -> IO () 320 | halt a = do 321 | m <- Async.poll a 322 | case m of 323 | Nothing -> Async.cancel a 324 | Just (Left e) -> Exception.throwIO e 325 | Just (Right _) -> return () 326 | 327 | {-| `system` generalizes `shell` and `proc` by allowing you to supply your own 328 | custom `CreateProcess`. This is for advanced users who feel comfortable 329 | using the lower-level @process@ API 330 | -} 331 | system 332 | :: MonadIO io 333 | => Process.CreateProcess 334 | -- ^ Command 335 | -> Shell ByteString 336 | -- ^ Chunks of bytes written to process input 337 | -> io ExitCode 338 | -- ^ Exit code 339 | system p s = liftIO (do 340 | let open = do 341 | (m, Nothing, Nothing, ph) <- Process.createProcess p 342 | case m of 343 | Just hIn -> System.IO.hSetBuffering hIn (System.IO.BlockBuffering Nothing) 344 | _ -> return () 345 | return (m, ph) 346 | 347 | -- Prevent double close 348 | mvar <- MVar.newMVar False 349 | let close handle = do 350 | MVar.modifyMVar_ mvar (\finalized -> do 351 | Control.Monad.unless finalized 352 | (ignoreSIGPIPE (System.IO.hClose handle)) 353 | return True ) 354 | let close' (Just hIn, ph) = do 355 | close hIn 356 | Process.terminateProcess ph 357 | close' (Nothing , ph) = do 358 | Process.terminateProcess ph 359 | 360 | let handle (Just hIn, ph) = do 361 | let feedIn :: (forall a. IO a -> IO a) -> IO () 362 | feedIn restore = 363 | restore (ignoreSIGPIPE (outhandle hIn s)) 364 | `Exception.finally` close hIn 365 | Exception.mask (\restore -> 366 | Async.withAsync (feedIn restore) (\a -> 367 | restore (Process.waitForProcess ph) <* halt a ) ) 368 | handle (Nothing , ph) = do 369 | Process.waitForProcess ph 370 | 371 | Exception.bracket open close' handle ) 372 | 373 | {-| `systemStrict` generalizes `shellStrict` and `procStrict` by allowing you to 374 | supply your own custom `CreateProcess`. This is for advanced users who feel 375 | comfortable using the lower-level @process@ API 376 | -} 377 | systemStrict 378 | :: MonadIO io 379 | => Process.CreateProcess 380 | -- ^ Command 381 | -> Shell ByteString 382 | -- ^ Chunks of bytes written to process input 383 | -> io (ExitCode, ByteString) 384 | -- ^ Exit code and stdout 385 | systemStrict p s = liftIO (do 386 | let p' = p 387 | { Process.std_in = Process.CreatePipe 388 | , Process.std_out = Process.CreatePipe 389 | , Process.std_err = Process.Inherit 390 | } 391 | 392 | let open = do 393 | (Just hIn, Just hOut, Nothing, ph) <- liftIO (Process.createProcess p') 394 | System.IO.hSetBuffering hIn (System.IO.BlockBuffering Nothing) 395 | return (hIn, hOut, ph) 396 | 397 | -- Prevent double close 398 | mvar <- MVar.newMVar False 399 | let close handle = do 400 | MVar.modifyMVar_ mvar (\finalized -> do 401 | Control.Monad.unless finalized 402 | (ignoreSIGPIPE (System.IO.hClose handle)) 403 | return True ) 404 | 405 | Exception.bracket open (\(hIn, _, ph) -> close hIn >> Process.terminateProcess ph) (\(hIn, hOut, ph) -> do 406 | let feedIn :: (forall a. IO a -> IO a) -> IO () 407 | feedIn restore = 408 | restore (ignoreSIGPIPE (outhandle hIn s)) 409 | `Exception.finally` close hIn 410 | 411 | Async.concurrently 412 | (Exception.mask (\restore -> 413 | Async.withAsync (feedIn restore) (\a -> 414 | restore (Process.waitForProcess ph) <* halt a ) )) 415 | (Data.ByteString.hGetContents hOut) ) ) 416 | 417 | {-| `systemStrictWithErr` generalizes `shellStrictWithErr` and 418 | `procStrictWithErr` by allowing you to supply your own custom 419 | `CreateProcess`. This is for advanced users who feel comfortable using 420 | the lower-level @process@ API 421 | -} 422 | systemStrictWithErr 423 | :: MonadIO io 424 | => Process.CreateProcess 425 | -- ^ Command 426 | -> Shell ByteString 427 | -- ^ Chunks of bytes written to process input 428 | -> io (ExitCode, ByteString, ByteString) 429 | -- ^ Exit code and stdout 430 | systemStrictWithErr p s = liftIO (do 431 | let p' = p 432 | { Process.std_in = Process.CreatePipe 433 | , Process.std_out = Process.CreatePipe 434 | , Process.std_err = Process.CreatePipe 435 | } 436 | 437 | let open = do 438 | (Just hIn, Just hOut, Just hErr, ph) <- liftIO (Process.createProcess p') 439 | System.IO.hSetBuffering hIn (System.IO.BlockBuffering Nothing) 440 | return (hIn, hOut, hErr, ph) 441 | 442 | -- Prevent double close 443 | mvar <- MVar.newMVar False 444 | let close handle = do 445 | MVar.modifyMVar_ mvar (\finalized -> do 446 | Control.Monad.unless finalized 447 | (ignoreSIGPIPE (System.IO.hClose handle)) 448 | return True ) 449 | 450 | Exception.bracket open (\(hIn, _, _, ph) -> close hIn >> Process.terminateProcess ph) (\(hIn, hOut, hErr, ph) -> do 451 | let feedIn :: (forall a. IO a -> IO a) -> IO () 452 | feedIn restore = 453 | restore (ignoreSIGPIPE (outhandle hIn s)) 454 | `Exception.finally` close hIn 455 | 456 | runConcurrently $ (,,) 457 | <$> Concurrently (Exception.mask (\restore -> 458 | Async.withAsync (feedIn restore) (\a -> 459 | restore (Process.waitForProcess ph) <* halt a ) )) 460 | <*> Concurrently (Data.ByteString.hGetContents hOut) 461 | <*> Concurrently (Data.ByteString.hGetContents hErr) ) ) 462 | 463 | {-| Run a command using @execvp@, streaming @stdout@ as chunks of `ByteString` 464 | 465 | The command inherits @stderr@ for the current process 466 | -} 467 | inproc 468 | :: Text 469 | -- ^ Command 470 | -> [Text] 471 | -- ^ Arguments 472 | -> Shell ByteString 473 | -- ^ Chunks of bytes written to process input 474 | -> Shell ByteString 475 | -- ^ Chunks of bytes read from process output 476 | inproc cmd args = 477 | stream (Process.proc (Data.Text.unpack cmd) (map Data.Text.unpack args)) 478 | 479 | {-| Run a command line using the shell, streaming @stdout@ as chunks of 480 | `ByteString` 481 | 482 | This command is more powerful than `inproc`, but highly vulnerable to code 483 | injection if you template the command line with untrusted input 484 | 485 | The command inherits @stderr@ for the current process 486 | -} 487 | inshell 488 | :: Text 489 | -- ^ Command line 490 | -> Shell ByteString 491 | -- ^ Chunks of bytes written to process input 492 | -> Shell ByteString 493 | -- ^ Chunks of bytes read from process output 494 | inshell cmd = stream (Process.shell (Data.Text.unpack cmd)) 495 | 496 | waitForProcessThrows :: Process.ProcessHandle -> IO () 497 | waitForProcessThrows ph = do 498 | exitCode <- Process.waitForProcess ph 499 | case exitCode of 500 | ExitSuccess -> return () 501 | ExitFailure _ -> Exception.throwIO exitCode 502 | 503 | {-| `stream` generalizes `inproc` and `inshell` by allowing you to supply your 504 | own custom `CreateProcess`. This is for advanced users who feel comfortable 505 | using the lower-level @process@ API 506 | 507 | Throws an `ExitCode` exception if the command returns a non-zero exit code 508 | -} 509 | stream 510 | :: Process.CreateProcess 511 | -- ^ Command 512 | -> Shell ByteString 513 | -- ^ Chunks of bytes written to process input 514 | -> Shell ByteString 515 | -- ^ Chunks of bytes read from process output 516 | stream p s = do 517 | let p' = p 518 | { Process.std_in = Process.CreatePipe 519 | , Process.std_out = Process.CreatePipe 520 | , Process.std_err = Process.Inherit 521 | } 522 | 523 | let open = do 524 | (Just hIn, Just hOut, Nothing, ph) <- liftIO (Process.createProcess p') 525 | System.IO.hSetBuffering hIn (System.IO.BlockBuffering Nothing) 526 | return (hIn, hOut, ph) 527 | 528 | -- Prevent double close 529 | mvar <- liftIO (MVar.newMVar False) 530 | let close handle = do 531 | MVar.modifyMVar_ mvar (\finalized -> do 532 | Control.Monad.unless finalized (ignoreSIGPIPE (System.IO.hClose handle)) 533 | return True ) 534 | 535 | (hIn, hOut, ph) <- using (Managed.managed (Exception.bracket open (\(hIn, _, ph) -> close hIn >> Process.terminateProcess ph))) 536 | let feedIn :: (forall a. IO a -> IO a) -> IO () 537 | feedIn restore = 538 | restore (ignoreSIGPIPE (sh (do 539 | bytes <- s 540 | liftIO (Data.ByteString.hPut hIn bytes) ) ) ) 541 | `Exception.finally` close hIn 542 | 543 | a <- using 544 | (Managed.managed (\k -> 545 | Exception.mask (\restore -> 546 | Async.withAsync (feedIn restore) k ) )) 547 | inhandle hOut <|> (liftIO (waitForProcessThrows ph *> halt a) *> empty) 548 | 549 | {-| `streamWithErr` generalizes `inprocWithErr` and `inshellWithErr` by allowing 550 | you to supply your own custom `CreateProcess`. This is for advanced users 551 | who feel comfortable using the lower-level @process@ API 552 | 553 | Throws an `ExitCode` exception if the command returns a non-zero exit code 554 | -} 555 | streamWithErr 556 | :: Process.CreateProcess 557 | -- ^ Command 558 | -> Shell ByteString 559 | -- ^ Chunks of bytes written to process input 560 | -> Shell (Either ByteString ByteString) 561 | -- ^ Chunks of bytes read from process output 562 | streamWithErr p s = do 563 | let p' = p 564 | { Process.std_in = Process.CreatePipe 565 | , Process.std_out = Process.CreatePipe 566 | , Process.std_err = Process.CreatePipe 567 | } 568 | 569 | let open = do 570 | (Just hIn, Just hOut, Just hErr, ph) <- liftIO (Process.createProcess p') 571 | System.IO.hSetBuffering hIn (System.IO.BlockBuffering Nothing) 572 | return (hIn, hOut, hErr, ph) 573 | 574 | -- Prevent double close 575 | mvar <- liftIO (MVar.newMVar False) 576 | let close handle = do 577 | MVar.modifyMVar_ mvar (\finalized -> do 578 | Control.Monad.unless finalized (ignoreSIGPIPE (System.IO.hClose handle)) 579 | return True ) 580 | 581 | (hIn, hOut, hErr, ph) <- using (Managed.managed (Exception.bracket open (\(hIn, _, _, ph) -> close hIn >> Process.terminateProcess ph))) 582 | let feedIn :: (forall a. IO a -> IO a) -> IO () 583 | feedIn restore = 584 | restore (ignoreSIGPIPE (sh (do 585 | bytes <- s 586 | liftIO (Data.ByteString.hPut hIn bytes) ) ) ) 587 | `Exception.finally` close hIn 588 | 589 | queue <- liftIO TQueue.newTQueueIO 590 | let forwardOut :: (forall a. IO a -> IO a) -> IO () 591 | forwardOut restore = 592 | restore (sh (do 593 | bytes <- inhandle hOut 594 | liftIO (STM.atomically (TQueue.writeTQueue queue (Just (Right bytes)))) )) 595 | `Exception.finally` STM.atomically (TQueue.writeTQueue queue Nothing) 596 | let forwardErr :: (forall a. IO a -> IO a) -> IO () 597 | forwardErr restore = 598 | restore (sh (do 599 | bytes <- inhandle hErr 600 | liftIO (STM.atomically (TQueue.writeTQueue queue (Just (Left bytes)))) )) 601 | `Exception.finally` STM.atomically (TQueue.writeTQueue queue Nothing) 602 | let drain = Shell (\(FoldShell step begin done) -> do 603 | let loop x numNothing 604 | | numNothing < 2 = do 605 | m <- STM.atomically (TQueue.readTQueue queue) 606 | case m of 607 | Nothing -> loop x $! numNothing + 1 608 | Just e -> do 609 | x' <- step x e 610 | loop x' numNothing 611 | | otherwise = return x 612 | x1 <- loop begin (0 :: Int) 613 | done x1 ) 614 | 615 | a <- using 616 | (Managed.managed (\k -> 617 | Exception.mask (\restore -> 618 | Async.withAsync (feedIn restore) k ) )) 619 | b <- using 620 | (Managed.managed (\k -> 621 | Exception.mask (\restore -> 622 | Async.withAsync (forwardOut restore) k ) )) 623 | c <- using 624 | (Managed.managed (\k -> 625 | Exception.mask (\restore -> 626 | Async.withAsync (forwardErr restore) k ) )) 627 | let l `also` r = do 628 | _ <- l <|> (r *> STM.retry) 629 | _ <- r 630 | return () 631 | let waitAll = STM.atomically (Async.waitSTM a `also` (Async.waitSTM b `also` Async.waitSTM c)) 632 | drain <|> (liftIO (waitForProcessThrows ph *> waitAll) *> empty) 633 | 634 | {-| Run a command using the shell, streaming @stdout@ and @stderr@ as chunks of 635 | `ByteString`. Chunks from @stdout@ are wrapped in `Right` and chunks from 636 | @stderr@ are wrapped in `Left`. 637 | 638 | Throws an `ExitCode` exception if the command returns a non-zero exit code 639 | -} 640 | inprocWithErr 641 | :: Text 642 | -- ^ Command 643 | -> [Text] 644 | -- ^ Arguments 645 | -> Shell ByteString 646 | -- ^ Chunks of bytes written to process input 647 | -> Shell (Either ByteString ByteString) 648 | -- ^ Chunks of either output (`Right`) or error (`Left`) 649 | inprocWithErr cmd args = 650 | streamWithErr (Process.proc (Data.Text.unpack cmd) (map Data.Text.unpack args)) 651 | 652 | 653 | {-| Run a command line using the shell, streaming @stdout@ and @stderr@ as 654 | chunks of `ByteString`. Chunks from @stdout@ are wrapped in `Right` and 655 | chunks from @stderr@ are wrapped in `Left`. 656 | 657 | This command is more powerful than `inprocWithErr`, but highly vulnerable to 658 | code injection if you template the command line with untrusted input 659 | 660 | Throws an `ExitCode` exception if the command returns a non-zero exit code 661 | -} 662 | inshellWithErr 663 | :: Text 664 | -- ^ Command line 665 | -> Shell ByteString 666 | -- ^ Chunks of bytes written to process input 667 | -> Shell (Either ByteString ByteString) 668 | -- ^ Chunks of either output (`Right`) or error (`Left`) 669 | inshellWithErr cmd = streamWithErr (Process.shell (Data.Text.unpack cmd)) 670 | 671 | -- | Internal utility used by both `compress` and `decompress` 672 | fromPopper :: Popper -> Shell ByteString 673 | fromPopper popper = loop 674 | where 675 | loop = do 676 | result <- liftIO popper 677 | 678 | case result of 679 | PRDone -> 680 | empty 681 | PRNext compressedByteString -> 682 | return compressedByteString <|> loop 683 | PRError exception -> 684 | liftIO (Exception.throwIO exception) 685 | 686 | {-| Compress a stream using @zlib@ 687 | 688 | Note that this can decompress streams that are the concatenation of 689 | multiple compressed streams (just like @gzip@) 690 | 691 | >>> let compressed = select [ "ABC", "DEF" ] & compress 0 defaultWindowBits 692 | >>> compressed & decompress defaultWindowBits & view 693 | "ABCDEF" 694 | >>> (compressed <|> compressed) & decompress defaultWindowBits & view 695 | "ABCDEF" 696 | "ABCDEF" 697 | -} 698 | compress 699 | :: Int 700 | -- ^ Compression level 701 | -> WindowBits 702 | -- ^ 703 | -> Shell ByteString 704 | -- ^ 705 | -> Shell ByteString 706 | compress compressionLevel windowBits bytestrings = do 707 | deflate <- liftIO (Zlib.initDeflate compressionLevel windowBits) 708 | 709 | let loop = do 710 | bytestring <- bytestrings 711 | 712 | popper <- liftIO (Zlib.feedDeflate deflate bytestring) 713 | 714 | fromPopper popper 715 | 716 | let wrapUp = do 717 | let popper = liftIO (Zlib.finishDeflate deflate) 718 | 719 | fromPopper popper 720 | 721 | loop <|> wrapUp 722 | 723 | data DecompressionState = Uninitialized | Decompressing Inflate 724 | 725 | -- | Decompress a stream using @zlib@ (just like the @gzip@ command) 726 | decompress :: WindowBits -> Shell ByteString -> Shell ByteString 727 | decompress windowBits (Shell k) = Shell k' 728 | where 729 | k' (FoldShell step begin done) = k (FoldShell step' begin' done') 730 | where 731 | begin' = (begin, Uninitialized) 732 | 733 | step' (x0, Uninitialized) compressedByteString = do 734 | inflate <- Zlib.initInflate windowBits 735 | 736 | step' (x0, Decompressing inflate) compressedByteString 737 | step' (x0, Decompressing inflate) compressedByteString = do 738 | popper <- Zlib.feedInflate inflate compressedByteString 739 | 740 | let loop x = do 741 | result <- popper 742 | 743 | case result of 744 | PRDone -> do 745 | compressedByteString' <- Zlib.getUnusedInflate inflate 746 | 747 | if Data.ByteString.null compressedByteString' 748 | then return (x, Decompressing inflate) 749 | else do 750 | decompressedByteString <- Zlib.finishInflate inflate 751 | 752 | x' <- step x decompressedByteString 753 | 754 | step' (x', Uninitialized) compressedByteString' 755 | PRNext decompressedByteString -> do 756 | x' <- step x decompressedByteString 757 | 758 | loop x' 759 | PRError exception -> do 760 | Exception.throwIO exception 761 | 762 | loop x0 763 | 764 | done' (x0, Uninitialized) = do 765 | done x0 766 | done' (x0, Decompressing inflate) = do 767 | decompressedByteString <- Zlib.finishInflate inflate 768 | 769 | x0' <- step x0 decompressedByteString 770 | 771 | done' (x0', Uninitialized) 772 | 773 | {-| Decode a stream of bytes as UTF8 `Text` 774 | 775 | NOTE: This function will throw a pure exception (i.e. an `error`) if UTF8 776 | decoding fails (mainly due to limitations in the @text@ package's stream 777 | decoding API) 778 | -} 779 | toUTF8 :: Shell ByteString -> Shell Text 780 | toUTF8 (Shell k) = Shell k' 781 | where 782 | k' (FoldShell step begin done) = 783 | k (FoldShell step' begin' done') 784 | where 785 | begin' = 786 | (mempty, Encoding.streamDecodeUtf8With Encoding.Error.strictDecode, begin) 787 | 788 | step' (prefix, decoder, x) suffix = do 789 | let bytes = prefix <> suffix 790 | 791 | let Some text prefix' decoder' = decoder bytes 792 | 793 | x' <- step x text 794 | 795 | return (prefix', decoder', x') 796 | 797 | done' (_, _, x) = do 798 | done x 799 | 800 | -- | Encode a stream of bytes as UTF8 `Text` 801 | fromUTF8 :: Shell Text -> Shell ByteString 802 | fromUTF8 = fmap Encoding.encodeUtf8 803 | -------------------------------------------------------------------------------- /src/Turtle/Format.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | {-| Minimalist implementation of type-safe formatted strings, borrowing heavily 4 | from the implementation of the @formatting@ package. 5 | 6 | Example use of this module: 7 | 8 | >>> :set -XOverloadedStrings 9 | >>> import Turtle.Format 10 | >>> format ("This is a "%s%" string that takes "%d%" arguments") "format" 2 11 | "This is a format string that takes 2 arguments" 12 | 13 | A `Format` string that takes no arguments has this type: 14 | 15 | > "I take 0 arguments" :: Format r r 16 | > 17 | > format "I take 0 arguments" :: Text 18 | 19 | >>> format "I take 0 arguments" 20 | "I take 0 arguments" 21 | 22 | A `Format` string that takes one argument has this type: 23 | 24 | > "I take "%d%" arguments" :: Format r (Int -> r) 25 | > 26 | > format ("I take "%d%" argument") :: Int -> Text 27 | 28 | >>> format ("I take "%d%" argument") 1 29 | "I take 1 argument" 30 | 31 | A `Format` string that takes two arguments has this type: 32 | 33 | > "I "%s%" "%d%" arguments" :: Format r (Text -> Int -> r) 34 | > 35 | > format ("I "%s%" "%d%" arguments") :: Text -> Int -> Text 36 | 37 | >>> format ("I "%s%" "%d%" arguments") "take" 2 38 | "I take 2 arguments" 39 | -} 40 | 41 | {-# LANGUAGE TypeFamilies #-} 42 | 43 | module Turtle.Format ( 44 | -- * Format 45 | Format (..) 46 | , (%) 47 | , format 48 | , printf 49 | , eprintf 50 | , makeFormat 51 | 52 | -- * Parameters 53 | , w 54 | , d 55 | , u 56 | , o 57 | , x 58 | , f 59 | , e 60 | , g 61 | , s 62 | , l 63 | , fp 64 | , utc 65 | 66 | -- * Utilities 67 | , repr 68 | ) where 69 | 70 | import Control.Category (Category(..)) 71 | import Control.Monad.IO.Class (MonadIO(..)) 72 | import Data.Monoid ((<>)) 73 | import Data.String (IsString(..)) 74 | import Data.Text (Text, pack) 75 | import Data.Time (UTCTime) 76 | import Data.Word 77 | import Numeric (showEFloat, showFFloat, showGFloat, showHex, showOct) 78 | import Prelude hiding ((.), id) 79 | import qualified System.IO as IO 80 | import Turtle.Line (Line) 81 | 82 | import qualified Data.Text.IO as Text 83 | import qualified Turtle.Line 84 | 85 | -- | A `Format` string 86 | newtype Format a b = Format { (>>-) :: (Text -> a) -> b } 87 | 88 | instance Category Format where 89 | id = Format (\return_ -> return_ "") 90 | 91 | fmt1 . fmt2 = Format (\return_ -> 92 | fmt1 >>- \str1 -> 93 | fmt2 >>- \str2 -> 94 | return_ (str1 <> str2) ) 95 | 96 | -- | Concatenate two `Format` strings 97 | (%) :: Format b c -> Format a b -> Format a c 98 | (%) = (.) 99 | 100 | instance (a ~ b) => IsString (Format a b) where 101 | fromString str = Format (\return_ -> return_ (pack str)) 102 | 103 | {-| Convert a `Format` string to a print function that takes zero or more typed 104 | arguments and returns a `Text` string 105 | -} 106 | format :: Format Text r -> r 107 | format fmt = fmt >>- id 108 | 109 | {-| Print a `Format` string to standard output (without a trailing newline) 110 | 111 | >>> printf ("Hello, "%s%"!\n") "world" 112 | Hello, world! 113 | -} 114 | printf :: MonadIO io => Format (io ()) r -> r 115 | printf fmt = fmt >>- (liftIO . Text.putStr) 116 | 117 | {-| Print a `Format` string to standard err (without a trailing newline) 118 | 119 | >>> eprintf ("Hello, "%s%"!\n") "world" 120 | Hello, world! 121 | -} 122 | eprintf :: MonadIO io => Format (io ()) r -> r 123 | eprintf fmt = fmt >>- (liftIO . Text.hPutStr IO.stderr) 124 | 125 | -- | Create your own format specifier 126 | makeFormat :: (a -> Text) -> Format r (a -> r) 127 | makeFormat k = Format (\return_ -> \a -> return_ (k a)) 128 | 129 | {-| `Format` any `Show`able value 130 | 131 | >>> format w True 132 | "True" 133 | -} 134 | w :: Show a => Format r (a -> r) 135 | w = makeFormat (pack . show) 136 | 137 | {-| `Format` an `Integral` value as a signed decimal 138 | 139 | >>> format d 25 140 | "25" 141 | >>> format d (-25) 142 | "-25" 143 | -} 144 | d :: Integral n => Format r (n -> r) 145 | d = makeFormat (pack . show . toInteger) 146 | 147 | {-| `Format` a `Word` value as an unsigned decimal 148 | 149 | >>> format u 25 150 | "25" 151 | -} 152 | u :: Format r (Word -> r) 153 | u = w 154 | 155 | {-| `Format` a `Word` value as an unsigned octal number 156 | 157 | >>> format o 25 158 | "31" 159 | -} 160 | o :: Format r (Word -> r) 161 | o = makeFormat (\n -> pack (showOct n "")) 162 | 163 | {-| `Format` a `Word` value as an unsigned hexadecimal number (without a 164 | leading \"0x\") 165 | 166 | >>> format x 25 167 | "19" 168 | -} 169 | x :: Format r (Word -> r) 170 | x = makeFormat (\n -> pack (showHex n "")) 171 | 172 | {-| `Format` a `Double` using decimal notation with 6 digits of precision 173 | 174 | >>> format f 25.1 175 | "25.100000" 176 | -} 177 | f :: Format r (Double -> r) 178 | f = makeFormat (\n -> pack (showFFloat (Just 6) n "")) 179 | 180 | {-| `Format` a `Double` using scientific notation with 6 digits of precision 181 | 182 | >>> format e 25.1 183 | "2.510000e1" 184 | -} 185 | e :: Format r (Double -> r) 186 | e = makeFormat (\n -> pack (showEFloat (Just 6) n "")) 187 | 188 | {-| `Format` a `Double` using decimal notation for small exponents and 189 | scientific notation for large exponents 190 | 191 | >>> format g 25.1 192 | "25.100000" 193 | >>> format g 123456789 194 | "1.234568e8" 195 | >>> format g 0.00000000001 196 | "1.000000e-11" 197 | -} 198 | g :: Format r (Double -> r) 199 | g = makeFormat (\n -> pack (showGFloat (Just 6) n "")) 200 | 201 | {-| `Format` that inserts `Text` 202 | 203 | >>> format s "ABC" 204 | "ABC" 205 | -} 206 | s :: Format r (Text -> r) 207 | s = makeFormat id 208 | 209 | {-| `Format` that inserts a `Line` 210 | 211 | >>> format l "ABC" 212 | "ABC" 213 | -} 214 | l :: Format r (Line -> r) 215 | l = makeFormat Turtle.Line.lineToText 216 | 217 | -- | `Format` a `FilePath` into `Text` 218 | fp :: Format r (FilePath -> r) 219 | fp = makeFormat pack 220 | 221 | -- | `Format` a `UTCTime` into `Text` 222 | utc :: Format r (UTCTime -> r) 223 | utc = w 224 | 225 | {-| Convert a `Show`able value to any type that implements `IsString` (such as 226 | `Text`) 227 | 228 | >>> repr (1,2) 229 | "(1,2)" 230 | -} 231 | repr :: (Show a, IsString text) => a -> text 232 | repr = fromString . show 233 | -------------------------------------------------------------------------------- /src/Turtle/Internal.hs: -------------------------------------------------------------------------------- 1 | module Turtle.Internal where 2 | 3 | import Control.Applicative ((<|>)) 4 | import Control.Exception (handle, throwIO) 5 | import Data.Text (Text) 6 | import Foreign.C.Error (Errno(..), ePIPE) 7 | import GHC.IO.Exception (IOErrorType(..), IOException(..)) 8 | import System.FilePath (()) 9 | 10 | import qualified Data.List as List 11 | import qualified Data.Text as Text 12 | import qualified Data.Text.IO as Text.IO 13 | import qualified System.FilePath as FilePath 14 | 15 | ignoreSIGPIPE :: IO () -> IO () 16 | ignoreSIGPIPE = handle (\e -> case e of 17 | IOError 18 | { ioe_type = ResourceVanished 19 | , ioe_errno = Just ioe } 20 | | Errno ioe == ePIPE -> return () 21 | _ -> throwIO e 22 | ) 23 | 24 | {-| Convert a `FilePath` to human-readable `Text` 25 | 26 | Note that even though the type says `Either` this utility actually always 27 | succeeds and returns a `Right` value. The only reason for the `Either` is 28 | compatibility with the old type from the @system-filepath@ package. 29 | -} 30 | toText :: FilePath -> Either Text Text 31 | toText = Right . Text.pack 32 | {-# DEPRECATED toText "Use Data.Text.pack instead" #-} 33 | 34 | -- | Convert `Text` to a `FilePath` 35 | fromText :: Text -> FilePath 36 | fromText = Text.unpack 37 | {-# DEPRECATED fromText "Use Data.Text.unpack instead" #-} 38 | 39 | -- | Convert a `String` to a `FilePath` 40 | decodeString :: String -> FilePath 41 | decodeString = id 42 | {-# DEPRECATED decodeString "Use id instead" #-} 43 | 44 | -- | Convert a `FilePath` to a `String` 45 | encodeString :: FilePath -> String 46 | encodeString = id 47 | {-# DEPRECATED encodeString "Use id instead" #-} 48 | 49 | -- | Find the greatest common prefix between a list of `FilePath`s 50 | commonPrefix :: [FilePath] -> FilePath 51 | commonPrefix [ ] = mempty 52 | commonPrefix (path : paths) = foldr longestPathPrefix path paths 53 | where 54 | longestPathPrefix left right 55 | | leftComponents == rightComponents = 56 | FilePath.joinPath leftComponents 57 | ++ mconcat (longestPrefix leftExtensions rightExtensions) 58 | | otherwise = 59 | FilePath.joinPath (longestPrefix leftComponents rightComponents) 60 | where 61 | (leftComponents, leftExtensions) = splitExt (splitDirectories left) 62 | 63 | (rightComponents, rightExtensions) = splitExt (splitDirectories right) 64 | 65 | longestPrefix :: Eq a => [a] -> [a] -> [a] 66 | longestPrefix (l : ls) (r : rs) 67 | | l == r = l : longestPrefix ls rs 68 | longestPrefix _ _ = [ ] 69 | 70 | -- | Remove a prefix from a path 71 | stripPrefix :: FilePath -> FilePath -> Maybe FilePath 72 | stripPrefix prefix path = do 73 | componentSuffix <- List.stripPrefix prefixComponents pathComponents 74 | 75 | if null componentSuffix 76 | then do 77 | prefixSuffix <- List.stripPrefix prefixExtensions pathExtensions 78 | 79 | return (mconcat prefixSuffix) 80 | else do 81 | return (FilePath.joinPath componentSuffix ++ mconcat pathExtensions) 82 | where 83 | (prefixComponents, prefixExtensions) = splitExt (splitDirectories prefix) 84 | 85 | (pathComponents, pathExtensions) = splitExt (splitDirectories path) 86 | 87 | -- Internal helper function for `stripPrefix` and `commonPrefix` 88 | splitExt :: [FilePath] -> ([FilePath], [String]) 89 | splitExt [ component ] = ([ base ], map ("." ++) exts) 90 | where 91 | (base, exts) = splitExtensions component 92 | splitExt [ ] = 93 | ([ ], [ ]) 94 | splitExt (component : components) = (component : base, exts) 95 | where 96 | (base, exts) = splitExt components 97 | 98 | -- | Normalise a path 99 | collapse :: FilePath -> FilePath 100 | collapse = FilePath.normalise 101 | {-# DEPRECATED collapse "Use System.FilePath.normalise instead" #-} 102 | 103 | -- | Read in a file as `Text` 104 | readTextFile :: FilePath -> IO Text 105 | readTextFile = Text.IO.readFile 106 | {-# DEPRECATED readTextFile "Use Data.Text.IO.readFile instead" #-} 107 | 108 | -- | Write out a file as `Text` 109 | writeTextFile :: FilePath -> Text -> IO () 110 | writeTextFile = Text.IO.writeFile 111 | {-# DEPRECATED writeTextFile "Use Data.Text.IO.writeFile instead" #-} 112 | 113 | -- | Retrieves the `FilePath`'s root 114 | root :: FilePath -> FilePath 115 | root = fst . FilePath.splitDrive 116 | 117 | -- | Retrieves the `FilePath`'s parent directory 118 | parent :: FilePath -> FilePath 119 | parent path = prefix suffix 120 | where 121 | (drive, rest) = FilePath.splitDrive path 122 | 123 | components = loop (splitDirectories rest) 124 | 125 | prefix = 126 | case components of 127 | "./" : _ -> drive 128 | "../" : _ -> drive 129 | _ | null drive -> "./" 130 | | otherwise -> drive 131 | 132 | suffix = FilePath.joinPath components 133 | 134 | loop [ _ ] = [ ] 135 | loop [ ] = [ ] 136 | loop (c : cs) = c : loop cs 137 | 138 | -- | Retrieves the `FilePath`'s directory 139 | directory :: FilePath -> FilePath 140 | directory path 141 | | prefix == "" && suffix == ".." = 142 | "../" 143 | | otherwise = 144 | trailingSlash (FilePath.takeDirectory prefix) ++ suffix 145 | where 146 | (prefix, suffix) = trailingParent path 147 | where 148 | trailingParent ".." = ("" , "..") 149 | trailingParent [ a, b ] = ([ a, b ], "" ) 150 | trailingParent [ a ] = ([ a ] , "" ) 151 | trailingParent [ ] = ([ ] , "" ) 152 | trailingParent (c : cs) = (c : p, s) 153 | where 154 | ~(p, s) = trailingParent cs 155 | 156 | trailingSlash "" = "/" 157 | trailingSlash "/" = "/" 158 | trailingSlash (c : cs) = c : trailingSlash cs 159 | 160 | -- | Retrieves the `FilePath`'s filename component 161 | filename :: FilePath -> FilePath 162 | filename path 163 | | result == "." || result == ".." = "" 164 | | otherwise = result 165 | where 166 | result = FilePath.takeFileName path 167 | 168 | -- | Retrieve a `FilePath`'s directory name 169 | dirname :: FilePath -> FilePath 170 | dirname path = loop (splitDirectories path) 171 | where 172 | loop [ x, y ] = 173 | case deslash y <|> deslash x of 174 | Just name -> name 175 | Nothing -> "" 176 | loop [ x ] = 177 | case deslash x of 178 | Just name -> name 179 | Nothing -> "" 180 | loop [ ] = 181 | "" 182 | loop (_ : xs) = 183 | loop xs 184 | 185 | deslash "" = Nothing 186 | deslash "/" = Just "" 187 | deslash (c : cs) = fmap (c :) (deslash cs) 188 | 189 | -- | Retrieve a `FilePath`'s basename component 190 | basename :: FilePath -> String 191 | basename path = 192 | case name of 193 | '.' : _ -> name 194 | _ -> 195 | case splitExtensions name of 196 | (base, _) -> base 197 | where 198 | name = filename path 199 | 200 | -- | Test whether a path is absolute 201 | absolute :: FilePath -> Bool 202 | absolute = FilePath.isAbsolute 203 | {-# DEPRECATED absolute "Use System.FilePath.isAbsolute instead" #-} 204 | 205 | -- | Test whether a path is relative 206 | relative :: FilePath -> Bool 207 | relative = FilePath.isRelative 208 | {-# DEPRECATED relative "Use System.FilePath.isRelative instead" #-} 209 | 210 | -- | Split a `FilePath` into its components 211 | splitDirectories :: FilePath -> [FilePath] 212 | splitDirectories path = loop (FilePath.splitPath path) 213 | where 214 | loop [ ] = [ ] 215 | loop [ ".." ] = [ "../" ] 216 | loop [ "." ] = [ "./" ] 217 | loop (c : cs) = c : loop cs 218 | 219 | -- | Get a `FilePath`'s last extension, or `Nothing` if it has no extension 220 | extension :: FilePath -> Maybe String 221 | extension path = 222 | case suffix of 223 | '.' : ext -> Just ext 224 | _ -> Nothing 225 | where 226 | suffix = FilePath.takeExtension path 227 | 228 | -- | Split a `FilePath` on its extension 229 | splitExtension :: FilePath -> (String, Maybe String) 230 | splitExtension path = 231 | case suffix of 232 | '.' : ext -> (prefix, Just ext) 233 | _ -> (prefix, Nothing) 234 | where 235 | (prefix, suffix) = FilePath.splitExtension path 236 | 237 | -- | Split a `FilePath` on its extensions 238 | splitExtensions :: FilePath -> (String, [String]) 239 | splitExtensions path0 = (prefix0, reverse exts0) 240 | where 241 | (prefix0, exts0) = loop path0 242 | 243 | loop path = case splitExtension path of 244 | (prefix, Just ext) -> 245 | (base, ext : exts) 246 | where 247 | (base, exts) = loop prefix 248 | (base, Nothing) -> 249 | (base, []) 250 | -------------------------------------------------------------------------------- /src/Turtle/Line.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DeriveDataTypeable #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | 6 | module Turtle.Line 7 | ( Line 8 | , lineToText 9 | , textToLines 10 | , linesToText 11 | , textToLine 12 | , unsafeTextToLine 13 | , NewlineForbidden(..) 14 | ) where 15 | 16 | import Data.Text (Text) 17 | import qualified Data.Text as Text 18 | #if __GLASGOW_HASKELL__ >= 708 19 | import Data.Coerce 20 | #endif 21 | import Data.List.NonEmpty (NonEmpty(..)) 22 | import Data.String 23 | #if __GLASGOW_HASKELL__ >= 710 24 | #else 25 | import Data.Monoid 26 | #endif 27 | import Data.Maybe 28 | import Data.Typeable 29 | import Control.Exception 30 | 31 | import qualified Data.List.NonEmpty 32 | 33 | -- | The `NewlineForbidden` exception is thrown when you construct a `Line` 34 | -- using an overloaded string literal or by calling `fromString` explicitly 35 | -- and the supplied string contains newlines. This is a programming error to 36 | -- do so: if you aren't sure that the input string is newline-free, do not 37 | -- rely on the @`IsString` `Line`@ instance. 38 | -- 39 | -- When debugging, it might be useful to look for implicit invocations of 40 | -- `fromString` for `Line`: 41 | -- 42 | -- > >>> sh (do { line <- "Hello\nWorld"; echo line }) 43 | -- > *** Exception: NewlineForbidden 44 | -- 45 | -- In the above example, `echo` expects its argument to be a `Line`, thus 46 | -- @line :: `Line`@. Since we bind @line@ in `Shell`, the string literal 47 | -- @\"Hello\\nWorld\"@ has type @`Shell` `Line`@. The 48 | -- @`IsString` (`Shell` `Line`)@ instance delegates the construction of a 49 | -- `Line` to the @`IsString` `Line`@ instance, where the exception is thrown. 50 | -- 51 | -- To fix the problem, use `textToLines`: 52 | -- 53 | -- > >>> sh (do { line <- select (textToLines "Hello\nWorld"); echo line }) 54 | -- > Hello 55 | -- > World 56 | data NewlineForbidden = NewlineForbidden 57 | deriving (Show, Typeable) 58 | 59 | instance Exception NewlineForbidden 60 | 61 | -- | A line of text (does not contain newlines). 62 | newtype Line = Line Text 63 | deriving (Eq, Ord, Show, Monoid) 64 | 65 | #if __GLASGOW_HASKELL__ >= 804 66 | instance Semigroup Line where 67 | (<>) = mappend 68 | #endif 69 | 70 | instance IsString Line where 71 | fromString = fromMaybe (throw NewlineForbidden) . textToLine . fromString 72 | 73 | -- | Convert a line to a text value. 74 | lineToText :: Line -> Text 75 | lineToText (Line t) = t 76 | 77 | -- | Split text into lines. The inverse of `linesToText`. 78 | textToLines :: Text -> NonEmpty Line 79 | textToLines = 80 | #if __GLASGOW_HASKELL__ >= 708 81 | Data.List.NonEmpty.fromList . coerce (Text.splitOn "\n") 82 | #else 83 | Data.List.NonEmpty.fromList . map unsafeTextToLine . Text.splitOn "\n" 84 | #endif 85 | 86 | -- | Merge lines into a single text value. 87 | linesToText :: [Line] -> Text 88 | linesToText = 89 | #if __GLASGOW_HASKELL__ >= 708 90 | coerce Text.unlines 91 | #else 92 | Text.unlines . map lineToText 93 | #endif 94 | 95 | -- | Try to convert a text value into a line. 96 | -- Precondition (checked): the argument does not contain newlines. 97 | textToLine :: Text -> Maybe Line 98 | textToLine = fromSingleton . textToLines 99 | where 100 | fromSingleton (a :| []) = Just a 101 | fromSingleton _ = Nothing 102 | 103 | -- | Convert a text value into a line. 104 | -- Precondition (unchecked): the argument does not contain newlines. 105 | unsafeTextToLine :: Text -> Line 106 | unsafeTextToLine = Line 107 | -------------------------------------------------------------------------------- /src/Turtle/Options.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | 6 | -- | Example usage of this module: 7 | -- 8 | -- > -- options.hs 9 | -- > 10 | -- > {-# LANGUAGE OverloadedStrings #-} 11 | -- > 12 | -- > import Turtle 13 | -- > 14 | -- > parser :: Parser (Text, Int) 15 | -- > parser = (,) <$> optText "name" 'n' "Your first name" 16 | -- > <*> optInt "age" 'a' "Your current age" 17 | -- > 18 | -- > main = do 19 | -- > (name, age) <- options "Greeting script" parser 20 | -- > echo (repr (format ("Hello there, "%s) name)) 21 | -- > echo (repr (format ("You are "%d%" years old") age)) 22 | -- 23 | -- > $ ./options --name John --age 42 24 | -- > Hello there, John 25 | -- > You are 42 years old 26 | -- 27 | -- > $ ./options --help 28 | -- > Greeting script 29 | -- > 30 | -- > Usage: options (-n|--name NAME) (-a|--age AGE) 31 | -- > 32 | -- > Available options: 33 | -- > -h,--help Show this help text 34 | -- > --name NAME Your first name 35 | -- > --age AGE Your current age 36 | -- 37 | -- See the "Turtle.Tutorial" module which contains more examples on how to use 38 | -- command-line parsing. 39 | 40 | module Turtle.Options 41 | ( -- * Types 42 | Parser 43 | , ArgName(..) 44 | , CommandName(..) 45 | , ShortName 46 | , Description(..) 47 | , HelpMessage(..) 48 | 49 | -- * Flag-based option parsers 50 | , switch 51 | , optText 52 | , optLine 53 | , optInt 54 | , optInteger 55 | , optDouble 56 | , optPath 57 | , optRead 58 | , opt 59 | 60 | -- * Positional argument parsers 61 | , argText 62 | , argLine 63 | , argInt 64 | , argInteger 65 | , argDouble 66 | , argPath 67 | , argRead 68 | , arg 69 | 70 | -- * Consume parsers 71 | , subcommand 72 | , subcommandGroup 73 | , options 74 | , optionsExt 75 | 76 | ) where 77 | 78 | import Data.Monoid 79 | import Data.Foldable 80 | import Data.String (IsString) 81 | import Text.Read (readMaybe) 82 | import Data.Text (Text) 83 | import Data.Optional 84 | import Control.Applicative 85 | import Control.Monad.IO.Class 86 | import Options.Applicative (Parser) 87 | import Text.PrettyPrint.ANSI.Leijen (Doc, displayS, renderCompact) 88 | import Turtle.Line (Line) 89 | 90 | import qualified Data.Text as Text 91 | import qualified Options.Applicative as Opts 92 | import qualified Options.Applicative.Types as Opts 93 | import qualified Turtle.Line 94 | 95 | -- | Parse the given options from the command line 96 | options :: MonadIO io => Description -> Parser a -> io a 97 | options desc parser = liftIO 98 | $ Opts.customExecParser (Opts.prefs prefs) 99 | $ Opts.info (Opts.helper <*> parser) 100 | (Opts.headerDoc (Just (getDescription desc))) 101 | where 102 | prefs :: Opts.PrefsMod 103 | #if MIN_VERSION_optparse_applicative(0,13,0) 104 | prefs = Opts.showHelpOnError <> Opts.showHelpOnEmpty 105 | #else 106 | prefs = Opts.showHelpOnError 107 | #endif 108 | 109 | {-| Parse the given options from the command line and add additional information 110 | 111 | Extended version of @options@ with program version header and footer information 112 | -} 113 | optionsExt :: MonadIO io => Header -> Footer -> Description -> Version -> Parser a -> io a 114 | optionsExt header footer desc version parser = liftIO 115 | $ Opts.customExecParser (Opts.prefs prefs) 116 | $ Opts.info (Opts.helper <*> versionOption <*> parser) 117 | (Opts.headerDoc (Just (getHeader header)) <> 118 | Opts.footerDoc (Just (getFooter footer)) <> 119 | Opts.progDescDoc (Just (getDescription desc))) 120 | where 121 | versionOption = 122 | Opts.infoOption 123 | (Text.unpack version) 124 | (Opts.long "version" <> Opts.help "Show version") 125 | prefs :: Opts.PrefsMod 126 | #if MIN_VERSION_optparse_applicative(0,13,0) 127 | prefs = Opts.showHelpOnError <> Opts.showHelpOnEmpty 128 | #else 129 | prefs = Opts.showHelpOnError 130 | #endif 131 | 132 | 133 | {-| The name of a command-line argument 134 | 135 | This is used to infer the long name and metavariable for the command line 136 | flag. For example, an `ArgName` of @\"name\"@ will create a @--name@ flag 137 | with a @NAME@ metavariable 138 | -} 139 | newtype ArgName = ArgName { getArgName :: Text } 140 | deriving (IsString) 141 | 142 | -- | The short one-character abbreviation for a flag (i.e. @-n@) 143 | type ShortName = Char 144 | 145 | {-| The name of a sub-command 146 | 147 | This is lower-cased to create a sub-command. For example, a `CommandName` of 148 | @\"Name\"@ will parse `name` on the command line before parsing the 149 | remaining arguments using the command's subparser. 150 | -} 151 | newtype CommandName = CommandName { getCommandName :: Text } 152 | deriving (IsString) 153 | 154 | {-| A brief description of what your program does 155 | 156 | This description will appear in the header of the @--help@ output 157 | -} 158 | newtype Description = Description { getDescription :: Doc } 159 | deriving (IsString) 160 | 161 | {-| Header of the program 162 | 163 | This description will appear in the header of the @--help@ output 164 | -} 165 | newtype Header = Header { getHeader :: Doc } 166 | deriving (IsString) 167 | {-| Footer of the program 168 | 169 | This description will appear in the footer of the @--help@ output 170 | -} 171 | newtype Footer = Fotter { getFooter :: Doc } 172 | deriving (IsString) 173 | 174 | -- | Program Version 175 | type Version = Text 176 | {-| A helpful message explaining what a flag does 177 | 178 | This will appear in the @--help@ output 179 | -} 180 | newtype HelpMessage = HelpMessage { getHelpMessage :: Text } 181 | deriving (IsString) 182 | 183 | {-| This parser returns `True` if the given flag is set and `False` if the 184 | flag is absent 185 | -} 186 | switch 187 | :: ArgName 188 | -> ShortName 189 | -> Optional HelpMessage 190 | -> Parser Bool 191 | switch argName c helpMessage 192 | = Opts.switch 193 | $ (Opts.long . Text.unpack . getArgName) argName 194 | <> Opts.short c 195 | <> foldMap (Opts.help . Text.unpack . getHelpMessage) helpMessage 196 | 197 | {- | Build a flag-based option parser for any type by providing a `Text`-parsing 198 | function 199 | -} 200 | opt :: (Text -> Maybe a) 201 | -> ArgName 202 | -> ShortName 203 | -> Optional HelpMessage 204 | -> Parser a 205 | opt argParse argName c helpMessage 206 | = Opts.option (argParseToReadM argParse) 207 | $ Opts.metavar (Text.unpack (Text.toUpper (getArgName argName))) 208 | <> Opts.long (Text.unpack (getArgName argName)) 209 | <> Opts.short c 210 | <> foldMap (Opts.help . Text.unpack . getHelpMessage) helpMessage 211 | 212 | -- | Parse any type that implements `Read` 213 | optRead :: Read a => ArgName -> ShortName -> Optional HelpMessage -> Parser a 214 | optRead = opt (readMaybe . Text.unpack) 215 | 216 | -- | Parse an `Int` as a flag-based option 217 | optInt :: ArgName -> ShortName -> Optional HelpMessage -> Parser Int 218 | optInt = optRead 219 | 220 | -- | Parse an `Integer` as a flag-based option 221 | optInteger :: ArgName -> ShortName -> Optional HelpMessage -> Parser Integer 222 | optInteger = optRead 223 | 224 | -- | Parse a `Double` as a flag-based option 225 | optDouble :: ArgName -> ShortName -> Optional HelpMessage -> Parser Double 226 | optDouble = optRead 227 | 228 | -- | Parse a `Text` value as a flag-based option 229 | optText :: ArgName -> ShortName -> Optional HelpMessage -> Parser Text 230 | optText = opt Just 231 | 232 | -- | Parse a `Line` value as a flag-based option 233 | optLine :: ArgName -> ShortName -> Optional HelpMessage -> Parser Line 234 | optLine = opt Turtle.Line.textToLine 235 | 236 | -- | Parse a `FilePath` value as a flag-based option 237 | optPath :: ArgName -> ShortName -> Optional HelpMessage -> Parser FilePath 238 | optPath argName short msg = fmap Text.unpack (optText argName short msg) 239 | 240 | {- | Build a positional argument parser for any type by providing a 241 | `Text`-parsing function 242 | -} 243 | arg :: (Text -> Maybe a) 244 | -> ArgName 245 | -> Optional HelpMessage 246 | -> Parser a 247 | arg argParse argName helpMessage 248 | = Opts.argument (argParseToReadM argParse) 249 | $ Opts.metavar (Text.unpack (Text.toUpper (getArgName argName))) 250 | <> foldMap (Opts.help . Text.unpack . getHelpMessage) helpMessage 251 | 252 | -- | Parse any type that implements `Read` as a positional argument 253 | argRead :: Read a => ArgName -> Optional HelpMessage -> Parser a 254 | argRead = arg (readMaybe . Text.unpack) 255 | 256 | -- | Parse an `Int` as a positional argument 257 | argInt :: ArgName -> Optional HelpMessage -> Parser Int 258 | argInt = argRead 259 | 260 | -- | Parse an `Integer` as a positional argument 261 | argInteger :: ArgName -> Optional HelpMessage -> Parser Integer 262 | argInteger = argRead 263 | 264 | -- | Parse a `Double` as a positional argument 265 | argDouble :: ArgName -> Optional HelpMessage -> Parser Double 266 | argDouble = argRead 267 | 268 | -- | Parse a `Text` as a positional argument 269 | argText :: ArgName -> Optional HelpMessage -> Parser Text 270 | argText = arg Just 271 | 272 | -- | Parse a `Line` as a positional argument 273 | argLine :: ArgName -> Optional HelpMessage -> Parser Line 274 | argLine = arg Turtle.Line.textToLine 275 | 276 | -- | Parse a `FilePath` as a positional argument 277 | argPath :: ArgName -> Optional HelpMessage -> Parser FilePath 278 | argPath argName msg = fmap Text.unpack (argText argName msg) 279 | 280 | argParseToReadM :: (Text -> Maybe a) -> Opts.ReadM a 281 | argParseToReadM f = do 282 | s <- Opts.readerAsk 283 | case f (Text.pack s) of 284 | Just a -> return a 285 | Nothing -> Opts.readerAbort (Opts.ShowHelpText Nothing) 286 | 287 | {-| Create a sub-command that parses `CommandName` and then parses the rest 288 | of the command-line arguments 289 | 290 | The sub-command will have its own `Description` and help text 291 | -} 292 | subcommand :: CommandName -> Description -> Parser a -> Parser a 293 | subcommand cmdName desc p = 294 | Opts.hsubparser (Opts.command name info <> Opts.metavar name) 295 | where 296 | name = Text.unpack (getCommandName cmdName) 297 | 298 | info = Opts.info p (Opts.progDescDoc (Just (getDescription desc))) 299 | 300 | -- | Create a named group of sub-commands 301 | subcommandGroup :: forall a. Description -> [(CommandName, Description, Parser a)] -> Parser a 302 | subcommandGroup name cmds = 303 | Opts.hsubparser (Opts.commandGroup name' <> foldMap f cmds <> Opts.metavar metavar) 304 | where 305 | f :: (CommandName, Description, Parser a) -> Opts.Mod Opts.CommandFields a 306 | f (cmdName, desc, p) = 307 | Opts.command 308 | (Text.unpack (getCommandName cmdName)) 309 | (Opts.info p (Opts.progDescDoc (Just (getDescription desc)))) 310 | 311 | metavar :: String 312 | metavar = Text.unpack (Text.intercalate " | " (map g cmds)) 313 | where 314 | g :: (CommandName, Description, Parser a) -> Text 315 | g (cmdName, _, _) = getCommandName cmdName 316 | 317 | name' :: String 318 | name' = displayS (renderCompact (getDescription name)) "" 319 | -------------------------------------------------------------------------------- /src/Turtle/Pattern.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | {-# OPTIONS_GHC -fno-warn-missing-methods #-} 6 | 7 | {-| Use this module to either: 8 | 9 | * match `Text` with light-weight backtracking patterns, or: 10 | 11 | * parse structured values from `Text`. 12 | 13 | Example usage: 14 | 15 | >>> :set -XOverloadedStrings 16 | >>> match ("can" <|> "cat") "cat" 17 | ["cat"] 18 | >>> match ("can" <|> "cat") "dog" 19 | [] 20 | >>> match (decimal `sepBy` ",") "1,2,3" 21 | [[1,2,3]] 22 | 23 | This pattern has unlimited backtracking, and will return as many solutions 24 | as possible: 25 | 26 | >>> match (prefix (star anyChar)) "123" 27 | ["123","12","1",""] 28 | 29 | Use @do@ notation to structure more complex patterns: 30 | 31 | >>> :{ 32 | let bit = ("0" *> pure False) <|> ("1" *> pure True) :: Pattern Bool; 33 | portableBitMap = do 34 | { "P1" 35 | ; width <- spaces1 *> decimal 36 | ; height <- spaces1 *> decimal 37 | ; count width (count height (spaces1 *> bit)) 38 | }; 39 | in match (prefix portableBitMap) "P1\n2 2\n0 0\n1 0\n" 40 | :} 41 | [[[False,False],[True,False]]] 42 | 43 | -} 44 | 45 | module Turtle.Pattern ( 46 | -- * Pattern 47 | Pattern 48 | , match 49 | 50 | -- * Primitive patterns 51 | , anyChar 52 | , eof 53 | 54 | -- * Character patterns 55 | , dot 56 | , satisfy 57 | , char 58 | , notChar 59 | , text 60 | , asciiCI 61 | , oneOf 62 | , noneOf 63 | , space 64 | , spaces 65 | , spaces1 66 | , tab 67 | , newline 68 | , crlf 69 | , upper 70 | , lower 71 | , alphaNum 72 | , letter 73 | , digit 74 | , hexDigit 75 | , octDigit 76 | 77 | -- * Numbers 78 | , decimal 79 | , signed 80 | 81 | -- * Combinators 82 | , prefix 83 | , suffix 84 | , has 85 | , begins 86 | , ends 87 | , contains 88 | , invert 89 | , once 90 | , star 91 | , plus 92 | , selfless 93 | , choice 94 | , count 95 | , lowerBounded 96 | , upperBounded 97 | , bounded 98 | , option 99 | , between 100 | , skip 101 | , within 102 | , fixed 103 | , sepBy 104 | , sepBy1 105 | 106 | -- * High-efficiency primitives 107 | , chars 108 | , chars1 109 | ) where 110 | 111 | import Control.Applicative 112 | import Control.Monad 113 | import Control.Monad.Trans.Class (lift) 114 | import Control.Monad.Trans.State 115 | import Data.Char 116 | import Data.List (foldl') 117 | import Data.Monoid 118 | import Data.String (IsString(..)) 119 | import Data.Text (Text) 120 | import qualified Data.Text as Text 121 | import Prelude -- Fix redundant import warnings 122 | 123 | -- | A fully backtracking pattern that parses an @\'a\'@ from some `Text` 124 | newtype Pattern a = Pattern { runPattern :: StateT Text [] a } 125 | deriving (Functor, Applicative, Monad, Alternative, MonadPlus) 126 | 127 | #if __GLASGOW_HASKELL__ >= 804 128 | instance Monoid a => Semigroup (Pattern a) where 129 | (<>) = mappend 130 | #endif 131 | 132 | instance Monoid a => Monoid (Pattern a) where 133 | mempty = pure mempty 134 | mappend = liftA2 mappend 135 | 136 | -- | Pattern forms a semiring, this is the closest approximation 137 | instance Monoid a => Num (Pattern a) where 138 | fromInteger n = Pattern (lift (replicate (fromInteger n) mempty)) 139 | (+) = (<|>) 140 | (*) = (<>) 141 | 142 | instance (a ~ Text) => IsString (Pattern a) where 143 | fromString str = text (Text.pack str) 144 | 145 | {-| Match a `Pattern` against a `Text` input, returning all possible solutions 146 | 147 | The `Pattern` must match the entire `Text` 148 | -} 149 | match :: Pattern a -> Text -> [a] 150 | match p = evalStateT (runPattern (p <* eof)) 151 | 152 | {-| Match any character 153 | 154 | >>> match anyChar "1" 155 | "1" 156 | >>> match anyChar "" 157 | "" 158 | -} 159 | anyChar :: Pattern Char 160 | anyChar = Pattern (do 161 | Just (c, cs) <- fmap Text.uncons get 162 | put cs 163 | return c ) 164 | 165 | {-| Matches the end of input 166 | 167 | >>> match eof "1" 168 | [] 169 | >>> match eof "" 170 | [()] 171 | -} 172 | eof :: Pattern () 173 | eof = Pattern (do 174 | True <- fmap Text.null get 175 | return () ) 176 | 177 | -- | Synonym for `anyChar` 178 | dot :: Pattern Char 179 | dot = anyChar 180 | 181 | {-| Match any character that satisfies the given predicate 182 | 183 | >>> match (satisfy (== '1')) "1" 184 | "1" 185 | >>> match (satisfy (== '2')) "1" 186 | "" 187 | -} 188 | satisfy :: (Char -> Bool) -> Pattern Char 189 | satisfy predicate = do 190 | c <- anyChar 191 | guard (predicate c) 192 | return c 193 | 194 | {-| Match a specific character 195 | 196 | >>> match (char '1') "1" 197 | "1" 198 | >>> match (char '2') "1" 199 | "" 200 | -} 201 | char :: Char -> Pattern Char 202 | char c = satisfy (== c) 203 | 204 | {-| Match any character except the given one 205 | 206 | >>> match (notChar '2') "1" 207 | "1" 208 | >>> match (notChar '1') "1" 209 | "" 210 | -} 211 | notChar :: Char -> Pattern Char 212 | notChar c = satisfy (/= c) 213 | 214 | {-| Match a specific string 215 | 216 | >>> match (text "123") "123" 217 | ["123"] 218 | 219 | You can also omit the `text` function if you enable the @OverloadedStrings@ 220 | extension: 221 | 222 | >>> match "123" "123" 223 | ["123"] 224 | -} 225 | text :: Text -> Pattern Text 226 | text before' = Pattern (do 227 | txt <- get 228 | let (before, after) = Text.splitAt (Text.length before') txt 229 | guard (before == before') 230 | put after 231 | return before) 232 | 233 | {-| Match a specific string in a case-insensitive way 234 | 235 | This only handles ASCII strings 236 | 237 | >>> match (asciiCI "abc") "ABC" 238 | ["ABC"] 239 | -} 240 | asciiCI :: Text -> Pattern Text 241 | asciiCI before' = Pattern (do 242 | txt <- get 243 | let (before, after) = Text.splitAt (Text.length before') txt 244 | guard (lowerChars before == lowerChars before') 245 | put after 246 | return before ) 247 | where 248 | lowerChars = Text.map lowerChar 249 | lowerChar c | 'A' <= c && c <= 'Z' = chr (ord c + ord 'a' - ord 'A') 250 | | otherwise = c 251 | 252 | {-| Match any one of the given characters 253 | 254 | >>> match (oneOf "1a") "1" 255 | "1" 256 | >>> match (oneOf "2a") "1" 257 | "" 258 | -} 259 | oneOf :: [Char] -> Pattern Char 260 | oneOf cs = satisfy (`elem` cs) 261 | 262 | {-| Match anything other than the given characters 263 | 264 | >>> match (noneOf "2a") "1" 265 | "1" 266 | >>> match (noneOf "1a") "1" 267 | "" 268 | -} 269 | noneOf :: [Char] -> Pattern Char 270 | noneOf cs = satisfy (`notElem` cs) 271 | 272 | {-| Match a whitespace character 273 | 274 | >>> match space " " 275 | " " 276 | >>> match space "1" 277 | "" 278 | -} 279 | space :: Pattern Char 280 | space = satisfy isSpace 281 | 282 | {-| Match zero or more whitespace characters 283 | 284 | >>> match spaces " " 285 | [" "] 286 | >>> match spaces "" 287 | [""] 288 | -} 289 | spaces :: Pattern Text 290 | spaces = star space 291 | 292 | {-| Match one or more whitespace characters 293 | 294 | >>> match spaces1 " " 295 | [" "] 296 | >>> match spaces1 "" 297 | [] 298 | -} 299 | spaces1 :: Pattern Text 300 | spaces1 = plus space 301 | 302 | {-| Match the tab character (@\'\t\'@) 303 | 304 | >>> match tab "\t" 305 | "\t" 306 | >>> match tab " " 307 | "" 308 | -} 309 | tab :: Pattern Char 310 | tab = char '\t' 311 | 312 | {-| Match the newline character (@\'\n\'@) 313 | 314 | >>> match newline "\n" 315 | "\n" 316 | >>> match newline " " 317 | "" 318 | -} 319 | newline :: Pattern Char 320 | newline = char '\n' 321 | 322 | {-| Matches a carriage return (@\'\r\'@) followed by a newline (@\'\n\'@) 323 | 324 | >>> match crlf "\r\n" 325 | ["\r\n"] 326 | >>> match crlf "\n\r" 327 | [] 328 | -} 329 | crlf :: Pattern Text 330 | crlf = text "\r\n" 331 | 332 | {-| Match an uppercase letter 333 | 334 | >>> match upper "A" 335 | "A" 336 | >>> match upper "a" 337 | "" 338 | -} 339 | upper :: Pattern Char 340 | upper = satisfy isUpper 341 | 342 | {-| Match a lowercase letter 343 | 344 | >>> match lower "a" 345 | "a" 346 | >>> match lower "A" 347 | "" 348 | -} 349 | lower :: Pattern Char 350 | lower = satisfy isLower 351 | 352 | {-| Match a letter or digit 353 | 354 | >>> match alphaNum "1" 355 | "1" 356 | >>> match alphaNum "a" 357 | "a" 358 | >>> match alphaNum "A" 359 | "A" 360 | >>> match alphaNum "." 361 | "" 362 | -} 363 | alphaNum :: Pattern Char 364 | alphaNum = satisfy isAlphaNum 365 | 366 | {-| Match a letter 367 | 368 | >>> match letter "A" 369 | "A" 370 | >>> match letter "a" 371 | "a" 372 | >>> match letter "1" 373 | "" 374 | -} 375 | letter :: Pattern Char 376 | letter = satisfy isLetter 377 | 378 | {-| Match a digit 379 | 380 | >>> match digit "1" 381 | "1" 382 | >>> match digit "a" 383 | "" 384 | -} 385 | digit :: Pattern Char 386 | digit = satisfy isDigit 387 | 388 | {-| Match a hexadecimal digit 389 | 390 | >>> match hexDigit "1" 391 | "1" 392 | >>> match hexDigit "A" 393 | "A" 394 | >>> match hexDigit "a" 395 | "a" 396 | >>> match hexDigit "g" 397 | "" 398 | -} 399 | hexDigit :: Pattern Char 400 | hexDigit = satisfy isHexDigit 401 | 402 | {-| Match an octal digit 403 | 404 | >>> match octDigit "1" 405 | "1" 406 | >>> match octDigit "9" 407 | "" 408 | -} 409 | octDigit :: Pattern Char 410 | octDigit = satisfy isOctDigit 411 | 412 | {-| Match an unsigned decimal number 413 | 414 | >>> match decimal "123" 415 | [123] 416 | >>> match decimal "-123" 417 | [] 418 | -} 419 | decimal :: Num n => Pattern n 420 | decimal = do 421 | ds <- some digit 422 | return (foldl' step 0 ds) 423 | where 424 | step n d = n * 10 + fromIntegral (ord d - ord '0') 425 | 426 | {-| Transform a numeric parser to accept an optional leading @\'+\'@ or @\'-\'@ 427 | sign 428 | 429 | >>> match (signed decimal) "+123" 430 | [123] 431 | >>> match (signed decimal) "-123" 432 | [-123] 433 | >>> match (signed decimal) "123" 434 | [123] 435 | -} 436 | signed :: Num a => Pattern a -> Pattern a 437 | signed p = do 438 | sign <- (char '+' *> pure id) <|> (char '-' *> pure negate) <|> (pure id) 439 | fmap sign p 440 | 441 | {-| @(`invert` p)@ succeeds if @p@ fails and fails if @p@ succeeds 442 | 443 | >>> match (invert "A") "A" 444 | [] 445 | >>> match (invert "A") "B" 446 | [()] 447 | >>> match (invert "A") "AA" 448 | [()] 449 | -} 450 | invert :: Pattern a -> Pattern () 451 | invert p = Pattern (StateT f) 452 | where 453 | f str = case match p str of 454 | [] -> [((), "")] 455 | _ -> [] 456 | 457 | {-| Match a `Char`, but return `Text` 458 | 459 | >>> match (once (char '1')) "1" 460 | ["1"] 461 | >>> match (once (char '1')) "" 462 | [] 463 | -} 464 | once :: Pattern Char -> Pattern Text 465 | once p = fmap Text.singleton p 466 | 467 | {-| Use this to match the prefix of a string 468 | 469 | >>> match "A" "ABC" 470 | [] 471 | >>> match (prefix "A") "ABC" 472 | ["A"] 473 | -} 474 | prefix :: Pattern a -> Pattern a 475 | prefix p = p <* chars 476 | 477 | {-| Use this to match the suffix of a string 478 | 479 | >>> match "C" "ABC" 480 | [] 481 | >>> match (suffix "C") "ABC" 482 | ["C"] 483 | -} 484 | suffix :: Pattern a -> Pattern a 485 | suffix p = chars *> p 486 | 487 | {-| Use this to match the interior of a string 488 | 489 | >>> match "B" "ABC" 490 | [] 491 | >>> match (has "B") "ABC" 492 | ["B"] 493 | -} 494 | has :: Pattern a -> Pattern a 495 | has p = chars *> p <* chars 496 | 497 | {-| Match the entire string if it begins with the given pattern 498 | 499 | This returns the entire string, not just the matched prefix 500 | 501 | >>> match (begins "A" ) "ABC" 502 | ["ABC"] 503 | >>> match (begins ("A" *> pure "1")) "ABC" 504 | ["1BC"] 505 | -} 506 | begins :: Pattern Text -> Pattern Text 507 | begins pattern = pattern <> chars 508 | 509 | {-| Match the entire string if it ends with the given pattern 510 | 511 | This returns the entire string, not just the matched prefix 512 | 513 | >>> match (ends "C" ) "ABC" 514 | ["ABC"] 515 | >>> match (ends ("C" *> pure "1")) "ABC" 516 | ["AB1"] 517 | -} 518 | ends :: Pattern Text -> Pattern Text 519 | ends pattern = chars <> pattern 520 | 521 | {-| Match the entire string if it contains the given pattern 522 | 523 | This returns the entire string, not just the interior pattern 524 | 525 | >>> match (contains "B" ) "ABC" 526 | ["ABC"] 527 | >>> match (contains ("B" *> pure "1")) "ABC" 528 | ["A1C"] 529 | -} 530 | contains :: Pattern Text -> Pattern Text 531 | contains pattern = chars <> pattern <> chars 532 | 533 | {-| Parse 0 or more occurrences of the given character 534 | 535 | >>> match (star anyChar) "123" 536 | ["123"] 537 | >>> match (star anyChar) "" 538 | [""] 539 | 540 | See also: `chars` 541 | -} 542 | star :: Pattern Char -> Pattern Text 543 | star p = fmap Text.pack (many p) 544 | 545 | {-| Parse 1 or more occurrences of the given character 546 | 547 | >>> match (plus digit) "123" 548 | ["123"] 549 | >>> match (plus digit) "" 550 | [] 551 | 552 | See also: `chars1` 553 | -} 554 | plus :: Pattern Char -> Pattern Text 555 | plus p = fmap Text.pack (some p) 556 | 557 | {-| Patterns that match multiple times are greedy by default, meaning that they 558 | try to match as many times as possible. The `selfless` combinator makes a 559 | pattern match as few times as possible 560 | 561 | This only changes the order in which solutions are returned, by prioritizing 562 | less greedy solutions 563 | 564 | >>> match (prefix (selfless (some anyChar))) "123" 565 | ["1","12","123"] 566 | >>> match (prefix (some anyChar) ) "123" 567 | ["123","12","1"] 568 | -} 569 | selfless :: Pattern a -> Pattern a 570 | selfless p = Pattern (StateT (\s -> reverse (runStateT (runPattern p) s))) 571 | 572 | {-| Apply the patterns in the list in order, until one of them succeeds 573 | 574 | >>> match (choice ["cat", "dog", "egg"]) "egg" 575 | ["egg"] 576 | >>> match (choice ["cat", "dog", "egg"]) "cat" 577 | ["cat"] 578 | >>> match (choice ["cat", "dog", "egg"]) "fan" 579 | [] 580 | -} 581 | choice :: [Pattern a] -> Pattern a 582 | choice = msum 583 | 584 | {-| Apply the given pattern a fixed number of times, collecting the results 585 | 586 | >>> match (count 3 anyChar) "123" 587 | ["123"] 588 | >>> match (count 4 anyChar) "123" 589 | [] 590 | -} 591 | count :: Int -> Pattern a -> Pattern [a] 592 | count = replicateM 593 | 594 | {-| Apply the given pattern at least the given number of times, collecting the 595 | results 596 | 597 | >>> match (lowerBounded 5 dot) "123" 598 | [] 599 | >>> match (lowerBounded 2 dot) "123" 600 | ["123"] 601 | -} 602 | lowerBounded :: Int -> Pattern a -> Pattern [a] 603 | lowerBounded n p = do 604 | ps1 <- count n p 605 | ps2 <- many p 606 | return (ps1 ++ ps2) 607 | 608 | {-| Apply the given pattern 0 or more times, up to a given bound, 609 | collecting the results 610 | 611 | >>> match (upperBounded 5 dot) "123" 612 | ["123"] 613 | >>> match (upperBounded 2 dot) "123" 614 | [] 615 | >>> match ((,) <$> upperBounded 2 dot <*> chars) "123" 616 | [("12","3"),("1","23")] 617 | -} 618 | upperBounded :: Int -> Pattern a -> Pattern [a] 619 | upperBounded n p 620 | | n <= 0 = mempty 621 | | n == 1 = fmap pure p 622 | | otherwise = (:) <$> p <*> option (upperBounded (n - 1) p) 623 | 624 | {-| Apply the given pattern a number of times restricted by given 625 | lower and upper bounds, collecting the results 626 | 627 | >>> match (bounded 2 5 "cat") "catcatcat" 628 | [["cat","cat","cat"]] 629 | >>> match (bounded 2 5 "cat") "cat" 630 | [] 631 | >>> match (bounded 2 5 "cat") "catcatcatcatcatcat" 632 | [] 633 | 634 | `bounded` could be implemented naively as follows: 635 | 636 | > bounded m n p = do 637 | > x <- choice (map pure [m..n]) 638 | > count x p 639 | 640 | -} 641 | bounded :: Int -> Int -> Pattern a -> Pattern [a] 642 | bounded m n p 643 | | m == n = count m p 644 | | m < n = (++) <$> count m p <*> option (upperBounded (n - m) p) 645 | | otherwise = mzero 646 | 647 | {-| Transform a parser to a succeed with an empty value instead of failing 648 | 649 | See also: `optional` 650 | 651 | >>> match (option "1" <> "2") "12" 652 | ["12"] 653 | >>> match (option "1" <> "2") "2" 654 | ["2"] 655 | -} 656 | option :: Monoid a => Pattern a -> Pattern a 657 | option p = p <|> mempty 658 | 659 | {-| @(between open close p)@ matches @\'p\'@ in between @\'open\'@ and 660 | @\'close\'@ 661 | 662 | >>> match (between (char '(') (char ')') (star anyChar)) "(123)" 663 | ["123"] 664 | >>> match (between (char '(') (char ')') (star anyChar)) "(123" 665 | [] 666 | -} 667 | between :: Pattern a -> Pattern b -> Pattern c -> Pattern c 668 | between open close p = open *> p <* close 669 | 670 | {-| Discard the pattern's result 671 | 672 | >>> match (skip anyChar) "1" 673 | [()] 674 | >>> match (skip anyChar) "" 675 | [] 676 | -} 677 | skip :: Pattern a -> Pattern () 678 | skip = void 679 | 680 | {-| Restrict the pattern to consume no more than the given number of characters 681 | 682 | >>> match (within 2 decimal) "12" 683 | [12] 684 | >>> match (within 2 decimal) "1" 685 | [1] 686 | >>> match (within 2 decimal) "123" 687 | [] 688 | -} 689 | within :: Int -> Pattern a -> Pattern a 690 | within n p = Pattern (do 691 | txt <- get 692 | let (before, after) = Text.splitAt n txt 693 | put before 694 | a <- runPattern p 695 | modify (<> after) 696 | return a ) 697 | 698 | {-| Require the pattern to consume exactly the given number of characters 699 | 700 | >>> match (fixed 2 decimal) "12" 701 | [12] 702 | >>> match (fixed 2 decimal) "1" 703 | [] 704 | -} 705 | fixed :: Int -> Pattern a -> Pattern a 706 | fixed n p = do 707 | txt <- Pattern get 708 | guard (Text.length txt >= n) 709 | within n (p <* eof) 710 | 711 | {-| @p `sepBy` sep@ matches zero or more occurrences of @p@ separated by @sep@ 712 | 713 | >>> match (decimal `sepBy` char ',') "1,2,3" 714 | [[1,2,3]] 715 | >>> match (decimal `sepBy` char ',') "" 716 | [[]] 717 | -} 718 | sepBy :: Pattern a -> Pattern b -> Pattern [a] 719 | p `sepBy` sep = (p `sepBy1` sep) <|> pure [] 720 | 721 | {-| @p `sepBy1` sep@ matches one or more occurrences of @p@ separated by @sep@ 722 | 723 | >>> match (decimal `sepBy1` ",") "1,2,3" 724 | [[1,2,3]] 725 | >>> match (decimal `sepBy1` ",") "" 726 | [] 727 | -} 728 | sepBy1 :: Pattern a -> Pattern b -> Pattern [a] 729 | p `sepBy1` sep = (:) <$> p <*> many (sep *> p) 730 | 731 | -- | Like @star dot@ or @star anyChar@, except more efficient 732 | chars :: Pattern Text 733 | chars = Pattern (StateT (\txt -> 734 | reverse (zip (Text.inits txt) (Text.tails txt)) )) 735 | 736 | -- | Like @plus dot@ or @plus anyChar@, except more efficient 737 | chars1 :: Pattern Text 738 | chars1 = Text.cons <$> dot <*> chars 739 | -------------------------------------------------------------------------------- /src/Turtle/Shell.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE CPP #-} 3 | {-# LANGUAGE ExistentialQuantification #-} 4 | {-# LANGUAGE RankNTypes #-} 5 | {-# OPTIONS_GHC -fno-warn-missing-methods #-} 6 | 7 | {-| You can think of `Shell` as @[]@ + `IO` + `Managed`. In fact, you can embed 8 | all three of them within a `Shell`: 9 | 10 | > select :: [a] -> Shell a 11 | > liftIO :: IO a -> Shell a 12 | > using :: Managed a -> Shell a 13 | 14 | Those three embeddings obey these laws: 15 | 16 | > do { x <- select m; select (f x) } = select (do { x <- m; f x }) 17 | > do { x <- liftIO m; liftIO (f x) } = liftIO (do { x <- m; f x }) 18 | > do { x <- with m; using (f x) } = using (do { x <- m; f x }) 19 | > 20 | > select (return x) = return x 21 | > liftIO (return x) = return x 22 | > using (return x) = return x 23 | 24 | ... and `select` obeys these additional laws: 25 | 26 | > select xs <|> select ys = select (xs <|> ys) 27 | > select empty = empty 28 | 29 | You typically won't build `Shell`s using the `Shell` constructor. Instead, 30 | use these functions to generate primitive `Shell`s: 31 | 32 | * `empty`, to create a `Shell` that outputs nothing 33 | 34 | * `return`, to create a `Shell` that outputs a single value 35 | 36 | * `select`, to range over a list of values within a `Shell` 37 | 38 | * `liftIO`, to embed an `IO` action within a `Shell` 39 | 40 | * `using`, to acquire a `Managed` resource within a `Shell` 41 | 42 | Then use these classes to combine those primitive `Shell`s into larger 43 | `Shell`s: 44 | 45 | * `Alternative`, to concatenate `Shell` outputs using (`<|>`) 46 | 47 | * `Monad`, to build `Shell` comprehensions using @do@ notation 48 | 49 | If you still insist on building your own `Shell` from scratch, then the 50 | `Shell` you build must satisfy this law: 51 | 52 | > -- For every shell `s`: 53 | > _foldShell s (FoldShell step begin done) = do 54 | > x' <- _foldShell s (FoldShell step begin return) 55 | > done x' 56 | 57 | ... which is a fancy way of saying that your `Shell` must call @\'begin\'@ 58 | exactly once when it begins and call @\'done\'@ exactly once when it ends. 59 | -} 60 | 61 | module Turtle.Shell ( 62 | -- * Shell 63 | Shell(..) 64 | , FoldShell(..) 65 | , _foldIO 66 | , _Shell 67 | , foldIO 68 | , foldShell 69 | , fold 70 | , reduce 71 | , sh 72 | , view 73 | 74 | -- * Embeddings 75 | , select 76 | , liftIO 77 | , using 78 | , fromIO 79 | ) where 80 | 81 | import Control.Applicative 82 | import Control.Monad (MonadPlus(..), ap) 83 | import Control.Monad.Catch (MonadThrow(..), MonadCatch(..)) 84 | import Control.Monad.IO.Class (MonadIO(..)) 85 | import Control.Monad.Managed (MonadManaged(..), with) 86 | import qualified Control.Monad.Fail as Fail 87 | import Control.Foldl (Fold(..), FoldM(..)) 88 | import qualified Control.Foldl as Foldl 89 | import Data.Foldable (Foldable) 90 | import qualified Data.Foldable 91 | import Data.Monoid 92 | import Data.String (IsString(..)) 93 | import Prelude -- Fix redundant import warnings 94 | 95 | {-| This is similar to @`Control.Foldl.FoldM` `IO`@ except that the @begin@ 96 | field is pure 97 | 98 | This small difference is necessary to implement a well-behaved `MonadCatch` 99 | instance for `Shell` 100 | -} 101 | data FoldShell a b = forall x . FoldShell (x -> a -> IO x) x (x -> IO b) 102 | 103 | -- | A @(Shell a)@ is a protected stream of @a@'s with side effects 104 | newtype Shell a = Shell { _foldShell:: forall r . FoldShell a r -> IO r } 105 | 106 | data Maybe' a = Just' !a | Nothing' 107 | 108 | translate :: FoldM IO a b -> FoldShell a b 109 | translate (FoldM step begin done) = FoldShell step' Nothing' done' 110 | where 111 | step' Nothing' a = do 112 | x <- begin 113 | x' <- step x a 114 | return $! Just' x' 115 | step' (Just' x) a = do 116 | x' <- step x a 117 | return $! Just' x' 118 | 119 | done' Nothing' = do 120 | x <- begin 121 | done x 122 | done' (Just' x) = do 123 | done x 124 | 125 | -- | Use a @`FoldM` `IO`@ to reduce the stream of @a@'s produced by a `Shell` 126 | foldIO :: MonadIO io => Shell a -> FoldM IO a r -> io r 127 | foldIO s f = liftIO (_foldIO s f) 128 | 129 | {-| Provided for backwards compatibility with versions of @turtle-1.4.*@ and 130 | older 131 | -} 132 | _foldIO :: Shell a -> FoldM IO a r -> IO r 133 | _foldIO s foldM = _foldShell s (translate foldM) 134 | 135 | -- | Provided for ease of migration from versions of @turtle-1.4.*@ and older 136 | _Shell :: (forall r . FoldM IO a r -> IO r) -> Shell a 137 | _Shell f = Shell (f . adapt) 138 | where 139 | adapt (FoldShell step begin done) = FoldM step (return begin) done 140 | 141 | -- | Use a `FoldShell` to reduce the stream of @a@'s produced by a `Shell` 142 | foldShell :: MonadIO io => Shell a -> FoldShell a b -> io b 143 | foldShell s f = liftIO (_foldShell s f) 144 | 145 | -- | Use a `Fold` to reduce the stream of @a@'s produced by a `Shell` 146 | fold :: MonadIO io => Shell a -> Fold a b -> io b 147 | fold s f = foldIO s (Foldl.generalize f) 148 | 149 | -- | Flipped version of 'fold'. Useful for reducing a stream of data 150 | -- 151 | -- ==== __Example__ 152 | -- Sum a `Shell` of numbers: 153 | -- 154 | -- >>> select [1, 2, 3] & reduce Fold.sum 155 | -- 6 156 | reduce :: MonadIO io => Fold a b -> Shell a -> io b 157 | reduce = flip fold 158 | 159 | -- | Run a `Shell` to completion, discarding any unused values 160 | sh :: MonadIO io => Shell a -> io () 161 | sh s = fold s (pure ()) 162 | 163 | -- | Run a `Shell` to completion, `print`ing any unused values 164 | view :: (MonadIO io, Show a) => Shell a -> io () 165 | view s = sh (do 166 | x <- s 167 | liftIO (print x) ) 168 | 169 | instance Functor Shell where 170 | fmap f s = Shell (\(FoldShell step begin done) -> 171 | let step' x a = step x (f a) 172 | in _foldShell s (FoldShell step' begin done) ) 173 | 174 | instance Applicative Shell where 175 | pure = return 176 | (<*>) = ap 177 | 178 | instance Monad Shell where 179 | return a = Shell (\(FoldShell step begin done) -> do 180 | x <- step begin a 181 | done x ) 182 | 183 | m >>= f = Shell (\(FoldShell step0 begin0 done0) -> do 184 | let step1 x a = _foldShell (f a) (FoldShell step0 x return) 185 | _foldShell m (FoldShell step1 begin0 done0) ) 186 | 187 | #if!(MIN_VERSION_base(4,13,0)) 188 | fail = Fail.fail 189 | #endif 190 | 191 | instance Alternative Shell where 192 | empty = Shell (\(FoldShell _ begin done) -> done begin) 193 | 194 | s1 <|> s2 = Shell (\(FoldShell step begin done) -> do 195 | x <- _foldShell s1 (FoldShell step begin return) 196 | _foldShell s2 (FoldShell step x done) ) 197 | 198 | instance MonadPlus Shell where 199 | mzero = empty 200 | 201 | mplus = (<|>) 202 | 203 | instance MonadIO Shell where 204 | liftIO io = Shell (\(FoldShell step begin done) -> do 205 | a <- io 206 | x <- step begin a 207 | done x ) 208 | 209 | instance MonadManaged Shell where 210 | using resource = Shell (\(FoldShell step begin done) -> do 211 | x <- with resource (step begin) 212 | done x ) 213 | 214 | instance MonadThrow Shell where 215 | throwM e = Shell (\_ -> throwM e) 216 | 217 | instance MonadCatch Shell where 218 | m `catch` k = Shell (\f-> _foldShell m f `catch` (\e -> _foldShell (k e) f)) 219 | 220 | instance Fail.MonadFail Shell where 221 | fail _ = mzero 222 | 223 | #if __GLASGOW_HASKELL__ >= 804 224 | instance Monoid a => Semigroup (Shell a) where 225 | (<>) = mappend 226 | #endif 227 | 228 | instance Monoid a => Monoid (Shell a) where 229 | mempty = pure mempty 230 | mappend = liftA2 mappend 231 | 232 | -- | Shell forms a semiring, this is the closest approximation 233 | instance Monoid a => Num (Shell a) where 234 | fromInteger n = select (replicate (fromInteger n) mempty) 235 | 236 | (+) = (<|>) 237 | (*) = (<>) 238 | 239 | instance IsString a => IsString (Shell a) where 240 | fromString str = pure (fromString str) 241 | 242 | -- | Convert a list to a `Shell` that emits each element of the list 243 | select :: Foldable f => f a -> Shell a 244 | select as = Shell (\(FoldShell step begin done) -> do 245 | let step' a k x = do 246 | x' <- step x a 247 | k $! x' 248 | Data.Foldable.foldr step' done as $! begin ) 249 | 250 | -- | Convert an `IO` action that returns a `Maybe` into a `Shell` 251 | fromIO :: IO (Maybe a) -> Shell a 252 | fromIO io = 253 | Shell 254 | (\(FoldShell step begin done) -> do 255 | let loop x = do 256 | m <- io 257 | case m of 258 | Just a -> do 259 | x' <- step x a 260 | loop x' 261 | Nothing -> do 262 | done x 263 | 264 | loop begin 265 | ) 266 | -------------------------------------------------------------------------------- /stack-lts-10.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-10.2 2 | extra-deps: [] 3 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-19.5 -------------------------------------------------------------------------------- /test/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Test.DocTest 4 | 5 | main :: IO () 6 | main = doctest 7 | [ "src/Turtle/Pattern.hs" 8 | , "src/Turtle/Format.hs" 9 | , "src/Turtle/Line.hs" 10 | ] 11 | -------------------------------------------------------------------------------- /test/RegressionBrokenPipe.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | import Control.Monad 3 | import System.Timeout 4 | import Turtle 5 | import qualified Turtle.Bytes as Bytes 6 | 7 | main :: IO () 8 | main = do 9 | echo "proc (text)" 10 | void $ timeout duration $ forever $ proc "true" [] message 11 | echo "procStrict (text)" 12 | void $ timeout duration $ forever $ procStrict "true" [] message 13 | echo "procStrictWithErr (text)" 14 | void $ timeout duration $ forever $ procStrictWithErr "true" [] message 15 | echo "proc (bytes)" 16 | void $ timeout duration $ forever $ Bytes.proc "true" [] message 17 | echo "procStrict (bytes)" 18 | void $ timeout duration $ forever $ Bytes.procStrict "true" [] message 19 | echo "procStrictWithErr (bytes)" 20 | void $ timeout duration $ forever $ Bytes.procStrictWithErr "true" [] message 21 | where 22 | message :: IsString s => s 23 | message = "foobarbaz" 24 | duration = 3 * 10^ (6 :: Int) 25 | -------------------------------------------------------------------------------- /test/RegressionMaskingException.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | import Turtle 4 | 5 | -- This test fails by hanging 6 | main :: IO () 7 | main = runManaged (do 8 | _ <- fork (shells "while true; do sleep 1; done" empty) 9 | sleep 1 10 | return () ) 11 | -------------------------------------------------------------------------------- /test/cptree.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | import Turtle 4 | import System.IO.Temp (withSystemTempDirectory) 5 | import qualified Control.Monad.Fail as Fail 6 | import Control.Monad (unless) 7 | 8 | check :: String -> Bool-> IO () 9 | check errorMessage successs = unless successs $ Fail.fail errorMessage 10 | 11 | main :: IO () 12 | main = withSystemTempDirectory "tempDir" (runTest . fromString) 13 | 14 | runTest :: Turtle.FilePath -> IO () 15 | runTest tempDir = do 16 | let srcDirectory = tempDir "src" 17 | 18 | mktree $ srcDirectory "directory" 19 | touch $ srcDirectory "directory" "file" 20 | 21 | let destDirectory = tempDir "dest" 22 | 23 | cptree srcDirectory destDirectory 24 | 25 | testdir (destDirectory "directory") >>= check "cptree did not preserve directory" 26 | testfile (destDirectory "directory" "file") >>= check "cptree did not preserve directory" 27 | -------------------------------------------------------------------------------- /test/system-filepath.hs: -------------------------------------------------------------------------------- 1 | {-# Language CPP #-} 2 | {-# Options_GHC -Wno-deprecations #-} 3 | 4 | module Main (main) where 5 | 6 | import Test.Tasty 7 | import Test.Tasty.HUnit 8 | import Turtle 9 | 10 | main :: IO () 11 | main = defaultMain $ testGroup "system-filepath tests" 12 | [ test_Root 13 | , test_Directory 14 | , test_Parent 15 | , test_CommonPrefix 16 | , test_StripPrefix 17 | , test_Collapse 18 | , test_Filename 19 | , test_Dirname 20 | , test_Basename 21 | , test_Absolute 22 | , test_Relative 23 | , test_SplitDirectories 24 | , test_SplitExtension 25 | ] 26 | 27 | test_Root :: TestTree 28 | test_Root = testCase "root" $ do 29 | "" @=? root "" 30 | #if defined(mingw32_HOST_OS) || defined(__MINGW32__) 31 | "c:\\" @=? root "c:\\" 32 | "c:\\" @=? root "c:\\foo" 33 | #else 34 | "/" @=? root "/" 35 | "/" @=? root "/foo" 36 | #endif 37 | "" @=? root "foo" 38 | 39 | test_Directory :: TestTree 40 | test_Directory = testCase "directory" $ do 41 | "./" @=? directory "" 42 | "/" @=? directory "/" 43 | "/foo/" @=? directory "/foo/bar" 44 | "/foo/bar/" @=? directory "/foo/bar/" 45 | "./" @=? directory "." 46 | "../" @=? directory ".." 47 | "../" @=? directory "../foo" 48 | "../foo/" @=? directory "../foo/" 49 | "./" @=? directory "foo" 50 | "foo/" @=? directory "foo/bar" 51 | 52 | test_Parent :: TestTree 53 | test_Parent = testCase "parent" $ do 54 | -- The behavior in the presence of `.` / `..` is messed up, but that's how 55 | -- the old system-filepath package worked, so we're preserving that for 56 | -- backwards compatibility (for now) 57 | "./" @=? parent "" 58 | "./" @=? parent "." 59 | "./" @=? parent ".." 60 | "/" @=? parent "/.." 61 | "/" @=? parent "/." 62 | "./" @=? parent "./." 63 | "./" @=? parent "./.." 64 | "../" @=? parent "../.." 65 | "../" @=? parent "../." 66 | 67 | #if defined(mingw32_HOST_OS) || defined(__MINGW32__) 68 | "c:\\" @=? parent "c:\\" 69 | #else 70 | "/" @=? parent "/" 71 | #endif 72 | "./" @=? parent "foo" 73 | "./" @=? parent "./foo" 74 | "./foo/" @=? parent "foo/bar" 75 | "./foo/" @=? parent "foo/bar/" 76 | "./foo/" @=? parent "./foo/bar" 77 | "/" @=? parent "/foo" 78 | "/foo/" @=? parent "/foo/bar" 79 | 80 | test_Filename :: TestTree 81 | test_Filename = testCase "filename" $ do 82 | "" @=? filename "" 83 | "" @=? filename "." 84 | "" @=? filename ".." 85 | "" @=? filename "/" 86 | "" @=? filename "/foo/" 87 | "bar" @=? filename "/foo/bar" 88 | "bar.txt" @=? filename "/foo/bar.txt" 89 | 90 | test_Dirname :: TestTree 91 | test_Dirname = testCase "dirname" $ do 92 | "" @=? dirname "" 93 | "" @=? dirname "/" 94 | "" @=? dirname "foo" 95 | ".." @=? dirname ".." 96 | "foo" @=? dirname "foo/bar" 97 | "bar" @=? dirname "foo/bar/" 98 | "bar" @=? dirname "foo/bar/baz.txt" 99 | 100 | -- the directory name will be re-parsed to a file name. 101 | let dirnameExts q = snd (splitExtensions (dirname q)) 102 | ["d"] @=? dirnameExts "foo.d/bar" 103 | 104 | test_Basename :: TestTree 105 | test_Basename = testCase "basename" $ do 106 | "" @=? basename ".." 107 | "" @=? basename "/" 108 | "" @=? basename "." 109 | ".txt" @=? basename ".txt" 110 | "foo" @=? basename "foo.txt" 111 | "bar" @=? basename "foo/bar.txt" 112 | 113 | #if defined(mingw32_HOST_OS) || defined(__MINGW32__) 114 | "bar" @=? basename "c:\\foo\\bar" 115 | "bar" @=? basename "c:\\foo\\bar.txt" 116 | #else 117 | "bar" @=? basename "/foo/bar" 118 | "bar" @=? basename "/foo/bar.txt" 119 | #endif 120 | 121 | test_Absolute :: TestTree 122 | test_Absolute = testCase "absolute" $ do 123 | let myAssert q = assertBool ("absolute " ++ show q) $ absolute q 124 | let myAssert' q = assertBool ("not $ absolute " ++ show q) $ not $ absolute q 125 | 126 | #if defined(mingw32_HOST_OS) || defined(__MINGW32__) 127 | myAssert "c:\\" 128 | myAssert "c:\\foo\\bar" 129 | myAssert' "" 130 | myAssert' "foo\\bar" 131 | myAssert' "\\foo\\bar" 132 | #else 133 | myAssert "/" 134 | myAssert "/foo/bar" 135 | myAssert' "" 136 | myAssert' "foo/bar" 137 | #endif 138 | 139 | 140 | test_Relative :: TestTree 141 | test_Relative = testCase "relative" $ do 142 | let myAssert q = assertBool ("relative " ++ show q) $ relative q 143 | let myAssert' q = assertBool ("not $ relative " ++ show q) $ not $ relative q 144 | 145 | #if defined(mingw32_HOST_OS) || defined(__MINGW32__) 146 | myAssert' "c:\\" 147 | myAssert' "c:\\foo\\bar" 148 | myAssert "" 149 | myAssert "foo\\bar" 150 | #else 151 | myAssert' "/" 152 | myAssert' "/foo/bar" 153 | myAssert "" 154 | myAssert "foo/bar" 155 | #endif 156 | 157 | test_CommonPrefix :: TestTree 158 | test_CommonPrefix = testCase "commonPrefix" $ do 159 | "" @=? commonPrefix [] 160 | "./" @=? commonPrefix [".", "."] 161 | "" @=? commonPrefix [".", ".."] 162 | "foo/" @=? commonPrefix ["foo/bar", "foo/baz"] 163 | "foo/a.b" @=? commonPrefix ["foo/a.b.c", "foo/a.b.d"] 164 | "" @=? commonPrefix ["foo/", "bar/"] 165 | 166 | test_StripPrefix :: TestTree 167 | test_StripPrefix = testCase "stripPrefix" $ do 168 | Just "" @=? stripPrefix "" "" 169 | Just "/" @=? stripPrefix "" "/" 170 | Just "" @=? stripPrefix "/" "/" 171 | Just "foo" @=? stripPrefix "/" "/foo" 172 | Just "foo" @=? stripPrefix "./" "./foo" 173 | Just "foo.ext" @=? stripPrefix "./" "./foo.ext" 174 | Just "foo/bar" @=? stripPrefix "/" "/foo/bar" 175 | Just "bar" @=? stripPrefix "/foo/" "/foo/bar" 176 | Just "bar/baz" @=? stripPrefix "/foo/" "/foo/bar/baz" 177 | Just ".txt" @=? stripPrefix "/foo/bar" "/foo/bar.txt" 178 | Just ".gz" @=? stripPrefix "/foo/bar.txt" "/foo/bar.txt.gz" 179 | 180 | -- Test ignoring non-matching prefixes 181 | Nothing @=? stripPrefix "/foo" "/foo/bar" 182 | Nothing @=? stripPrefix "/foo/bar/baz" "/foo" 183 | Nothing @=? stripPrefix "/foo/baz/" "/foo/bar/qux" 184 | Nothing @=? stripPrefix "/foo/bar/baz" "/foo/bar/qux" 185 | 186 | test_Collapse :: TestTree 187 | test_Collapse = testCase "collapse" $ do 188 | -- This behavior differs from the old `system-filepath` package, but this 189 | -- behavior is more correct in the presence of symlinks 190 | #if defined(mingw32_HOST_OS) || defined(__MINGW32__) 191 | "foo\\..\\bar" @=? collapse "foo/../bar" 192 | "foo\\bar" @=? collapse "foo/bar" 193 | "foo\\bar" @=? collapse "foo/./bar" 194 | #else 195 | "foo/../bar" @=? collapse "foo/../bar" 196 | "foo/bar" @=? collapse "foo/bar" 197 | "foo/bar" @=? collapse "foo/./bar" 198 | #endif 199 | 200 | test_SplitDirectories :: TestTree 201 | test_SplitDirectories = testCase "splitDirectories" $ do 202 | [] @=? splitDirectories "" 203 | ["./"] @=? splitDirectories "." 204 | ["../"] @=? splitDirectories ".." 205 | ["foo/", "../"] @=? splitDirectories "foo/.." 206 | ["foo/", "./"] @=? splitDirectories "foo/." 207 | ["/"] @=? splitDirectories "/" 208 | ["/", "a"] @=? splitDirectories "/a" 209 | ["/", "ab/", "cd"] @=? splitDirectories "/ab/cd" 210 | ["/", "ab/", "cd/"] @=? splitDirectories "/ab/cd/" 211 | ["ab/", "cd"] @=? splitDirectories "ab/cd" 212 | ["ab/", "cd/"] @=? splitDirectories "ab/cd/" 213 | ["ab/", "cd.txt"] @=? splitDirectories "ab/cd.txt" 214 | ["ab/", "cd/", ".txt"] @=? splitDirectories "ab/cd/.txt" 215 | ["ab/", "./", "cd"] @=? splitDirectories "ab/./cd" 216 | 217 | test_SplitExtension :: TestTree 218 | test_SplitExtension = testCase "splitExtension" $ do 219 | ("", Nothing) @=? splitExtension "" 220 | ("foo", Nothing) @=? splitExtension "foo" 221 | ("foo", Just "") @=? splitExtension "foo." 222 | ("foo", Just "a") @=? splitExtension "foo.a" 223 | ("foo.a/", Nothing) @=? splitExtension "foo.a/" 224 | ("foo.a/bar", Nothing) @=? splitExtension "foo.a/bar" 225 | ("foo.a/bar", Just "b") @=? splitExtension "foo.a/bar.b" 226 | ("foo.a/bar.b", Just "c") @=? splitExtension "foo.a/bar.b.c" 227 | -------------------------------------------------------------------------------- /turtle.cabal: -------------------------------------------------------------------------------- 1 | Name: turtle 2 | Version: 1.6.2 3 | Cabal-Version: >=1.10 4 | Build-Type: Simple 5 | License: BSD3 6 | License-File: LICENSE 7 | Copyright: 2015 Gabriella Gonzalez 8 | Author: Gabriella Gonzalez 9 | Maintainer: GenuineGabriella@gmail.com 10 | Bug-Reports: https://github.com/Gabriella439/turtle/issues 11 | Synopsis: Shell programming, Haskell-style 12 | Description: @turtle@ is a reimplementation of the Unix command line environment 13 | in Haskell so that you can use Haskell as both a shell and a scripting 14 | language. 15 | . 16 | Features include: 17 | . 18 | * Batteries included: Command an extended suite of predefined utilities 19 | . 20 | * Interoperability: You can still run external shell commands 21 | . 22 | * Portability: Works on Windows, OS X, and Linux 23 | . 24 | * Exception safety: Safely acquire and release resources 25 | . 26 | * Streaming: Transform or fold command output in constant space 27 | . 28 | * Patterns: Use typed regular expressions that can parse structured values 29 | . 30 | * Formatting: Type-safe @printf@-style text formatting 31 | . 32 | * Modern: Supports @text@ 33 | . 34 | Read "Turtle.Tutorial" for a detailed tutorial or "Turtle.Prelude" for a 35 | quick-start guide 36 | . 37 | @turtle@ is designed to be beginner-friendly, but as a result lacks certain 38 | features, like tracing commands. If you feel comfortable using @turtle@ 39 | then you should also check out the @Shelly@ library which provides similar 40 | functionality. 41 | Category: System 42 | 43 | Tested-With: 44 | GHC == 9.6.1 45 | GHC == 9.4.4 46 | GHC == 9.2.7 47 | GHC == 9.0.2 48 | GHC == 8.10.7 49 | GHC == 8.8.4 50 | GHC == 8.6.5 51 | GHC == 8.4.4 52 | GHC == 8.2.2 53 | GHC == 8.0.2 54 | 55 | Extra-Source-Files: 56 | CHANGELOG.md 57 | 58 | Source-Repository head 59 | Type: git 60 | Location: https://github.com/Gabriella439/turtle 61 | 62 | Flag new-deps 63 | Description: Use new versions of ansi-wl-pprint and optparse-applicative 64 | Manual: False 65 | Default: True 66 | 67 | Library 68 | HS-Source-Dirs: src 69 | Build-Depends: 70 | -- 2021-09-07: Turtle.Prelude uses GHC-8.0 features, so base >= 4.9 71 | base >= 4.9 && < 5 , 72 | async >= 2.0.0.0 && < 2.3 , 73 | bytestring >= 0.9.1.8 && < 0.13, 74 | clock >= 0.4.1.2 && < 0.9 , 75 | containers >= 0.5.0.0 && < 0.8 , 76 | directory >= 1.3.1.0 && < 1.4 , 77 | exceptions >= 0.4 && < 0.11, 78 | filepath >= 1.4.1.2 && < 1.6 , 79 | foldl >= 1.1 && < 1.5 , 80 | hostname < 1.1 , 81 | managed >= 1.0.3 && < 1.1 , 82 | process >= 1.0.1.1 && < 1.7 , 83 | stm < 2.6 , 84 | streaming-commons < 0.3 , 85 | temporary < 1.4 , 86 | text >= 1.0.0 && < 2.2 , 87 | time < 1.15, 88 | transformers >= 0.2.0.0 && < 0.7 , 89 | optional-args >= 1.0 && < 2.0 , 90 | unix-compat >= 0.4 && < 0.8 91 | if os(windows) 92 | Build-Depends: Win32 >= 2.12 93 | else 94 | Build-Depends: unix >= 2.5.1.0 && < 2.9 95 | 96 | -- A possible Cabal issue makes it try an old version of ansi-wl-pprint 97 | -- even though a newer would work. 98 | -- See discussion in https://github.com/Gabriella439/turtle/pull/446 99 | if flag(new-deps) 100 | Build-Depends: ansi-wl-pprint >= 1.0 && < 1.1 , 101 | optparse-applicative >= 0.18 && < 0.19 102 | else 103 | Build-Depends: ansi-wl-pprint >= 0.6 && < 1.0 , 104 | optparse-applicative >= 0.16 && < 0.18 105 | 106 | Exposed-Modules: 107 | Turtle, 108 | Turtle.Bytes, 109 | Turtle.Format, 110 | Turtle.Pattern, 111 | Turtle.Shell, 112 | Turtle.Options, 113 | Turtle.Line, 114 | Turtle.Prelude, 115 | Turtle.Tutorial 116 | Other-Modules: 117 | Turtle.Internal 118 | GHC-Options: -Wall 119 | Default-Language: Haskell2010 120 | 121 | test-suite tests 122 | Type: exitcode-stdio-1.0 123 | HS-Source-Dirs: test 124 | Main-Is: Main.hs 125 | GHC-Options: -Wall 126 | Default-Language: Haskell2010 127 | Build-Depends: 128 | base >= 4 && < 5 , 129 | doctest >= 0.7 130 | 131 | test-suite regression-broken-pipe 132 | Type: exitcode-stdio-1.0 133 | HS-Source-Dirs: test 134 | Main-Is: RegressionBrokenPipe.hs 135 | GHC-Options: -Wall -threaded 136 | Default-Language: Haskell2010 137 | Build-Depends: 138 | base >= 4 && < 5, 139 | turtle 140 | 141 | test-suite regression-masking-exception 142 | Type: exitcode-stdio-1.0 143 | HS-Source-Dirs: test 144 | Main-Is: RegressionMaskingException.hs 145 | GHC-Options: -Wall -threaded 146 | Default-Language: Haskell2010 147 | Build-Depends: 148 | base >= 4 && < 5, 149 | turtle 150 | 151 | test-suite cptree 152 | Type: exitcode-stdio-1.0 153 | HS-Source-Dirs: test 154 | Main-Is: cptree.hs 155 | GHC-Options: -Wall -threaded 156 | Default-Language: Haskell2010 157 | Build-Depends: 158 | base >= 4 && < 5, 159 | temporary, 160 | filepath >= 0.4, 161 | turtle 162 | 163 | test-suite system-filepath-tests 164 | Type: exitcode-stdio-1.0 165 | HS-Source-Dirs: test 166 | Main-Is: system-filepath.hs 167 | GHC-Options: -Wall -threaded 168 | Default-Language: Haskell2010 169 | Build-Depends: 170 | base, 171 | filepath, 172 | tasty >=1.4 && <1.6, 173 | tasty-hunit >=0.10 && <0.11, 174 | turtle 175 | 176 | benchmark bench 177 | Type: exitcode-stdio-1.0 178 | HS-Source-Dirs: bench 179 | Main-Is: Main.hs 180 | GHC-Options: -O2 -Wall -threaded 181 | Default-Language: Haskell2010 182 | Build-Depends: 183 | base >= 4 && < 5 , 184 | tasty-bench >= 0.3.1 , 185 | text < 2.2, 186 | turtle 187 | --------------------------------------------------------------------------------