├── .github └── workflows │ └── haskell-ci.yml ├── .gitignore ├── .stylish-haskell.yaml ├── Makefile ├── README.md ├── build-in-docker.sh ├── cabal-bundler ├── Changelog.md ├── LICENSE ├── LICENSE.GPLv2 ├── LICENSE.GPLv3 ├── cabal-bundler.cabal ├── cli │ └── Main.hs ├── data │ └── single.nix ├── fixtures │ ├── cabal-fmt.plan.json │ ├── derivation.nix │ ├── fetch-with-curl.sh │ └── openbsd-ports.txt ├── src │ └── CabalBundler │ │ ├── Curl.hs │ │ ├── ExeOption.hs │ │ ├── Main.hs │ │ ├── NixBase32.hs │ │ ├── NixSingle.hs │ │ ├── NixSingle │ │ ├── Input.hs │ │ └── Template.hs │ │ └── OpenBSD.hs └── tests │ └── Tests.hs ├── cabal-core-inspection ├── Changelog.md ├── LICENSE ├── LICENSE.GPLv2 ├── LICENSE.GPLv3 ├── README.md ├── cabal-core-inspection.cabal ├── cli │ └── Main.hs ├── example │ ├── cabal-core-inspection-examples.cabal │ ├── cabal.project │ ├── core-inspection.json │ ├── example.sh │ └── src │ │ ├── Example.hs │ │ └── GenericEq.hs └── src │ └── CabalCoreInspection │ ├── GHC.hs │ ├── GHC │ ├── DynFlags.hs │ └── Show.hs │ └── Main.hs ├── cabal-deps ├── .gitmodules ├── Changelog.md ├── LICENSE ├── LICENSE.GPLv2 ├── LICENSE.GPLv3 ├── cabal-deps.cabal ├── cli │ └── Main.hs └── src │ └── CabalDeps │ └── Main.hs ├── cabal-diff ├── .gitmodules ├── Changelog.md ├── LICENSE ├── LICENSE.GPLv2 ├── LICENSE.GPLv3 ├── cabal-diff.cabal ├── cli │ └── Main.hs ├── fixtures │ ├── colour-2.3.4.golden │ ├── colour-2.3.4.txt │ ├── colour-2.3.5.golden │ ├── colour-2.3.5.txt │ ├── foldable1.golden │ ├── foldable1.txt │ ├── optics-core.golden │ ├── optics-core.txt │ ├── resolv.golden │ ├── resolv.txt │ ├── servant.golden │ ├── servant.txt │ ├── singletons.golden │ ├── singletons.txt │ ├── vec.golden │ └── vec.txt ├── src │ └── CabalDiff │ │ ├── Diff.hs │ │ ├── Hoogle.hs │ │ └── Main.hs └── test │ └── Golden.hs ├── cabal-docspec ├── .gitignore ├── Changelog.md ├── LICENSE ├── LICENSE.GPLv2 ├── LICENSE.GPLv3 ├── MANUAL.md ├── Makefile ├── cabal-docspec.1 ├── cabal-docspec.cabal ├── cli │ └── Main.hs ├── cpphs │ ├── LICENCE-GPL │ ├── LICENCE-LGPL │ ├── LICENCE-commercial │ ├── Language │ │ └── Preprocessor │ │ │ ├── Cpphs.hs │ │ │ ├── Cpphs │ │ │ ├── CppIfdef.hs │ │ │ ├── HashDefine.hs │ │ │ ├── MacroPass.hs │ │ │ ├── Options.hs │ │ │ ├── Position.hs │ │ │ ├── ReadFirst.hs │ │ │ ├── RunCpphs.hs │ │ │ ├── SymTab.hs │ │ │ └── Tokenise.hs │ │ │ └── Unlit.hs │ ├── README │ └── cpphs.cabal ├── src │ ├── CabalDocspec │ │ ├── Cpp.hs │ │ ├── Diff.hs │ │ ├── Doctest │ │ │ ├── Example.hs │ │ │ ├── Extract.hs │ │ │ └── Parse.hs │ │ ├── ExprVars.hs │ │ ├── GHCi.hs │ │ ├── Lexer.hs │ │ ├── Library.hs │ │ ├── Located.hs │ │ ├── Main.hs │ │ ├── Man.hs │ │ ├── Man │ │ │ └── Content.hs │ │ ├── Opts.hs │ │ ├── Package.hs │ │ ├── Phase1.hs │ │ ├── Phase2.hs │ │ ├── Summary.hs │ │ ├── Trace.hs │ │ └── Warning.hs │ └── System │ │ └── Process │ │ └── Interactive.hs └── tests │ └── tests.hs ├── cabal-env ├── Changelog.md ├── LICENSE ├── LICENSE.GPLv2 ├── LICENSE.GPLv3 ├── cabal-env.cabal ├── cli │ └── Main.hs └── src │ └── CabalEnv │ ├── Environment.hs │ ├── Main.hs │ └── Warning.hs ├── cabal-haddock-server ├── Changelog.md ├── LICENSE ├── LICENSE.GPLv2 ├── LICENSE.GPLv3 ├── README.md ├── cabal-haddock-server.cabal ├── cli │ └── Main.hs ├── src │ └── CabalHaddockServer │ │ ├── DocsContents.hs │ │ ├── Hoogle.hs │ │ ├── Main.hs │ │ ├── Options.hs │ │ ├── Pages │ │ ├── Error.hs │ │ ├── Index.hs │ │ ├── NotFound.hs │ │ ├── Package.hs │ │ ├── Redirect.hs │ │ └── Search.hs │ │ ├── Routes.hs │ │ ├── Static.hs │ │ ├── TopPage.hs │ │ ├── Wai.hs │ │ └── Warning.hs └── static │ └── bootstrap.min.css ├── cabal-hasklint ├── .gitignore ├── Changelog.md ├── LICENSE ├── LICENSE.GPLv2 ├── LICENSE.GPLv3 ├── cabal-hasklint.cabal ├── cli │ └── Main.hs ├── cpphs │ ├── LICENCE-GPL │ ├── LICENCE-LGPL │ ├── LICENCE-commercial │ ├── Language │ │ └── Preprocessor │ │ │ ├── Cpphs.hs │ │ │ ├── Cpphs │ │ │ ├── CppIfdef.hs │ │ │ ├── HashDefine.hs │ │ │ ├── MacroPass.hs │ │ │ ├── Options.hs │ │ │ ├── Position.hs │ │ │ ├── ReadFirst.hs │ │ │ ├── RunCpphs.hs │ │ │ ├── SymTab.hs │ │ │ └── Tokenise.hs │ │ │ └── Unlit.hs │ ├── README │ └── cpphs.cabal ├── src │ └── CabalHasklint │ │ ├── Cpp.hs │ │ ├── GHC │ │ └── Utils.hs │ │ ├── Lint.hs │ │ ├── Main.hs │ │ ├── Opts.hs │ │ ├── Package.hs │ │ ├── Parse.hs │ │ ├── Trace.hs │ │ └── Warning.hs └── tests │ └── tests.hs ├── cabal-hie ├── .gitmodules ├── Changelog.md ├── LICENSE ├── LICENSE.GPLv2 ├── LICENSE.GPLv3 ├── cabal-hie.cabal ├── cli │ └── Main.hs └── src │ └── CabalHie │ └── Main.hs ├── cabal-iface-query ├── Changelog.md ├── LICENSE ├── LICENSE.GPLv2 ├── LICENSE.GPLv3 ├── cabal-iface-query.cabal ├── cli │ └── Main.hs └── src │ └── CabalIfaceQuery │ ├── GHC.hs │ ├── GHC │ ├── DynFlags.hs │ └── Show.hs │ └── Main.hs ├── cabal-store-check ├── .gitmodules ├── Changelog.md ├── LICENSE ├── LICENSE.GPLv2 ├── LICENSE.GPLv3 ├── cabal-store-check.cabal ├── cli │ └── Main.hs └── src │ └── CabalStoreCheck │ └── Main.hs ├── cabal-store-gc ├── .gitmodules ├── Changelog.md ├── LICENSE ├── LICENSE.GPLv2 ├── LICENSE.GPLv3 ├── cabal-store-gc.cabal ├── cli │ └── Main.hs └── src │ └── CabalStoreGC │ ├── Deps.hs │ └── Main.hs ├── cabal.haskell-ci ├── cabal.project ├── cabal.project.local.sample ├── extras ├── gentle-introduction-2024.4.1.tar.gz └── hooglite-0.20240409.tar.gz ├── fragments └── boot-deps.fragment ├── hie.yaml ├── paths-0.2.0.0 ├── ChangeLog.md ├── LICENSE ├── Setup.hs ├── paths.cabal └── src │ └── System │ ├── Path.hs │ └── Path │ ├── IO.hs │ ├── Internal.hs │ ├── Internal │ ├── Compat.hs │ └── Native.hs │ ├── Lens.hs │ ├── QQ.hs │ └── Unsafe.hs └── peura ├── LICENSE ├── LICENSE.GPLv2 ├── LICENSE.GPLv3 ├── peura.cabal ├── src ├── Peura.hs └── Peura │ ├── Async.hs │ ├── ByteString.hs │ ├── Cabal.hs │ ├── Debug.hs │ ├── Exports.hs │ ├── GHC.hs │ ├── Glob.hs │ ├── Monad.hs │ ├── Orphans.hs │ ├── Paths.hs │ ├── Process.hs │ ├── Run.hs │ ├── Serialise.hs │ ├── Temporary.hs │ ├── Trace.hs │ ├── Tracer.hs │ └── Warning.hs └── test ├── TestProcess.hs └── Tests.hs /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | dist-newstyle/ 3 | cabal.project.local 4 | .ghc.environment.* 5 | test-actual 6 | test-expected 7 | test-lock 8 | deps.png 9 | 10 | -- testing cabal-bundler 11 | derivation.nix 12 | default.nix 13 | result 14 | 15 | -------------------------------------------------------------------------------- /.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | steps: 2 | - imports: 3 | align: group 4 | list_align: after_alias 5 | long_list_align: new_line 6 | empty_list_align: right_after 7 | list_padding: module_name 8 | - language_pragmas: 9 | style: vertical 10 | remove_redundant: true 11 | - trailing_whitespace: {} 12 | columns: 120 13 | language_extensions: 14 | - BangPatterns 15 | - DataKinds 16 | - DeriveAnyClass 17 | - DeriveFunctor 18 | - DeriveGeneric 19 | - DerivingStrategies 20 | - EmptyCase 21 | - ExplicitForAll 22 | - FlexibleContexts 23 | - FunctionalDependencies 24 | - GADTs 25 | - GeneralizedNewtypeDeriving 26 | - MultiParamTypeClasses 27 | - MultiWayIf 28 | - OverloadedLabels 29 | - OverloadedStrings 30 | - ScopedTypeVariables 31 | - TypeApplications 32 | - TypeFamilies 33 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | INSTALL_FLAGS= 2 | 3 | all : 4 | @echo done nothing 5 | 6 | cabal-diff-test-colour : 7 | cabal v2-run cabal-diff:cabal-diff colour 2.3.4 2.3.5 8 | 9 | install-env : 10 | cabal v2-install cabal-env --overwrite-policy=always $(INSTALL_FLAGS) 11 | 12 | install-diff : 13 | cabal v2-install cabal-diff --overwrite-policy=always $(INSTALL_FLAGS) 14 | 15 | install-deps : 16 | cabal v2-install cabal-deps --overwrite-policy=always $(INSTALL_FLAGS) 17 | 18 | install-docspec : 19 | cabal v2-install cabal-docspec --overwrite-policy=always $(INSTALL_FLAGS) 20 | 21 | install-bundler : 22 | cabal v2-install cabal-bundler --overwrite-policy=always $(INSTALL_FLAGS) 23 | 24 | install-store-check : 25 | cabal v2-install cabal-store-check --overwrite-policy=always $(INSTALL_FLAGS) 26 | 27 | install-store-gc : 28 | cabal v2-install cabal-store-gc --overwrite-policy=always $(INSTALL_FLAGS) 29 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # cabal-extras 2 | 3 | A tool suite to aid Haskell development using `cabal-install`. 4 | There are four tools in this repository: 5 | - `cabal-env`: An experiment on what `cabal install --lib` could be. 6 | - `cabal-diff`: Compare API of different package versions 7 | - `cabal-bundler`: (ab)use `cabal-install` solver to build standalone installation bundles 8 | - `cabal-deps`: An experiment on what `cabal outdated` could be. 9 | - `cabal-store-check`: A naive tool to try to repair cabal's nix-store 10 | 11 | All tools are highly experimental, although I (Oleg Grenrus) use them daily. 12 | 13 | There's also [`cabal-fmt`](https://hackage.haskell.org/package/cabal-fmt), a `.cabal` file formatter, but it's more standalone tool. 14 | 15 | # Installation 16 | 17 | To install individual executables from this repository, 18 | 19 | 1. Make sure you have `GHC-8.2` and `cabal-install-3.0` or later installed. 20 | 2. Clone it with `git clone https://github.com/phadej/cabal-extras.git` 21 | 3. Install individual executables with `make install-cabal-env`, `make install-cabal-deps` etc. 22 | 23 | You can pass flags to `cabal install` by setting `INSTALL_FLAGS`, e.g. 24 | 25 | ``` 26 | make INSTALL_FLAGS="--installdir $HOME/bin --install-method copy" install-cabal-env 27 | ``` 28 | 29 | # Executables 30 | 31 | ## cabal-bundler 32 | 33 | TBW 34 | 35 | ## cabal-diff 36 | 37 | TBW 38 | 39 | ## cabal-deps 40 | 41 | TBW 42 | 43 | ## cabal-env 44 | 45 | ### Synopsis 46 | 47 | ``` 48 | $ cabal-env optics 49 | $ ghci 50 | Prelude> import Optics 51 | Prelude Optics> 52 | ``` 53 | 54 | TBW 55 | 56 | ## cabal-store-check 57 | 58 | This is a small script which can find some broken packages in cabal nix-store. 59 | It's a proof-of-concept of 60 | 61 | - https://gitlab.haskell.org/ghc/ghc/merge_requests/2284 62 | - https://github.com/haskell/cabal/issues/6060 63 | 64 | ### Synopsis 65 | 66 | ``` 67 | # Check if store package db is inconsistent 68 | $ cabal-store-check 69 | ... 70 | [ 0.64132] error: haskell-ci-0.3.20190327-98543f1828739a9ad62f8722220f5d812f7f4a13f6fe2745a286c227593452b9 interface file for HaskellCI is missing 71 | ... 72 | 73 | # You can remove broken packages with, which would repair the state 74 | $ cabal-store-check --repair 75 | ``` 76 | 77 | ## cabal-store-gc 78 | 79 | This is another small script to reduce size of cabal's nix-store. 80 | 81 | ### Synopsis 82 | 83 | ```bash 84 | # Add possible current projects dependencies as in direct root, 85 | # and print reclaiming information 86 | $ cabal-store-gc 87 | ... 88 | ... 89 | [ 16.89166] info: 262 components are referenced from the roots 90 | [ 16.89714] info: 183 components are in the store 91 | [ 16.89726] info: 393 components can be removed from the store 92 | [ 17.71338] info: 2328 MB can be freed 93 | 94 | # If you want to perform the cleanup 95 | $ cabal-store-gc --collect 96 | 97 | # For more information, see 98 | $ cabal-store-gc --help 99 | ``` 100 | 101 | ### Roots 102 | 103 | There are three kind of roots, which retain the packages in the store: 104 | 105 | - executables in `installdir`. These are automatic roots. 106 | - packages references from environments in `~/.ghc/.../environments/...`. These are also automatic roots. 107 | - indirect roots, which are links from `~/.cabal/store/roots` to `plan.json`s 108 | elsewhere in the file system. Indirect links allow to retain development 109 | project dependencies. 110 | New indirect roots can be added with `--add-project-root` or `--add-root` actions. 111 | -------------------------------------------------------------------------------- /build-in-docker.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # Run this script with 4 | # 5 | # sh build-in-docker.sh 6 | # 7 | # To produce a simple bindist in dist-newstyle/bindist 8 | 9 | set -ex 10 | 11 | if [ "x$DOCKER" = "xYES" ]; then 12 | # Install cabal-plan 13 | mkdir -p "$HOME/.cabal/bin" 14 | curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.6.2.0/cabal-plan-0.6.2.0-x86_64-linux.xz > cabal-plan.xz 15 | echo "de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz" | sha256sum -c - 16 | xz -d < cabal-plan.xz > "$HOME/.cabal/bin/cabal-plan" 17 | rm -f cabal-plan.xz 18 | chmod a+x "$HOME/.cabal/bin/cabal-plan" 19 | 20 | cd /build 21 | cabal update 22 | 23 | cd /build/src 24 | cabal build --builddir=/build/builddir all 25 | 26 | TARGETS="cabal-bundler cabal-deps cabal-docspec cabal-diff cabal-env cabal-store-check cabal-store-gc" 27 | VERSION=$(date +'%Y%m%d') 28 | 29 | for TARGET in $TARGETS; do 30 | cp "$(cabal-plan list-bin --builddir=/build/builddir "$TARGET")" "/build/bindist/$TARGET" 31 | strip "/build/bindist/$TARGET" 32 | xz -c < "/build/bindist/$TARGET" > "/build/bindist/$TARGET-$VERSION-x86_64-linux.xz" 33 | done 34 | 35 | ls -lh /build/bindist 36 | 37 | else 38 | 39 | mkdir -p dist-newstyle/bindist 40 | docker run --rm -ti -e DOCKER=YES -v "$(pwd):/build/src:ro" -v "$(pwd)/dist-newstyle/bindist:/build/bindist" phadej/ghc:8.6.5-xenial sh /build/src/build-in-docker.sh 41 | cd dist-newstyle/bindist 42 | sha256sum cabal-*.xz > SHA256SUMS 43 | gpg2 --sign --detach-sig --armor SHA256SUMS 44 | 45 | fi 46 | -------------------------------------------------------------------------------- /cabal-bundler/Changelog.md: -------------------------------------------------------------------------------- 1 | # 0.1 2 | 3 | First release 4 | -------------------------------------------------------------------------------- /cabal-bundler/LICENSE: -------------------------------------------------------------------------------- 1 | SPDX-License-Identifier: GPL-2.0-or-later 2 | 3 | Copyright (c) 2019 Oleg Grenrus 4 | 5 | This library is free software: you may copy, redistribute and/or modify it 6 | under the terms of the GNU General Public License as published by the 7 | Free Software Foundation, either version 3 of the License, or (at your 8 | option) any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but 11 | WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program (see `LICENSE.GPLv3`). If not, see 17 | . 18 | -------------------------------------------------------------------------------- /cabal-bundler/cabal-bundler.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: cabal-bundler 3 | version: 0.1 4 | synopsis: 5 | Bundle cabal packages for installation in different environments. 6 | 7 | category: Development 8 | description: 9 | Bundle cabal packages for installation in different environments. 10 | Supported variants: 11 | . 12 | * @nix-single@: A single Nix-derivation 13 | * @curl@: Fetch packages with cURL 14 | 15 | license: GPL-3.0-or-later AND BSD-3-Clause 16 | license-file: LICENSE 17 | author: Oleg Grenrus 18 | maintainer: Oleg Grenrus 19 | tested-with: GHC ==9.8.4 20 | extra-source-files: 21 | Changelog.md 22 | data/single.nix 23 | fixtures/cabal-fmt.plan.json 24 | fixtures/derivation.nix 25 | fixtures/fetch-with-curl.sh 26 | 27 | source-repository head 28 | type: git 29 | location: https://github.com/phadej/cabal-extras 30 | 31 | library cabal-bundler-internal 32 | default-language: Haskell2010 33 | hs-source-dirs: src 34 | ghc-options: -Wall 35 | exposed-modules: 36 | CabalBundler.Curl 37 | CabalBundler.ExeOption 38 | CabalBundler.Main 39 | CabalBundler.NixBase32 40 | CabalBundler.NixSingle 41 | CabalBundler.NixSingle.Input 42 | CabalBundler.NixSingle.Template 43 | CabalBundler.OpenBSD 44 | 45 | other-modules: Paths_cabal_bundler 46 | autogen-modules: Paths_cabal_bundler 47 | 48 | -- ghc-boot dependencies 49 | -- cabal-fmt: fragment ../fragments/boot-deps.fragment 50 | build-depends: 51 | , base ^>=4.19.0.0 52 | , binary ^>=0.8.9.0 53 | , bytestring ^>=0.12.0.2 54 | , containers ^>=0.6.8 55 | , deepseq ^>=1.5.0.0 56 | , directory ^>=1.3.8.1 57 | , filepath ^>=1.4.100.4 58 | , mtl ^>=2.3.1 59 | , parsec ^>=3.1.17.0 60 | , pretty ^>=1.1.3.6 61 | , process ^>=1.6.18.0 62 | , stm ^>=2.5.0.0 63 | , template-haskell 64 | , text ^>=2.1 65 | 66 | -- We use Cabal-3.12 67 | build-depends: Cabal ^>=3.12.1.0 68 | 69 | -- We also use peura 70 | build-depends: peura 71 | 72 | -- dependencies in library 73 | build-depends: 74 | , cabal-install-parsers 75 | , cabal-plan 76 | , optparse-applicative ^>=0.18.0.0 77 | , topograph 78 | , vector 79 | , zinza ^>=0.2 80 | 81 | default-extensions: 82 | NoImplicitPrelude 83 | OverloadedStrings 84 | 85 | executable cabal-bundler 86 | default-language: Haskell2010 87 | hs-source-dirs: cli 88 | main-is: Main.hs 89 | ghc-options: -Wall -threaded 90 | build-depends: 91 | , base 92 | , cabal-bundler-internal 93 | 94 | test-suite cabal-bundler-tests 95 | default-language: Haskell2010 96 | type: exitcode-stdio-1.0 97 | ghc-options: -Wall -threaded 98 | hs-source-dirs: tests 99 | main-is: Tests.hs 100 | build-depends: 101 | , base 102 | , Cabal 103 | , cabal-bundler-internal 104 | , cabal-install-parsers 105 | , cabal-plan 106 | , directory 107 | , filepath 108 | , peura 109 | 110 | -- test dependencies 111 | build-depends: 112 | , tasty ^>=1.5 113 | , tasty-golden ^>=2.3.4 114 | -------------------------------------------------------------------------------- /cabal-bundler/cli/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | import CabalBundler.Main (main) 3 | -------------------------------------------------------------------------------- /cabal-bundler/fixtures/fetch-with-curl.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # This file is generated with cabal-bundler 3 | 4 | set -ex 5 | 6 | cat < SHA256SUMS 7 | f0862eca5ef06da6e6a592c452a747a953e52adce6f66246d3c7a0aa458dfe35 Cabal-3.0.0.0.cabal 8 | 5143ec26d740c1a508c93a8860e64407e7546c29b9817db20ff1595c1968d287 Cabal-3.0.0.0.tar.gz 9 | 31397cff165772b6c3725583cd45e535145945ad7dd5251a79342c84cc4726ac ansi-terminal-0.10.1.tar.gz 10 | fb737bc96e2aef34ad595d54ced7a73f648c521ebcb00fe0679aff45ccd49212 ansi-wl-pprint-0.6.9.cabal 11 | a7b2e8e7cd3f02f2954e8b17dc60a0ccd889f49e2068ebb15abfa1d42f7a4eac ansi-wl-pprint-0.6.9.tar.gz 12 | a9595b2bd73aefebafdd358564bfe5a78aafab29b5d62ff43eb0fe428f0e1d1e cabal-fmt-0.1.1.tar.gz 13 | 3b8d471979617dce7c193523743c9782df63433d8e87e3ef6d97922e0da104e7 colour-2.3.5.tar.gz 14 | 29ff6146aabf54d46c4c8788e8d1eadaea27c94f6d360c690c5f6c93dac4b07e optparse-applicative-0.15.1.0.cabal 15 | 4db3675fd1e0594afdf079db46f4cd412d483835d703e7c07e1a1a37d6f046f3 optparse-applicative-0.15.1.0.tar.gz 16 | da67cf11515da751b32a8ce6e96549f7268f7c435769ad19dc9766b69774620b transformers-compat-0.6.5.tar.gz 17 | EOF 18 | 19 | curl --silent --location --output Cabal-3.0.0.0.cabal 'http://hackage.haskell.org/package/Cabal-3.0.0.0/revision/1.cabal' 20 | curl --silent --location --output Cabal-3.0.0.0.tar.gz 'http://hackage.haskell.org/package/Cabal-3.0.0.0/Cabal-3.0.0.0.tar.gz' 21 | curl --silent --location --output ansi-terminal-0.10.1.tar.gz 'http://hackage.haskell.org/package/ansi-terminal-0.10.1/ansi-terminal-0.10.1.tar.gz' 22 | curl --silent --location --output ansi-wl-pprint-0.6.9.cabal 'http://hackage.haskell.org/package/ansi-wl-pprint-0.6.9/revision/4.cabal' 23 | curl --silent --location --output ansi-wl-pprint-0.6.9.tar.gz 'http://hackage.haskell.org/package/ansi-wl-pprint-0.6.9/ansi-wl-pprint-0.6.9.tar.gz' 24 | curl --silent --location --output cabal-fmt-0.1.1.tar.gz 'http://hackage.haskell.org/package/cabal-fmt-0.1.1/cabal-fmt-0.1.1.tar.gz' 25 | curl --silent --location --output colour-2.3.5.tar.gz 'http://hackage.haskell.org/package/colour-2.3.5/colour-2.3.5.tar.gz' 26 | curl --silent --location --output optparse-applicative-0.15.1.0.cabal 'http://hackage.haskell.org/package/optparse-applicative-0.15.1.0/revision/1.cabal' 27 | curl --silent --location --output optparse-applicative-0.15.1.0.tar.gz 'http://hackage.haskell.org/package/optparse-applicative-0.15.1.0/optparse-applicative-0.15.1.0.tar.gz' 28 | curl --silent --location --output transformers-compat-0.6.5.tar.gz 'http://hackage.haskell.org/package/transformers-compat-0.6.5/transformers-compat-0.6.5.tar.gz' 29 | 30 | sha256sum -c SHA256SUMS 31 | -------------------------------------------------------------------------------- /cabal-bundler/fixtures/openbsd-ports.txt: -------------------------------------------------------------------------------- 1 | MODCABAL_STEM = cabal-fmt 2 | MODCABAL_VERSION = 0.1.1 3 | MODCABAL_MANIFEST = \ 4 | Cabal 3.0.0.0 1 \ 5 | ansi-terminal 0.10.1 0 \ 6 | ansi-wl-pprint 0.6.9 4 \ 7 | colour 2.3.5 0 \ 8 | optparse-applicative 0.15.1.0 1 \ 9 | transformers-compat 0.6.5 0 \ 10 | -------------------------------------------------------------------------------- /cabal-bundler/src/CabalBundler/ExeOption.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor #-} 2 | module CabalBundler.ExeOption where 3 | 4 | import Peura 5 | import Prelude () 6 | 7 | import Distribution.Types.UnqualComponentName (UnqualComponentName) 8 | 9 | 10 | data ExeOption a 11 | = ExeOptionPkg a -- ^ derive from package identifier 12 | | ExeOptionAll -- ^ all executables 13 | | ExeOption UnqualComponentName -- ^ given name 14 | deriving (Functor) 15 | -------------------------------------------------------------------------------- /cabal-bundler/src/CabalBundler/NixBase32.hs: -------------------------------------------------------------------------------- 1 | module CabalBundler.NixBase32 ( 2 | encodeBase32, 3 | ) where 4 | 5 | import Peura 6 | 7 | import Prelude (splitAt) 8 | 9 | import Data.Bits 10 | 11 | import qualified Data.Vector.Unboxed as V 12 | import qualified Data.ByteString as BS 13 | 14 | -- | Print 'BS.ByteString' in Nix favoured base32. 15 | -- 16 | -- This implementation is not efficient, but it's obvious what happens. 17 | -- Plenty of 'reverse' is due "Big-endianess" of nix variant. 18 | encodeBase32 :: BS.ByteString -> String 19 | encodeBase32 20 | = reverse 21 | . map (toChar . bitsToBits . reverse) 22 | . chunks 5 23 | . reverse 24 | . concatMap w8ToBits 25 | . reverse 26 | . BS.unpack 27 | where 28 | toChar :: Int -> Char 29 | toChar i = charsBase32 V.! i 30 | 31 | charsBase32 :: V.Vector Char 32 | charsBase32 = V.fromList "0123456789abcdfghijklmnpqrsvwxyz" 33 | 34 | ------------------------------------------------------------------------------- 35 | -- C "reference" implementation 36 | ------------------------------------------------------------------------------- 37 | 38 | -- 39 | -- 40 | -- static string printHash32(const Hash & hash) 41 | -- { 42 | -- assert(hash.hashSize); 43 | -- size_t len = hash.base32Len(); 44 | -- assert(len); 45 | -- 46 | -- string s; 47 | -- s.reserve(len); 48 | -- 49 | -- for (int n = (int) len - 1; n >= 0; n--) { 50 | -- unsigned int b = n * 5; 51 | -- unsigned int i = b / 8; 52 | -- unsigned int j = b % 8; 53 | -- unsigned char c = 54 | -- (hash.hash[i] >> j) 55 | -- | (i >= hash.hashSize - 1 ? 0 : hash.hash[i + 1] << (8 - j)); 56 | -- s.push_back(base32Chars[c & 0x1f]); 57 | -- } 58 | -- 59 | -- return s; 60 | -- } 61 | 62 | _encodeBase32 :: BS.ByteString -> String 63 | _encodeBase32 bs 64 | | BS.length bs == 32 = 65 | [ digits32 V.! (idx .&. 0x1f) 66 | | n <- reverse [ 0 .. len - 1] 67 | , let b = n * 5 68 | , let (i, j) = b `divMod` 8 69 | , let idx = fromIntegral (BS.index bs i) `shiftR` j .|. if i >= 32 - 1 then 0 else fromIntegral (BS.index bs (succ i)) `shiftL` (8 - j) 70 | ] 71 | | otherwise = "" 72 | where 73 | len = 52 -- length of hash 74 | 75 | digits32 :: V.Vector Char 76 | digits32 = V.fromList "0123456789abcdfghijklmnpqrsvwxyz" 77 | 78 | 79 | ------------------------------------------------------------------------------- 80 | -- Bit streams 81 | ------------------------------------------------------------------------------- 82 | 83 | data Bit = B0 | B1 84 | deriving (Show) 85 | 86 | w8ToBits :: Word8 -> [Bit] 87 | w8ToBits w = map toBit 88 | [ w .&. 0x80 89 | , w .&. 0x40 90 | , w .&. 0x20 91 | , w .&. 0x10 92 | , w .&. 0x08 93 | , w .&. 0x04 94 | , w .&. 0x02 95 | , w .&. 0x01 96 | ] 97 | where 98 | toBit 0 = B0 99 | toBit _ = B1 100 | 101 | bitsToBits :: Bits a => [Bit] -> a 102 | bitsToBits = foldl' f zeroBits where 103 | f x B0 = x `shiftL` 1 104 | f x B1 = (x `shiftL` 1) `setBit` 0 105 | 106 | chunks :: Int -> [a] -> [[a]] 107 | chunks _ [] = [] 108 | chunks n xs = ys : chunks n zs 109 | where 110 | (ys, zs) = splitAt n xs 111 | -------------------------------------------------------------------------------- /cabal-bundler/src/CabalBundler/NixSingle/Input.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | module CabalBundler.NixSingle.Input ( 3 | ZZ (..), 4 | ZDep (..), 5 | ) where 6 | 7 | import Peura 8 | import qualified Zinza 9 | 10 | -- cabal repl cabal-bundler-internal 11 | -- :m *CabalBundler.NixSingle.Input 12 | -- import Prelude (writeFile) 13 | -- Zinza.parseAndCompileModuleIO _moduleConfig "data/single.nix" >>= writeFile "src/CabalBundler/NixSingle/Template.hs" 14 | 15 | _moduleConfig :: Zinza.ModuleConfig ZZ 16 | _moduleConfig = Zinza.simpleConfig "CabalBundler.NixSingle.Template" 17 | [ "CabalBundler.NixSingle.Input" 18 | ] 19 | 20 | data ZZ = ZZ 21 | { zDerivationName :: String 22 | , zComponentName :: String 23 | , zExecutableName :: String 24 | , zCdeps :: [String] 25 | , zHsdeps :: NonEmpty ZDep 26 | } 27 | deriving (Show, Generic) 28 | 29 | instance Zinza.Zinza ZZ where 30 | toType = Zinza.genericToTypeSFP 31 | toValue = Zinza.genericToValueSFP 32 | fromValue = Zinza.genericFromValueSFP 33 | 34 | data ZDep = ZDep 35 | { zdepName :: String 36 | , zdepVersion :: String 37 | , zdepSha256 :: String 38 | , zdepRevision :: String 39 | } 40 | deriving (Show, Generic) 41 | 42 | instance Zinza.Zinza ZDep where 43 | toType = Zinza.genericToTypeSFP 44 | toValue = Zinza.genericToValueSFP 45 | fromValue = Zinza.genericFromValueSFP 46 | -------------------------------------------------------------------------------- /cabal-bundler/tests/Tests.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Peura 4 | import Prelude () 5 | 6 | import Data.List (isPrefixOf) 7 | import Test.Tasty (TestName, TestTree, defaultMain, testGroup) 8 | import Test.Tasty.Golden (goldenVsStringDiff) 9 | 10 | import qualified Cabal.Index as I 11 | import qualified Cabal.Plan as P 12 | import qualified Distribution.Types.UnqualComponentName as C 13 | import qualified System.Directory as Dir 14 | import qualified System.FilePath as FP 15 | 16 | import CabalBundler.Curl (generateCurl) 17 | import CabalBundler.ExeOption 18 | import CabalBundler.NixSingle (generateDerivationNix) 19 | import CabalBundler.OpenBSD (generateOpenBSD) 20 | 21 | main :: IO () 22 | main = do 23 | (_, meta) <- liftIO I.cachedHackageMetadata 24 | 25 | cwd <- Dir.getCurrentDirectory 26 | let pwd = case reverse (FP.splitPath cwd) of 27 | segment : _ | "cabal-bundler" `isPrefixOf` segment -> cwd 28 | _ -> cwd FP. "cabal-bundler" 29 | 30 | let nullTracer' = nullTracer :: TracerPeu () Void 31 | 32 | let golden :: TestName -> Peu () ByteString -> TestTree 33 | golden name action = goldenVsStringDiff 34 | name 35 | diffProc 36 | (pwd FP. "fixtures" FP. name) 37 | (runPeu nullTracer' () (fmap toLazy action)) 38 | 39 | let pn = mkPackageName "cabal-fmt" 40 | exeName = ExeOption (C.mkUnqualComponentName "cabal-fmt") 41 | 42 | defaultMain $ testGroup "cabal-bundler" 43 | [ golden "derivation.nix" $ do 44 | planPath <- makeAbsoluteFilePath $ pwd FP. "fixtures/cabal-fmt.plan.json" 45 | plan <- liftIO $ P.decodePlanJson (toFilePath planPath) 46 | script <- generateDerivationNix nullTracer' pn exeName plan meta 47 | 48 | return (toUTF8BS script) 49 | 50 | , golden "fetch-with-curl.sh"$ do 51 | planPath <- makeAbsoluteFilePath $ pwd FP. "fixtures/cabal-fmt.plan.json" 52 | plan <- liftIO $ P.decodePlanJson (toFilePath planPath) 53 | script <- generateCurl nullTracer' pn exeName plan meta 54 | 55 | return (toUTF8BS script) 56 | 57 | , golden "openbsd-ports.txt" $ do 58 | planPath <- makeAbsoluteFilePath $ pwd FP. "fixtures/cabal-fmt.plan.json" 59 | plan <- liftIO $ P.decodePlanJson (toFilePath planPath) 60 | script <- generateOpenBSD nullTracer' pn exeName plan meta 61 | 62 | return (toUTF8BS script) 63 | ] 64 | where 65 | diffProc ref new = ["diff", "-u", ref, new] 66 | 67 | -------------------------------------------------------------------------------- /cabal-core-inspection/Changelog.md: -------------------------------------------------------------------------------- 1 | # 0.1 2 | 3 | First release 4 | -------------------------------------------------------------------------------- /cabal-core-inspection/LICENSE: -------------------------------------------------------------------------------- 1 | SPDX-License-Identifier: GPL-2.0-or-later 2 | 3 | Copyright (c) 2019 Oleg Grenrus 4 | 5 | This library is free software: you may copy, redistribute and/or modify it 6 | under the terms of the GNU General Public License as published by the 7 | Free Software Foundation, either version 3 of the License, or (at your 8 | option) any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but 11 | WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program (see `LICENSE.GPLv3`). If not, see 17 | . 18 | -------------------------------------------------------------------------------- /cabal-core-inspection/cabal-core-inspection.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: cabal-core-inspection 3 | version: 0.1 4 | synopsis: Core inspection 5 | category: Development 6 | description: Core inspection. 7 | license: GPL-3.0-or-later AND BSD-3-Clause 8 | license-file: LICENSE 9 | author: Oleg Grenrus 10 | maintainer: Oleg Grenrus 11 | tested-with: GHC ==9.8.4 12 | extra-source-files: Changelog.md 13 | 14 | source-repository head 15 | type: git 16 | location: https://github.com/phadej/cabal-extras 17 | 18 | library cabal-core-inspection-internal 19 | default-language: Haskell2010 20 | hs-source-dirs: src 21 | ghc-options: -Wall 22 | exposed-modules: 23 | CabalCoreInspection.GHC 24 | CabalCoreInspection.GHC.DynFlags 25 | CabalCoreInspection.GHC.Show 26 | CabalCoreInspection.Main 27 | 28 | other-modules: Paths_cabal_core_inspection 29 | autogen-modules: Paths_cabal_core_inspection 30 | 31 | -- ghc-boot dependencies 32 | -- cabal-fmt: fragment ../fragments/boot-deps.fragment 33 | build-depends: 34 | , base ^>=4.19.0.0 35 | , binary ^>=0.8.9.0 36 | , bytestring ^>=0.12.0.2 37 | , containers ^>=0.6.8 38 | , deepseq ^>=1.5.0.0 39 | , directory ^>=1.3.8.1 40 | , filepath ^>=1.4.100.4 41 | , mtl ^>=2.3.1 42 | , parsec ^>=3.1.17.0 43 | , pretty ^>=1.1.3.6 44 | , process ^>=1.6.18.0 45 | , stm ^>=2.5.0.0 46 | , template-haskell 47 | , text ^>=2.1 48 | 49 | build-depends: 50 | , ghc 51 | , ghc-boot 52 | 53 | -- We use Cabal-3.12 54 | build-depends: Cabal ^>=3.12.1.0 55 | 56 | -- We also use peura 57 | build-depends: peura 58 | 59 | -- dependencies in library 60 | build-depends: 61 | , aeson 62 | , cabal-install-parsers 63 | , cabal-plan 64 | , debruijn ^>=0.1 65 | , Glob 66 | , optparse-applicative ^>=0.18.0.0 67 | 68 | default-extensions: 69 | NoImplicitPrelude 70 | OverloadedStrings 71 | 72 | executable cabal-core-inspection 73 | default-language: Haskell2010 74 | hs-source-dirs: cli 75 | main-is: Main.hs 76 | ghc-options: -Wall -threaded 77 | build-depends: 78 | , base 79 | , cabal-core-inspection-internal 80 | -------------------------------------------------------------------------------- /cabal-core-inspection/cli/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | import CabalCoreInspection.Main (main) 3 | -------------------------------------------------------------------------------- /cabal-core-inspection/example/cabal-core-inspection-examples.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | name: cabal-core-inspection-examples 3 | version: 0 4 | 5 | library 6 | default-language: Haskell2010 7 | default-extensions: DeriveGeneric FlexibleContexts GADTs TypeOperators 8 | hs-source-dirs: src 9 | build-depends: 10 | , base 11 | , bytestring 12 | , text 13 | 14 | exposed-modules: Example GenericEq 15 | -------------------------------------------------------------------------------- /cabal-core-inspection/example/cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | 3 | with-compiler: ghc-9.8.2 4 | 5 | package cabal-core-inspection-examples 6 | ghc-options: -fwrite-if-simplified-core 7 | -------------------------------------------------------------------------------- /cabal-core-inspection/example/core-inspection.json: -------------------------------------------------------------------------------- 1 | [] 2 | -------------------------------------------------------------------------------- /cabal-core-inspection/example/example.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | THISDIR=$(pwd) 4 | cd ../ || exit 5 | 6 | cabal build cabal-core-inspection:exe:cabal-core-inspection || exit 7 | COREINSP=$(cabal-plan list-bin cabal-core-inspection) 8 | 9 | cd "$THISDIR" || exit 10 | 11 | cabal build 12 | $COREINSP -w ghc-9.8.2 13 | -------------------------------------------------------------------------------- /cabal-core-inspection/example/src/Example.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -ddump-simpl -dsuppress-all #-} 2 | module Example where 3 | 4 | import Data.ByteString (ByteString) 5 | import GHC.Generics (Generic) 6 | 7 | import qualified Data.Text as T 8 | import qualified Data.Text.Encoding as TE 9 | 10 | import GenericEq 11 | 12 | ------------------------------------------------------------------------------- 13 | -- text 14 | ------------------------------------------------------------------------------- 15 | 16 | countChars :: ByteString -> Int 17 | countChars = T.length . T.toUpper . TE.decodeUtf8 18 | {-# INLINE countChars #-} 19 | 20 | 21 | ------------------------------------------------------------------------------- 22 | -- Generic equality 23 | ------------------------------------------------------------------------------- 24 | 25 | data T where 26 | T1 :: Int -> Char -> T 27 | T2 :: Bool -> Double -> T 28 | T3 :: ByteString -> T.Text -> T 29 | deriving Generic 30 | 31 | {- 32 | data T where 33 | T1 :: Int -> T 34 | T2 :: Bool -> T 35 | T3 :: Char -> T 36 | T4 :: Double -> T 37 | deriving Generic 38 | -} 39 | 40 | instance Eq T where 41 | (==) = genericEq 42 | -------------------------------------------------------------------------------- /cabal-core-inspection/example/src/GenericEq.hs: -------------------------------------------------------------------------------- 1 | module GenericEq (genericEq) where 2 | 3 | import GHC.Generics 4 | 5 | genericEq :: (Generic a, GEq (Rep a)) => a -> a -> Bool 6 | genericEq = \ x y -> geq (from x) (from y) 7 | {-# INLINE genericEq #-} 8 | 9 | class GEq f where 10 | geq :: f a -> f a -> Bool 11 | 12 | instance (GEqSum f, i ~ D) => GEq (M1 i c f) where 13 | geq (M1 x) (M1 y) = geqSum x y 14 | {-# INLINE geq #-} 15 | 16 | class GEqSum f where 17 | geqSum :: f a -> f a -> Bool 18 | 19 | instance (GEqSum f, GEqSum g) => GEqSum (f :+: g) where 20 | geqSum (L1 x) (L1 y) = geqSum x y 21 | geqSum (R1 x) (R1 y) = geqSum x y 22 | geqSum _ _ = False 23 | {-# INLINE geqSum #-} 24 | 25 | instance (GEqProduct f, i ~ C) => GEqSum (M1 i c f) where 26 | geqSum (M1 x) (M1 y) = geqProduct x y 27 | {-# INLINE geqSum #-} 28 | 29 | class GEqProduct f where 30 | geqProduct :: f a -> f a -> Bool 31 | 32 | instance (GEqProduct f, GEqProduct g) => GEqProduct (f :*: g) where 33 | geqProduct (x1 :*: y1) (x2 :*: y2) = 34 | geqProduct x1 x2 && geqProduct y1 y2 35 | {-# INLINE geqProduct #-} 36 | 37 | instance (GEqField f, i ~ S) => GEqProduct (M1 i c f) where 38 | geqProduct (M1 x) (M1 y) = geqField x y 39 | {-# INLINE geqProduct #-} 40 | 41 | class GEqField f where 42 | geqField :: f a -> f a -> Bool 43 | 44 | instance (Eq a, i ~ R) => GEqField (K1 i a) where 45 | geqField (K1 x) (K1 y) = x == y 46 | {-# INLINE geqField #-} 47 | -------------------------------------------------------------------------------- /cabal-core-inspection/src/CabalCoreInspection/GHC.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | {-# OPTIONS -Wno-missing-fields #-} 4 | module CabalCoreInspection.GHC ( 5 | -- * DynFlags 6 | getDynFlags, 7 | -- * Other 8 | easyReadBinIface, 9 | ghcShow, 10 | ghcShowIfaceClsInst, 11 | ) where 12 | 13 | import Peura 14 | 15 | import GHC.Driver.Session (targetProfile) 16 | import GHC.Iface.Binary (CheckHiWay (CheckHiWay), TraceBinIFace (QuietBinIFace), readBinIface) 17 | import GHC.Iface.Syntax (IfaceClsInst (..), IfaceTyCon (..)) 18 | import GHC.Types.Name (nameModule_maybe) 19 | import GHC.Types.Name.Cache (NameCache) 20 | import GHC.Unit.Module.ModIface (ModIface) 21 | 22 | import CabalCoreInspection.GHC.DynFlags 23 | import CabalCoreInspection.GHC.Show 24 | 25 | ------------------------------------------------------------------------------- 26 | -- "Easy" interface 27 | ------------------------------------------------------------------------------- 28 | 29 | easyReadBinIface :: DynFlags -> NameCache -> Path Absolute -> IO ModIface 30 | easyReadBinIface dflags nc path = 31 | readBinIface (targetProfile dflags) nc CheckHiWay QuietBinIFace (toFilePath path) 32 | 33 | ------------------------------------------------------------------------------- 34 | -- Showing 35 | ------------------------------------------------------------------------------- 36 | 37 | ghcShowIfaceClsInst :: DynFlags -> IfaceClsInst -> String 38 | ghcShowIfaceClsInst dflags ifci = unwords $ 39 | "instance" : 40 | ghcShow dflags (ifInstCls ifci) : 41 | [ maybe "_" (ghcShow dflags) tyCon 42 | | tyCon <- ifInstTys ifci 43 | ] ++ 44 | extras 45 | where 46 | extras = case ifInstTys ifci of 47 | (Just (IfaceTyCon n _) : _) -> 48 | maybe [] (\m -> ["(from " ++ ghcShow dflags m ++ ")"]) (nameModule_maybe n) 49 | _ -> [] 50 | 51 | -------------------------------------------------------------------------------- /cabal-core-inspection/src/CabalCoreInspection/GHC/DynFlags.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module CabalCoreInspection.GHC.DynFlags ( 3 | DynFlags, 4 | getDynFlags, 5 | ) where 6 | 7 | import Peura 8 | 9 | import GHC.Driver.Session (DynFlags, defaultDynFlags) 10 | import GHC.SysTools (initSysTools) 11 | 12 | -- | Get 'DynFlags' given 'GhcInfo' for this GHC. 13 | getDynFlags :: TracerPeu r w -> GhcInfo -> Peu r DynFlags 14 | getDynFlags tracer ghcInfo = do 15 | unless (VERSION_ghc == prettyShow (ghcVersion ghcInfo)) $ do 16 | die tracer $ "Compiler version mismatch: " ++ 17 | VERSION_ghc ++ " /= " ++ prettyShow (ghcVersion ghcInfo) 18 | 19 | let libDir = toFilePath $ ghcLibDir ghcInfo 20 | settings <- liftIO $ initSysTools libDir 21 | return $ defaultDynFlags settings 22 | -------------------------------------------------------------------------------- /cabal-core-inspection/src/CabalCoreInspection/GHC/Show.hs: -------------------------------------------------------------------------------- 1 | module CabalCoreInspection.GHC.Show ( 2 | ghcShow, 3 | ) where 4 | 5 | import Prelude (String, (.)) 6 | 7 | import GHC.Driver.Session (DynFlags, initSDocContext) 8 | import GHC.Utils.Outputable (Outputable, defaultDumpStyle, ppr, showSDocOneLine) 9 | 10 | ghcShow :: Outputable t => DynFlags -> t -> String 11 | ghcShow dflags = showSDocOneLine (initSDocContext dflags defaultDumpStyle) . ppr 12 | -------------------------------------------------------------------------------- /cabal-deps/.gitmodules: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/phadej/cabal-extras/cf4fd3ee047fc8a6c6ca9d0868a701b851f94037/cabal-deps/.gitmodules -------------------------------------------------------------------------------- /cabal-deps/Changelog.md: -------------------------------------------------------------------------------- 1 | # 0.1 2 | 3 | First release 4 | -------------------------------------------------------------------------------- /cabal-deps/LICENSE: -------------------------------------------------------------------------------- 1 | SPDX-License-Identifier: GPL-2.0-or-later 2 | 3 | Copyright (c) 2019 Oleg Grenrus 4 | 5 | This library is free software: you may copy, redistribute and/or modify it 6 | under the terms of the GNU General Public License as published by the 7 | Free Software Foundation, either version 3 of the License, or (at your 8 | option) any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but 11 | WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program (see `LICENSE.GPLv3`). If not, see 17 | . 18 | -------------------------------------------------------------------------------- /cabal-deps/cabal-deps.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: cabal-deps 3 | version: 0.1 4 | synopsis: Check that dependencies are up to date 5 | category: Development 6 | description: 7 | Check the project or package(s) dependencies are up to date. 8 | 9 | license: GPL-2.0-or-later 10 | license-files: 11 | LICENSE 12 | LICENSE.GPLv2 13 | LICENSE.GPLv3 14 | 15 | author: Oleg Grenrus 16 | maintainer: Oleg Grenrus 17 | tested-with: GHC ==9.8.4 18 | extra-source-files: Changelog.md 19 | 20 | source-repository head 21 | type: git 22 | location: https://github.com/phadej/cabal-extras.git 23 | 24 | library cabal-deps-internal 25 | default-language: Haskell2010 26 | hs-source-dirs: src 27 | ghc-options: -Wall 28 | exposed-modules: CabalDeps.Main 29 | other-modules: Paths_cabal_deps 30 | autogen-modules: Paths_cabal_deps 31 | 32 | -- ghc-boot dependencies 33 | -- cabal-fmt: fragment ../fragments/boot-deps.fragment 34 | build-depends: 35 | , base ^>=4.19.0.0 36 | , binary ^>=0.8.9.0 37 | , bytestring ^>=0.12.0.2 38 | , containers ^>=0.6.8 39 | , deepseq ^>=1.5.0.0 40 | , directory ^>=1.3.8.1 41 | , filepath ^>=1.4.100.4 42 | , mtl ^>=2.3.1 43 | , parsec ^>=3.1.17.0 44 | , pretty ^>=1.1.3.6 45 | , process ^>=1.6.18.0 46 | , stm ^>=2.5.0.0 47 | , template-haskell 48 | , text ^>=2.1 49 | 50 | -- We use Cabal-3.12 51 | build-depends: Cabal ^>=3.12.1.0 52 | 53 | -- We also use peura 54 | build-depends: peura 55 | 56 | -- dependencies in library 57 | build-depends: 58 | , ansi-terminal 59 | , cabal-install-parsers 60 | , cabal-plan 61 | , optparse-applicative 62 | 63 | executable cabal-deps 64 | default-language: Haskell2010 65 | hs-source-dirs: cli 66 | main-is: Main.hs 67 | ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N2 68 | build-depends: 69 | , base 70 | , cabal-deps-internal 71 | -------------------------------------------------------------------------------- /cabal-deps/cli/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | import CabalDeps.Main (main) 3 | -------------------------------------------------------------------------------- /cabal-diff/.gitmodules: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/phadej/cabal-extras/cf4fd3ee047fc8a6c6ca9d0868a701b851f94037/cabal-diff/.gitmodules -------------------------------------------------------------------------------- /cabal-diff/Changelog.md: -------------------------------------------------------------------------------- 1 | # 0.1 2 | 3 | First release 4 | -------------------------------------------------------------------------------- /cabal-diff/LICENSE: -------------------------------------------------------------------------------- 1 | SPDX-License-Identifier: GPL-2.0-or-later 2 | 3 | Copyright (c) 2019 Oleg Grenrus 4 | 5 | This library is free software: you may copy, redistribute and/or modify it 6 | under the terms of the GNU General Public License as published by the 7 | Free Software Foundation, either version 3 of the License, or (at your 8 | option) any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but 11 | WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program (see `LICENSE.GPLv3`). If not, see 17 | . 18 | -------------------------------------------------------------------------------- /cabal-diff/cabal-diff.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | name: cabal-diff 3 | version: 0.1 4 | synopsis: Compare API of cabal packages 5 | category: Development 6 | description: 7 | Compare API of cabal packages. Like @hackage-diff@ but uses 8 | @cabal v2-build@ functionality. 9 | 10 | license: GPL-2.0-or-later 11 | license-file: LICENSE 12 | author: Oleg Grenrus 13 | maintainer: Oleg Grenrus 14 | tested-with: GHC ==9.8.4 15 | extra-source-files: 16 | Changelog.md 17 | fixtures/*.golden 18 | fixtures/*.txt 19 | 20 | source-repository head 21 | type: git 22 | location: https://github.com/phadej/cabal-extras.git 23 | 24 | library cabal-diff-internal 25 | default-language: Haskell2010 26 | hs-source-dirs: src 27 | ghc-options: -Wall 28 | exposed-modules: 29 | CabalDiff.Diff 30 | CabalDiff.Hoogle 31 | CabalDiff.Main 32 | 33 | other-modules: Paths_cabal_diff 34 | autogen-modules: Paths_cabal_diff 35 | 36 | -- ghc-boot dependencies 37 | -- cabal-fmt: fragment ../fragments/boot-deps.fragment 38 | build-depends: 39 | , base ^>=4.19.0.0 40 | , binary ^>=0.8.9.0 41 | , bytestring ^>=0.12.0.2 42 | , containers ^>=0.6.8 43 | , deepseq ^>=1.5.0.0 44 | , directory ^>=1.3.8.1 45 | , filepath ^>=1.4.100.4 46 | , mtl ^>=2.3.1 47 | , parsec ^>=3.1.17.0 48 | , pretty ^>=1.1.3.6 49 | , process ^>=1.6.18.0 50 | , stm ^>=2.5.0.0 51 | , template-haskell 52 | , text ^>=2.1 53 | 54 | -- We use Cabal-3.12 55 | build-depends: Cabal ^>=3.12.1.0 56 | 57 | -- We also use peura 58 | build-depends: peura 59 | 60 | -- dependencies in library 61 | build-depends: 62 | , ansi-terminal ^>=1.1 63 | , base16-bytestring ^>=1.0.0.0 64 | , cabal-install-parsers 65 | , cabal-plan 66 | , cryptohash-sha256 ^>=0.11.101.0 67 | , Glob ^>=0.10.0 68 | , optparse-applicative ^>=0.18.0.0 69 | , semialign ^>=1.3 70 | , stm 71 | , these ^>=1.2 72 | 73 | executable cabal-diff 74 | default-language: Haskell2010 75 | hs-source-dirs: cli 76 | main-is: Main.hs 77 | ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N2 78 | build-depends: 79 | , base 80 | , cabal-diff-internal 81 | 82 | test-suite cabal-diff-golden 83 | default-language: Haskell2010 84 | type: exitcode-stdio-1.0 85 | main-is: Golden.hs 86 | hs-source-dirs: test 87 | 88 | -- inherited constraints 89 | build-depends: 90 | , ansi-terminal 91 | , base 92 | , bytestring 93 | , Cabal 94 | , cabal-diff-internal 95 | , containers 96 | , directory 97 | , filepath 98 | 99 | -- dependencies needing explicit constraints 100 | build-depends: 101 | , tasty ^>=1.5 102 | , tasty-golden ^>=2.3.1.1 103 | , tree-diff ^>=0.3 104 | -------------------------------------------------------------------------------- /cabal-diff/cli/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | import CabalDiff.Main (main) 3 | -------------------------------------------------------------------------------- /cabal-diff/src/CabalDiff/Diff.hs: -------------------------------------------------------------------------------- 1 | module CabalDiff.Diff ( 2 | Diff (..), 3 | apiDiff, 4 | outputApiDiff, 5 | ) where 6 | 7 | import Peura 8 | import Prelude () 9 | 10 | import Distribution.ModuleName (ModuleName) 11 | import System.Console.ANSI 12 | (Color (..), ColorIntensity (Vivid), ConsoleLayer (Foreground), SGR (..)) 13 | 14 | import CabalDiff.Hoogle 15 | 16 | data Diff 17 | = Added String 18 | | Removed String 19 | | Same String 20 | | Changed String String 21 | deriving (Show) 22 | 23 | isSame :: Diff -> Bool 24 | isSame (Same _) = True 25 | isSame _ = False 26 | 27 | apiDiff 28 | :: API -> API 29 | -> Map ModuleName (Map Key Diff) 30 | apiDiff = alignWith $ \m' -> case m' of 31 | This m -> fmap Removed m 32 | That m -> fmap Added m 33 | These x y -> alignWith f x y 34 | where 35 | f (This a) = Removed a 36 | f (That a) = Added a 37 | f (These a b) 38 | | a == b = Same a 39 | | otherwise = Changed a b 40 | 41 | outputApiDiff :: TracerPeu r w -> Map ModuleName (Map Key Diff) -> Peu r () 42 | outputApiDiff tracer ad = do 43 | let colored c = [SetColor Foreground Vivid c] 44 | ifor_ ad $ \moduleName moduleDiff -> 45 | if all isSame moduleDiff 46 | then output tracer $ " " ++ prettyShow moduleName 47 | else do 48 | outputSgr tracer (colored Cyan) $ "@@@" ++ " " ++ prettyShow moduleName 49 | ifor_ moduleDiff $ \key change -> case change of 50 | Same _rest -> return () 51 | Added rest -> outputSgr tracer (colored Green) $ "++ " ++ renderKey key rest 52 | Removed rest -> outputSgr tracer (colored Red) $ "-- " ++ renderKey key rest 53 | Changed a b -> do 54 | outputSgr tracer (colored Blue) $ " - " ++ renderKey key a 55 | outputSgr tracer (colored Yellow) $ " + " ++ renderKey key b 56 | 57 | ------------------------------------------------------------------------------- 58 | -- Test examples 59 | ------------------------------------------------------------------------------- 60 | 61 | -- _test1 :: IO () 62 | -- _test1 = runPeu () $ do 63 | -- a <- liftIO $ BS.readFile "fixtures/colour-2.3.4.txt" >>= either fail return . parseFile 64 | -- b <- liftIO $ BS.readFile "fixtures/colour-2.3.5.txt" >>= either fail return . parseFile 65 | -- outputApiDiff (let x = x in x) (apiDiff a b) 66 | -- 67 | -- _test2 :: IO () 68 | -- _test2 = runPeu () $ do 69 | -- a <- liftIO $ BS.readFile "fixtures/optics-core.txt" >>= either fail return . parseFile 70 | -- b <- liftIO $ BS.readFile "fixtures/servant.txt" >>= either fail return . parseFile 71 | -- outputApiDiff (let x = x in x) (apiDiff a b) 72 | -------------------------------------------------------------------------------- /cabal-diff/test/Golden.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wno-orphans #-} 2 | module Main (main) where 3 | 4 | import Data.TreeDiff 5 | import Data.TreeDiff.Golden (ediffGolden) 6 | import Distribution.ModuleName (ModuleName) 7 | import Distribution.Pretty (prettyShow) 8 | import System.FilePath (()) 9 | import Test.Tasty (defaultMain, testGroup) 10 | import Test.Tasty.Golden.Advanced (goldenTest) 11 | 12 | import qualified Data.ByteString as BS 13 | 14 | import CabalDiff.Hoogle 15 | 16 | main :: IO () 17 | main = defaultMain $ testGroup "golden" 18 | [ testGroup "parser" 19 | [ golden "foldable1" 20 | , golden "optics-core" 21 | , golden "servant" 22 | , golden "singletons" 23 | , golden "vec" 24 | , golden "colour-2.3.4" 25 | , golden "colour-2.3.5" 26 | , golden "resolv" 27 | ] 28 | ] 29 | where 30 | golden name = ediffGolden goldenTest name goldenPath $ do 31 | contents <- BS.readFile hooglePath 32 | either fail return $ parseFile contents 33 | where 34 | goldenPath = "fixtures" (name ++ ".golden") 35 | hooglePath = "fixtures" (name ++ ".txt") 36 | 37 | ------------------------------------------------------------------------------- 38 | -- orphans 39 | ------------------------------------------------------------------------------- 40 | 41 | instance ToExpr ModuleName where 42 | toExpr mn = App "ModuleName" [toExpr (prettyShow mn)] 43 | 44 | instance ToExpr Key 45 | -------------------------------------------------------------------------------- /cabal-docspec/.gitignore: -------------------------------------------------------------------------------- 1 | # "releases" 2 | cabal-docspec-*.xz 3 | cabal-docspec-*.SHA256SUM 4 | -------------------------------------------------------------------------------- /cabal-docspec/Changelog.md: -------------------------------------------------------------------------------- 1 | # 0.0.0.2024mmdd 2 | 3 | - Accecpt @pkgname:libname@ target syntax 4 | 5 | # 0.0.0.20240703 6 | 7 | - Fix "Project Unit Id" bug 8 | 9 | # 0.0.0.20240702 10 | 11 | - Support `cabal-install-3.12` changed store directory logic 12 | - Update dependencies, in particular use `Cabal-3.12.1.0` 13 | 14 | # 0.0.0.20240414 15 | 16 | - `--extra-package` accepts sublibraries, i.e. `mypkg:sublib` syntax. 17 | - `cabal-docspec` tests all library components, also internal (visible and invisible) components. 18 | 19 | # 0.0.0.20231219 20 | 21 | - Pass `default-language` flag to GHC 22 | - Fix issue with CPP defines without an explicit value (i.e. `-DFOO`, not `-DBAR=42`) 23 | - Include `include-dirs` in build directory (for Configure generated headers) 24 | 25 | # 0.0.0.20230406 26 | 27 | - Change failing docspec output to be proper diff. 28 | Additionally print actual output for easy copying. 29 | - Preprocess source files also if `default-extension` contains `CPP` 30 | - Update dependencies, in particular use `Cabal-3.10.1.0` 31 | - Build with GHC-9.2.7 32 | 33 | # 0.0.0.20211114 34 | 35 | - Add `--module` flag 36 | - static binary release 37 | 38 | # 0.0.0.20210111 39 | 40 | - `--check-properties` 41 | - CPP includes 42 | - ghci RTS options 43 | 44 | # 0.0.0.20210110 45 | 46 | - Set datadir environment variables 47 | 48 | # 0.0.0.20210108 49 | 50 | - Named chunks handling 51 | 52 | # 0.0.0.20201230.1 53 | 54 | - Second alpha release 55 | 56 | # 0.0.0.20201230 57 | 58 | - First alpha release 59 | -------------------------------------------------------------------------------- /cabal-docspec/LICENSE: -------------------------------------------------------------------------------- 1 | SPDX-License-Identifier: GPL-2.0-or-later 2 | 3 | Copyright (c) 2019 Oleg Grenrus 4 | 5 | This library is free software: you may copy, redistribute and/or modify it 6 | under the terms of the GNU General Public License as published by the 7 | Free Software Foundation, either version 3 of the License, or (at your 8 | option) any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but 11 | WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program (see `LICENSE.GPLv3`). If not, see 17 | . 18 | -------------------------------------------------------------------------------- /cabal-docspec/Makefile: -------------------------------------------------------------------------------- 1 | VERSION=0.0.0.20240703 2 | DATE="July 3nd, 2024" 3 | EXETARGET=cabal-docspec 4 | 5 | cabal-docspec.1 : MANUAL.md 6 | echo '.TH CABAL-DOCSPEC 1 "$(DATE)" "cabal-docspec $(VERSION)" "Cabal Extras"' > cabal-docspec.1 7 | pandoc -f markdown -t man MANUAL.md >> cabal-docspec.1 8 | 9 | man : cabal-docspec.1 10 | cat cabal-docspec.1 | man -l - 11 | 12 | ALPINEVERSION:=3.17.3 13 | GHCUPVERSION:=0.1.22.0 14 | GHCVERSION:=9.8.2 15 | CABALVERSION:=3.10.3.0 16 | 17 | CABALPLAN:=$(HOME)/.local/bin/cabal-plan 18 | CABAL:=$(HOME)/.ghcup/bin/cabal 19 | GHC:=$(HOME)/.ghcup/bin/ghc-$(GHCVERSION) 20 | GHCUP:=$(HOME)/.ghcup/bin/ghcup 21 | 22 | # docker run -ti -v $(dirname $(pwd)):/src alpine:3.17.3 23 | # cd /src/cabal-docspec 24 | # apk add make 25 | # make alpine-release 26 | # 27 | .PHONY: alpine-release 28 | alpine-release : 29 | apk add binutils-gold curl gcc g++ git gmp-dev libc-dev libffi-dev make musl-dev ncurses-dev openssh-client perl tar tmux vim xz xz-dev zlib-dev zlib-static 30 | mkdir -p $(HOME)/.local/bin 31 | curl -L https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz | xz -d > $(CABALPLAN) 32 | chmod a+x $(CABALPLAN) 33 | mkdir -p $(HOME)/.ghcup/bin 34 | curl https://downloads.haskell.org/~ghcup/$(GHCUPVERSION)/x86_64-linux-ghcup-$(GHCUPVERSION) > $(GHCUP) 35 | chmod a+x $(GHCUP) 36 | $(GHCUP) install ghc $(GHCVERSION) 37 | $(GHCUP) install cabal $(CABALVERSION) 38 | $(CABAL) update --ignore-project 39 | $(CABAL) build exe:$(EXETARGET) -fexe --with-compiler $(GHC) --enable-executable-static 40 | strip $$($(CABALPLAN) list-bin $(EXETARGET)) 41 | @ls -l $$($(CABALPLAN) list-bin $(EXETARGET)) 42 | cat $$($(CABALPLAN) list-bin $(EXETARGET)) | xz > $(EXETARGET)-$(VERSION)-x86_64-linux.xz 43 | @ls -l $(EXETARGET)-$(VERSION)-x86_64-linux.xz 44 | sha256sum $(EXETARGET)-$(VERSION)-x86_64-linux.xz | tee $(EXETARGET)-$(VERSION).SHA256SUM 45 | -------------------------------------------------------------------------------- /cabal-docspec/cli/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | import CabalDocspec.Main (main) 3 | -------------------------------------------------------------------------------- /cabal-docspec/cpphs/LICENCE-commercial: -------------------------------------------------------------------------------- 1 | Commercial licence for cpphs. 2 | 3 | Copyright 2004-2010, Malcolm Wallace (malcolm.wallace@me.com) 4 | All rights reserved. 5 | 6 | * This software, built from original unmodified sources, may be used for 7 | any purpose whatsoever, without restriction. 8 | 9 | * Redistribution in binary form, without modification, is permitted 10 | provided that the above copyright notice, these conditions and the 11 | following disclaimer are reproduced in the documentation and/or other 12 | materials provided with the distribution. 13 | 14 | * Redistribution in source form, with or without modification, is not 15 | permitted under this license. 16 | 17 | THIS SOFTWARE IS PROVIDED BY Malcolm Wallace 18 | AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, 19 | INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 20 | FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL 21 | Malcolm Wallace OR THE CONTRIBUTORS BE LIABLE 22 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 24 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 25 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 26 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 27 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH 28 | DAMAGE. 29 | 30 | -------------------------------------------------------------------------------- /cabal-docspec/cpphs/Language/Preprocessor/Cpphs.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Language.Preprocessor.Cpphs 4 | -- Copyright : 2000-2006 Malcolm Wallace 5 | -- Licence : LGPL 6 | -- 7 | -- Maintainer : Malcolm Wallace 8 | -- Stability : experimental 9 | -- Portability : All 10 | -- 11 | -- Include the interface that is exported 12 | ----------------------------------------------------------------------------- 13 | 14 | module Language.Preprocessor.Cpphs 15 | ( runCpphs, runCpphsPass1, runCpphsPass2, runCpphsReturningSymTab 16 | , cppIfdef, tokenise, WordStyle(..) 17 | , macroPass, macroPassReturningSymTab 18 | , CpphsOptions(..), BoolOptions(..) 19 | , parseOptions, defaultCpphsOptions, defaultBoolOptions 20 | , CpphsActions(..), defaultCpphsActions 21 | , module Language.Preprocessor.Cpphs.Position 22 | ) where 23 | 24 | import Language.Preprocessor.Cpphs.CppIfdef(cppIfdef) 25 | import Language.Preprocessor.Cpphs.MacroPass(macroPass 26 | ,macroPassReturningSymTab) 27 | import Language.Preprocessor.Cpphs.RunCpphs(runCpphs 28 | ,runCpphsPass1 29 | ,runCpphsPass2 30 | ,runCpphsReturningSymTab) 31 | import Language.Preprocessor.Cpphs.Options 32 | (CpphsOptions(..), BoolOptions(..), parseOptions 33 | ,defaultCpphsOptions,defaultBoolOptions 34 | ,CpphsActions(..), defaultCpphsActions 35 | ) 36 | import Language.Preprocessor.Cpphs.Position 37 | import Language.Preprocessor.Cpphs.Tokenise 38 | -------------------------------------------------------------------------------- /cabal-docspec/cpphs/Language/Preprocessor/Cpphs/ReadFirst.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : ReadFirst 4 | -- Copyright : 2004 Malcolm Wallace 5 | -- Licence : LGPL 6 | -- 7 | -- Maintainer : Malcolm Wallace 8 | -- Stability : experimental 9 | -- Portability : All 10 | -- 11 | -- Read the first file that matches in a list of search paths. 12 | ----------------------------------------------------------------------------- 13 | 14 | module Language.Preprocessor.Cpphs.ReadFirst 15 | ( readFirst 16 | , readFileUTF8 17 | , writeFileUTF8 18 | ) where 19 | 20 | import System.IO 21 | import System.Directory (doesFileExist) 22 | import Data.List (intersperse) 23 | import Control.Exception as E 24 | import Control.Monad (when) 25 | import Language.Preprocessor.Cpphs.Position (Posn,directory,cleanPath) 26 | import Language.Preprocessor.Cpphs.Options (CpphsActions (..)) 27 | 28 | -- | Attempt to read the given file from any location within the search path. 29 | -- The first location found is returned, together with the file content. 30 | -- (The directory of the calling file is always searched first, then 31 | -- the current directory, finally any specified search path.) 32 | readFirst :: CpphsActions 33 | -> String -- ^ filename 34 | -> Posn -- ^ inclusion point 35 | -> [String] -- ^ search path 36 | -> Bool -- ^ report warnings? 37 | -> IO ( FilePath 38 | , String 39 | ) -- ^ discovered filepath, and file contents 40 | 41 | readFirst actions name demand path warn = 42 | case name of 43 | -- Windows drive in absolute path 44 | c:':':'\\':nm-> try nm (Just (c:':':[])) [""] 45 | c:':':'/':nm -> try nm (Just (c:':':[])) [""] 46 | -- Windows drive in relative path 47 | c:':':nm -> try nm (Just (c:':':[])) (cons dd (".":path)) 48 | -- unix-like absolute path 49 | '/':nm -> try nm Nothing [""] 50 | -- any relative path 51 | _ -> try name Nothing (cons dd (".":path)) 52 | where 53 | dd = directory demand 54 | cons x xs = if null x then xs else x:xs 55 | try name _ [] = do 56 | when warn $ 57 | cpphsPutWarning actions 58 | ("Warning: Can't find file \""++name 59 | ++"\" in directories\n\t" 60 | ++concat (intersperse "\n\t" (cons dd (".":path))) 61 | ++"\n Asked for by: "++show demand) 62 | return ("missing file: "++name,"") 63 | try name drive (p:ps) = do 64 | let file = (maybe id (++) drive) $ cleanPath p++'/':cleanPath name 65 | ok <- doesFileExist file 66 | if not ok then try name drive ps 67 | else do content <- readFileUTF8 file 68 | return (file,content) 69 | 70 | readFileUTF8 :: FilePath -> IO String 71 | readFileUTF8 file = do 72 | h <- openFile file ReadMode 73 | (do utf8r <- mkTextEncoding "UTF-8//ROUNDTRIP" 74 | hSetEncoding h utf8r 75 | hGetContents h) `E.onException` (hClose h) 76 | 77 | writeFileUTF8 :: FilePath -> String -> IO () 78 | writeFileUTF8 f txt = withFile f WriteMode $ \hdl-> 79 | do utf8r <- mkTextEncoding "UTF-8//ROUNDTRIP" 80 | hSetEncoding hdl utf8r 81 | hPutStr hdl txt 82 | `E.onException` (hClose hdl) 83 | 84 | -------------------------------------------------------------------------------- /cabal-docspec/cpphs/Language/Preprocessor/Cpphs/SymTab.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : SymTab 4 | -- Copyright : 2000-2004 Malcolm Wallace 5 | -- Licence : LGPL 6 | -- 7 | -- Maintainer : Malcolm Wallace 8 | -- Stability : Stable 9 | -- Portability : All 10 | -- 11 | -- Symbol Table, based on index trees using a hash on the key. 12 | -- Keys are always Strings. Stored values can be any type. 13 | ----------------------------------------------------------------------------- 14 | 15 | module Language.Preprocessor.Cpphs.SymTab 16 | ( SymTab 17 | , emptyST 18 | , insertST 19 | , deleteST 20 | , lookupST 21 | , definedST 22 | , flattenST 23 | , IndTree 24 | ) where 25 | 26 | -- | Symbol Table. Stored values are polymorphic, but the keys are 27 | -- always strings. 28 | type SymTab v = IndTree [(String,v)] 29 | 30 | emptyST :: SymTab v 31 | insertST :: (String,v) -> SymTab v -> SymTab v 32 | deleteST :: String -> SymTab v -> SymTab v 33 | lookupST :: String -> SymTab v -> Maybe v 34 | definedST :: String -> SymTab v -> Bool 35 | flattenST :: SymTab v -> [v] 36 | 37 | emptyST = itgen maxHash [] 38 | insertST (s,v) ss = itiap (hash s) ((s,v):) ss id 39 | deleteST s ss = itiap (hash s) (filter ((/=s).fst)) ss id 40 | lookupST s ss = let vs = filter ((==s).fst) ((itind (hash s)) ss) 41 | in if null vs then Nothing 42 | else (Just . snd . head) vs 43 | definedST s ss = let vs = filter ((==s).fst) ((itind (hash s)) ss) 44 | in (not . null) vs 45 | flattenST ss = itfold (map snd) (++) ss 46 | 47 | 48 | ---- 49 | -- | Index Trees (storing indexes at nodes). 50 | 51 | data IndTree t = Leaf t | Fork Int (IndTree t) (IndTree t) 52 | deriving Show 53 | 54 | itgen :: Int -> a -> IndTree a 55 | itgen 1 x = Leaf x 56 | itgen n x = 57 | let n' = n `div` 2 58 | in Fork n' (itgen n' x) (itgen (n-n') x) 59 | 60 | itiap :: --Eval a => 61 | Int -> (a->a) -> IndTree a -> (IndTree a -> b) -> b 62 | itiap _ f (Leaf x) k = let fx = f x in {-seq fx-} (k (Leaf fx)) 63 | itiap i f (Fork n lt rt) k = 64 | if i k (Fork n lt' rt) 66 | else itiap (i-n) f rt $ \rt' -> k (Fork n lt rt') 67 | 68 | itind :: Int -> IndTree a -> a 69 | itind _ (Leaf x) = x 70 | itind i (Fork n lt rt) = if ib) -> (b->b->b) -> IndTree a -> b 73 | itfold leaf _fork (Leaf x) = leaf x 74 | itfold leaf fork (Fork _ l r) = fork (itfold leaf fork l) (itfold leaf fork r) 75 | 76 | ---- 77 | -- Hash values 78 | 79 | maxHash :: Int -- should be prime 80 | maxHash = 101 81 | 82 | class Hashable a where 83 | hashWithMax :: Int -> a -> Int 84 | hash :: a -> Int 85 | hash = hashWithMax maxHash 86 | 87 | instance Enum a => Hashable [a] where 88 | hashWithMax m = h 0 89 | where h a [] = a 90 | h a (c:cs) = h ((17*(fromEnum c)+19*a)`rem`m) cs 91 | 92 | ---- 93 | -------------------------------------------------------------------------------- /cabal-docspec/cpphs/Language/Preprocessor/Unlit.hs: -------------------------------------------------------------------------------- 1 | -- | Part of this code is from "Report on the Programming Language Haskell", 2 | -- version 1.2, appendix C. 3 | module Language.Preprocessor.Unlit (unlit) where 4 | 5 | import Data.Char 6 | import Data.List (isPrefixOf) 7 | 8 | data Classified = Program String | Blank | Comment 9 | | Include Int String | Pre String 10 | 11 | classify :: [String] -> [Classified] 12 | classify [] = [] 13 | classify (('\\':x):xs) | x == "begin{code}" = Blank : allProg xs 14 | where allProg [] = [] -- Should give an error message, 15 | -- but I have no good position information. 16 | allProg (('\\':x):xs) | "end{code}"`isPrefixOf`x = Blank : classify xs 17 | allProg (x:xs) = Program x:allProg xs 18 | classify (('>':x):xs) = Program (' ':x) : classify xs 19 | classify (('#':x):xs) = (case words x of 20 | (line:rest) | all isDigit line 21 | -> Include (read line) (unwords rest) 22 | _ -> Pre x 23 | ) : classify xs 24 | --classify (x:xs) | "{-# LINE" `isPrefixOf` x = Program x: classify xs 25 | classify (x:xs) | all isSpace x = Blank:classify xs 26 | classify (x:xs) = Comment:classify xs 27 | 28 | unclassify :: Classified -> String 29 | unclassify (Program s) = s 30 | unclassify (Pre s) = '#':s 31 | unclassify (Include i f) = '#':' ':show i ++ ' ':f 32 | unclassify Blank = "" 33 | unclassify Comment = "" 34 | 35 | -- | 'unlit' takes a filename (for error reports), and transforms the 36 | -- given string, to eliminate the literate comments from the program text. 37 | unlit :: FilePath -> String -> String 38 | unlit file lhs = (unlines 39 | . map unclassify 40 | . adjacent file (0::Int) Blank 41 | . classify) (inlines lhs) 42 | 43 | adjacent :: FilePath -> Int -> Classified -> [Classified] -> [Classified] 44 | adjacent file 0 _ (x :xs) = x : adjacent file 1 x xs -- force evaluation of line number 45 | adjacent file n y@(Program _) (x@Comment :xs) = error (message file n "program" "comment") 46 | adjacent file n y@(Program _) (x@(Include i f):xs) = x: adjacent f i y xs 47 | adjacent file n y@(Program _) (x@(Pre _) :xs) = x: adjacent file (n+1) y xs 48 | adjacent file n y@Comment (x@(Program _) :xs) = error (message file n "comment" "program") 49 | adjacent file n y@Comment (x@(Include i f):xs) = x: adjacent f i y xs 50 | adjacent file n y@Comment (x@(Pre _) :xs) = x: adjacent file (n+1) y xs 51 | adjacent file n y@Blank (x@(Include i f):xs) = x: adjacent f i y xs 52 | adjacent file n y@Blank (x@(Pre _) :xs) = x: adjacent file (n+1) y xs 53 | adjacent file n _ (x@next :xs) = x: adjacent file (n+1) x xs 54 | adjacent file n _ [] = [] 55 | 56 | message :: String -> Int -> String -> String -> String 57 | message "\"\"" n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n" 58 | message [] n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n" 59 | message file n p c = "In file " ++ file ++ " at line "++show n++": "++p++ " line before "++c++" line.\n" 60 | 61 | 62 | -- Re-implementation of 'lines', for better efficiency (but decreased laziness). 63 | -- Also, importantly, accepts non-standard DOS and Mac line ending characters. 64 | inlines :: String -> [String] 65 | inlines s = lines' s id 66 | where 67 | lines' [] acc = [acc []] 68 | lines' ('\^M':'\n':s) acc = acc [] : lines' s id -- DOS 69 | lines' ('\^M':s) acc = acc [] : lines' s id -- MacOS 70 | lines' ('\n':s) acc = acc [] : lines' s id -- Unix 71 | lines' (c:s) acc = lines' s (acc . (c:)) 72 | 73 | -------------------------------------------------------------------------------- /cabal-docspec/cpphs/README: -------------------------------------------------------------------------------- 1 | This directory contains 'cpphs', a simplified but robust 2 | re-implementation of cpp, the C pre-processor, in Haskell. 3 | 4 | TO BUILD 5 | -------- 6 | Just use 7 | hmake cpphs [-package base] 8 | or 9 | ghc --make cpphs [-o cpphs] # -o needed for ghc <= 6.4.1 ] 10 | or 11 | runhugs cpphs # or rename the script cpphs.hugs to cpphs 12 | 13 | 14 | USAGE 15 | ----- 16 | cpphs [filename | -Dsym | -Dsym=val | -Ipath]+ [-Ofile] 17 | [ --include=file ]* 18 | [ --nomacro | --noline | --nowarn | --strip | --strip-eol | 19 | --pragma | --text | --hashes | --layout | --unlit | 20 | --linepragma ]* 21 | [ --cpp compatopts ] 22 | 23 | For fuller details, see docs/index.html 24 | 25 | If you want to use cpphs as a completely drop-in replacement for the 26 | real cpp, that is, to accept the same arguments, and have broadly 27 | the same behaviour in response to them, then use the --cpp compatibility 28 | option. 29 | 30 | 31 | COPYRIGHT 32 | --------- 33 | Copyright (c) 2004-2017 Malcolm Wallace (Malcolm.Wallace@me.com) 34 | 35 | 36 | LICENCE 37 | ------- 38 | These library modules are distributed under the terms of the LGPL. 39 | The application module 'cpphs.hs' is GPL. 40 | 41 | This software comes with no warranty. Use at your own risk. 42 | 43 | If you have a commercial use for cpphs, and feel the terms of the (L)GPL 44 | are too onerous, you have the option of distributing unmodified binaries 45 | (only, not sources) under the terms of a different licence (see 46 | LICENCE-commercial). 47 | 48 | 49 | WEBSITE 50 | ------- 51 | http://projects.haskell.org/cpphs/ 52 | darcs get http://code.haskell.org/~malcolm/cpphs 53 | -------------------------------------------------------------------------------- /cabal-docspec/cpphs/cpphs.cabal: -------------------------------------------------------------------------------- 1 | Name: cpphs 2 | Version: 1.20.9.1 3 | Copyright: 2004-2017, Malcolm Wallace 4 | License: LGPL 5 | License-File: LICENCE-LGPL 6 | Cabal-Version: >= 1.8 7 | Author: Malcolm Wallace 8 | Maintainer: Malcolm Wallace 9 | Homepage: http://projects.haskell.org/cpphs/ 10 | bug-reports: https://github.com/malcolmwallace/cpphs/issues 11 | Synopsis: A liberalised re-implementation of cpp, the C pre-processor. 12 | Description: 13 | Cpphs is a re-implementation of the C pre-processor that is both 14 | more compatible with Haskell, and itself written in Haskell so 15 | that it can be distributed with compilers. 16 | . 17 | This version of the C pre-processor is pretty-much 18 | feature-complete and compatible with traditional (K&R) 19 | pre-processors. Additional features include: a plain-text mode; 20 | an option to unlit literate code files; and an option to turn 21 | off macro-expansion. 22 | Category: Development 23 | Build-type: Simple 24 | Extra-Source-Files: README, LICENCE-GPL, LICENCE-commercial, CHANGELOG, docs/cpphs.1, docs/index.html 25 | 26 | tested-with: 27 | ghc ==8.10.1 28 | || ==8.8.3 29 | || ==8.6.5 30 | || ==8.4.4 31 | || ==8.2.2 32 | || ==8.0.2 33 | || ==7.10.3 34 | || ==7.8.4 35 | || ==7.6.3 36 | || ==7.4.2 37 | || ==7.2.2 38 | || ==7.0.4 39 | 40 | flag old-locale 41 | description: If true, use old-locale, otherwise use time 1.5 or newer. 42 | manual: False 43 | default: False 44 | 45 | Library 46 | Build-Depends: base >= 4.3 && <5, directory <1.4, polyparse>=1.13 && <1.14 47 | 48 | if flag(old-locale) 49 | Build-Depends: 50 | old-locale >=1.0.0.2 && <1.1 51 | , time >=0 && <1.5 52 | Hs-Source-Dirs: . old 53 | 54 | else 55 | Build-Depends: time >=1.5 && <1.11 56 | Hs-Source-Dirs: . new 57 | 58 | Exposed-Modules: 59 | Language.Preprocessor.Cpphs 60 | Language.Preprocessor.Unlit 61 | Other-Modules: 62 | Language.Preprocessor.Cpphs.CppIfdef 63 | Language.Preprocessor.Cpphs.HashDefine 64 | Language.Preprocessor.Cpphs.MacroPass 65 | Language.Preprocessor.Cpphs.Options 66 | Language.Preprocessor.Cpphs.Position 67 | Language.Preprocessor.Cpphs.ReadFirst 68 | Language.Preprocessor.Cpphs.RunCpphs 69 | Language.Preprocessor.Cpphs.SymTab 70 | Language.Preprocessor.Cpphs.Tokenise 71 | TimeCompat 72 | 73 | Executable cpphs 74 | Build-Depends: base>=3&&<6, directory <1.4, polyparse>=1.13 && <1.14 75 | Main-Is: cpphs.hs 76 | 77 | if flag(old-locale) 78 | Build-Depends: 79 | old-locale >=1.0.0.2 && <1.1 80 | , time >=0 && <1.5 81 | Hs-Source-Dirs: . old 82 | 83 | else 84 | Build-Depends: time >=1.5 && <1.11 85 | Hs-Source-Dirs: . new 86 | 87 | Other-Modules: 88 | Language.Preprocessor.Cpphs 89 | Language.Preprocessor.Unlit 90 | Language.Preprocessor.Cpphs.CppIfdef 91 | Language.Preprocessor.Cpphs.HashDefine 92 | Language.Preprocessor.Cpphs.MacroPass 93 | Language.Preprocessor.Cpphs.Options 94 | Language.Preprocessor.Cpphs.Position 95 | Language.Preprocessor.Cpphs.ReadFirst 96 | Language.Preprocessor.Cpphs.RunCpphs 97 | Language.Preprocessor.Cpphs.SymTab 98 | Language.Preprocessor.Cpphs.Tokenise 99 | TimeCompat 100 | 101 | Source-Repository head 102 | Type: git 103 | Location: https://github.com/hackage-trustees/malcolm-wallace-universe 104 | -------------------------------------------------------------------------------- /cabal-docspec/src/CabalDocspec/Cpp.hs: -------------------------------------------------------------------------------- 1 | module CabalDocspec.Cpp ( 2 | cpphs, 3 | ) where 4 | 5 | import Peura 6 | 7 | import qualified Distribution.Simple.Build.Macros as C 8 | import qualified Language.Preprocessor.Cpphs as Cpphs 9 | 10 | import CabalDocspec.Trace 11 | import CabalDocspec.Warning 12 | 13 | -- | C-preprocess file 14 | cpphs 15 | :: TracerPeu r Tr 16 | -> Version -- ^ this package version 17 | -> [PackageIdentifier] -- ^ package identifiers, for @cabal_macros.h@ 18 | -> [Path Absolute] -- ^ includes 19 | -> [(String, String)] -- ^ additional defines 20 | -> Path Absolute -- ^ filepath 21 | -> String -- ^ file contents 22 | -> Peu r String 23 | cpphs tracer pkgVer pkgIds includes defines path input = withRunInIO $ \runInIO -> do 24 | let cpphsActions = Cpphs.CpphsActions 25 | { Cpphs.cpphsPutWarning = \msg -> runInIO (putWarning tracer WCpphs msg) 26 | , Cpphs.cpphsDie = \msg -> runInIO (die tracer msg) 27 | } 28 | --putInfo tracer $ show defines 29 | liftIO $ Cpphs.runCpphs cpphsActions cpphsOpts path' input' 30 | where 31 | 32 | path' = toFilePath path 33 | input' = unlines 34 | [ "#line 1 \"" ++ Cpphs.cleanPath "cabal_macros.h" ++ "\"" 35 | , C.generatePackageVersionMacros pkgVer pkgIds 36 | , "#line 1 \"" ++ Cpphs.cleanPath path' ++ "\"" 37 | , input 38 | ] 39 | 40 | cpphsOpts = Cpphs.defaultCpphsOptions 41 | { Cpphs.boolopts = cpphsBoolOpts 42 | , Cpphs.defines = defines 43 | , Cpphs.includes = map toFilePath includes 44 | } 45 | 46 | cpphsBoolOpts :: Cpphs.BoolOptions 47 | cpphsBoolOpts = Cpphs.defaultBoolOptions 48 | { Cpphs.hashline = False 49 | , Cpphs.warnings = True 50 | } 51 | -------------------------------------------------------------------------------- /cabal-docspec/src/CabalDocspec/Doctest/Example.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- This module is derivative of 3 | -- 4 | -- Copyright (c) 2009-2018 Simon Hengel 5 | -- 6 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 7 | -- of this software and associated documentation files (the "Software"), to deal 8 | -- in the Software without restriction, including without limitation the rights 9 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | -- copies of the Software, and to permit persons to whom the Software is 11 | -- furnished to do so, subject to the following conditions: 12 | -- 13 | -- The above copyright notice and this permission notice shall be included in 14 | -- all copies or substantial portions of the Software. 15 | -- 16 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 22 | -- THE SOFTWARE. 23 | -- 24 | module CabalDocspec.Doctest.Example ( 25 | Result (..), 26 | mkResult, 27 | ) where 28 | 29 | import Prelude 30 | 31 | import Peura (fromString) 32 | 33 | import qualified System.Console.ANSI as ANSI 34 | import qualified Text.PrettyPrint.Annotated as PP 35 | 36 | import CabalDocspec.Diff 37 | import CabalDocspec.Doctest.Parse 38 | 39 | data Result = Equal | NotEqual (PP.Doc [ANSI.SGR]) 40 | deriving (Eq, Show) 41 | 42 | -- TODO: escape 43 | mkResult :: ExpectedResult -> [String] -> Result 44 | mkResult expected actual = 45 | case diffLines expected' actual of 46 | (0, _) -> Equal 47 | (_, d) -> NotEqual (ppDiff d) 48 | where 49 | expected' :: [Wild [Wild Char]] 50 | expected' = 51 | [ case l of 52 | WildCardLine -> Wildcard 53 | ExpectedLine l' -> Exact $ concat 54 | [ case c of 55 | WildCardChunk -> [Wildcard] 56 | LineChunk c' -> map Exact c' 57 | | c <- l' 58 | ] 59 | 60 | | l <- expected 61 | ] 62 | 63 | ppDiff :: Diff -> PP.Doc [ANSI.SGR] 64 | ppDiff = PP.vcat . go where 65 | go :: Diff -> [PP.Doc [ANSI.SGR]] 66 | go DiffEmpty = [] 67 | go (DiffSame ls d) = 68 | [ fromString $ ' ' : l 69 | | l <- ls 70 | ] ++ go d 71 | 72 | go (DiffChunk xs ys d) = 73 | [ PP.annotate [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Red] $ "-" <> go' ANSI.Red x 74 | | x <- xs 75 | ] ++ 76 | [ PP.annotate [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Green] $ "+" <> go' ANSI.Green y 77 | | y <- ys 78 | ] ++ go d 79 | 80 | go' :: ANSI.Color -> EmphString -> PP.Doc [ANSI.SGR] 81 | go' _ Empty = "" 82 | go' c (Norm s ss) = fromString s <> go' c ss 83 | go' c (Emph s ss) = bold c (fromString s) <> go' c ss 84 | 85 | bold :: ANSI.Color -> PP.Doc [ANSI.SGR] -> PP.Doc [ANSI.SGR] 86 | bold c = PP.annotate [ANSI.SetColor ANSI.Background ANSI.Dull c, ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.White] 87 | -------------------------------------------------------------------------------- /cabal-docspec/src/CabalDocspec/Doctest/Extract.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveTraversable #-} 2 | module CabalDocspec.Doctest.Extract where 3 | 4 | import Peura 5 | 6 | import qualified Distribution.ModuleName as C 7 | 8 | ------------------------------------------------------------------------------- 9 | -- Datatype from doctest Extract module 10 | ------------------------------------------------------------------------------- 11 | 12 | -- | Documentation for a module grouped together with the modules name. 13 | data Module a = Module 14 | { moduleName :: C.ModuleName 15 | , moduleSetup :: Maybe a 16 | , moduleContent :: [a] 17 | } 18 | deriving (Eq, Show, Functor, Foldable, Traversable) 19 | -------------------------------------------------------------------------------- /cabal-docspec/src/CabalDocspec/ExprVars.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor #-} 2 | module CabalDocspec.ExprVars ( 3 | exprVars, 4 | ) where 5 | 6 | import Peura 7 | 8 | import qualified Language.Haskell.Lexer as L 9 | import qualified Data.Set as Set 10 | 11 | exprVars :: String -> Set String 12 | exprVars input = 13 | expr Set.empty Set.empty $ filter notWhitespace $ L.lexerPass0 input 14 | where 15 | expr :: Set String -> Set String -> [L.PosToken] -> Set String 16 | expr acc bound [] = Set.difference acc bound 17 | 18 | -- collect ids 19 | expr acc bound ((L.Varid, (_, v)) : rest) = expr (Set.insert v acc) bound rest 20 | -- we skip Varsyms. Don't use them in properties :) 21 | 22 | expr acc bound ((L.Reservedop, (_, "\\")) : rest) = 23 | let (vars, rest') = span notArrow rest 24 | in expr acc (bound <> Set.fromList (mapMaybe isVarid vars)) rest' 25 | 26 | -- debug 27 | -- expr acc bound rest = error (show (take 5 rest)) 28 | 29 | -- for other tokens, we simply continue. 30 | expr acc bound (_ : rest) = expr acc bound rest 31 | 32 | notWhitespace :: L.PosToken -> Bool 33 | notWhitespace (L.Whitespace, _) = False 34 | notWhitespace _ = True 35 | 36 | isVarid :: L.PosToken -> Maybe String 37 | isVarid (L.Varid, (_, v)) = Just v 38 | isVarid _ = Nothing 39 | 40 | notArrow :: L.PosToken -> Bool 41 | notArrow (L.Reservedop, (_, "->")) = False 42 | notArrow _ = True 43 | -------------------------------------------------------------------------------- /cabal-docspec/src/CabalDocspec/Library.hs: -------------------------------------------------------------------------------- 1 | module CabalDocspec.Library where 2 | 3 | import Peura 4 | 5 | import qualified Distribution.Compat.CharParsing as P 6 | import qualified Distribution.Parsec as C 7 | import qualified Distribution.Pretty as C 8 | import qualified Distribution.Types.PackageName as C 9 | import qualified Distribution.Types.UnqualComponentName as C 10 | import qualified Text.PrettyPrint as PP 11 | 12 | data Library = Library !PackageName !LibraryName 13 | deriving (Eq, Ord, Show) 14 | 15 | instance C.Parsec Library where 16 | parsec = do 17 | pn <- C.parsec 18 | ln <- fmap (fromMaybe LMainLibName) $ optional $ do 19 | _ <- P.char ':' 20 | qn <- C.parsec 21 | return $ 22 | if C.unPackageName pn == C.unUnqualComponentName qn 23 | then LMainLibName 24 | else LSubLibName qn 25 | 26 | return (Library pn ln) 27 | 28 | instance C.Pretty Library where 29 | pretty (Library pn LMainLibName) = C.pretty pn 30 | pretty (Library pn (LSubLibName ln)) = C.pretty pn <> PP.colon <> C.pretty ln 31 | -------------------------------------------------------------------------------- /cabal-docspec/src/CabalDocspec/Located.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFoldable #-} 2 | {-# LANGUAGE DeriveFunctor #-} 3 | {-# LANGUAGE DeriveTraversable #-} 4 | module CabalDocspec.Located where 5 | 6 | import Peura 7 | 8 | import Language.Haskell.Lexer (Pos, line, column) 9 | 10 | type Located = GenLocated Pos 11 | 12 | data GenLocated l e = L l e 13 | deriving (Eq, Show, Functor, Foldable, Traversable) 14 | 15 | unLoc :: GenLocated l e -> e 16 | unLoc (L _ e) = e 17 | 18 | prettyPos :: Pos -> String 19 | prettyPos pos = "in comment at " ++ show (line pos) ++ ":" ++ show (column pos) 20 | -------------------------------------------------------------------------------- /cabal-docspec/src/CabalDocspec/Man.hs: -------------------------------------------------------------------------------- 1 | module CabalDocspec.Man where 2 | 3 | import Data.Foldable (for_) 4 | import Prelude (IO, ($)) 5 | import System.Exit (exitWith) 6 | import System.IO (hClose, hPutStr) 7 | 8 | import qualified System.Process as Proc 9 | 10 | import CabalDocspec.Man.Content (manContent) 11 | 12 | man :: IO () 13 | man = do 14 | let cmd = "man" 15 | args = ["-l", "-"] 16 | 17 | (mb_in, _, _, ph) <- Proc.createProcess (Proc.proc cmd args) 18 | { Proc.std_in = Proc.CreatePipe 19 | , Proc.std_out = Proc.Inherit 20 | , Proc.std_err = Proc.Inherit 21 | } 22 | 23 | -- put contents 24 | for_ mb_in $ \hin -> do 25 | hPutStr hin manContent 26 | hClose hin 27 | 28 | -- wait for process to exit, propagate exit code 29 | ec <- Proc.waitForProcess ph 30 | exitWith ec 31 | -------------------------------------------------------------------------------- /cabal-docspec/src/CabalDocspec/Man/Content.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | module CabalDocspec.Man.Content ( 3 | manContent, 4 | ) where 5 | 6 | import Language.Haskell.TH (litE, stringL) 7 | import Language.Haskell.TH.Syntax (qAddDependentFile, qRunIO) 8 | import Prelude (String, readFile, ($)) 9 | 10 | manContent :: String 11 | manContent = $(do 12 | let fp = "cabal-docspec.1" 13 | qAddDependentFile fp 14 | contents <- qRunIO (readFile fp) 15 | litE $ stringL contents 16 | ) 17 | -------------------------------------------------------------------------------- /cabal-docspec/src/CabalDocspec/Package.hs: -------------------------------------------------------------------------------- 1 | module CabalDocspec.Package ( 2 | Package (..), 3 | readLocalCabalFiles, 4 | readDirectCabalFiles, 5 | ) where 6 | 7 | import Peura 8 | 9 | import qualified Distribution.PackageDescription.Parsec as C 10 | 11 | readDirectCabalFiles 12 | :: TracerPeu r w 13 | -> [FilePath] 14 | -> Peu r [Package] 15 | readDirectCabalFiles tracer paths = for paths $ \path -> do 16 | cabalPath <- makeAbsoluteFilePath path 17 | cabalBS <- readByteString cabalPath 18 | gpd <- maybe (die tracer $ "cannot parse " ++ toFilePath cabalPath) return 19 | $ C.parseGenericPackageDescriptionMaybe cabalBS 20 | 21 | return Package 22 | { pkgGpd = gpd 23 | , pkgDir = takeDirectory cabalPath 24 | , pkgUnits = [] 25 | } 26 | -------------------------------------------------------------------------------- /cabal-docspec/src/CabalDocspec/Phase1.hs: -------------------------------------------------------------------------------- 1 | module CabalDocspec.Phase1 ( 2 | phase1, 3 | ) where 4 | 5 | import Peura 6 | 7 | import qualified Distribution.ModuleName as C 8 | import qualified Distribution.Types.BuildInfo as C 9 | import qualified Distribution.Types.Version as C 10 | 11 | import CabalDocspec.Cpp 12 | import CabalDocspec.Doctest.Extract 13 | import CabalDocspec.Lexer 14 | import CabalDocspec.Located 15 | import CabalDocspec.Trace 16 | 17 | -- | First phase. 18 | -- 19 | -- Read file, extract doctest blocks. 20 | -- 21 | -- In particular, this runs CPP preprocessing if needed. 22 | phase1 23 | :: TracerPeu r Tr 24 | -> GhcInfo 25 | -> Maybe (Path Absolute) -- ^ builddir 26 | -> PackageName -- ^ package name 27 | -> Version -- ^ package version 28 | -> Path Absolute -- ^ package directory 29 | -> Bool -- ^ cpp extension 30 | -> [Path Absolute] -- ^ additional include directories 31 | -> [PackageIdentifier] -- ^ dependencies 32 | -> C.BuildInfo 33 | -> C.ModuleName 34 | -> Path Absolute 35 | -> Peu r (Module (Located String)) 36 | phase1 tracer ghcInfo mbuildDir pkgName_ pkgVer pkgDir cppEnabled cppDirs pkgIds bi modname modpath = do 37 | traceApp tracer $ TracePhase1 modname modpath 38 | 39 | contents <- fromUTF8BS <$> readByteString modpath 40 | 41 | -- lex the input. 42 | -- If it includes {-# LANGUAGE CPP #-}, then cpphs and re-lex. 43 | comments <- case needsCppPass cppEnabled contents of 44 | Just tokens -> do 45 | -- putDebug tracer $ unlines $ map show tokens 46 | return $ extractComments tokens 47 | Nothing -> do 48 | contents' <- cpphs tracer pkgVer pkgIds cppIncludes cppDefines modpath contents 49 | evaluate $ force $ extractComments $ stubbornPass0 contents' 50 | 51 | -- putDebug tracer $ unlines $ map show comments 52 | 53 | -- extract docstrings from all comments 54 | let docs = extractDocstrings modname comments 55 | 56 | return docs 57 | where 58 | cppIncludes :: [Path Absolute] 59 | cppIncludes = 60 | -- if there are absolute dirs, they are converted to relative, 61 | -- so may break 62 | [ pkgDir fromUnrootedFilePath dir 63 | | dir <- C.includeDirs bi 64 | ] ++ 65 | [ buildDir 66 | fromUnrootedFilePath "build" 67 | componentDir ghcInfo (PackageIdentifier pkgName_ pkgVer) 68 | fromUnrootedFilePath "build" 69 | fromUnrootedFilePath dir 70 | | buildDir <- toList mbuildDir 71 | , dir <- C.includeDirs bi 72 | ] ++ 73 | cppDirs 74 | 75 | cppDefines :: [(String, String)] 76 | cppDefines = 77 | [ ("__GLASGOW_HASKELL__", cppGhcVersion (ghcVersion ghcInfo)) 78 | ] ++ 79 | [ d' 80 | | d <- C.cppOptions bi 81 | , Just d' <- return (parseDefineFlag d) 82 | ] 83 | 84 | -- x86_64-linux/ghc-9.8.1/streamly-0.10.0 85 | componentDir :: GhcInfo -> PackageIdentifier -> Path Unrooted 86 | componentDir ghcInfo pid = 87 | fromUnrootedFilePath(ghcPlatform ghcInfo) 88 | fromUnrootedFilePath ("ghc-" ++ prettyShow (ghcVersion ghcInfo)) 89 | fromUnrootedFilePath (prettyShow pid) 90 | 91 | cppGhcVersion :: Version -> String 92 | cppGhcVersion v = case C.versionNumbers v of 93 | [] -> "0" 94 | (x:[]) -> show (x * 100) 95 | (x:y:_) -> show (x * 100 + y) 96 | 97 | parseDefineFlag :: String -> Maybe (String, String) 98 | parseDefineFlag ('-' : 'D' : rest) = 99 | case after of 100 | [] -> Just (before, "1") 101 | '=':value -> Just (before, value) 102 | _ -> Nothing -- shouldn't happen 103 | where 104 | (before, after) = span (/= '=') rest 105 | 106 | parseDefineFlag _ = Nothing 107 | -------------------------------------------------------------------------------- /cabal-docspec/src/CabalDocspec/Summary.hs: -------------------------------------------------------------------------------- 1 | module CabalDocspec.Summary where 2 | 3 | import Peura 4 | 5 | import CabalDocspec.Doctest.Parse 6 | import CabalDocspec.Located 7 | 8 | -- | Summary of a test run. 9 | data Summary = Summary 10 | { sSetup :: !SubSummary 11 | , sExamples :: !SubSummary 12 | , sProperties :: !SubSummary 13 | } 14 | deriving (Eq, Show) 15 | 16 | sumSummary :: Summary -> SubSummary 17 | sumSummary (Summary a b c) = a <> b <> c 18 | 19 | instance Semigroup Summary where 20 | Summary a b c <> Summary a' b' c' = 21 | Summary (a <> a') (b <> b') (c <> c') 22 | 23 | instance Monoid Summary where 24 | mempty = Summary mempty mempty mempty 25 | mappend = (<>) 26 | 27 | data SubSummary = SubSummary 28 | { _ssTotal :: !Int -- ^ total cases 29 | , _ssTried :: !Int -- ^ tried 30 | , _ssSuccess :: !Int -- ^ successful 31 | , _ssErrors :: !Int -- ^ errors 32 | , _ssFailures :: !Int -- ^ property failure 33 | , _ssSkipped :: !Int -- ^ skipped 34 | } 35 | deriving (Eq, Show) 36 | 37 | instance Semigroup SubSummary where 38 | SubSummary a b c d e f <> SubSummary a' b' c' d' e' f' = 39 | SubSummary (a + a') (b + b') (c + c') (d + d') (e + e') (f + f') 40 | 41 | instance Monoid SubSummary where 42 | mempty = SubSummary 0 0 0 0 0 0 43 | mappend = (<>) 44 | 45 | isOk :: SubSummary -> Bool 46 | isOk s = _ssErrors s == 0 && _ssFailures s == 0 47 | 48 | ssSuccess :: SubSummary 49 | ssSuccess = SubSummary 1 1 1 0 0 0 50 | 51 | ssError :: SubSummary 52 | ssError = SubSummary 1 1 0 1 0 0 53 | 54 | ssFailure :: SubSummary 55 | ssFailure = SubSummary 1 1 0 1 0 0 56 | 57 | ssSkip :: SubSummary 58 | ssSkip = SubSummary 1 0 0 0 0 1 59 | 60 | skipDocTest :: DocTest -> Summary 61 | skipDocTest Example {} = mempty { sExamples = ssSkip } 62 | skipDocTest Property {} = mempty { sProperties = ssSkip } 63 | 64 | -- In setup properties are always a failure. 65 | skipSetupDocTest :: DocTest -> SubSummary 66 | skipSetupDocTest Example {} = ssSkip 67 | skipSetupDocTest Property {} = ssFailure 68 | 69 | skipModule :: Module [Located DocTest] -> Summary 70 | skipModule m = 71 | mempty { sSetup = foldMap (foldMap (foldMap skipSetupDocTest)) (moduleSetup m) } <> 72 | foldMap (foldMap (foldMap skipDocTest)) (moduleContent m) 73 | -------------------------------------------------------------------------------- /cabal-docspec/src/CabalDocspec/Trace.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | module CabalDocspec.Trace where 4 | 5 | import Peura 6 | 7 | import Text.Printf (printf) 8 | 9 | import qualified Cabal.Plan as Plan 10 | import qualified Data.Text as T 11 | import qualified Distribution.ModuleName as C 12 | import qualified System.Console.ANSI as ANSI 13 | 14 | import CabalDocspec.Summary 15 | import CabalDocspec.Warning 16 | 17 | data Tr 18 | = TraceComponent PackageIdentifier Plan.CompName 19 | | TracePhase1 C.ModuleName (Path Absolute) 20 | | TracePhase2 C.ModuleName 21 | | TraceGHCi FilePath [String] 22 | | TraceGHCiInput String 23 | | TraceSummary Summary 24 | deriving Show 25 | 26 | instance IsPeuraTrace Tr where 27 | type TraceW Tr = W 28 | 29 | showTrace (TraceComponent pid cn) = (ANSI.Green, ["docspec","component"], prettyShow pid ++ " " ++ T.unpack (Plan.dispCompName cn)) 30 | showTrace (TracePhase1 n p) = (ANSI.Green, ["docspec","phase1"], prettyShow n ++ ": " ++ toFilePath p) 31 | showTrace (TracePhase2 n) = (ANSI.Green, ["docspec","phase2"], prettyShow n) 32 | showTrace (TraceGHCi p args) = (ANSI.Blue, ["ghci"], unwords (p : args)) 33 | showTrace (TraceGHCiInput input) = (ANSI.Blue, ["ghci", "input"], input) 34 | showTrace (TraceSummary Summary {..}) = (ANSI.Green, ["doctest.summary"], str) where 35 | str = unlines $ 36 | [ "" 37 | , showSs "Total: " total 38 | , showSs "Examples: " sExamples 39 | ] 40 | ++ [ showSs "Properties:" sProperties | sProperties /= mempty ] 41 | ++ [ showSs "Setup: " sSetup | sSetup /= mempty ] 42 | 43 | total :: SubSummary 44 | total = sSetup <> sExamples <> sProperties 45 | 46 | showSs :: String -> SubSummary -> String 47 | showSs n SubSummary {..} = printf "%s %4d; Tried: %4d; Skipped: %4d; Success: %4d; Errors: %4d; Failures %4d" 48 | n 49 | _ssTotal 50 | _ssTried 51 | _ssSkipped 52 | _ssSuccess 53 | _ssErrors 54 | _ssFailures 55 | -------------------------------------------------------------------------------- /cabal-docspec/src/CabalDocspec/Warning.hs: -------------------------------------------------------------------------------- 1 | module CabalDocspec.Warning where 2 | 3 | import Peura 4 | 5 | data W 6 | = WMultipleModuleFiles 7 | | WMissingModuleFile 8 | | WTimeout 9 | | WUnknownExtension 10 | | WInvalidField 11 | | WCpphs 12 | | WErrorInSetup 13 | | WSkippedProperty 14 | deriving (Eq, Ord, Enum, Bounded) 15 | 16 | instance Universe W where universe = [minBound .. maxBound] 17 | instance Finite W 18 | 19 | instance Warning W where 20 | warningToFlag WMultipleModuleFiles = "multiple-module-files" 21 | warningToFlag WMissingModuleFile = "missing-module-file" 22 | warningToFlag WTimeout = "timeout" 23 | warningToFlag WUnknownExtension = "unknown-extension" 24 | warningToFlag WInvalidField = "invalid-field" 25 | warningToFlag WCpphs = "cpphs" 26 | warningToFlag WErrorInSetup = "error-in-setup" 27 | warningToFlag WSkippedProperty = "skipped-property" 28 | -------------------------------------------------------------------------------- /cabal-docspec/tests/tests.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Test.Tasty (defaultMain, testGroup, TestTree) 4 | import Test.Tasty.HUnit (testCase, (@=?), (@?=)) 5 | 6 | import qualified Data.Set as Set 7 | 8 | import CabalDocspec.Diff 9 | import CabalDocspec.ExprVars 10 | 11 | 12 | main :: IO () 13 | main = defaultMain $ testGroup "cabal-docspec" 14 | [ exprVarsTests 15 | , diffTests 16 | ] 17 | 18 | exprVarsTests :: TestTree 19 | exprVarsTests = testGroup "ExprVars" 20 | [ ex "x + y" ["x","y"] 21 | , ex "forAll xs $ \\x -> x == x" ["forAll", "xs"] 22 | , ex "\\(xs :: [Int]) -> reverse xs === xs" ["reverse"] 23 | ] 24 | where 25 | ex expr vars = testCase expr $ Set.fromList vars @=? exprVars expr 26 | 27 | diffTests :: TestTree 28 | diffTests = testGroup "Diff" 29 | [ testCase "diffString1" $ diffString (map Exact "foo") "boo" @?= (1, 3, DS "f" "b" (SS "oo" ES)) 30 | , testCase "diffString2" $ diffString (Wildcard : map Exact "oo") "bboo" @?= (0, 4, SS "bboo" ES) 31 | 32 | , testCase "diffLines1" $ diffLines [Wildcard] ["aaa","bbb"] @?= (0, DiffSame ["aaa","bbb"] DiffEmpty) 33 | , testCase "diffLines2" $ diffLines [Wildcard, Exact $ map Exact "bbb"] ["aaa","bbb"] @?= (0, DiffSame ["aaa","bbb"] DiffEmpty) 34 | , testCase "diffLines3" $ diffLines [Wildcard, Exact $ map Exact "bbc"] ["aaa","bbb"] @?= 35 | (1 / 3,DiffSame ["aaa"] (DiffChunk [Norm "bb" (Emph "c" Empty)] [Norm "bb" (Emph "b" Empty)] DiffEmpty)) 36 | ] -------------------------------------------------------------------------------- /cabal-env/Changelog.md: -------------------------------------------------------------------------------- 1 | # 0.1 2 | 3 | First release 4 | -------------------------------------------------------------------------------- /cabal-env/LICENSE: -------------------------------------------------------------------------------- 1 | SPDX-License-Identifier: GPL-2.0-or-later 2 | 3 | Copyright (c) 2019 Oleg Grenrus 4 | 5 | This library is free software: you may copy, redistribute and/or modify it 6 | under the terms of the GNU General Public License as published by the 7 | Free Software Foundation, either version 3 of the License, or (at your 8 | option) any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but 11 | WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program (see `LICENSE.GPLv3`). If not, see 17 | . 18 | -------------------------------------------------------------------------------- /cabal-env/cabal-env.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: cabal-env 3 | version: 0.1 4 | synopsis: Manage GHC package-environments with cabal-install 5 | category: Development 6 | description: 7 | GHC-8.0 support package environment files. 8 | Those could be used to view parts of global @cabal-install@ package store. 9 | . 10 | Tuned for Oleg's preference, but has some knobs still. 11 | 12 | license: GPL-2.0-or-later 13 | license-files: 14 | LICENSE 15 | LICENSE.GPLv2 16 | LICENSE.GPLv3 17 | 18 | author: Oleg Grenrus 19 | maintainer: Oleg Grenrus 20 | tested-with: GHC ==9.8.4 21 | extra-source-files: Changelog.md 22 | 23 | source-repository head 24 | type: git 25 | location: https://github.com/phadej/cabal-extras.git 26 | 27 | library cabal-env-internal 28 | default-language: Haskell2010 29 | hs-source-dirs: src 30 | ghc-options: -Wall 31 | exposed-modules: 32 | CabalEnv.Environment 33 | CabalEnv.Main 34 | CabalEnv.Warning 35 | 36 | other-modules: Paths_cabal_env 37 | autogen-modules: Paths_cabal_env 38 | 39 | -- ghc-boot dependencies 40 | -- cabal-fmt: fragment ../fragments/boot-deps.fragment 41 | build-depends: 42 | , base ^>=4.19.0.0 43 | , binary ^>=0.8.9.0 44 | , bytestring ^>=0.12.0.2 45 | , containers ^>=0.6.8 46 | , deepseq ^>=1.5.0.0 47 | , directory ^>=1.3.8.1 48 | , filepath ^>=1.4.100.4 49 | , mtl ^>=2.3.1 50 | , parsec ^>=3.1.17.0 51 | , pretty ^>=1.1.3.6 52 | , process ^>=1.6.18.0 53 | , stm ^>=2.5.0.0 54 | , template-haskell 55 | , text ^>=2.1 56 | 57 | -- We use Cabal-3.12 58 | build-depends: Cabal ^>=3.12.1.0 59 | 60 | -- We also use peura 61 | build-depends: peura 62 | 63 | -- dependencies in library 64 | build-depends: 65 | , aeson ^>=2.2.1.0 66 | , base16-bytestring ^>=1.0.0.0 67 | , base64-bytestring ^>=1.2.0.0 68 | , cabal-install-parsers ^>=0.6 69 | , cabal-plan ^>=0.7.0.0 70 | , cryptohash-sha256 ^>=0.11.101.0 71 | , generic-lens-lite ^>=0.1 72 | , Glob ^>=0.10.0 73 | , lzma ^>=0.0.0.3 74 | , optparse-applicative ^>=0.18.0.0 75 | 76 | default-extensions: 77 | NoImplicitPrelude 78 | OverloadedStrings 79 | 80 | executable cabal-env 81 | default-language: Haskell2010 82 | hs-source-dirs: cli 83 | main-is: Main.hs 84 | ghc-options: -Wall -threaded 85 | build-depends: 86 | , base 87 | , cabal-env-internal 88 | -------------------------------------------------------------------------------- /cabal-env/cli/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | import CabalEnv.Main (main) 3 | -------------------------------------------------------------------------------- /cabal-env/src/CabalEnv/Warning.hs: -------------------------------------------------------------------------------- 1 | module CabalEnv.Warning where 2 | 3 | import Peura 4 | 5 | data W = WMissingCabalEnvData 6 | deriving (Eq, Ord, Enum, Bounded) 7 | 8 | instance Universe W where universe = [minBound .. maxBound] 9 | instance Finite W 10 | 11 | instance Warning W where 12 | warningToFlag WMissingCabalEnvData = "missing-cabal-envdata" 13 | -------------------------------------------------------------------------------- /cabal-haddock-server/Changelog.md: -------------------------------------------------------------------------------- 1 | # 0.1 2 | 3 | First release 4 | -------------------------------------------------------------------------------- /cabal-haddock-server/LICENSE: -------------------------------------------------------------------------------- 1 | SPDX-License-Identifier: GPL-2.0-or-later 2 | 3 | Copyright (c) 2019 Oleg Grenrus 4 | 5 | This library is free software: you may copy, redistribute and/or modify it 6 | under the terms of the GNU General Public License as published by the 7 | Free Software Foundation, either version 3 of the License, or (at your 8 | option) any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but 11 | WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program (see `LICENSE.GPLv3`). If not, see 17 | . 18 | -------------------------------------------------------------------------------- /cabal-haddock-server/README.md: -------------------------------------------------------------------------------- 1 | # cabal-haddock-server 2 | -------------------------------------------------------------------------------- /cabal-haddock-server/cabal-haddock-server.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: cabal-haddock-server 3 | version: 0.1 4 | synopsis: Spawn a web server providing haddocks docs tarballs 5 | category: Development 6 | description: Spawn a web server providing haddocks docs tarballs. 7 | license: GPL-2.0-or-later 8 | license-files: 9 | LICENSE 10 | LICENSE.GPLv2 11 | LICENSE.GPLv3 12 | 13 | author: Oleg Grenrus 14 | maintainer: Oleg Grenrus 15 | tested-with: GHC ==9.8.4 16 | extra-source-files: 17 | Changelog.md 18 | static/bootstrap.min.css 19 | 20 | source-repository head 21 | type: git 22 | location: https://github.com/phadej/cabal-extras.git 23 | subdir: cabal-haddock-server 24 | 25 | library cabal-haddock-server-internal 26 | default-language: Haskell2010 27 | hs-source-dirs: src 28 | ghc-options: -Wall 29 | 30 | -- main module separately 31 | exposed-modules: CabalHaddockServer.Main 32 | exposed-modules: 33 | CabalHaddockServer.DocsContents 34 | CabalHaddockServer.Options 35 | CabalHaddockServer.Pages.Error 36 | CabalHaddockServer.Pages.Index 37 | CabalHaddockServer.Pages.NotFound 38 | CabalHaddockServer.Pages.Package 39 | CabalHaddockServer.Pages.Redirect 40 | CabalHaddockServer.Pages.Search 41 | CabalHaddockServer.Routes 42 | CabalHaddockServer.Static 43 | CabalHaddockServer.TopPage 44 | CabalHaddockServer.Wai 45 | CabalHaddockServer.Warning 46 | 47 | -- ghc-boot dependencies 48 | -- cabal-fmt: fragment ../fragments/boot-deps.fragment 49 | build-depends: 50 | , base ^>=4.19.0.0 51 | , binary ^>=0.8.9.0 52 | , bytestring ^>=0.12.0.2 53 | , containers ^>=0.6.8 54 | , deepseq ^>=1.5.0.0 55 | , directory ^>=1.3.8.1 56 | , filepath ^>=1.4.100.4 57 | , mtl ^>=2.3.1 58 | , parsec ^>=3.1.17.0 59 | , pretty ^>=1.1.3.6 60 | , process ^>=1.6.18.0 61 | , stm ^>=2.5.0.0 62 | , template-haskell 63 | , text ^>=2.1 64 | 65 | -- We use Cabal-3.12 66 | build-depends: Cabal ^>=3.12.1.0 67 | 68 | -- We also use peura 69 | build-depends: peura 70 | 71 | -- hooglite is not (yet?) on Hackage 72 | build-depends: hooglite 73 | 74 | -- dependencies in library 75 | build-depends: 76 | , aeson 77 | , base16-bytestring ^>=1.0.0.0 78 | , cabal-install-parsers ^>=0.6 79 | , cryptohash-sha256 ^>=0.11.101.0 80 | , file-embed-lzma ^>=0.1 81 | , haskell-lexer 82 | , http-types ^>=0.12.3 83 | , lucid ^>=2.11.1 84 | , optparse-applicative ^>=0.18.0.0 85 | , tar ^>=0.6.2.0 86 | , time-manager ^>=0.1.0 87 | , wai ^>=3.2.3 88 | , warp ^>=3.4.0 89 | , zlib ^>=0.7.0.0 90 | 91 | default-extensions: 92 | NoImplicitPrelude 93 | OverloadedStrings 94 | 95 | executable cabal-haddock-server 96 | default-language: Haskell2010 97 | hs-source-dirs: cli 98 | main-is: Main.hs 99 | ghc-options: -Wall -threaded 100 | build-depends: 101 | , base 102 | , cabal-haddock-server-internal 103 | -------------------------------------------------------------------------------- /cabal-haddock-server/cli/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | import CabalHaddockServer.Main (main) 3 | -------------------------------------------------------------------------------- /cabal-haddock-server/src/CabalHaddockServer/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | {-# LANGUAGE TypeApplications #-} 5 | -- | 6 | -- Copyright: Oleg Grenrus 7 | -- License: GPL-3.0-or-later 8 | module CabalHaddockServer.Main (main) where 9 | 10 | import Peura 11 | 12 | import Hooglite.Haddock 13 | import System.TimeManager (TimeoutThread) 14 | 15 | import qualified Data.Map.Strict as Map 16 | import qualified Data.Set as Set 17 | 18 | import qualified Cabal.Index as CI 19 | import qualified Hooglite 20 | import qualified Network.Wai.Handler.Warp as Warp 21 | 22 | import CabalHaddockServer.DocsContents 23 | import CabalHaddockServer.Options 24 | import CabalHaddockServer.Wai 25 | import CabalHaddockServer.Warning 26 | 27 | main :: IO () 28 | main = do 29 | opts <- parseOptions 30 | tracer <- makeTracerPeu @(V1 W) (optTracer opts defaultTracerOptions) 31 | runPeu tracer () $ do 32 | meta <- cachedHackageMetadata tracer 33 | let hackagePkgIds :: Set PackageIdentifier 34 | hackagePkgIds = Set.fromList 35 | [ PackageIdentifier pn v 36 | | (pn, pi) <- Map.toList meta 37 | , (v, _) <- Map.toList (CI.piVersions pi) 38 | ] 39 | 40 | dcs <- for (optTarballs opts) $ \fspath -> do 41 | fspath' <- makeAbsolute fspath >>= canonicalizePath 42 | putInfo tracer $ show fspath' 43 | 44 | isFile <- doesFileExist fspath' 45 | if isFile 46 | then readDocsContentsTarball tracer fspath' 47 | else do 48 | isDir <- doesDirectoryExist fspath' 49 | if isDir 50 | then readDocsContentsDirectory tracer fspath' 51 | else die tracer $ toFilePath fspath' ++ " is not a file or a directory" 52 | 53 | let contents :: Map PackageIdentifier DocsContents 54 | contents = Map.fromList 55 | [ (apiPackageId $ docsContentsApi dc, dc) 56 | | dc <- catMaybes dcs 57 | ] 58 | 59 | let port = 13333 60 | 61 | putInfo tracer $ "Starting server at http://localhost:" ++ show port 62 | withRunInIO $ \runInIO -> do 63 | let warpOnException _mreq sexc@(SomeException exc) = 64 | case fromException sexc :: Maybe TimeoutThread of 65 | Just _ -> return () 66 | Nothing -> runInIO $ putError tracer $ fromString $ displayException exc 67 | 68 | let warpExceptionResponse (SomeException exc) = 69 | internalErrorResponse exc 70 | 71 | let settings = Warp.defaultSettings 72 | & Warp.setPort port 73 | & Warp.setOnException warpOnException 74 | & Warp.setOnExceptionResponse warpExceptionResponse 75 | 76 | Warp.runSettings settings $ application Ctx 77 | { ctxPackages = contents 78 | , ctxHackage = hackagePkgIds 79 | , ctxDatabase = foldMap (Hooglite.apiToDatabase . docsContentsApi) contents 80 | } 81 | -------------------------------------------------------------------------------- /cabal-haddock-server/src/CabalHaddockServer/Options.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module CabalHaddockServer.Options where 3 | 4 | import Peura 5 | 6 | import Control.Applicative ((<**>)) 7 | 8 | import qualified Options.Applicative as O 9 | 10 | import CabalHaddockServer.Warning 11 | 12 | parseOptions :: IO Opts 13 | parseOptions = O.execParser $ 14 | O.info (optsP <**> O.helper <**> versionP) $ mconcat 15 | [ O.fullDesc 16 | , O.progDesc "Browse local multi-package haddocks" 17 | , O.header "cabal-haddock-server - serves the docs tarball contents" 18 | ] 19 | where 20 | versionP = O.infoOption CURRENT_PACKAGE_VERSION 21 | $ O.long "version" <> O.help "Show version" 22 | 23 | ------------------------------------------------------------------------------- 24 | -- Options 25 | ------------------------------------------------------------------------------- 26 | 27 | data Opts = Opts 28 | { optTarballs :: [FsPath] 29 | , optTracer :: TracerOptions W -> TracerOptions W 30 | } 31 | 32 | optsP :: O.Parser Opts 33 | optsP = pure Opts 34 | <*> many (O.argument fspathP $ mconcat [O.metavar "TARBALL", O.help "docs tarball"]) 35 | <*> tracerOptionsParser 36 | 37 | fspathP :: O.ReadM FsPath 38 | fspathP = O.eitherReader $ return . fromFilePath 39 | -------------------------------------------------------------------------------- /cabal-haddock-server/src/CabalHaddockServer/Pages/Error.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module CabalHaddockServer.Pages.Error ( 3 | internalErrorPage, 4 | ) where 5 | 6 | import Lucid 7 | import Peura 8 | 9 | import CabalHaddockServer.Routes 10 | import CabalHaddockServer.TopPage 11 | 12 | internalErrorPage :: Exception e => e -> Html () 13 | internalErrorPage e = doctypehtml_ $ do 14 | link_ [ rel_ "stylesheet", href_ $ dispRoute (RouteStatic (fromUnrootedFilePath "bootstrap.min.css")) ] 15 | head_ $ do 16 | title_ "Exception" 17 | 18 | page_ $ do 19 | p_ $ pre_ $ code_ $ toHtml $ displayException e 20 | p_ $ a_ [ route_ RouteIndex ] $ "To main page" 21 | -------------------------------------------------------------------------------- /cabal-haddock-server/src/CabalHaddockServer/Pages/Index.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module CabalHaddockServer.Pages.Index ( 3 | indexPage, 4 | ) where 5 | 6 | import Lucid hiding (for_) 7 | import Peura 8 | 9 | import CabalHaddockServer.Routes 10 | import CabalHaddockServer.TopPage 11 | 12 | indexPage :: [PackageIdentifier] -> Html () 13 | indexPage pis = doctypehtml_ $ do 14 | head_ $ do 15 | link_ [ rel_ "stylesheet", href_ $ dispRoute (RouteStatic (fromUnrootedFilePath "bootstrap.min.css")) ] 16 | title_ "Haddock Server" 17 | 18 | page_ $ do 19 | h2_ "Local packages" 20 | 21 | ul_ $ for_ pis $ \pi -> li_ $ 22 | a_ [ route_ $ RoutePackageId pi ] $ toHtml $ prettyShow pi 23 | -------------------------------------------------------------------------------- /cabal-haddock-server/src/CabalHaddockServer/Pages/NotFound.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module CabalHaddockServer.Pages.NotFound ( 3 | notFoundPage, 4 | ) where 5 | 6 | import Lucid 7 | import Peura 8 | 9 | import CabalHaddockServer.Routes 10 | import CabalHaddockServer.TopPage 11 | 12 | notFoundPage :: [Text] -> Html () 13 | notFoundPage pi = doctypehtml_ $ do 14 | head_ $ do 15 | link_ [ rel_ "stylesheet", href_ $ dispRoute (RouteStatic (fromUnrootedFilePath "bootstrap.min.css")) ] 16 | title_ "Not found" 17 | 18 | page_ $ do 19 | p_ $ do 20 | code_ $ toHtml $ foldMap ("/" <>) pi 21 | " not found" 22 | 23 | p_ $ a_ [ route_ RouteIndex ] $ "To main page" 24 | 25 | -------------------------------------------------------------------------------- /cabal-haddock-server/src/CabalHaddockServer/Pages/Package.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module CabalHaddockServer.Pages.Package ( 3 | packagePage, 4 | ) where 5 | 6 | import Lucid hiding (for_) 7 | import Peura 8 | import Hooglite.Haddock 9 | 10 | import qualified Data.Map.Strict as Map 11 | import qualified Data.Set as Set 12 | import qualified Distribution.ModuleName as C 13 | 14 | import CabalHaddockServer.DocsContents 15 | import CabalHaddockServer.Routes 16 | import CabalHaddockServer.TopPage 17 | 18 | packagePage :: [PackageIdentifier] -> DocsContents -> Html () 19 | packagePage pis dc = doctypehtml_ $ do 20 | head_ $ do 21 | link_ [ rel_ "stylesheet", href_ $ dispRoute (RouteStatic (fromUnrootedFilePath "bootstrap.min.css")) ] 22 | title_ $ toHtml $ prettyShow pkgId ++ " - Haddock Server" 23 | when (Set.member (fromUnrootedFilePath "quick-jump.css") (docsContentsFiles dc)) $ do 24 | link_ [ rel_ "stylesheet", type_ "text/css", href_ $ "/package/" <> fromString (prettyShow pkgId) <> "/docs/quick-jump.css" ] 25 | 26 | page_ $ do 27 | h1_ $ toHtml $ prettyShow pkgId ++ " - cabal-haddock-server" 28 | 29 | ul_ $ li_ $ a_ [ route_ RouteIndex ] "Local package index" 30 | 31 | h2_ "Modules" 32 | 33 | ul_ $ for_ (Map.keys $ apiModules $ docsContentsApi dc) $ \mn -> li_ $ 34 | a_ [ route_ $ RoutePackageDocs pkgId $ mnToPath mn ] $ toHtml $ prettyShow mn 35 | 36 | when (Set.member (fromUnrootedFilePath "quick-jump.min.js") (docsContentsFiles dc)) $ do 37 | script_ 38 | [ src_ $ "/package/" <> fromString (prettyShow pkgId) <> "/docs/quick-jump.min.js" 39 | , type_ "text/javascript" 40 | ] 41 | ("" :: Text) 42 | 43 | script_ [ type_ "text/javascript" ] $ 44 | "quickNav.init('/package/" ++ prettyShow pkgId ++ "/docs', function(toggle) {var t = document.getElementById('quickjump-trigger');if (t) {t.onclick = function(e) { e.preventDefault(); toggle(); };}});" 45 | 46 | h2_ "Local packages" 47 | 48 | ul_ $ for_ pis $ \pi -> li_ $ 49 | a_ [ route_ $ RoutePackageId pi ] $ toHtml $ prettyShow pi 50 | where 51 | 52 | pkgId = apiPackageId $ docsContentsApi dc 53 | 54 | mnToPath :: C.ModuleName -> Path Unrooted 55 | mnToPath mn = fromUnrootedFilePath $ 56 | map f (prettyShow mn) ++ ".html" 57 | where 58 | f '.' = '-' 59 | f c = c 60 | -------------------------------------------------------------------------------- /cabal-haddock-server/src/CabalHaddockServer/Pages/Redirect.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module CabalHaddockServer.Pages.Redirect ( 3 | redirectPage, 4 | ) where 5 | 6 | import Lucid 7 | import Peura 8 | 9 | redirectPage :: ByteString -> Html () 10 | redirectPage bs = doctypehtml_ $ do 11 | let t = decodeUtf8Lenient bs 12 | 13 | head_ $ do 14 | title_ "Redirecting..." 15 | 16 | body_ $ p_ $ do 17 | "Redirecting to " 18 | a_ [ href_ t ] $ toHtml t 19 | 20 | -------------------------------------------------------------------------------- /cabal-haddock-server/src/CabalHaddockServer/Pages/Search.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module CabalHaddockServer.Pages.Search ( 3 | searchPage, 4 | ) where 5 | 6 | import Lucid hiding (for_) 7 | import Peura 8 | import Prelude (even) 9 | 10 | import qualified Hooglite 11 | import qualified Language.Haskell.Lexer as L 12 | 13 | import CabalHaddockServer.Routes 14 | import CabalHaddockServer.TopPage 15 | 16 | searchPage :: [PackageIdentifier] -> Hooglite.Database -> Maybe String -> Html () 17 | searchPage pis db q = doctypehtml_ $ do 18 | head_ $ do 19 | link_ [ rel_ "stylesheet", href_ $ dispRoute (RouteStatic (fromUnrootedFilePath "bootstrap.min.css")) ] 20 | title_ "Haddock Server" 21 | 22 | page_ $ do 23 | for_ q $ \q' -> do 24 | let q'' = Hooglite.parseQuery q' 25 | h2_ "Search" 26 | 27 | form_ [ class_ "row mb-3", action_ (dispRoute RouteSearch), method_ "GET"] $ do 28 | div_ [ class_ "col-md-10"] $ input_ [ name_ "q", class_ "form-control me-2", type_ "search", placeholder_ "search", value_ (fromString q') ] -- aria-label="Search" 29 | div_ [ class_ "col-md-2" ] $ button_ [ class_ "btn btn-primary", type_ "submit" ] "Search" 30 | 31 | p_ $ "Query was parsed as " *> code_ (toHtml (Hooglite.pretty q'')) 32 | 33 | ifor_ (take 200 $ Hooglite.query db q'') $ \i (Hooglite.Entry pn ver mn name decl) -> do 34 | let pkgId = PackageIdentifier pn ver 35 | 36 | let dotToDash '.' = '-' 37 | dotToDash c = c 38 | 39 | let mkLink :: Maybe String -> Html () -> Html () 40 | mkLink anchor' t = a_ [ href_ $ dispRoute $ RoutePackageDocs pkgId $ fromUnrootedFilePath $ "/" ++ map dotToDash (prettyShow mn) ++ ".html" ++ maybe "" ("#"++) anchor'] t 41 | 42 | let anchor = case decl of 43 | Hooglite.SigD {} -> "v:" ++ Hooglite.pretty name 44 | Hooglite.ConD {} -> "v:" ++ Hooglite.pretty name 45 | _ -> "t:" ++ Hooglite.pretty name 46 | 47 | div_ [ class_ $ "row mb-1 border-bottom " <> if even i then "bg-light" else "bg-white" ] $ do 48 | div_ [ class_ "col-md-8" ] $ do 49 | for_ (L.lexerPass0 $ Hooglite.declarationSrc decl) $ \(tk, (_, str)) -> case tk of 50 | L.Reservedid -> b_ $ toHtml str 51 | _ -> case str of 52 | _ | str == Hooglite.pretty name 53 | -> mkLink (Just anchor) $ toHtml str 54 | -- selected pieces from https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/unicode_syntax.html 55 | "->" -> "→" 56 | "=>" -> "⇒" 57 | "forall" -> "∀" 58 | _ -> toHtml str 59 | 60 | div_ [ class_ "col-md-4" ] $ small_ $ do 61 | b_ $ a_ [ href_ $ dispRoute $ RoutePackageId pkgId ] $ toHtml $ prettyShow pkgId 62 | toHtmlRaw (" — " :: String) 63 | mkLink Nothing $ toHtml (prettyShow mn) 64 | 65 | h2_ "Local packages" 66 | 67 | ul_ $ for_ pis $ \pi -> li_ $ 68 | a_ [ route_ $ RoutePackageId pi ] $ toHtml $ prettyShow pi 69 | 70 | ------------------------------------------------------------------------------- 71 | -- Pretty-print haskell code 72 | ------------------------------------------------------------------------------- 73 | 74 | 75 | -------------------------------------------------------------------------------- /cabal-haddock-server/src/CabalHaddockServer/Routes.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module CabalHaddockServer.Routes ( 3 | Route (..), 4 | parseRoute, 5 | dispRoute, 6 | route_, 7 | ) where 8 | 9 | import Peura 10 | 11 | import Data.List (intercalate) 12 | import Distribution.Parsec (eitherParsec) 13 | 14 | import qualified Data.Text as T 15 | import qualified Lucid.Base as L 16 | 17 | -- | Routes in the web application. 18 | data Route 19 | = RouteIndex 20 | -- ^ @/@ index page. 21 | | RouteSearch 22 | -- ^ @/search@ search page 23 | | RoutePackageId PackageIdentifier 24 | -- ^ @/package/@ 25 | | RoutePackageDocs PackageIdentifier (Path Unrooted) 26 | -- ^ @/package//docs/@ some file 27 | | RouteStatic (Path Unrooted) 28 | -- ^ @/static/a.file.css@ static files 29 | deriving Show 30 | 31 | parseRoute :: [Text] -> Maybe Route 32 | parseRoute [] = Just RouteIndex 33 | parseRoute ["search"] = Just RouteSearch 34 | parseRoute ["package", pi] 35 | | Right pi' <- eitherParsec (T.unpack pi) 36 | = Just (RoutePackageId pi') 37 | parseRoute ("package" : pi : "docs" : rest) 38 | | Right pi' <- eitherParsec (T.unpack pi) 39 | , not (null rest) 40 | , let p = fromUnrootedFilePath $ intercalate "/" $ map T.unpack rest 41 | = Just (RoutePackageDocs pi' p) 42 | parseRoute ["static", file] 43 | = Just (RouteStatic (fromUnrootedFilePath (T.unpack file))) 44 | parseRoute _ = Nothing 45 | 46 | dispRoute :: Route -> Text 47 | dispRoute RouteIndex = 48 | "/" 49 | dispRoute RouteSearch = 50 | "/search" 51 | dispRoute (RoutePackageId pkgId) = 52 | "/package/" <> fromString (prettyShow pkgId) 53 | dispRoute (RoutePackageDocs pkgId p) = 54 | "/package/" <> fromString (prettyShow pkgId) <> 55 | "/docs/" <> fromString (toUnrootedFilePath p) 56 | dispRoute (RouteStatic file) = 57 | "/static/" <> fromString (toUnrootedFilePath file) 58 | 59 | route_ :: Route -> L.Attribute 60 | route_ = L.makeAttribute "href" . dispRoute 61 | -------------------------------------------------------------------------------- /cabal-haddock-server/src/CabalHaddockServer/Static.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | module CabalHaddockServer.Static ( 3 | staticFiles, 4 | ) where 5 | 6 | import Peura 7 | 8 | import qualified Data.Map.Strict as Map 9 | import qualified FileEmbedLzma 10 | 11 | staticFiles :: Map FilePath ByteString 12 | staticFiles = Map.fromList $$(FileEmbedLzma.embedDir "static") 13 | -------------------------------------------------------------------------------- /cabal-haddock-server/src/CabalHaddockServer/TopPage.hs: -------------------------------------------------------------------------------- 1 | module CabalHaddockServer.TopPage where 2 | 3 | import Lucid 4 | import Peura 5 | 6 | import CabalHaddockServer.Routes 7 | 8 | page_ :: Html () -> Html () 9 | page_ body = body_ [ class_ "bg-light" ] $ do 10 | nav_ [ class_ "navbar navbar-light bg-dark mb-3" ] $ div_ [ class_ "container-fluid" ] $ do 11 | a_ [ class_ "navbar-brand text-light", href_ (dispRoute RouteIndex) ] "Cabal Haddock Server" 12 | 13 | form_ [ class_ "d-flex", action_ (dispRoute RouteSearch), method_ "GET"] $ do 14 | input_ [ name_ "q", class_ "form-control me-2", type_ "search", placeholder_ "search" ] -- aria-label="Search" 15 | button_ [ class_ "btn btn-primary", type_ "submit" ] "Search" 16 | 17 | div_ [ class_ "container" ] $ div_ [ class_ "row" ] $ div_ [ class_ "col-md-12" ] body 18 | -------------------------------------------------------------------------------- /cabal-haddock-server/src/CabalHaddockServer/Wai.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | module CabalHaddockServer.Wai ( 4 | application, 5 | Ctx (..), 6 | internalErrorResponse, 7 | ) where 8 | 9 | import Peura 10 | 11 | import Network.HTTP.Types.Status (Status, notFound404, ok200, status302, status500) 12 | 13 | import qualified Data.List as L 14 | import qualified Data.Map.Strict as Map 15 | import qualified Data.Set as Set 16 | import qualified Lucid 17 | import qualified Network.Wai as Wai 18 | import qualified Hooglite 19 | 20 | import CabalHaddockServer.DocsContents 21 | import CabalHaddockServer.Pages.Error 22 | import CabalHaddockServer.Pages.Index 23 | import CabalHaddockServer.Pages.NotFound 24 | import CabalHaddockServer.Pages.Package 25 | import CabalHaddockServer.Pages.Redirect 26 | import CabalHaddockServer.Pages.Search 27 | import CabalHaddockServer.Routes 28 | import CabalHaddockServer.Static 29 | 30 | data Ctx = Ctx 31 | { ctxPackages :: Map PackageIdentifier DocsContents 32 | , ctxHackage :: Set PackageIdentifier 33 | , ctxDatabase :: Hooglite.Database 34 | } 35 | 36 | application :: Ctx -> Wai.Application 37 | application ctx req res = case parseRoute (Wai.pathInfo req) of 38 | Just RouteIndex -> res indexResponse 39 | Just RouteSearch -> res searchResponse 40 | 41 | Just (RoutePackageId pkgId) 42 | | Just dc <- Map.lookup pkgId (ctxPackages ctx) 43 | -> res $ packageResponse dc 44 | 45 | Just (RoutePackageDocs pkgId fp) 46 | | Just dc <- Map.lookup pkgId (ctxPackages ctx) 47 | , Set.member fp (docsContentsFiles dc) 48 | -> res $ case docsContentsServe dc fp of 49 | DocsFileOnDisk fp' -> Wai.responseFile ok200 50 | [("Content-Type", contentType (takeExtension fp))] 51 | (toFilePath fp') 52 | Nothing 53 | DocsFileInMemory lbs -> Wai.responseLBS ok200 54 | [("Content-Type", contentType (takeExtension fp))] 55 | lbs 56 | 57 | Just (RoutePackageDocs pkgId _fp) 58 | | Set.member pkgId (ctxHackage ctx) 59 | -> res $ Wai.responseLBS 60 | status302 61 | [ ("Content-Type", "text/html; ; charset=utf-8") 62 | , ("Location", loc) 63 | ] 64 | (Lucid.renderBS $ redirectPage loc) 65 | where 66 | loc = fromString "https://hackage.haskell.org" <> Wai.rawPathInfo req 67 | 68 | Just (RouteStatic file) 69 | | Just bs <- Map.lookup ("/" ++ (toUnrootedFilePath file)) staticFiles 70 | -> res $ Wai.responseLBS ok200 71 | [ ("Content-Type", contentType (takeExtension file)) ] 72 | (toLazy bs) 73 | 74 | _ -> res notFoundResponse 75 | where 76 | indexResponse = page ok200 $ indexPage (Map.keys (ctxPackages ctx)) 77 | searchResponse = page ok200 $ searchPage (Map.keys (ctxPackages ctx)) (ctxDatabase ctx) q 78 | notFoundResponse = page notFound404 $ notFoundPage (Wai.pathInfo req) 79 | packageResponse dc = page ok200 $ packagePage (Map.keys (ctxPackages ctx)) dc 80 | 81 | contentType (Just (FileExt "html")) = "text/html; charset=utf-8" 82 | contentType (Just (FileExt "css")) = "text/css" 83 | contentType (Just (FileExt "js")) = "text/javascript" 84 | contentType (Just (FileExt "png")) = "image/png" 85 | contentType _ = "application/octet-stream" 86 | 87 | q :: Maybe String 88 | q = fromUTF8BS <$> join (L.lookup "q" (Wai.queryString req)) 89 | 90 | internalErrorResponse :: Exception e => e -> Wai.Response 91 | internalErrorResponse e = page status500 (internalErrorPage e) 92 | 93 | page :: Status -> Lucid.Html () -> Wai.Response 94 | page s l = Wai.responseLBS 95 | s 96 | [("Content-Type", "text/html; charset=utf-8")] 97 | (Lucid.renderBS l) 98 | -------------------------------------------------------------------------------- /cabal-haddock-server/src/CabalHaddockServer/Warning.hs: -------------------------------------------------------------------------------- 1 | module CabalHaddockServer.Warning where 2 | 3 | import Peura 4 | 5 | data W 6 | = WMissingHoogleFile 7 | | WMultipleHoogleFiles 8 | | WHoogle 9 | deriving (Eq, Ord, Enum, Bounded) 10 | 11 | instance Universe W where universe = [minBound .. maxBound] 12 | instance Finite W 13 | 14 | instance Warning W where 15 | warningToFlag WMissingHoogleFile = "missing-hoogle-file" 16 | warningToFlag WMultipleHoogleFiles = "multiple-hoogle-files" 17 | warningToFlag WHoogle = "hoogle" 18 | -------------------------------------------------------------------------------- /cabal-hasklint/.gitignore: -------------------------------------------------------------------------------- 1 | # "releases" 2 | cabal-hasklint-*.xz 3 | -------------------------------------------------------------------------------- /cabal-hasklint/Changelog.md: -------------------------------------------------------------------------------- 1 | # 0.1 2 | 3 | First release 4 | -------------------------------------------------------------------------------- /cabal-hasklint/LICENSE: -------------------------------------------------------------------------------- 1 | SPDX-License-Identifier: GPL-2.0-or-later 2 | 3 | Copyright (c) 2019 Oleg Grenrus 4 | 5 | This library is free software: you may copy, redistribute and/or modify it 6 | under the terms of the GNU General Public License as published by the 7 | Free Software Foundation, either version 3 of the License, or (at your 8 | option) any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but 11 | WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program (see `LICENSE.GPLv3`). If not, see 17 | . 18 | -------------------------------------------------------------------------------- /cabal-hasklint/cabal-hasklint.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: cabal-hasklint 3 | version: 0.0.0.20211218 4 | synopsis: Another linter 5 | category: Development 6 | description: 7 | The @cabal-haskelint@ is different from e.g. HLint or stan 8 | as it takes into account cabal file information. 9 | . 10 | This is proof of concept, and currently it only lints for unqualified 11 | imports, yet allowing package own modules to be imported unqualified. 12 | 13 | license: GPL-2.0-or-later 14 | license-files: 15 | LICENSE 16 | LICENSE.GPLv2 17 | LICENSE.GPLv3 18 | 19 | author: Oleg Grenrus 20 | maintainer: Oleg Grenrus 21 | tested-with: GHC ==9.8.4 22 | extra-source-files: Changelog.md 23 | 24 | source-repository head 25 | type: git 26 | location: https://github.com/phadej/cabal-extras.git 27 | subdir: cabal-hasklint 28 | 29 | library internal-cpphs 30 | default-language: Haskell2010 31 | hs-source-dirs: cpphs 32 | build-depends: 33 | , base >=4.13 && <5 34 | , directory ^>=1.3.0.2 35 | , polyparse ^>=1.13 36 | , time-compat ^>=1.9.4 37 | 38 | exposed-modules: 39 | Language.Preprocessor.Cpphs 40 | Language.Preprocessor.Unlit 41 | 42 | other-modules: 43 | Language.Preprocessor.Cpphs.CppIfdef 44 | Language.Preprocessor.Cpphs.HashDefine 45 | Language.Preprocessor.Cpphs.MacroPass 46 | Language.Preprocessor.Cpphs.Options 47 | Language.Preprocessor.Cpphs.Position 48 | Language.Preprocessor.Cpphs.ReadFirst 49 | Language.Preprocessor.Cpphs.RunCpphs 50 | Language.Preprocessor.Cpphs.SymTab 51 | Language.Preprocessor.Cpphs.Tokenise 52 | 53 | library cabal-hasklint-internal 54 | default-language: Haskell2010 55 | hs-source-dirs: src 56 | ghc-options: -Wall 57 | 58 | -- Main module 59 | exposed-modules: CabalHasklint.Main 60 | 61 | -- rest of the implementation 62 | exposed-modules: 63 | CabalHasklint.Cpp 64 | CabalHasklint.GHC.Utils 65 | CabalHasklint.Lint 66 | CabalHasklint.Opts 67 | CabalHasklint.Package 68 | CabalHasklint.Parse 69 | CabalHasklint.Trace 70 | CabalHasklint.Warning 71 | 72 | -- ghc-boot dependencies 73 | -- cabal-fmt: fragment ../fragments/boot-deps.fragment 74 | build-depends: 75 | , base ^>=4.19.0.0 76 | , binary ^>=0.8.9.0 77 | , bytestring ^>=0.12.0.2 78 | , containers ^>=0.6.8 79 | , deepseq ^>=1.5.0.0 80 | , directory ^>=1.3.8.1 81 | , filepath ^>=1.4.100.4 82 | , mtl ^>=2.3.1 83 | , parsec ^>=3.1.17.0 84 | , pretty ^>=1.1.3.6 85 | , process ^>=1.6.18.0 86 | , stm ^>=2.5.0.0 87 | , template-haskell 88 | , text ^>=2.1 89 | 90 | -- We use Cabal-3.12 91 | build-depends: Cabal ^>=3.12.1.0 92 | 93 | -- We also use peura 94 | build-depends: peura 95 | 96 | -- vendored cpphs, so we can integrate warnings 97 | build-depends: internal-cpphs 98 | 99 | -- dependencies in library 100 | build-depends: 101 | , ansi-terminal ^>=1.1 102 | , async ^>=2.2.2 103 | , cabal-install-parsers ^>=0.6 104 | , cabal-plan ^>=0.7.0.0 105 | , ghc-lib-parser ^>=9.8.2.20240223 106 | , ghc-lib-parser-ex ^>=9.8.0.0 107 | , Glob ^>=0.10.0 108 | , optparse-applicative ^>=0.18.0.0 109 | , splitmix ^>=0.1.0.3 110 | , unliftio-core ^>=0.2.0.1 111 | 112 | default-extensions: 113 | NoImplicitPrelude 114 | OverloadedStrings 115 | 116 | executable cabal-hasklint 117 | default-language: Haskell2010 118 | hs-source-dirs: cli 119 | main-is: Main.hs 120 | ghc-options: -Wall -rtsopts -threaded 121 | build-depends: 122 | , base 123 | , cabal-hasklint-internal 124 | -------------------------------------------------------------------------------- /cabal-hasklint/cli/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | import CabalHasklint.Main (main) 3 | -------------------------------------------------------------------------------- /cabal-hasklint/cpphs/LICENCE-commercial: -------------------------------------------------------------------------------- 1 | Commercial licence for cpphs. 2 | 3 | Copyright 2004-2010, Malcolm Wallace (malcolm.wallace@me.com) 4 | All rights reserved. 5 | 6 | * This software, built from original unmodified sources, may be used for 7 | any purpose whatsoever, without restriction. 8 | 9 | * Redistribution in binary form, without modification, is permitted 10 | provided that the above copyright notice, these conditions and the 11 | following disclaimer are reproduced in the documentation and/or other 12 | materials provided with the distribution. 13 | 14 | * Redistribution in source form, with or without modification, is not 15 | permitted under this license. 16 | 17 | THIS SOFTWARE IS PROVIDED BY Malcolm Wallace 18 | AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, 19 | INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 20 | FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL 21 | Malcolm Wallace OR THE CONTRIBUTORS BE LIABLE 22 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 24 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 25 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 26 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 27 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH 28 | DAMAGE. 29 | 30 | -------------------------------------------------------------------------------- /cabal-hasklint/cpphs/Language/Preprocessor/Cpphs.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Language.Preprocessor.Cpphs 4 | -- Copyright : 2000-2006 Malcolm Wallace 5 | -- Licence : LGPL 6 | -- 7 | -- Maintainer : Malcolm Wallace 8 | -- Stability : experimental 9 | -- Portability : All 10 | -- 11 | -- Include the interface that is exported 12 | ----------------------------------------------------------------------------- 13 | 14 | module Language.Preprocessor.Cpphs 15 | ( runCpphs, runCpphsPass1, runCpphsPass2, runCpphsReturningSymTab 16 | , cppIfdef, tokenise, WordStyle(..) 17 | , macroPass, macroPassReturningSymTab 18 | , CpphsOptions(..), BoolOptions(..) 19 | , parseOptions, defaultCpphsOptions, defaultBoolOptions 20 | , CpphsActions(..), defaultCpphsActions 21 | , module Language.Preprocessor.Cpphs.Position 22 | ) where 23 | 24 | import Language.Preprocessor.Cpphs.CppIfdef(cppIfdef) 25 | import Language.Preprocessor.Cpphs.MacroPass(macroPass 26 | ,macroPassReturningSymTab) 27 | import Language.Preprocessor.Cpphs.RunCpphs(runCpphs 28 | ,runCpphsPass1 29 | ,runCpphsPass2 30 | ,runCpphsReturningSymTab) 31 | import Language.Preprocessor.Cpphs.Options 32 | (CpphsOptions(..), BoolOptions(..), parseOptions 33 | ,defaultCpphsOptions,defaultBoolOptions 34 | ,CpphsActions(..), defaultCpphsActions 35 | ) 36 | import Language.Preprocessor.Cpphs.Position 37 | import Language.Preprocessor.Cpphs.Tokenise 38 | -------------------------------------------------------------------------------- /cabal-hasklint/cpphs/Language/Preprocessor/Cpphs/ReadFirst.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : ReadFirst 4 | -- Copyright : 2004 Malcolm Wallace 5 | -- Licence : LGPL 6 | -- 7 | -- Maintainer : Malcolm Wallace 8 | -- Stability : experimental 9 | -- Portability : All 10 | -- 11 | -- Read the first file that matches in a list of search paths. 12 | ----------------------------------------------------------------------------- 13 | 14 | module Language.Preprocessor.Cpphs.ReadFirst 15 | ( readFirst 16 | , readFileUTF8 17 | , writeFileUTF8 18 | ) where 19 | 20 | import System.IO 21 | import System.Directory (doesFileExist) 22 | import Data.List (intersperse) 23 | import Control.Exception as E 24 | import Control.Monad (when) 25 | import Language.Preprocessor.Cpphs.Position (Posn,directory,cleanPath) 26 | import Language.Preprocessor.Cpphs.Options (CpphsActions (..)) 27 | 28 | -- | Attempt to read the given file from any location within the search path. 29 | -- The first location found is returned, together with the file content. 30 | -- (The directory of the calling file is always searched first, then 31 | -- the current directory, finally any specified search path.) 32 | readFirst :: CpphsActions 33 | -> String -- ^ filename 34 | -> Posn -- ^ inclusion point 35 | -> [String] -- ^ search path 36 | -> Bool -- ^ report warnings? 37 | -> IO ( FilePath 38 | , String 39 | ) -- ^ discovered filepath, and file contents 40 | 41 | readFirst actions name demand path warn = 42 | case name of 43 | -- Windows drive in absolute path 44 | c:':':'\\':nm-> try nm (Just (c:':':[])) [""] 45 | c:':':'/':nm -> try nm (Just (c:':':[])) [""] 46 | -- Windows drive in relative path 47 | c:':':nm -> try nm (Just (c:':':[])) (cons dd (".":path)) 48 | -- unix-like absolute path 49 | '/':nm -> try nm Nothing [""] 50 | -- any relative path 51 | _ -> try name Nothing (cons dd (".":path)) 52 | where 53 | dd = directory demand 54 | cons x xs = if null x then xs else x:xs 55 | try name _ [] = do 56 | when warn $ 57 | cpphsPutWarning actions 58 | ("Warning: Can't find file \""++name 59 | ++"\" in directories\n\t" 60 | ++concat (intersperse "\n\t" (cons dd (".":path))) 61 | ++"\n Asked for by: "++show demand) 62 | return ("missing file: "++name,"") 63 | try name drive (p:ps) = do 64 | let file = (maybe id (++) drive) $ cleanPath p++'/':cleanPath name 65 | ok <- doesFileExist file 66 | if not ok then try name drive ps 67 | else do content <- readFileUTF8 file 68 | return (file,content) 69 | 70 | readFileUTF8 :: FilePath -> IO String 71 | readFileUTF8 file = do 72 | h <- openFile file ReadMode 73 | (do utf8r <- mkTextEncoding "UTF-8//ROUNDTRIP" 74 | hSetEncoding h utf8r 75 | hGetContents h) `E.onException` (hClose h) 76 | 77 | writeFileUTF8 :: FilePath -> String -> IO () 78 | writeFileUTF8 f txt = withFile f WriteMode $ \hdl-> 79 | do utf8r <- mkTextEncoding "UTF-8//ROUNDTRIP" 80 | hSetEncoding hdl utf8r 81 | hPutStr hdl txt 82 | `E.onException` (hClose hdl) 83 | 84 | -------------------------------------------------------------------------------- /cabal-hasklint/cpphs/Language/Preprocessor/Cpphs/SymTab.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : SymTab 4 | -- Copyright : 2000-2004 Malcolm Wallace 5 | -- Licence : LGPL 6 | -- 7 | -- Maintainer : Malcolm Wallace 8 | -- Stability : Stable 9 | -- Portability : All 10 | -- 11 | -- Symbol Table, based on index trees using a hash on the key. 12 | -- Keys are always Strings. Stored values can be any type. 13 | ----------------------------------------------------------------------------- 14 | 15 | module Language.Preprocessor.Cpphs.SymTab 16 | ( SymTab 17 | , emptyST 18 | , insertST 19 | , deleteST 20 | , lookupST 21 | , definedST 22 | , flattenST 23 | , IndTree 24 | ) where 25 | 26 | -- | Symbol Table. Stored values are polymorphic, but the keys are 27 | -- always strings. 28 | type SymTab v = IndTree [(String,v)] 29 | 30 | emptyST :: SymTab v 31 | insertST :: (String,v) -> SymTab v -> SymTab v 32 | deleteST :: String -> SymTab v -> SymTab v 33 | lookupST :: String -> SymTab v -> Maybe v 34 | definedST :: String -> SymTab v -> Bool 35 | flattenST :: SymTab v -> [v] 36 | 37 | emptyST = itgen maxHash [] 38 | insertST (s,v) ss = itiap (hash s) ((s,v):) ss id 39 | deleteST s ss = itiap (hash s) (filter ((/=s).fst)) ss id 40 | lookupST s ss = let vs = filter ((==s).fst) ((itind (hash s)) ss) 41 | in if null vs then Nothing 42 | else (Just . snd . head) vs 43 | definedST s ss = let vs = filter ((==s).fst) ((itind (hash s)) ss) 44 | in (not . null) vs 45 | flattenST ss = itfold (map snd) (++) ss 46 | 47 | 48 | ---- 49 | -- | Index Trees (storing indexes at nodes). 50 | 51 | data IndTree t = Leaf t | Fork Int (IndTree t) (IndTree t) 52 | deriving Show 53 | 54 | itgen :: Int -> a -> IndTree a 55 | itgen 1 x = Leaf x 56 | itgen n x = 57 | let n' = n `div` 2 58 | in Fork n' (itgen n' x) (itgen (n-n') x) 59 | 60 | itiap :: --Eval a => 61 | Int -> (a->a) -> IndTree a -> (IndTree a -> b) -> b 62 | itiap _ f (Leaf x) k = let fx = f x in {-seq fx-} (k (Leaf fx)) 63 | itiap i f (Fork n lt rt) k = 64 | if i k (Fork n lt' rt) 66 | else itiap (i-n) f rt $ \rt' -> k (Fork n lt rt') 67 | 68 | itind :: Int -> IndTree a -> a 69 | itind _ (Leaf x) = x 70 | itind i (Fork n lt rt) = if ib) -> (b->b->b) -> IndTree a -> b 73 | itfold leaf _fork (Leaf x) = leaf x 74 | itfold leaf fork (Fork _ l r) = fork (itfold leaf fork l) (itfold leaf fork r) 75 | 76 | ---- 77 | -- Hash values 78 | 79 | maxHash :: Int -- should be prime 80 | maxHash = 101 81 | 82 | class Hashable a where 83 | hashWithMax :: Int -> a -> Int 84 | hash :: a -> Int 85 | hash = hashWithMax maxHash 86 | 87 | instance Enum a => Hashable [a] where 88 | hashWithMax m = h 0 89 | where h a [] = a 90 | h a (c:cs) = h ((17*(fromEnum c)+19*a)`rem`m) cs 91 | 92 | ---- 93 | -------------------------------------------------------------------------------- /cabal-hasklint/cpphs/Language/Preprocessor/Unlit.hs: -------------------------------------------------------------------------------- 1 | -- | Part of this code is from "Report on the Programming Language Haskell", 2 | -- version 1.2, appendix C. 3 | module Language.Preprocessor.Unlit (unlit) where 4 | 5 | import Data.Char 6 | import Data.List (isPrefixOf) 7 | 8 | data Classified = Program String | Blank | Comment 9 | | Include Int String | Pre String 10 | 11 | classify :: [String] -> [Classified] 12 | classify [] = [] 13 | classify (('\\':x):xs) | x == "begin{code}" = Blank : allProg xs 14 | where allProg [] = [] -- Should give an error message, 15 | -- but I have no good position information. 16 | allProg (('\\':x):xs) | "end{code}"`isPrefixOf`x = Blank : classify xs 17 | allProg (x:xs) = Program x:allProg xs 18 | classify (('>':x):xs) = Program (' ':x) : classify xs 19 | classify (('#':x):xs) = (case words x of 20 | (line:rest) | all isDigit line 21 | -> Include (read line) (unwords rest) 22 | _ -> Pre x 23 | ) : classify xs 24 | --classify (x:xs) | "{-# LINE" `isPrefixOf` x = Program x: classify xs 25 | classify (x:xs) | all isSpace x = Blank:classify xs 26 | classify (x:xs) = Comment:classify xs 27 | 28 | unclassify :: Classified -> String 29 | unclassify (Program s) = s 30 | unclassify (Pre s) = '#':s 31 | unclassify (Include i f) = '#':' ':show i ++ ' ':f 32 | unclassify Blank = "" 33 | unclassify Comment = "" 34 | 35 | -- | 'unlit' takes a filename (for error reports), and transforms the 36 | -- given string, to eliminate the literate comments from the program text. 37 | unlit :: FilePath -> String -> String 38 | unlit file lhs = (unlines 39 | . map unclassify 40 | . adjacent file (0::Int) Blank 41 | . classify) (inlines lhs) 42 | 43 | adjacent :: FilePath -> Int -> Classified -> [Classified] -> [Classified] 44 | adjacent file 0 _ (x :xs) = x : adjacent file 1 x xs -- force evaluation of line number 45 | adjacent file n y@(Program _) (x@Comment :xs) = error (message file n "program" "comment") 46 | adjacent file n y@(Program _) (x@(Include i f):xs) = x: adjacent f i y xs 47 | adjacent file n y@(Program _) (x@(Pre _) :xs) = x: adjacent file (n+1) y xs 48 | adjacent file n y@Comment (x@(Program _) :xs) = error (message file n "comment" "program") 49 | adjacent file n y@Comment (x@(Include i f):xs) = x: adjacent f i y xs 50 | adjacent file n y@Comment (x@(Pre _) :xs) = x: adjacent file (n+1) y xs 51 | adjacent file n y@Blank (x@(Include i f):xs) = x: adjacent f i y xs 52 | adjacent file n y@Blank (x@(Pre _) :xs) = x: adjacent file (n+1) y xs 53 | adjacent file n _ (x@next :xs) = x: adjacent file (n+1) x xs 54 | adjacent file n _ [] = [] 55 | 56 | message :: String -> Int -> String -> String -> String 57 | message "\"\"" n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n" 58 | message [] n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n" 59 | message file n p c = "In file " ++ file ++ " at line "++show n++": "++p++ " line before "++c++" line.\n" 60 | 61 | 62 | -- Re-implementation of 'lines', for better efficiency (but decreased laziness). 63 | -- Also, importantly, accepts non-standard DOS and Mac line ending characters. 64 | inlines :: String -> [String] 65 | inlines s = lines' s id 66 | where 67 | lines' [] acc = [acc []] 68 | lines' ('\^M':'\n':s) acc = acc [] : lines' s id -- DOS 69 | lines' ('\^M':s) acc = acc [] : lines' s id -- MacOS 70 | lines' ('\n':s) acc = acc [] : lines' s id -- Unix 71 | lines' (c:s) acc = lines' s (acc . (c:)) 72 | 73 | -------------------------------------------------------------------------------- /cabal-hasklint/cpphs/README: -------------------------------------------------------------------------------- 1 | This directory contains 'cpphs', a simplified but robust 2 | re-implementation of cpp, the C pre-processor, in Haskell. 3 | 4 | TO BUILD 5 | -------- 6 | Just use 7 | hmake cpphs [-package base] 8 | or 9 | ghc --make cpphs [-o cpphs] # -o needed for ghc <= 6.4.1 ] 10 | or 11 | runhugs cpphs # or rename the script cpphs.hugs to cpphs 12 | 13 | 14 | USAGE 15 | ----- 16 | cpphs [filename | -Dsym | -Dsym=val | -Ipath]+ [-Ofile] 17 | [ --include=file ]* 18 | [ --nomacro | --noline | --nowarn | --strip | --strip-eol | 19 | --pragma | --text | --hashes | --layout | --unlit | 20 | --linepragma ]* 21 | [ --cpp compatopts ] 22 | 23 | For fuller details, see docs/index.html 24 | 25 | If you want to use cpphs as a completely drop-in replacement for the 26 | real cpp, that is, to accept the same arguments, and have broadly 27 | the same behaviour in response to them, then use the --cpp compatibility 28 | option. 29 | 30 | 31 | COPYRIGHT 32 | --------- 33 | Copyright (c) 2004-2017 Malcolm Wallace (Malcolm.Wallace@me.com) 34 | 35 | 36 | LICENCE 37 | ------- 38 | These library modules are distributed under the terms of the LGPL. 39 | The application module 'cpphs.hs' is GPL. 40 | 41 | This software comes with no warranty. Use at your own risk. 42 | 43 | If you have a commercial use for cpphs, and feel the terms of the (L)GPL 44 | are too onerous, you have the option of distributing unmodified binaries 45 | (only, not sources) under the terms of a different licence (see 46 | LICENCE-commercial). 47 | 48 | 49 | WEBSITE 50 | ------- 51 | http://projects.haskell.org/cpphs/ 52 | darcs get http://code.haskell.org/~malcolm/cpphs 53 | -------------------------------------------------------------------------------- /cabal-hasklint/cpphs/cpphs.cabal: -------------------------------------------------------------------------------- 1 | Name: cpphs 2 | Version: 1.20.9.1 3 | Copyright: 2004-2017, Malcolm Wallace 4 | License: LGPL 5 | License-File: LICENCE-LGPL 6 | Cabal-Version: >= 1.8 7 | Author: Malcolm Wallace 8 | Maintainer: Malcolm Wallace 9 | Homepage: http://projects.haskell.org/cpphs/ 10 | bug-reports: https://github.com/malcolmwallace/cpphs/issues 11 | Synopsis: A liberalised re-implementation of cpp, the C pre-processor. 12 | Description: 13 | Cpphs is a re-implementation of the C pre-processor that is both 14 | more compatible with Haskell, and itself written in Haskell so 15 | that it can be distributed with compilers. 16 | . 17 | This version of the C pre-processor is pretty-much 18 | feature-complete and compatible with traditional (K&R) 19 | pre-processors. Additional features include: a plain-text mode; 20 | an option to unlit literate code files; and an option to turn 21 | off macro-expansion. 22 | Category: Development 23 | Build-type: Simple 24 | Extra-Source-Files: README, LICENCE-GPL, LICENCE-commercial, CHANGELOG, docs/cpphs.1, docs/index.html 25 | 26 | tested-with: 27 | ghc ==8.10.1 28 | || ==8.8.3 29 | || ==8.6.5 30 | || ==8.4.4 31 | || ==8.2.2 32 | || ==8.0.2 33 | || ==7.10.3 34 | || ==7.8.4 35 | || ==7.6.3 36 | || ==7.4.2 37 | || ==7.2.2 38 | || ==7.0.4 39 | 40 | flag old-locale 41 | description: If true, use old-locale, otherwise use time 1.5 or newer. 42 | manual: False 43 | default: False 44 | 45 | Library 46 | Build-Depends: base >= 4.3 && <5, directory <1.4, polyparse>=1.13 && <1.14 47 | 48 | if flag(old-locale) 49 | Build-Depends: 50 | old-locale >=1.0.0.2 && <1.1 51 | , time >=0 && <1.5 52 | Hs-Source-Dirs: . old 53 | 54 | else 55 | Build-Depends: time >=1.5 && <1.11 56 | Hs-Source-Dirs: . new 57 | 58 | Exposed-Modules: 59 | Language.Preprocessor.Cpphs 60 | Language.Preprocessor.Unlit 61 | Other-Modules: 62 | Language.Preprocessor.Cpphs.CppIfdef 63 | Language.Preprocessor.Cpphs.HashDefine 64 | Language.Preprocessor.Cpphs.MacroPass 65 | Language.Preprocessor.Cpphs.Options 66 | Language.Preprocessor.Cpphs.Position 67 | Language.Preprocessor.Cpphs.ReadFirst 68 | Language.Preprocessor.Cpphs.RunCpphs 69 | Language.Preprocessor.Cpphs.SymTab 70 | Language.Preprocessor.Cpphs.Tokenise 71 | TimeCompat 72 | 73 | Executable cpphs 74 | Build-Depends: base>=3&&<6, directory <1.4, polyparse>=1.13 && <1.14 75 | Main-Is: cpphs.hs 76 | 77 | if flag(old-locale) 78 | Build-Depends: 79 | old-locale >=1.0.0.2 && <1.1 80 | , time >=0 && <1.5 81 | Hs-Source-Dirs: . old 82 | 83 | else 84 | Build-Depends: time >=1.5 && <1.11 85 | Hs-Source-Dirs: . new 86 | 87 | Other-Modules: 88 | Language.Preprocessor.Cpphs 89 | Language.Preprocessor.Unlit 90 | Language.Preprocessor.Cpphs.CppIfdef 91 | Language.Preprocessor.Cpphs.HashDefine 92 | Language.Preprocessor.Cpphs.MacroPass 93 | Language.Preprocessor.Cpphs.Options 94 | Language.Preprocessor.Cpphs.Position 95 | Language.Preprocessor.Cpphs.ReadFirst 96 | Language.Preprocessor.Cpphs.RunCpphs 97 | Language.Preprocessor.Cpphs.SymTab 98 | Language.Preprocessor.Cpphs.Tokenise 99 | TimeCompat 100 | 101 | Source-Repository head 102 | Type: git 103 | Location: https://github.com/hackage-trustees/malcolm-wallace-universe 104 | -------------------------------------------------------------------------------- /cabal-hasklint/src/CabalHasklint/Cpp.hs: -------------------------------------------------------------------------------- 1 | module CabalHasklint.Cpp ( 2 | cpphs, 3 | ) where 4 | 5 | import Peura 6 | 7 | import qualified Distribution.Simple.Build.Macros as C 8 | import qualified Language.Preprocessor.Cpphs as Cpphs 9 | 10 | import CabalHasklint.Trace 11 | import CabalHasklint.Warning 12 | 13 | -- | C-preprocess file 14 | cpphs 15 | :: TracerPeu r Tr 16 | -> Version -- ^ this package version 17 | -> [PackageIdentifier] -- ^ package identifiers, for @cabal_macros.h@ 18 | -> [Path Absolute] -- ^ includes 19 | -> [(String, String)] -- ^ additional defines 20 | -> Path Absolute -- ^ filepath 21 | -> String -- ^ file contents 22 | -> Peu r String 23 | cpphs tracer pkgVer pkgIds includes defines path input = withRunInIO $ \runInIO -> do 24 | let cpphsActions = Cpphs.CpphsActions 25 | { Cpphs.cpphsPutWarning = \msg -> runInIO (putWarning tracer WCpphs msg) 26 | , Cpphs.cpphsDie = \msg -> runInIO (die tracer msg) 27 | } 28 | --putInfo tracer $ show defines 29 | liftIO $ Cpphs.runCpphs cpphsActions cpphsOpts path' input' 30 | where 31 | 32 | path' = toFilePath path 33 | input' = unlines 34 | [ "#line 1 \"" ++ Cpphs.cleanPath "cabal_macros.h" ++ "\"" 35 | , C.generatePackageVersionMacros pkgVer pkgIds 36 | , "#line 1 \"" ++ Cpphs.cleanPath path' ++ "\"" 37 | , input 38 | ] 39 | 40 | cpphsOpts = Cpphs.defaultCpphsOptions 41 | { Cpphs.boolopts = cpphsBoolOpts 42 | , Cpphs.defines = defines 43 | , Cpphs.includes = map toFilePath includes 44 | } 45 | 46 | cpphsBoolOpts :: Cpphs.BoolOptions 47 | cpphsBoolOpts = Cpphs.defaultBoolOptions 48 | { Cpphs.hashline = False 49 | , Cpphs.warnings = True 50 | , Cpphs.stripC89 = True 51 | } 52 | -------------------------------------------------------------------------------- /cabal-hasklint/src/CabalHasklint/GHC/Utils.hs: -------------------------------------------------------------------------------- 1 | module CabalHasklint.GHC.Utils where 2 | 3 | import Peura 4 | 5 | import GHC.Driver.Ppr (showPpr) 6 | import GHC.Driver.Session (DynFlags, defaultDynFlags) 7 | import GHC.Utils.Outputable (Outputable) 8 | import Language.Haskell.GhclibParserEx.GHC.Settings.Config (fakeSettings) 9 | 10 | fakeDynFlags :: DynFlags 11 | fakeDynFlags = defaultDynFlags fakeSettings 12 | 13 | fakeShowPpr :: Outputable a => a -> String 14 | fakeShowPpr = showPpr fakeDynFlags 15 | 16 | -------------------------------------------------------------------------------- /cabal-hasklint/src/CabalHasklint/Lint.hs: -------------------------------------------------------------------------------- 1 | module CabalHasklint.Lint where 2 | 3 | import Data.Monoid (All (..)) 4 | import Peura 5 | 6 | import qualified Data.Set as Set 7 | import qualified Distribution.ModuleName as C 8 | import qualified Distribution.Types.BuildInfo as C 9 | 10 | import GHC.Hs (GhcPs, HsModule, hsmodImports, hsmodName) 11 | import GHC.Hs.ImpExp (ImportDecl (..), ImportDeclQualifiedStyle (..)) 12 | import GHC.Types.SrcLoc (GenLocated (..), Located, unLoc) 13 | 14 | import Language.Haskell.Syntax.ImpExp (ImportListInterpretation (Exactly)) 15 | import Language.Haskell.Syntax.Module.Name (moduleNameString) 16 | 17 | import CabalHasklint.GHC.Utils 18 | import CabalHasklint.Trace 19 | import CabalHasklint.Warning 20 | 21 | lint 22 | :: TracerPeu r Tr 23 | -> [C.ModuleName] -- TODO: maybe take configured PD? 24 | -> C.BuildInfo 25 | -> Located (HsModule GhcPs) 26 | -> Peu r All 27 | lint tracer compModules _bi (L _ module_) = do 28 | traceApp tracer $ TraceLint (fromString thisModuleName) 29 | 30 | -- Check that all imports are either qualified or has import list, 31 | -- except for local ones. 32 | -- 33 | -- TODO: add configuration. 34 | -- Which modules are OK to import unqualified, e.g. Prelude.Compat, Peura... GHC.Generics? 35 | -- 36 | let compModules' = Set.fromList compModules 37 | for_ (hsmodImports module_) $ \(L loc importDecl) -> do 38 | let moduleName :: C.ModuleName 39 | moduleName = C.fromString (moduleNameString (unLoc (ideclName importDecl))) 40 | 41 | unless (Set.member moduleName compModules') $ case ideclQualified importDecl of 42 | NotQualified -> case ideclImportList importDecl of 43 | Just (Exactly, _) -> return () 44 | _ -> putWarning tracer WUnqualImport $ "Wild import of " ++ prettyShow moduleName ++ " in " ++ fakeShowPpr loc 45 | 46 | _ -> return () 47 | 48 | return (All True) 49 | where 50 | thisModuleName = maybe "" fakeShowPpr (hsmodName module_) 51 | -------------------------------------------------------------------------------- /cabal-hasklint/src/CabalHasklint/Package.hs: -------------------------------------------------------------------------------- 1 | module CabalHasklint.Package ( 2 | Package (..), 3 | readLocalCabalFiles, 4 | readDirectCabalFiles, 5 | ) where 6 | 7 | import Peura 8 | 9 | import qualified Distribution.PackageDescription.Parsec as C 10 | 11 | readDirectCabalFiles 12 | :: TracerPeu r w 13 | -> [FilePath] 14 | -> Peu r [Package] 15 | readDirectCabalFiles tracer paths = for paths $ \path -> do 16 | cabalPath <- makeAbsoluteFilePath path 17 | cabalBS <- readByteString cabalPath 18 | gpd <- maybe (die tracer $ "cannot parse " ++ toFilePath cabalPath) return 19 | $ C.parseGenericPackageDescriptionMaybe cabalBS 20 | 21 | return Package 22 | { pkgGpd = gpd 23 | , pkgDir = takeDirectory cabalPath 24 | , pkgUnits = [] 25 | } 26 | -------------------------------------------------------------------------------- /cabal-hasklint/src/CabalHasklint/Trace.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | module CabalHasklint.Trace where 4 | 5 | import Peura 6 | 7 | import qualified Cabal.Plan as Plan 8 | import qualified Data.Text as T 9 | import qualified Distribution.ModuleName as C 10 | import qualified System.Console.ANSI as ANSI 11 | 12 | import CabalHasklint.Warning 13 | 14 | data Tr 15 | = TraceComponent PackageIdentifier Plan.CompName 16 | | TraceParse C.ModuleName (Path Absolute) 17 | | TraceLint C.ModuleName {- (Path Absolute) -} 18 | deriving Show 19 | 20 | instance IsPeuraTrace Tr where 21 | type TraceW Tr = W 22 | 23 | showTrace (TraceComponent pid cn) = (ANSI.Green, ["hasklint","component"], prettyShow pid ++ " " ++ T.unpack (Plan.dispCompName cn)) 24 | showTrace (TraceParse n p) = (ANSI.Green, ["hasklint","parse"], prettyShow n ++ ": " ++ toFilePath p) 25 | showTrace (TraceLint n) = (ANSI.Green, ["hasklint","lint"], prettyShow n) 26 | -------------------------------------------------------------------------------- /cabal-hasklint/src/CabalHasklint/Warning.hs: -------------------------------------------------------------------------------- 1 | module CabalHasklint.Warning where 2 | 3 | import Peura 4 | 5 | data W 6 | = WMultipleModuleFiles 7 | | WMissingModuleFile 8 | | WInvalidField 9 | | WCpphs 10 | | WUnqualImport 11 | deriving (Eq, Ord, Enum, Bounded) 12 | 13 | instance Universe W where universe = [minBound .. maxBound] 14 | instance Finite W 15 | 16 | instance Warning W where 17 | warningToFlag WMultipleModuleFiles = "multiple-module-files" 18 | warningToFlag WMissingModuleFile = "missing-module-file" 19 | warningToFlag WInvalidField = "invalid-field" 20 | warningToFlag WCpphs = "cpphs" 21 | 22 | warningToFlag WUnqualImport = "unqual-import" 23 | -------------------------------------------------------------------------------- /cabal-hasklint/tests/tests.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Test.Tasty (defaultMain, testGroup, TestTree) 4 | import Test.Tasty.HUnit (testCase, (@=?)) 5 | 6 | import qualified Data.Set as Set 7 | 8 | import CabalDocspec.ExprVars 9 | 10 | main :: IO () 11 | main = defaultMain $ testGroup "cabal-docspec" 12 | [ exprVarsTests 13 | ] 14 | 15 | exprVarsTests :: TestTree 16 | exprVarsTests = testGroup "ExprVars" 17 | [ ex "x + y" ["x","y"] 18 | , ex "forAll xs $ \\x -> x == x" ["forAll", "xs"] 19 | , ex "\\(xs :: [Int]) -> reverse xs === xs" ["reverse"] 20 | ] 21 | where 22 | ex expr vars = testCase expr $ Set.fromList vars @=? exprVars expr 23 | -------------------------------------------------------------------------------- /cabal-hie/.gitmodules: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/phadej/cabal-extras/cf4fd3ee047fc8a6c6ca9d0868a701b851f94037/cabal-hie/.gitmodules -------------------------------------------------------------------------------- /cabal-hie/Changelog.md: -------------------------------------------------------------------------------- 1 | # 0.1 2 | 3 | First release 4 | -------------------------------------------------------------------------------- /cabal-hie/LICENSE: -------------------------------------------------------------------------------- 1 | SPDX-License-Identifier: GPL-2.0-or-later 2 | 3 | Copyright (c) 2019 Oleg Grenrus 4 | 5 | This library is free software: you may copy, redistribute and/or modify it 6 | under the terms of the GNU General Public License as published by the 7 | Free Software Foundation, either version 3 of the License, or (at your 8 | option) any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but 11 | WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program (see `LICENSE.GPLv3`). If not, see 17 | . 18 | -------------------------------------------------------------------------------- /cabal-hie/cabal-hie.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: cabal-hie 3 | version: 0.1 4 | synopsis: Generate hie.yaml files 5 | category: Development 6 | description: 7 | Generate hie.yaml files from cabal.project and plan.json data 8 | 9 | license: GPL-2.0-or-later 10 | license-files: 11 | LICENSE 12 | LICENSE.GPLv2 13 | LICENSE.GPLv3 14 | 15 | author: Oleg Grenrus 16 | maintainer: Oleg Grenrus 17 | tested-with: GHC ==9.8.4 18 | extra-source-files: Changelog.md 19 | 20 | source-repository head 21 | type: git 22 | location: https://github.com/phadej/cabal-extras.git 23 | 24 | library cabal-hie-internal 25 | default-language: Haskell2010 26 | hs-source-dirs: src 27 | ghc-options: -Wall 28 | exposed-modules: CabalHie.Main 29 | other-modules: Paths_cabal_hie 30 | autogen-modules: Paths_cabal_hie 31 | 32 | -- ghc-boot dependencies 33 | -- cabal-fmt: fragment ../fragments/boot-deps.fragment 34 | build-depends: 35 | , base ^>=4.19.0.0 36 | , binary ^>=0.8.9.0 37 | , bytestring ^>=0.12.0.2 38 | , containers ^>=0.6.8 39 | , deepseq ^>=1.5.0.0 40 | , directory ^>=1.3.8.1 41 | , filepath ^>=1.4.100.4 42 | , mtl ^>=2.3.1 43 | , parsec ^>=3.1.17.0 44 | , pretty ^>=1.1.3.6 45 | , process ^>=1.6.18.0 46 | , stm ^>=2.5.0.0 47 | , template-haskell 48 | , text ^>=2.1 49 | 50 | -- We use Cabal-3.12 51 | build-depends: Cabal ^>=3.12.1.0 52 | 53 | -- We also use peura 54 | build-depends: peura 55 | 56 | -- dependencies in library 57 | build-depends: 58 | , aeson 59 | , ansi-terminal 60 | , cabal-install-parsers 61 | , cabal-plan 62 | , HsYAML-aeson ^>=0.2 63 | , optparse-applicative 64 | 65 | executable cabal-hie 66 | default-language: Haskell2010 67 | hs-source-dirs: cli 68 | main-is: Main.hs 69 | ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N2 70 | build-depends: 71 | , base 72 | , cabal-hie-internal 73 | -------------------------------------------------------------------------------- /cabal-hie/cli/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | import CabalHie.Main (main) 3 | -------------------------------------------------------------------------------- /cabal-iface-query/Changelog.md: -------------------------------------------------------------------------------- 1 | # 0.1 2 | 3 | First release 4 | -------------------------------------------------------------------------------- /cabal-iface-query/LICENSE: -------------------------------------------------------------------------------- 1 | SPDX-License-Identifier: GPL-2.0-or-later 2 | 3 | Copyright (c) 2019 Oleg Grenrus 4 | 5 | This library is free software: you may copy, redistribute and/or modify it 6 | under the terms of the GNU General Public License as published by the 7 | Free Software Foundation, either version 3 of the License, or (at your 8 | option) any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but 11 | WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program (see `LICENSE.GPLv3`). If not, see 17 | . 18 | -------------------------------------------------------------------------------- /cabal-iface-query/cabal-iface-query.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: cabal-iface-query 3 | version: 0.1 4 | synopsis: Read GHC interface files 5 | category: Development 6 | description: Read GHC interface files. 7 | license: GPL-3.0-or-later AND BSD-3-Clause 8 | license-file: LICENSE 9 | author: Oleg Grenrus 10 | maintainer: Oleg Grenrus 11 | tested-with: GHC ==9.8.4 12 | extra-source-files: Changelog.md 13 | 14 | source-repository head 15 | type: git 16 | location: https://github.com/phadej/cabal-extras 17 | 18 | library cabal-iface-query-internal 19 | default-language: Haskell2010 20 | hs-source-dirs: src 21 | ghc-options: -Wall 22 | exposed-modules: 23 | CabalIfaceQuery.GHC 24 | CabalIfaceQuery.GHC.DynFlags 25 | CabalIfaceQuery.GHC.Show 26 | CabalIfaceQuery.Main 27 | 28 | other-modules: Paths_cabal_iface_query 29 | autogen-modules: Paths_cabal_iface_query 30 | 31 | -- ghc-boot dependencies 32 | -- cabal-fmt: fragment ../fragments/boot-deps.fragment 33 | build-depends: 34 | , base ^>=4.19.0.0 35 | , binary ^>=0.8.9.0 36 | , bytestring ^>=0.12.0.2 37 | , containers ^>=0.6.8 38 | , deepseq ^>=1.5.0.0 39 | , directory ^>=1.3.8.1 40 | , filepath ^>=1.4.100.4 41 | , mtl ^>=2.3.1 42 | , parsec ^>=3.1.17.0 43 | , pretty ^>=1.1.3.6 44 | , process ^>=1.6.18.0 45 | , stm ^>=2.5.0.0 46 | , template-haskell 47 | , text ^>=2.1 48 | 49 | build-depends: 50 | , ghc 51 | , ghc-boot 52 | 53 | -- We use Cabal-3.12 54 | build-depends: Cabal ^>=3.12.1.0 55 | 56 | -- We also use peura 57 | build-depends: peura 58 | 59 | -- dependencies in library 60 | build-depends: 61 | , cabal-install-parsers 62 | , cabal-plan 63 | , Glob 64 | , optparse-applicative ^>=0.18.0.0 65 | 66 | default-extensions: 67 | NoImplicitPrelude 68 | OverloadedStrings 69 | 70 | executable cabal-iface-query 71 | default-language: Haskell2010 72 | hs-source-dirs: cli 73 | main-is: Main.hs 74 | ghc-options: -Wall -threaded 75 | build-depends: 76 | , base 77 | , cabal-iface-query-internal 78 | -------------------------------------------------------------------------------- /cabal-iface-query/cli/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | import CabalIfaceQuery.Main (main) 3 | -------------------------------------------------------------------------------- /cabal-iface-query/src/CabalIfaceQuery/GHC.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | {-# OPTIONS -Wno-missing-fields #-} 4 | module CabalIfaceQuery.GHC ( 5 | -- * DynFlags 6 | getDynFlags, 7 | -- * Other 8 | easyReadBinIface, 9 | ghcShow, 10 | ghcShowIfaceClsInst, 11 | ) where 12 | 13 | import Peura 14 | 15 | import GHC.Driver.Session (targetProfile) 16 | import GHC.Iface.Binary (CheckHiWay (CheckHiWay), TraceBinIFace (QuietBinIFace), readBinIface) 17 | import GHC.Iface.Syntax (IfaceClsInst (..), IfaceTyCon (..)) 18 | import GHC.Types.Name (nameModule_maybe) 19 | import GHC.Types.Name.Cache (NameCache) 20 | import GHC.Unit.Module.ModIface (ModIface) 21 | 22 | import CabalIfaceQuery.GHC.DynFlags 23 | import CabalIfaceQuery.GHC.Show 24 | 25 | ------------------------------------------------------------------------------- 26 | -- "Easy" interface 27 | ------------------------------------------------------------------------------- 28 | 29 | easyReadBinIface :: DynFlags -> NameCache -> Path Absolute -> IO ModIface 30 | easyReadBinIface dflags nc path = 31 | readBinIface (targetProfile dflags) nc CheckHiWay QuietBinIFace (toFilePath path) 32 | 33 | ------------------------------------------------------------------------------- 34 | -- Showing 35 | ------------------------------------------------------------------------------- 36 | 37 | ghcShowIfaceClsInst :: DynFlags -> IfaceClsInst -> String 38 | ghcShowIfaceClsInst dflags ifci = unwords $ 39 | "instance" : 40 | ghcShow dflags (ifInstCls ifci) : 41 | [ maybe "_" (ghcShow dflags) tyCon 42 | | tyCon <- ifInstTys ifci 43 | ] ++ 44 | extras 45 | where 46 | extras = case ifInstTys ifci of 47 | (Just (IfaceTyCon n _) : _) -> 48 | maybe [] (\m -> ["(from " ++ ghcShow dflags m ++ ")"]) (nameModule_maybe n) 49 | _ -> [] 50 | 51 | -------------------------------------------------------------------------------- /cabal-iface-query/src/CabalIfaceQuery/GHC/DynFlags.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module CabalIfaceQuery.GHC.DynFlags ( 3 | DynFlags, 4 | getDynFlags, 5 | ) where 6 | 7 | import Peura 8 | 9 | import GHC.Driver.Session (DynFlags, defaultDynFlags) 10 | import GHC.SysTools (initSysTools) 11 | 12 | -- | Get 'DynFlags' given 'GhcInfo' for this GHC. 13 | getDynFlags :: TracerPeu r w -> GhcInfo -> Peu r DynFlags 14 | getDynFlags tracer ghcInfo = do 15 | unless (VERSION_ghc == prettyShow (ghcVersion ghcInfo)) $ do 16 | die tracer $ "Compiler version mismatch: " ++ 17 | VERSION_ghc ++ " /= " ++ prettyShow (ghcVersion ghcInfo) 18 | 19 | let libDir = toFilePath $ ghcLibDir ghcInfo 20 | settings <- liftIO $ initSysTools libDir 21 | return $ defaultDynFlags settings 22 | -------------------------------------------------------------------------------- /cabal-iface-query/src/CabalIfaceQuery/GHC/Show.hs: -------------------------------------------------------------------------------- 1 | module CabalIfaceQuery.GHC.Show ( 2 | ghcShow, 3 | ) where 4 | 5 | import Prelude (String, (.)) 6 | 7 | import GHC.Driver.Session (DynFlags, initSDocContext) 8 | import GHC.Utils.Outputable (Outputable, defaultDumpStyle, ppr, showSDocOneLine) 9 | 10 | ghcShow :: Outputable t => DynFlags -> t -> String 11 | ghcShow dflags = showSDocOneLine (initSDocContext dflags defaultDumpStyle) . ppr 12 | -------------------------------------------------------------------------------- /cabal-store-check/.gitmodules: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/phadej/cabal-extras/cf4fd3ee047fc8a6c6ca9d0868a701b851f94037/cabal-store-check/.gitmodules -------------------------------------------------------------------------------- /cabal-store-check/Changelog.md: -------------------------------------------------------------------------------- 1 | # 0.1 2 | 3 | First release 4 | -------------------------------------------------------------------------------- /cabal-store-check/LICENSE: -------------------------------------------------------------------------------- 1 | SPDX-License-Identifier: GPL-2.0-or-later 2 | 3 | Copyright (c) 2019 Oleg Grenrus 4 | 5 | This library is free software: you may copy, redistribute and/or modify it 6 | under the terms of the GNU General Public License as published by the 7 | Free Software Foundation, either version 3 of the License, or (at your 8 | option) any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but 11 | WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program (see `LICENSE.GPLv3`). If not, see 17 | . 18 | -------------------------------------------------------------------------------- /cabal-store-check/cabal-store-check.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: cabal-store-check 3 | version: 0.1 4 | synopsis: Check integrity of cabal store 5 | category: Development 6 | description: Check integrity of cabal store, think @ghc-pkg check@ 7 | license: GPL-2.0-or-later 8 | license-files: 9 | LICENSE 10 | LICENSE.GPLv2 11 | LICENSE.GPLv3 12 | 13 | author: Oleg Grenrus 14 | maintainer: Oleg Grenrus 15 | tested-with: GHC ==9.8.4 16 | extra-source-files: Changelog.md 17 | 18 | source-repository head 19 | type: git 20 | location: https://github.com/phadej/cabal-extras.git 21 | subdir: cabal-store-check 22 | 23 | library cabal-store-check-internal 24 | default-language: Haskell2010 25 | hs-source-dirs: src 26 | ghc-options: -Wall 27 | exposed-modules: CabalStoreCheck.Main 28 | other-modules: Paths_cabal_store_check 29 | autogen-modules: Paths_cabal_store_check 30 | 31 | -- ghc-boot dependencies 32 | -- cabal-fmt: fragment ../fragments/boot-deps.fragment 33 | build-depends: 34 | , base ^>=4.19.0.0 35 | , binary ^>=0.8.9.0 36 | , bytestring ^>=0.12.0.2 37 | , containers ^>=0.6.8 38 | , deepseq ^>=1.5.0.0 39 | , directory ^>=1.3.8.1 40 | , filepath ^>=1.4.100.4 41 | , mtl ^>=2.3.1 42 | , parsec ^>=3.1.17.0 43 | , pretty ^>=1.1.3.6 44 | , process ^>=1.6.18.0 45 | , stm ^>=2.5.0.0 46 | , template-haskell 47 | , text ^>=2.1 48 | 49 | -- We use Cabal-3.12 50 | build-depends: Cabal ^>=3.12.1.0 51 | 52 | -- We also use peura 53 | build-depends: peura 54 | 55 | -- dependencies in library 56 | build-depends: 57 | , cabal-install-parsers 58 | , optparse-applicative ^>=0.18.0.0 59 | , topograph 60 | 61 | default-extensions: 62 | DeriveFunctor 63 | NoImplicitPrelude 64 | OverloadedStrings 65 | 66 | executable cabal-store-check 67 | default-language: Haskell2010 68 | hs-source-dirs: cli 69 | main-is: Main.hs 70 | ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N2 71 | build-depends: 72 | , base 73 | , cabal-store-check-internal 74 | -------------------------------------------------------------------------------- /cabal-store-check/cli/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | import CabalStoreCheck.Main (main) 3 | -------------------------------------------------------------------------------- /cabal-store-gc/.gitmodules: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/phadej/cabal-extras/cf4fd3ee047fc8a6c6ca9d0868a701b851f94037/cabal-store-gc/.gitmodules -------------------------------------------------------------------------------- /cabal-store-gc/Changelog.md: -------------------------------------------------------------------------------- 1 | # 0.1 2 | 3 | First release 4 | -------------------------------------------------------------------------------- /cabal-store-gc/LICENSE: -------------------------------------------------------------------------------- 1 | SPDX-License-Identifier: GPL-2.0-or-later 2 | 3 | Copyright (c) 2019 Oleg Grenrus 4 | 5 | This library is free software: you may copy, redistribute and/or modify it 6 | under the terms of the GNU General Public License as published by the 7 | Free Software Foundation, either version 3 of the License, or (at your 8 | option) any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but 11 | WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program (see `LICENSE.GPLv3`). If not, see 17 | . 18 | -------------------------------------------------------------------------------- /cabal-store-gc/cabal-store-gc.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: cabal-store-gc 3 | version: 0.1 4 | synopsis: Garbage collection of cabal store 5 | category: Development 6 | description: 7 | Garbage collection of cabal store, modeled losely after nix gc. 8 | 9 | license: GPL-2.0-or-later 10 | license-files: 11 | LICENSE 12 | LICENSE.GPLv2 13 | LICENSE.GPLv3 14 | 15 | author: Oleg Grenrus 16 | maintainer: Oleg Grenrus 17 | tested-with: GHC ==9.8.4 18 | extra-source-files: Changelog.md 19 | 20 | source-repository head 21 | type: git 22 | location: https://github.com/phadej/cabal-extras.git 23 | subdir: cabal-store-gc 24 | 25 | library cabal-store-gc-internal 26 | default-language: Haskell2010 27 | hs-source-dirs: src 28 | ghc-options: -Wall 29 | exposed-modules: 30 | CabalStoreGC.Deps 31 | CabalStoreGC.Main 32 | 33 | other-modules: Paths_cabal_store_gc 34 | autogen-modules: Paths_cabal_store_gc 35 | 36 | -- ghc-boot dependencies 37 | -- cabal-fmt: fragment ../fragments/boot-deps.fragment 38 | build-depends: 39 | , base ^>=4.19.0.0 40 | , binary ^>=0.8.9.0 41 | , bytestring ^>=0.12.0.2 42 | , containers ^>=0.6.8 43 | , deepseq ^>=1.5.0.0 44 | , directory ^>=1.3.8.1 45 | , filepath ^>=1.4.100.4 46 | , mtl ^>=2.3.1 47 | , parsec ^>=3.1.17.0 48 | , pretty ^>=1.1.3.6 49 | , process ^>=1.6.18.0 50 | , stm ^>=2.5.0.0 51 | , template-haskell 52 | , text ^>=2.1 53 | 54 | -- We use Cabal-3.12 55 | build-depends: Cabal ^>=3.12.1.0 56 | 57 | -- We also use peura 58 | build-depends: peura 59 | 60 | -- dependencies in library 61 | build-depends: 62 | , base64-bytestring 63 | , cabal-install-parsers 64 | , cabal-plan 65 | , cryptohash-sha256 66 | , optics-core 67 | , optparse-applicative ^>=0.18.0.0 68 | , paths 69 | , topograph 70 | 71 | default-extensions: 72 | DeriveFunctor 73 | NoImplicitPrelude 74 | OverloadedStrings 75 | 76 | executable cabal-store-gc 77 | default-language: Haskell2010 78 | hs-source-dirs: cli 79 | main-is: Main.hs 80 | ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N2 81 | build-depends: 82 | , base 83 | , cabal-store-gc-internal 84 | -------------------------------------------------------------------------------- /cabal-store-gc/cli/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | import CabalStoreGC.Main (main) 3 | -------------------------------------------------------------------------------- /cabal-store-gc/src/CabalStoreGC/Deps.hs: -------------------------------------------------------------------------------- 1 | module CabalStoreGC.Deps (extractDeps) where 2 | 3 | import Peura 4 | 5 | import qualified Data.ByteString.Char8 as BS8 6 | import qualified Distribution.Compat.Newtype as C 7 | import qualified Distribution.FieldGrammar as C 8 | import qualified Distribution.Parsec as C 9 | import qualified Distribution.Types.UnitId as C 10 | 11 | extractDeps :: ByteString -> [C.UnitId] 12 | extractDeps contents = 13 | [ unitId 14 | | l <- BS8.lines contents 15 | , Just sfx' <- return (BS8.stripPrefix "deps:" l) 16 | , let sfx = BS8.dropWhile isSpace sfx' 17 | , unitId <- either fail (C.unpack' (C.alaList C.CommaFSep)) 18 | $ C.eitherParsec $ fromUTF8BS sfx 19 | ] 20 | -------------------------------------------------------------------------------- /cabal.haskell-ci: -------------------------------------------------------------------------------- 1 | branches: master 2 | installed: +all -Cabal -Cabal-syntax 3 | docspec: True 4 | docspec-options: --verbose 5 | jobs-selection: uniform 6 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | with-compiler: ghc-9.8.4 2 | index-state: 2024-07-03T13:49:27Z 3 | tests: True 4 | 5 | packages: cabal-bundler 6 | packages: cabal-core-inspection 7 | packages: cabal-deps 8 | packages: cabal-diff 9 | packages: cabal-docspec 10 | packages: cabal-env 11 | packages: cabal-haddock-server 12 | packages: cabal-hasklint 13 | packages: cabal-hie 14 | packages: cabal-iface-query 15 | 16 | packages: cabal-store-check 17 | packages: cabal-store-gc 18 | 19 | packages: peura 20 | 21 | -- compatibility with new directory 22 | packages: paths-0.2.0.0 23 | 24 | package * 25 | ghc-options: -fwrite-ide-info 26 | 27 | package peura 28 | flags: -concurrent-output 29 | 30 | constraints: Cabal ^>=3.12.1.0 31 | 32 | -- some constraints to force latest versions 33 | constraints: optics-core ^>=0.4.1 34 | constraints: aeson ^>=2.2.1.0 35 | 36 | 37 | constraints: directory installed 38 | constraints: process installed 39 | constraints: transformers installed 40 | 41 | -- packages: http://oleg.fi/gentle-introduction-2022.5.tar.gz 42 | -- packages: https://github.com/phadej/hooglite/releases/download/v0.20230131/hooglite-0.20230131.tar.gz 43 | 44 | -- source-repository-package 45 | -- type: git 46 | -- location: https://github.com/phadej/hooglite.git 47 | -- tag: 66ef795dd4d13d54aa5be5e13a07e9f495950e5e 48 | 49 | -- For local dev these can be used: 50 | packages: extras/gentle-introduction-*.tar.gz 51 | packages: extras/hooglite-*.tar.gz 52 | 53 | -- Always use ghc-lib-parser. 54 | constraints: ghc-lib-parser-ex -no-ghc-lib -auto 55 | 56 | -- Never depend on cryptonite. Aptly named package. 57 | constraints: cryptonite <0 58 | 59 | -- Warp without x509 60 | constraints: warp -x509 61 | 62 | allow-newer: hooglite:Cabal 63 | 64 | allow-newer: serialise-0.2.6.0:strict 65 | allow-newer: serialise-0.2.6.0:these 66 | -------------------------------------------------------------------------------- /cabal.project.local.sample: -------------------------------------------------------------------------------- 1 | package * 2 | split-sections: True 3 | -------------------------------------------------------------------------------- /extras/gentle-introduction-2024.4.1.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/phadej/cabal-extras/cf4fd3ee047fc8a6c6ca9d0868a701b851f94037/extras/gentle-introduction-2024.4.1.tar.gz -------------------------------------------------------------------------------- /extras/hooglite-0.20240409.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/phadej/cabal-extras/cf4fd3ee047fc8a6c6ca9d0868a701b851f94037/extras/hooglite-0.20240409.tar.gz -------------------------------------------------------------------------------- /fragments/boot-deps.fragment: -------------------------------------------------------------------------------- 1 | build-depends: 2 | , base ^>=4.19.0.0 3 | , binary ^>=0.8.9.0 4 | , bytestring ^>=0.12.0.2 5 | , containers ^>=0.6.8 6 | , deepseq ^>=1.5.0.0 7 | , directory ^>=1.3.8.1 8 | , filepath ^>=1.4.100.4 9 | , mtl ^>=2.3.1 10 | , parsec ^>=3.1.17.0 11 | , pretty ^>=1.1.3.6 12 | , process ^>=1.6.18.0 13 | , stm ^>=2.5.0.0 14 | , template-haskell 15 | , text ^>=2.1 16 | -------------------------------------------------------------------------------- /hie.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | cabal: 3 | - component: "cabal-bundler:lib:cabal-bundler-internal" 4 | path: "cabal-bundler/src" 5 | - component: "cabal-bundler:test:cabal-bundler-tests" 6 | path: "cabal-bundler/tests" 7 | - component: "cabal-deps:lib:cabal-deps-internal" 8 | path: "cabal-deps/src" 9 | - component: "cabal-diff:lib:cabal-diff-internal" 10 | path: "cabal-diff/src" 11 | - component: "cabal-diff:test:cabal-diff-golden" 12 | path: "cabal-diff/test" 13 | - component: "cabal-docspec:lib:internal-cpphs" 14 | path: "cabal-docspec/cpphs" 15 | - component: "cabal-docspec:lib:cabal-docspec-internal" 16 | path: "cabal-docspec/src" 17 | - component: "cabal-docspec:test:cabal-docspec-tests" 18 | path: "cabal-docspec/tests" 19 | - component: "cabal-env:lib:cabal-env-internal" 20 | path: "cabal-env/src" 21 | - component: "cabal-hie:lib:cabal-hie-internal" 22 | path: "cabal-hie/src" 23 | - component: "cabal-iface-query:lib:cabal-iface-query-internal" 24 | path: "cabal-iface-query/src" 25 | - component: "cabal-store-check:lib:cabal-store-check-internal" 26 | path: "cabal-store-check/src" 27 | - component: "cabal-store-gc:lib:cabal-store-gc-internal" 28 | path: "cabal-store-gc/src" 29 | - component: "peura:lib:peura" 30 | path: peura/src 31 | -------------------------------------------------------------------------------- /paths-0.2.0.0/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for `paths` 2 | 3 | ## 0.2.0.0 4 | 5 | * Make `Path` abstract by default and move type-unsafe operations into new `System.Path.Unsafe` module 6 | * Add wrappers for `Data.Text(.Lazy).IO` now that `text` is bundled with GHC 7 | * Add `appendByteString` & `appendLazyByteString` wrappers 8 | * Add `{has,drop,add}TrailingPathSeparator` operations 9 | * Add new `takeBaseName` and `normalise` operations 10 | * Introduce `FileExt` type for representing file extensions in the API and add more file-extension related operations. 11 | * Change types of `joinFragments` and `splitFragments`, and add new `fragments` smart-constructor 12 | * Change type-signature of `takeFileName` 13 | * Add new `System.Path.QQ` module providing QuasiQuoters 14 | * Add new `System.Path.Lens` module 15 | * Rename `Relative` to `CWD` 16 | * Synchronize operator fixities of `<.>`, `-<.>` and `` to match the ones from the `filepath` library 17 | 18 | ## 0.1 19 | 20 | * First version. Mostly derived from `hackage-security`'s `Hackage.Security.Util.Path` 21 | -------------------------------------------------------------------------------- /paths-0.2.0.0/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015-2017, Well-Typed LLP 2 | (c) 2017, Herbert Valerio Riedel 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the name of Well-Typed LLP nor the names of other 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /paths-0.2.0.0/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /paths-0.2.0.0/paths.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | name: paths 3 | version: 0.2.0.0 4 | synopsis: 5 | Library for representing and manipulating type-safe file paths 6 | 7 | description: 8 | This library provides a more type-safe version of 'FilePath's together with thin wrappers around common IO operations. 9 | . 10 | This library is directly derived from @hackage-security@'s 11 | 12 | module. 13 | 14 | bug-reports: https://github.com/hvr/paths/issues 15 | license: BSD3 16 | license-file: LICENSE 17 | author: Herbert Valerio Riedel 18 | copyright: 19 | 2015-2017 Well-Typed LLP, 20 | 2017 Herbert Valerio Riedel 21 | 22 | maintainer: hvr@gnu.org 23 | category: System 24 | build-type: Simple 25 | extra-source-files: ChangeLog.md 26 | tested-with: 27 | GHC ==9.8.4 28 | 29 | flag directory--LT-1_2 30 | description: 31 | [directory](https://hackage.haskell.org/package/directory) < 1.2 32 | 33 | manual: False 34 | default: False 35 | 36 | library 37 | hs-source-dirs: src 38 | exposed-modules: 39 | System.Path 40 | System.Path.IO 41 | System.Path.Lens 42 | System.Path.QQ 43 | System.Path.Unsafe 44 | 45 | other-modules: 46 | System.Path.Internal 47 | System.Path.Internal.Compat 48 | System.Path.Internal.Native 49 | 50 | default-language: Haskell2010 51 | other-extensions: 52 | CPP 53 | ExistentialQuantification 54 | Safe 55 | Trustworthy 56 | Unsafe 57 | 58 | if impl(ghc >=8.0) 59 | other-extensions: TemplateHaskellQuotes 60 | 61 | else 62 | other-extensions: TemplateHaskell 63 | 64 | build-depends: 65 | base >=4.5 && <4.20 66 | , bytestring >=0.9.2 && <0.13 67 | , deepseq >=1.3 && <1.6 68 | , directory >=1.1 && <1.4 69 | , filepath >=1.3 && <1.5 70 | , template-haskell >=2.7 && <2.22 71 | , text >=0.11 && <1.3 || >=2.0 && <2.2 72 | , time >=1.4 && <1.13 73 | 74 | if !impl(ghc >=8.0) 75 | build-depends: transformers >=0.3 && <0.6 76 | 77 | if flag(directory--lt-1_2) 78 | build-depends: 79 | directory <1.2 80 | , old-time >=1 && <1.2 81 | 82 | else 83 | build-depends: directory >=1.2 84 | 85 | ghc-options: -Wall 86 | 87 | source-repository head 88 | location: https://github.com/hvr/paths.git 89 | type: git 90 | -------------------------------------------------------------------------------- /paths-0.2.0.0/src/System/Path.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ExistentialQuantification #-} 3 | {-# LANGUAGE Safe #-} 4 | 5 | -- | A more type-safe version of file paths 6 | -- 7 | -- This module provides the basic 'Path' abstraction. See also 8 | -- "System.Path.IO" which extends this module by thin wrappers 9 | -- wrappers around common 'IO' operations. 10 | module System.Path ( 11 | -- * Paths 12 | Path 13 | -- * FilePath-like operations on paths with arbitrary roots 14 | , takeDirectory 15 | , takeFileName 16 | 17 | -- ** Operations aware of file-extensions 18 | , FileExt(..) 19 | , (<.>) 20 | , (-<.>) 21 | , splitExtension 22 | , splitExtensions 23 | , takeExtension 24 | , takeExtensions 25 | , takeBaseName 26 | , stripExtension 27 | , isExtensionOf 28 | 29 | -- ** Trailing slash functions 30 | , hasTrailingPathSeparator 31 | , addTrailingPathSeparator 32 | , dropTrailingPathSeparator 33 | 34 | -- * Unrooted paths 35 | , Unrooted 36 | , () 37 | , unrootPath 38 | , toUnrootedFilePath 39 | , fromUnrootedFilePath 40 | , fragment 41 | , fragments 42 | , joinFragments 43 | , splitFragments 44 | , normalise 45 | -- , isPathPrefixOf 46 | 47 | -- * File-system paths 48 | , FsRoot(..) 49 | , FsPath(..) 50 | , CWD 51 | , Relative 52 | , Absolute 53 | , HomeDir 54 | 55 | -- ** Conversions 56 | , toFilePath 57 | , fromFilePath 58 | , makeAbsolute 59 | , fromAbsoluteFilePath 60 | {- 61 | -- * Wrappers around Codec.Archive.Tar 62 | , Tar 63 | , tarIndexLookup 64 | , tarAppend 65 | -- * Wrappers around Network.URI 66 | , Web 67 | , toURIPath 68 | , fromURIPath 69 | , uriPath 70 | , modifyUriPath 71 | -} 72 | ) where 73 | 74 | import System.Path.Internal 75 | -------------------------------------------------------------------------------- /paths-0.2.0.0/src/System/Path/Internal/Compat.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE Trustworthy #-} 3 | 4 | {-# OPTIONS_GHC -fno-warn-unused-imports #-} 5 | 6 | -- compat layer 7 | module System.Path.Internal.Compat 8 | ( Applicative(..) 9 | , (<$>) 10 | , dirMakeAbsolute 11 | , posixIsExtensionOf 12 | ) where 13 | 14 | import Control.Applicative 15 | import Data.List (isSuffixOf) 16 | import qualified System.Directory as Dir 17 | import qualified System.FilePath as FP.Native 18 | import qualified System.FilePath.Posix as FP.Posix 19 | 20 | dirMakeAbsolute :: FilePath -> IO FilePath 21 | #if MIN_VERSION_directory(1,2,2) 22 | dirMakeAbsolute = Dir.makeAbsolute 23 | #else 24 | -- copied implementation from the directory package 25 | dirMakeAbsolute = (FP.Native.normalise <$>) . absolutize 26 | where 27 | absolutize path -- avoid the call to `getCurrentDirectory` if we can 28 | | FP.Native.isRelative path 29 | = (FP.Native. path) 30 | . FP.Native.addTrailingPathSeparator <$> 31 | Dir.getCurrentDirectory 32 | | otherwise = return path 33 | #endif 34 | 35 | 36 | posixIsExtensionOf :: String -> FilePath -> Bool 37 | #if MIN_VERSION_filepath(1,4,2) 38 | posixIsExtensionOf = FP.Posix.isExtensionOf 39 | #else 40 | posixIsExtensionOf ext@('.':_) = isSuffixOf ext . FP.Posix.takeExtensions 41 | posixIsExtensionOf ext = isSuffixOf ('.':ext) . FP.Posix.takeExtensions 42 | #endif 43 | -------------------------------------------------------------------------------- /paths-0.2.0.0/src/System/Path/Internal/Native.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | module System.Path.Internal.Native 4 | ( posixToNative 5 | , posixFromNative 6 | ) where 7 | 8 | import qualified System.FilePath as FP.Native 9 | import qualified System.FilePath.Posix as FP.Posix 10 | 11 | {-# INLINE isPosix #-} 12 | isPosix :: Bool 13 | #if defined(mingw32_HOST_OS) || defined(__MINGW32__) 14 | isPosix = False 15 | #else 16 | isPosix = True 17 | #endif 18 | 19 | posixToNative :: FilePath -> FilePath 20 | posixToNative 21 | | isPosix = id 22 | | otherwise = FP.Native.joinPath . FP.Posix.splitDirectories 23 | 24 | posixFromNative :: FilePath -> FilePath 25 | posixFromNative 26 | | isPosix = id 27 | | otherwise = FP.Posix.joinPath . FP.Native.splitDirectories 28 | -------------------------------------------------------------------------------- /paths-0.2.0.0/src/System/Path/Lens.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | {-# LANGUAGE Safe #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | -- | Lenses in the style of [System.FilePath.Lens](https://hackage.haskell.org/package/lens/docs/System-FilePath-Lens.html). 6 | -- 7 | -- @since 0.2.0.0 8 | module System.Path.Lens 9 | ( -- * Operators 10 | (~) 11 | , (<.>~) 12 | -- * Lenses 13 | , basename 14 | , directory 15 | , extension 16 | , filename 17 | ) where 18 | 19 | import Data.Functor as Fun 20 | import Data.Functor.Identity 21 | import System.Path 22 | 23 | ---------------------------------------------------------------------------- 24 | 25 | infixr 4 ~ 26 | (~) :: ASetter s t (Path a) (Path a) -> (Path Unrooted) -> s -> t 27 | l ~ n = overSafe l ( n) 28 | 29 | infixr 4 <.>~ 30 | (<.>~) :: ASetter s t (Path a) (Path a) -> FileExt -> s -> t 31 | l <.>~ n = overSafe l (<.> n) 32 | 33 | ---------------------------------------------------------------------------- 34 | 35 | basename :: Lens' (Path a) (Path Unrooted) 36 | basename f p = (<.?> takeExtension p) . (takeDirectory p ) Fun.<$> f (takeBaseName p) 37 | 38 | -- local helper 39 | (<.?>) :: Path a -> Maybe FileExt -> Path a 40 | fp <.?> Nothing = fp 41 | fp <.?> Just fe = fp <.> fe 42 | 43 | directory :: Lens' (Path a) (Path a) 44 | directory f p = ( takeFileName p) <$> f (takeDirectory p) 45 | 46 | extension :: Lens' (Path a) (Maybe FileExt) 47 | extension f p = (n <.?>) <$> f e 48 | where 49 | (n, e) = splitExtension p 50 | 51 | filename :: Lens' (Path a) (Path Unrooted) 52 | filename f p = (takeDirectory p ) <$> f (takeFileName p) 53 | 54 | ---------------------------------------------------------------------------- 55 | -- internal lens-api definitions 56 | type ASetter s t a b = (a -> Identity b) -> s -> Identity t 57 | type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t 58 | type Lens' s a = Lens s s a a 59 | 60 | {-# INLINE overSafe #-} 61 | overSafe :: ASetter s t a b -> (a -> b) -> s -> t 62 | overSafe l f = runIdentity `g` (l (Identity `h` f)) 63 | where 64 | h _ = (Identity .) 65 | g _ = (runIdentity .) 66 | 67 | {- unsafe/efficient variant of 'overSafe' 68 | 69 | over :: ASetter s t a b -> (a -> b) -> s -> t 70 | over l f = runIdentity #. l (Identity #. f) 71 | 72 | infixr 9 #. 73 | (#.) :: Coercible c b => (b -> c) -> (a -> b) -> (a -> c) 74 | (#.) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b 75 | 76 | -} 77 | -------------------------------------------------------------------------------- /paths-0.2.0.0/src/System/Path/QQ.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | #if __GLASGOW_HASKELL__ >= 802 4 | {-# LANGUAGE Safe #-} 5 | #else 6 | {-# LANGUAGE Trustworthy #-} 7 | #endif 8 | 9 | #if __GLASGOW_HASKELL__ >= 800 10 | {-# LANGUAGE TemplateHaskellQuotes #-} 11 | #else 12 | {-# LANGUAGE TemplateHaskell #-} 13 | #endif 14 | 15 | -- | QuasiQuoters for 'Path's 16 | -- 17 | -- @since 0.2.0.0 18 | module System.Path.QQ 19 | ( fspath 20 | , unrooted 21 | ) where 22 | 23 | import Language.Haskell.TH 24 | import qualified Language.Haskell.TH.Quote as QQ 25 | import qualified System.FilePath.Posix as FP.Posix 26 | 27 | import System.Path.Internal 28 | 29 | -- | Quasiquoter that materialises a value with a type of one of 30 | -- 31 | -- * 'Path' 'Absolute' 32 | -- * 'Path' 'HomeDir' 33 | -- * 'Path' 'CWD' 34 | -- 35 | -- depending on the POSIX-style path literal given. 36 | -- 37 | -- @since 0.2.0.0 38 | fspath :: QQ.QuasiQuoter 39 | fspath = quoter qfspath 40 | 41 | qfspath :: FilePath -> Q Exp 42 | qfspath fp 43 | | FP.Posix.isAbsolute fp = qPath fp [t|Absolute|] 44 | | Just fp' <- atHome fp = qPath fp' [t|HomeDir|] 45 | | otherwise = qPath fp [t|CWD|] 46 | where 47 | atHome :: FilePath -> Maybe FilePath 48 | atHome "~" = Just "" 49 | atHome ('~':sep:fp') | FP.Posix.isPathSeparator sep = Just fp' 50 | atHome _otherwise = Nothing 51 | 52 | 53 | -- | Quasiquoter for constructing 'Path' 'Unrooted' from POSIX-style path literals. 54 | -- 55 | -- @since 0.2.0.0 56 | unrooted :: QQ.QuasiQuoter 57 | unrooted = quoter qunrooted 58 | 59 | qunrooted :: FilePath -> Q Exp 60 | qunrooted fp 61 | | FP.Posix.isAbsolute fp = fail "Unrooted path must be relative" 62 | | otherwise = qPath fp [t|Unrooted|] 63 | 64 | -- | Helper for constructing 'Path x :: Path t' as TH expression 65 | qPath :: FilePath -> Q Type -> Q Exp 66 | qPath fp qtagTy = do 67 | pathCon <- [|Path|] 68 | pathTy <- [t|Path|] 69 | tagTy <- qtagTy 70 | return (SigE (AppE pathCon (LitE (StringL fp))) (AppT pathTy tagTy)) 71 | 72 | -- | Helper 73 | quoter :: (String -> Q Exp) -> QQ.QuasiQuoter 74 | quoter x = QQ.QuasiQuoter { QQ.quoteExp = x 75 | , QQ.quotePat = \_ -> fail "pattern position not supported" 76 | , QQ.quoteType = \_ -> fail "using as type not supported" 77 | , QQ.quoteDec = \_ -> fail "using as declaration not supported" 78 | } 79 | -------------------------------------------------------------------------------- /paths-0.2.0.0/src/System/Path/Unsafe.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Unsafe #-} 2 | 3 | -- | This module gives access to internals and operation which can 4 | -- subvert the type-safety of 'Path'. 5 | -- 6 | -- @since 0.2.0.0 7 | module System.Path.Unsafe 8 | ( Path(Path) 9 | , castRoot 10 | , rootPath 11 | ) where 12 | 13 | import System.Path.Internal 14 | 15 | -- | Reinterpret an unrooted path (/UNSAFE/) 16 | -- 17 | -- This is an alias for 'castRoot'; see comments there. 18 | -- 19 | rootPath :: Path Unrooted -> Path root 20 | rootPath (Path fp) = Path fp 21 | 22 | -- | Reinterpret the root of a path 23 | -- 24 | -- This literally just changes the type-level tag; use with caution! 25 | castRoot :: Path root -> Path root' 26 | castRoot (Path fp) = Path fp 27 | -------------------------------------------------------------------------------- /peura/LICENSE: -------------------------------------------------------------------------------- 1 | SPDX-License-Identifier: GPL-2.0-or-later 2 | 3 | Copyright (c) 2019 Oleg Grenrus 4 | 5 | This library is free software: you may copy, redistribute and/or modify it 6 | under the terms of the GNU General Public License as published by the 7 | Free Software Foundation, either version 3 of the License, or (at your 8 | option) any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but 11 | WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program (see `LICENSE.GPLv3`). If not, see 17 | . 18 | -------------------------------------------------------------------------------- /peura/peura.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: peura 3 | version: 0.20211209 4 | synopsis: Oleg's "prelude" 5 | category: Development 6 | description: 7 | A very opinionated library, used to power tools in cabal-extras suite. 8 | 9 | maintainer: Oleg Grenrus 10 | license: GPL-2.0-or-later 11 | license-files: 12 | LICENSE 13 | LICENSE.GPLv2 14 | LICENSE.GPLv3 15 | 16 | tested-with: GHC ==9.8.4 17 | 18 | source-repository head 19 | type: git 20 | location: https://github.com/phadej/cabal-extras 21 | 22 | flag concurrent-output 23 | description: Use concurrent-output. Beneficial if you need regions 24 | default: True 25 | manual: True 26 | 27 | library 28 | default-language: Haskell2010 29 | hs-source-dirs: src 30 | 31 | -- Main module 32 | exposed-modules: Peura 33 | 34 | -- These modules are re-exported 35 | -- cabal-fmt: expand src -Peura 36 | exposed-modules: 37 | Peura.Async 38 | Peura.ByteString 39 | Peura.Cabal 40 | Peura.Debug 41 | Peura.Exports 42 | Peura.GHC 43 | Peura.Glob 44 | Peura.Monad 45 | Peura.Orphans 46 | Peura.Paths 47 | Peura.Process 48 | Peura.Run 49 | Peura.Serialise 50 | Peura.Temporary 51 | Peura.Trace 52 | Peura.Tracer 53 | Peura.Warning 54 | 55 | -- ghc-boot dependencies 56 | -- cabal-fmt: fragment ../fragments/boot-deps.fragment 57 | build-depends: 58 | , base ^>=4.19.0.0 59 | , binary ^>=0.8.9.0 60 | , bytestring ^>=0.12.0.2 61 | , containers ^>=0.6.8 62 | , deepseq ^>=1.5.0.0 63 | , directory ^>=1.3.8.1 64 | , filepath ^>=1.4.100.4 65 | , mtl ^>=2.3.1 66 | , parsec ^>=3.1.17.0 67 | , pretty ^>=1.1.3.6 68 | , process ^>=1.6.18.0 69 | , stm ^>=2.5.0.0 70 | , template-haskell 71 | , text ^>=2.1 72 | 73 | -- We use Cabal-3.12 74 | build-depends: Cabal ^>=3.12.1.0 75 | 76 | -- Common exports 77 | build-depends: gentle-introduction ^>=2024.4 78 | 79 | -- Extra dependencies 80 | build-depends: 81 | , aeson ^>=2.2.1.0 82 | , ansi-terminal ^>=1.1 83 | , async ^>=2.2.2 84 | , cabal-install-parsers ^>=0.6 85 | , cabal-plan ^>=0.7.2.0 86 | , clock ^>=0.8 87 | , edit-distance ^>=0.2.2.1 88 | , exceptions ^>=0.10.3 89 | , Glob ^>=0.10.0 90 | , optics-core ^>=0.4.1 91 | , optics-extra ^>=0.4.1 92 | , optparse-applicative ^>=0.18.0.0 93 | , paths ^>=0.2.0.0 94 | , serialise ^>=0.2.1.0 95 | , stm ^>=2.4.5.1 || ^>=2.5.0.0 96 | , strict ^>=0.5 97 | , temporary ^>=1.3 98 | , these ^>=1.2 99 | , universe-base ^>=1.1.1 100 | , unliftio-core ^>=0.2.0.0 101 | 102 | if flag(concurrent-output) 103 | build-depends: concurrent-output ^>=1.10.11 104 | 105 | default-extensions: 106 | BangPatterns 107 | DeriveAnyClass 108 | DeriveFunctor 109 | DeriveGeneric 110 | DerivingStrategies 111 | FunctionalDependencies 112 | GADTs 113 | GeneralizedNewtypeDeriving 114 | MultiWayIf 115 | NoImplicitPrelude 116 | OverloadedLabels 117 | OverloadedStrings 118 | ScopedTypeVariables 119 | TypeApplications 120 | TypeFamilies 121 | TypeOperators 122 | 123 | x-docspec-options: --verbose 124 | -------------------------------------------------------------------------------- /peura/src/Peura.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- SDPX-License-Identifier: GPL-2.0-or-later 3 | -- Copyright: Oleg Grenrus 4 | -- 5 | -- Peura 6 | -- 7 | module Peura ( 8 | module A, 9 | ) where 10 | 11 | import Peura.Async as A 12 | import Peura.ByteString as A 13 | import Peura.Cabal as A 14 | import Peura.Debug as A 15 | import Peura.Exports as A 16 | import Peura.GHC as A 17 | import Peura.Glob as A 18 | import Peura.Monad as A 19 | import Peura.Paths as A 20 | import Peura.Process as A 21 | import Peura.Run as A 22 | import Peura.Serialise as A 23 | import Peura.Temporary as A 24 | import Peura.Trace as A 25 | import Peura.Tracer as A 26 | import Peura.Warning as A 27 | 28 | import Peura.Orphans () 29 | -------------------------------------------------------------------------------- /peura/src/Peura/Async.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- SPDX-License-Identifier: GPL-2.0-or-later 3 | -- Copyright: Oleg Grenrus 4 | module Peura.Async ( 5 | Async.Async, 6 | withAsync, 7 | wait, 8 | async, 9 | ) where 10 | 11 | import qualified Control.Concurrent.Async as Async 12 | 13 | import Peura.Exports 14 | import Peura.Monad 15 | 16 | withAsync :: Peu r a -> (Async.Async a -> Peu r b) -> Peu r b 17 | withAsync action inner = withRunInIO $ \runInIO -> 18 | Async.withAsync (runInIO action) $ \a -> runInIO (inner a) 19 | 20 | -- | Use 'withAsync' is possible. 21 | async :: Peu r a -> Peu r (Async.Async a) 22 | async m = withRunInIO $ \runInIO -> Async.async (runInIO m) 23 | 24 | wait :: Async.Async a -> Peu r a 25 | wait = liftIO . Async.wait 26 | -------------------------------------------------------------------------------- /peura/src/Peura/ByteString.hs: -------------------------------------------------------------------------------- 1 | module Peura.ByteString ( 2 | readByteString, 3 | writeByteString, 4 | readLazyByteString, 5 | fromUTF8BS, 6 | toUTF8BS, 7 | ) where 8 | 9 | import Peura.Exports 10 | import Peura.Monad 11 | import Peura.Paths 12 | 13 | import qualified Data.ByteString as BS 14 | import qualified Data.ByteString.Lazy as LBS 15 | 16 | readByteString :: Path Absolute -> Peu r ByteString 17 | readByteString = liftIO . BS.readFile . toFilePath 18 | 19 | writeByteString :: Path Absolute -> ByteString -> Peu r () 20 | writeByteString p bs = liftIO (BS.writeFile (toFilePath p) bs) 21 | 22 | readLazyByteString :: Path Absolute -> Peu r LazyByteString 23 | readLazyByteString = liftIO . LBS.readFile . toFilePath 24 | -------------------------------------------------------------------------------- /peura/src/Peura/Debug.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- SPDX-License-Identifier: GPL-2.0-or-later OR BSD-3-Clause 3 | -- Copyright: Oleg Grenrus 4 | -- 5 | -- Debug and development methods 6 | -- 7 | module Peura.Debug ( 8 | error, 9 | undefined, 10 | trace, 11 | traceShow, 12 | traceShowId, 13 | ) where 14 | 15 | import qualified Prelude 16 | import qualified Debug.Trace 17 | 18 | undefined :: a 19 | undefined = Prelude.undefined 20 | {-# DEPRECATED undefined "Don't leave me in the code" #-} 21 | 22 | error :: Prelude.String -> a 23 | error = Prelude.error 24 | {-# DEPRECATED error "Don't leave me in the code" #-} 25 | 26 | trace :: Prelude.String -> b -> b 27 | trace = Debug.Trace.trace 28 | {-# DEPRECATED trace "Don't leave me in the code" #-} 29 | 30 | traceShow :: Prelude.Show a => a -> b -> b 31 | traceShow = Debug.Trace.traceShow 32 | {-# DEPRECATED traceShow "Don't leave me in the code" #-} 33 | 34 | traceShowId :: Prelude.Show a => a -> a 35 | traceShowId = Debug.Trace.traceShowId 36 | {-# DEPRECATED traceShowId "Don't leave me in the code" #-} 37 | -------------------------------------------------------------------------------- /peura/src/Peura/Exports.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- SDPX-License-Identifier: GPL-2.0-or-later 3 | -- Copyright: Oleg Grenrus 4 | -- 5 | -- Collection of exports from the dependencies. 6 | -- 7 | module Peura.Exports ( 8 | module Gentle.Introduction, 9 | -- ** MTL 10 | MonadCatch (..), 11 | MonadMask (..), 12 | MonadReader (..), 13 | MonadThrow (..), 14 | -- ** Serialisation 15 | Binary, 16 | Serialise, 17 | -- * Types 18 | ExitCode (..), 19 | LazyByteString, 20 | LibraryName (..), 21 | PackageName, 22 | PackageIdentifier (..), 23 | Version, 24 | VersionRange, 25 | UnitId, 26 | -- * Exceptions 27 | IOException, 28 | finally, 29 | onException, 30 | -- * Individual functions 31 | -- ** Control.Monad.Catch 32 | handle, 33 | bracket, 34 | -- ** Data.List 35 | sortBy, sortOn, splitOn, 36 | -- ** Data.Tuple 37 | fstOf3, sndOf3, trdOf3, 38 | -- * Cabal 39 | prettyShow, 40 | mkPackageName, 41 | mkVersion, 42 | -- * GHC.Generics 43 | V1, 44 | -- * Optics 45 | (%), 46 | (^.), (^?), 47 | (.~), (?~), (%~), 48 | _1, _2, 49 | Ixed (..), At (..), 50 | coerced, 51 | folded, 52 | setOf, 53 | _Just, 54 | view, 55 | preview, 56 | review, 57 | matching, 58 | prism', 59 | -- * TODO: gentle-introduction 60 | these, 61 | ) where 62 | 63 | import Gentle.Introduction hiding (error, traceShow, traceShowId, undefined) 64 | 65 | import Codec.Serialise (Serialise) 66 | import Control.Exception (IOException) 67 | import Control.Monad.Catch 68 | (MonadCatch (..), MonadMask (..), MonadThrow (..), bracket, finally, handle, onException) 69 | import Control.Monad.Reader.Class (MonadReader (ask, local)) 70 | import Data.Binary (Binary) 71 | import Data.List (sortBy, sortOn) 72 | import Distribution.Pretty (prettyShow) 73 | import Data.These (these) 74 | import Distribution.Types.LibraryName (LibraryName (..)) 75 | import Distribution.Types.PackageId (PackageIdentifier (..)) 76 | import Distribution.Types.PackageName (PackageName, mkPackageName) 77 | import Distribution.Types.UnitId (UnitId) 78 | import Distribution.Types.Version (Version, mkVersion) 79 | import Distribution.Types.VersionRange (VersionRange) 80 | import GHC.Generics (V1) 81 | import System.Exit (ExitCode (..)) 82 | 83 | import qualified Data.ByteString.Lazy as LBS 84 | 85 | import Data.Set.Optics (setOf) 86 | import Optics.Core (At (..), Ixed (..), coerced, folded, (%), (%~), (.~), (?~), (^.), (^?), _1, _2, _Just) 87 | import Optics.Extra (matching, preview, prism', review, view) 88 | 89 | type LazyByteString = LBS.ByteString 90 | 91 | -- | One of missing functions for lists in Prelude. 92 | -- 93 | -- >>> splitOn '-' "x86_64-unknown-linux" 94 | -- "x86_64" :| ["unknown","linux"] 95 | -- 96 | -- >>> splitOn 'x' "x86_64-unknown-linux" 97 | -- "" :| ["86_64-unknown-linu",""] 98 | -- 99 | splitOn :: Eq a => a -> [a] -> NonEmpty [a] 100 | splitOn sep = go where 101 | go [] = [] :| [] 102 | go (x:xs) 103 | | x == sep = [] :| ys : yss 104 | | otherwise = (x : ys) :| yss 105 | where 106 | ~(ys :| yss) = go xs 107 | 108 | fstOf3 :: (a, b, c) -> a 109 | fstOf3 (a, _, _) = a 110 | 111 | sndOf3 :: (a, b, c) -> b 112 | sndOf3 (_, b, _) = b 113 | 114 | trdOf3 :: (a, b, c) -> c 115 | trdOf3 (_, _, c) = c 116 | -------------------------------------------------------------------------------- /peura/src/Peura/Glob.hs: -------------------------------------------------------------------------------- 1 | module Peura.Glob ( 2 | -- * Globbing 3 | globDir1, 4 | globDir1First, 5 | -- * Exceptions 6 | GlobCompileException (..), 7 | GlobNoMatchException (..), 8 | ) where 9 | 10 | import qualified System.FilePath.Glob as Glob 11 | 12 | import Peura.Monad 13 | import Peura.Paths 14 | import Peura.Exports 15 | 16 | -- | Glob files in a directory 17 | globDir1 :: String -> Path Absolute -> Peu r [Path Absolute] 18 | globDir1 pat path = do 19 | pat' <- either (throwM . GlobCompileException) pure $ 20 | Glob.tryCompileWith Glob.compDefault pat 21 | matches <- liftIO $ Glob.globDir1 pat' (toFilePath path) 22 | traverse makeAbsoluteFilePath matches 23 | 24 | -- | Look for a single file using glob. 25 | globDir1First :: String -> Path Absolute -> Peu r (Path Absolute) 26 | globDir1First pat path = do 27 | pat' <- either (throwM . GlobCompileException) pure $ 28 | Glob.tryCompileWith Glob.compDefault pat 29 | matches <- liftIO $ Glob.globDir1 pat' (toFilePath path) 30 | case matches of 31 | (p:_) -> makeAbsoluteFilePath p 32 | [] -> throwM $ GlobNoMatchException pat path 33 | 34 | ------------------------------------------------------------------------------- 35 | -- Exceptions 36 | ------------------------------------------------------------------------------- 37 | 38 | newtype GlobCompileException = GlobCompileException String 39 | deriving Show 40 | 41 | instance Exception GlobCompileException 42 | 43 | data GlobNoMatchException = GlobNoMatchException String (Path Absolute) 44 | deriving Show 45 | 46 | instance Exception GlobNoMatchException 47 | -------------------------------------------------------------------------------- /peura/src/Peura/Orphans.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wno-orphans #-} 2 | module Peura.Orphans () where 3 | 4 | {- 5 | import System.Path (Path, Unrooted, fromUnrootedFilePath) 6 | import Distribution.Parsec (eitherParsec) 7 | 8 | import qualified Codec.Serialise as S 9 | 10 | import Peura.Exports 11 | 12 | instance r ~ Unrooted => IsString (Path r) where 13 | fromString = fromUnrootedFilePath 14 | 15 | instance S.Serialise PackageName where 16 | encode = S.encode . prettyShow 17 | decode = S.decode >>= either fail return . eitherParsec 18 | 19 | instance S.Serialise Version where 20 | encode = S.encode . prettyShow 21 | decode = S.decode >>= either fail return . eitherParsec 22 | 23 | instance S.Serialise VersionRange where 24 | encode = S.encode . prettyShow 25 | decode = S.decode >>= either fail return . eitherParsec 26 | -} 27 | -------------------------------------------------------------------------------- /peura/src/Peura/Run.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | -- | TODO 3 | module Peura.Run ( 4 | -- * Output 5 | Output (..), 6 | output, 7 | -- * Control.Exception 8 | evaluate, 9 | evaluateForce, 10 | -- * System.Environment 11 | getArgs, 12 | lookupEnv, 13 | ) where 14 | 15 | import qualified Control.Exception as X 16 | import qualified Data.ByteString.Lazy as LBS 17 | import qualified System.Console.ANSI as ANSI 18 | import qualified System.Environment as X 19 | 20 | import Peura.Exports 21 | import Peura.Monad 22 | import Peura.Trace 23 | import Peura.Tracer 24 | 25 | ------------------------------------------------------------------------------- 26 | -- Output 27 | ------------------------------------------------------------------------------- 28 | 29 | class Output str where 30 | outputSgr :: TracerPeu r w -> [ANSI.SGR] -> str -> Peu r () 31 | outputErr :: TracerPeu r w -> str -> Peu r () 32 | 33 | instance Char ~ a => Output [a] where 34 | outputSgr tracer s msg = traceWith tracer (TraceStdout s msg) 35 | outputErr tracer msg = traceWith tracer (TraceStderr msg) 36 | 37 | instance Output ByteString where 38 | outputSgr tracer s = outputSgr tracer s . fromUTF8BS 39 | outputErr tracer = outputErr tracer . fromUTF8BS 40 | 41 | instance Output LazyByteString where 42 | outputSgr tracer s = outputSgr tracer s . LBS.toStrict 43 | outputErr tracer = outputErr tracer . LBS.toStrict 44 | 45 | output :: Output str => Tracer (Peu r) (Trace w) -> str -> Peu r () 46 | output tracer = outputSgr tracer [] 47 | 48 | ------------------------------------------------------------------------------- 49 | -- Control.Exception 50 | ------------------------------------------------------------------------------- 51 | 52 | evaluate :: NFData a => a -> Peu r a 53 | evaluate = liftIO . X.evaluate 54 | 55 | evaluateForce :: NFData a => a -> Peu r a 56 | evaluateForce = evaluate . force 57 | 58 | ------------------------------------------------------------------------------- 59 | -- System.Environment 60 | ------------------------------------------------------------------------------- 61 | 62 | getArgs :: Peu r [String] 63 | getArgs = liftIO X.getArgs 64 | 65 | lookupEnv :: String -> Peu r (Maybe String) 66 | lookupEnv = liftIO . X.lookupEnv 67 | -------------------------------------------------------------------------------- /peura/src/Peura/Serialise.hs: -------------------------------------------------------------------------------- 1 | module Peura.Serialise ( 2 | readFileDeserialise, 3 | writeFileSerialise, 4 | ) where 5 | 6 | import Peura.Exports 7 | import Peura.Monad 8 | import Peura.Paths 9 | 10 | import qualified Codec.Serialise as S 11 | 12 | readFileDeserialise :: Serialise a => Path Absolute -> Peu r a 13 | readFileDeserialise p = liftIO $ S.readFileDeserialise (toFilePath p) 14 | 15 | writeFileSerialise :: Serialise a => Path Absolute -> a -> Peu r () 16 | writeFileSerialise p = liftIO . S.writeFileSerialise (toFilePath p) 17 | -------------------------------------------------------------------------------- /peura/src/Peura/Temporary.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- SPDX-License-Identifier: GPL-2.0-or-later 3 | -- Copyright: Oleg Grenrus 4 | module Peura.Temporary ( 5 | withSystemTempDirectory, 6 | ) where 7 | 8 | import qualified System.IO.Temp as Temp 9 | 10 | import Peura.Exports 11 | import Peura.Monad 12 | import Peura.Paths 13 | 14 | withSystemTempDirectory :: String -> (Path Absolute -> Peu r a) -> Peu r a 15 | withSystemTempDirectory tmpl f = Temp.withSystemTempDirectory tmpl $ \p -> do 16 | a <- makeAbsoluteFilePath p 17 | f a 18 | -------------------------------------------------------------------------------- /peura/src/Peura/Tracer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | module Peura.Tracer ( 3 | -- * Tracer 4 | Tracer (..), 5 | nullTracer, 6 | traceWith, 7 | hoistTracer, 8 | ) where 9 | 10 | import GHC.Stack (callStack, CallStack) 11 | 12 | import Peura.Exports 13 | 14 | ------------------------------------------------------------------------------- 15 | -- Tracer 16 | ------------------------------------------------------------------------------- 17 | 18 | newtype Tracer m a = Tracer { traceWithCallStack :: CallStack -> a -> m () } 19 | 20 | instance Contravariant (Tracer m) where 21 | contramap f (Tracer g) = Tracer (\cs -> g cs . f) 22 | 23 | nullTracer :: Applicative m => Tracer m a 24 | nullTracer = Tracer (\_ _ -> pure ()) 25 | 26 | traceWith :: HasCallStack => Tracer m a -> a -> m () 27 | traceWith (Tracer g) = g callStack 28 | 29 | hoistTracer :: (forall x. m x -> n x) -> Tracer m a -> Tracer n a 30 | hoistTracer nt (Tracer f) = Tracer $ \cs x -> nt (f cs x) 31 | -------------------------------------------------------------------------------- /peura/src/Peura/Warning.hs: -------------------------------------------------------------------------------- 1 | module Peura.Warning where 2 | 3 | import Peura.Exports 4 | 5 | class (Finite w, Ord w) => Warning w where 6 | warningToFlag :: w -> String 7 | 8 | instance Warning Void where 9 | warningToFlag = absurd 10 | -------------------------------------------------------------------------------- /peura/test/TestProcess.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RankNTypes #-} 4 | module Main (main) where 5 | 6 | import Control.Concurrent (threadDelay) 7 | import Control.Exception (bracket) 8 | import System.Environment (getArgs) 9 | import System.IO (Handle, IOMode (ReadWriteMode), hClose, openFile) 10 | 11 | import qualified Data.ByteString as BS 12 | import qualified Data.ByteString.Char8 as BS8 13 | 14 | import Lukko 15 | 16 | #ifdef HAS_OFD_LOCKING 17 | import qualified Lukko.OFD as OFD 18 | #endif 19 | 20 | #ifdef HAS_FLOCK 21 | import qualified Lukko.FLock as FLock 22 | #endif 23 | 24 | main :: IO () 25 | main = withArgs $ \withLock -> do 26 | putStrLn "starting..." 27 | withLock $ do 28 | contents <- BS.readFile "test-actual" 29 | threadDelay 10000 -- 10 ms 30 | BS.writeFile "test-actual" $ BS.append contents $ BS8.pack "another line\n" 31 | 32 | withArgs 33 | :: ((forall r. IO r -> IO r) -> IO ()) 34 | -> IO () 35 | withArgs k = do 36 | args <- getArgs 37 | case args of 38 | ["default"] -> k (genWithLock hLock hUnlock "test-lock") 39 | #ifdef HAS_OFD_LOCKING 40 | ["ofd"] -> k (genWithLock OFD.hLock OFD.hUnlock "test-lock") 41 | #endif 42 | #ifdef HAS_FLOCK 43 | ["flock"] -> k (genWithLock FLock.hLock FLock.hUnlock "test-lock") 44 | #endif 45 | ["noop"] -> k (genWithLock noOpLock noOpUnlock "test-lock") 46 | _ -> putStrLn "Unknown paramters. Doing nothing." 47 | 48 | ------------------------------------------------------------------------------- 49 | -- copy pasted 50 | ------------------------------------------------------------------------------- 51 | 52 | noOpLock :: Handle -> LockMode -> IO () 53 | noOpLock _ _ = return () 54 | 55 | noOpUnlock :: Handle -> IO () 56 | noOpUnlock _ = return () 57 | 58 | genWithLock 59 | :: (Handle -> LockMode -> IO ()) 60 | -> (Handle -> IO ()) 61 | -> FilePath 62 | -> IO a 63 | -> IO a 64 | genWithLock implLock implUnlock fp action = 65 | bracket takeLock releaseLock (const action) 66 | where 67 | takeLock = do 68 | h <- openFile fp ReadWriteMode 69 | implLock h ExclusiveLock 70 | return h 71 | 72 | releaseLock :: Handle -> IO () 73 | releaseLock h = do 74 | implUnlock h 75 | hClose h 76 | -------------------------------------------------------------------------------- /peura/test/Tests.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module Main (main) where 3 | 4 | import Control.Concurrent (threadDelay) 5 | import Control.Concurrent.Async (forConcurrently_) 6 | import Control.Exception (bracket) 7 | import Data.IORef 8 | import System.FilePath (()) 9 | import System.IO 10 | (Handle, IOMode (ReadWriteMode), hClose, openFile) 11 | import System.IO.Temp (withSystemTempDirectory) 12 | import Test.Tasty (TestTree, defaultMain, testGroup) 13 | import Test.Tasty.HUnit (testCase, (@=?)) 14 | 15 | import Lukko 16 | 17 | #ifdef HAS_OFD_LOCKING 18 | import qualified Lukko.OFD as OFD 19 | #endif 20 | 21 | #ifdef HAS_FLOCK 22 | import qualified Lukko.FLock as FLock 23 | #endif 24 | 25 | main :: IO () 26 | main = defaultMain $ testGroup "lukko" $ 27 | [ testGroup "Lukko default" $ testSuite fdLock fdUnlock 28 | | fileLockingSupported 29 | ] 30 | #ifdef HAS_OFD_LOCKING 31 | ++ [ testGroup "Lukko.OFD" $ testSuite OFD.fdLock OFD.fdUnlock ] 32 | #endif 33 | #ifdef HAS_FLOCK 34 | ++ [ testGroup "Lukko.FLock" $ testSuite FLock.fdLock FLock.fdUnlock ] 35 | #endif 36 | 37 | testSuite 38 | :: (FD -> LockMode -> IO ()) 39 | -> (FD -> IO ()) 40 | -> [TestTree] 41 | testSuite implLock implUnlock = 42 | [ testCase "concurrent threads" $ do 43 | let n = 10 :: Int 44 | ref <- newIORef 0 45 | 46 | withSystemTempDirectory "handle-lock-tests" $ \tmpDir -> do 47 | -- print tmpDir 48 | forConcurrently_ [1 :: Int .. n] $ \_ -> 49 | withLock (tmpDir "lock") $ do 50 | val <- readIORef ref 51 | threadDelay 10000 -- 10ms 52 | writeIORef ref (succ val) 53 | 54 | val <- readIORef ref 55 | val @=? n 56 | ] 57 | where 58 | withLock = genWithLock implLock implUnlock 59 | 60 | genWithLock 61 | :: (FD -> LockMode -> IO ()) 62 | -> (FD -> IO ()) 63 | -> FilePath 64 | -> IO a 65 | -> IO a 66 | genWithLock implLock implUnlock fp action = 67 | bracket takeLock releaseLock (const action) 68 | where 69 | takeLock = do 70 | fd <- fdOpen fp 71 | implLock fd ExclusiveLock 72 | return fd 73 | 74 | releaseLock :: FD -> IO () 75 | releaseLock fd = do 76 | implUnlock fd 77 | fdClose fd 78 | --------------------------------------------------------------------------------