├── .ghci ├── .gitignore ├── .gitlab-ci.yml ├── .travis.yml ├── COPYING.AGPL3 ├── COPYING.BSD3 ├── ChangeLog ├── CodingStyle ├── GhcMod.hs ├── GhcMod └── Exe │ ├── Boot.hs │ ├── Browse.hs │ ├── CaseSplit.hs │ ├── Check.hs │ ├── Debug.hs │ ├── FillSig.hs │ ├── Find.hs │ ├── Flag.hs │ ├── Info.hs │ ├── Internal.hs │ ├── Lang.hs │ ├── Lint.hs │ ├── Modules.hs │ ├── PkgDoc.hs │ └── Test.hs ├── LICENSE ├── README.md ├── README_old.md ├── Setup.hs ├── bench ├── Bench.hs └── data │ └── simple-cabal │ ├── Main.hs │ ├── Setup.hs │ └── simple-cabal.cabal ├── cabal.project ├── core ├── COPYING.AGPL3 ├── COPYING.BSD3 ├── Data │ └── Binary │ │ └── Generic.hs ├── GhcMod │ ├── CabalHelper.hs │ ├── Caching.hs │ ├── Caching │ │ └── Types.hs │ ├── Convert.hs │ ├── Cradle.hs │ ├── CustomPackageDb.hs │ ├── DebugLogger.hs │ ├── Doc.hs │ ├── DynFlags.hs │ ├── DynFlagsTH.hs │ ├── Error.hs │ ├── FileMapping.hs │ ├── Gap.hs │ ├── GhcPkg.hs │ ├── HomeModuleGraph.hs │ ├── LightGhc.hs │ ├── Logger.hs │ ├── Logging.hs │ ├── Monad.hs │ ├── Monad │ │ ├── Compat.hs_h │ │ ├── Env.hs │ │ ├── Log.hs │ │ ├── Newtypes.hs │ │ ├── Orphans.hs │ │ ├── Out.hs │ │ ├── State.hs │ │ └── Types.hs │ ├── Options │ │ ├── DocUtils.hs │ │ ├── Help.hs │ │ └── Options.hs │ ├── Output.hs │ ├── PathsAndFiles.hs │ ├── Pretty.hs │ ├── Read.hs │ ├── SrcUtils.hs │ ├── Stack.hs │ ├── Target.hs │ ├── Types.hs │ ├── Utils.hs │ └── World.hs ├── GhcModCore.hs ├── LICENSE ├── Setup.hs ├── ghc-mod-core.cabal └── shared │ ├── System │ └── Directory │ │ └── ModTime.hs │ └── Utils.hs ├── doc ├── Makefile ├── bug.piki ├── copyright.piki ├── emacs.piki ├── ghc-mod.piki ├── ghc-modi.piki ├── history.piki ├── index.piki ├── install.piki ├── preparation.piki └── presentation │ ├── Rokkitt.otf │ ├── SIL Open Font License.txt │ ├── architecture.pdf │ ├── architecture.tex │ ├── auto │ └── main.el │ ├── current-architecture.dia │ ├── current-architecture.png │ ├── gh-stars.png │ ├── hackage-dls.png │ ├── logo.pdf │ ├── main.pdf │ ├── main.tex │ └── planned-architecture.png ├── elisp ├── Makefile ├── ghc-check.el ├── ghc-command.el ├── ghc-comp.el ├── ghc-doc.el ├── ghc-func.el ├── ghc-indent.el ├── ghc-info.el ├── ghc-ins-mod.el ├── ghc-pkg.el ├── ghc-process.el ├── ghc-rewrite.el └── ghc.el ├── ghc-mod.cabal ├── ghcmodHappyHaskellProgram-Dg.tex ├── scripts ├── bounds.hs ├── bump.sh ├── collect-debug-info.sh ├── compare-versions.sh ├── diff.hs ├── docker.sh ├── download-metadata.sh ├── edit-bounds-macros.el ├── extract-build-deps.hs ├── extract-upload-date.sh └── upload-metadata.hs ├── shelltest ├── ShellTest.hs ├── browse.test ├── browse │ ├── MyModule.hs │ ├── browse-project.testtpl │ ├── cabal │ │ ├── MyModule.hs │ │ ├── browse-cabal.cabal │ │ └── browse-cabal.test │ ├── plain │ │ ├── MyModule.hs │ │ └── browse-plain.test │ └── sandbox │ │ ├── MyModule.hs │ │ ├── browse-sandbox.test │ │ └── test-setup.sh └── version.test ├── src ├── GhcMod │ └── Exe │ │ ├── Options.hs │ │ ├── Options │ │ ├── Commands.hs │ │ └── ShellParse.hs │ │ └── Version.hs ├── GhcModMain.hs └── GhcModi.hs ├── test-elisp ├── inp.hs └── out.hs └── test ├── BrowseSpec.hs ├── CabalHelperSpec.hs ├── CaseSplitSpec.hs ├── CheckSpec.hs ├── CradleSpec.hs ├── CustomPackageDbSpec.hs ├── Dir.hs ├── FileMappingSpec.hs ├── FindSpec.hs ├── FlagSpec.hs ├── GhcPkgSpec.hs ├── HomeModuleGraphSpec.hs ├── InfoSpec.hs ├── LangSpec.hs ├── LintSpec.hs ├── ListSpec.hs ├── Main.hs ├── MonadSpec.hs ├── PathsAndFilesSpec.hs ├── ShellParseSpec.hs ├── TargetSpec.hs ├── TestUtils.hs ├── data ├── annotations │ └── With.hs ├── broken-cabal │ ├── .cabal-sandbox │ │ └── packages │ │ │ ├── 00-index.cache │ │ │ └── 00-index.tar │ ├── broken.cabal │ └── cabal.sandbox.config.in ├── broken-sandbox │ ├── cabal.sandbox.config │ └── dummy.cabal ├── cabal-flags │ └── cabal-flags.cabal ├── cabal-preprocessors │ ├── Main.hs │ ├── Preprocessed.hsc │ └── cabal-preprocessors.cabal ├── cabal-project │ ├── .cabal-sandbox │ │ ├── i386-osx-ghc-7.6.3-packages.conf.d │ │ │ └── Cabal-1.18.1.3-2b161c6bf77657aa17e1681d83cb051b.conf │ │ └── packages │ │ │ ├── 00-index.cache │ │ │ └── 00-index.tar │ ├── Baz.hs │ ├── Foo.hs │ ├── Info.hs │ ├── Main.hs │ ├── cabal.sandbox.config.in │ ├── cabalapi.cabal │ └── subdir1 │ │ └── subdir2 │ │ └── dummy ├── case-split │ ├── Crash.hs │ ├── Vect.hs │ └── Vect706.hs ├── check-missing-warnings │ └── DesugarWarnings.hs ├── check-packageid │ ├── .cabal-sandbox │ │ └── i386-osx-ghc-7.6.3-packages.conf.d │ │ │ └── template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c.conf │ └── cabal.sandbox.config.in ├── check-test-subdir │ ├── check-test-subdir.cabal │ ├── src │ │ └── Check │ │ │ └── Test │ │ │ └── Subdir.hs │ └── test │ │ ├── Bar │ │ └── Baz.hs │ │ ├── Foo.hs │ │ └── Main.hs ├── custom-cradle │ ├── custom-cradle.cabal │ ├── ghc-mod.package-db-stack │ ├── package-db-a │ │ └── .gitkeep │ ├── package-db-b │ │ └── .gitkeep │ └── package-db-c │ │ └── .gitkeep ├── duplicate-pkgver │ ├── .cabal-sandbox │ │ └── i386-osx-ghc-7.6.3-packages.conf.d │ │ │ ├── template-haskell-1.0-7c59d13f32294d1ef6dc6233c24df961.conf │ │ │ ├── template-haskell-2.8.0.0-14e543bdae2da4d2aeff5386892c9112.conf │ │ │ └── template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c.conf │ ├── cabal.sandbox.config.in │ └── duplicate-pkgver.cabal ├── file-mapping │ ├── File.hs │ ├── File_Redir.hs │ ├── File_Redir_Lint.hs │ ├── duplicate-main │ │ ├── Main.hs │ │ ├── Main_Redir.hs │ │ ├── OtherMain.hs │ │ ├── OtherMain_Redir.hs │ │ └── duplicate-main.cabal │ ├── lhs │ │ ├── File.lhs │ │ ├── File_Redir.lhs │ │ └── File_Redir_Lint.lhs │ └── preprocessor │ │ ├── File.hs │ │ ├── File_Redir.hs │ │ └── File_Redir_Lint.hs ├── foreign-export │ └── ForeignExport.hs ├── ghc-mod-check │ ├── ghc-mod-check.cabal │ ├── lib │ │ └── Data │ │ │ └── Foo.hs │ └── main.hs ├── hlint │ └── hlint.hs ├── home-module-graph │ ├── cpp │ │ ├── A.hs │ │ ├── A1.hs │ │ ├── A2.hs │ │ ├── A3.hs │ │ └── B.hs │ ├── cycle │ │ ├── A.hs │ │ └── B.hs │ ├── errors │ │ ├── A.hs │ │ ├── A1.hs │ │ ├── A2.hs │ │ ├── A3.hs │ │ └── B.hs │ ├── indirect-update │ │ ├── A.hs │ │ ├── A1.hs │ │ ├── A2.hs │ │ ├── A3.hs │ │ ├── B.hs │ │ └── C.hs │ └── indirect │ │ ├── A.hs │ │ ├── A1.hs │ │ ├── A2.hs │ │ ├── A3.hs │ │ ├── B.hs │ │ └── C.hs ├── import-cycle │ ├── Mutual1.hs │ └── Mutual2.hs ├── nice-qualification │ └── NiceQualification.hs ├── non-exported │ └── Fib.hs ├── pattern-synonyms │ ├── A.hs │ ├── B.hs │ ├── Setup.hs │ └── pattern-synonyms.cabal ├── quasi-quotes │ ├── FooQ.hs │ └── QuasiQuotes.hs ├── stack-project │ ├── Setup.hs │ ├── app │ │ └── Main.hs │ ├── new-template.cabal │ ├── src │ │ └── Lib.hs │ ├── stack.yaml.in │ └── test │ │ └── Spec.hs ├── target │ └── Cpp.hs └── template-haskell │ ├── Bar.hs │ ├── Foo.hs │ └── ImportsTH.hs ├── doctests.hs └── manual └── not-interpreted-error ├── GhcTestcase.hs ├── bad.gm ├── good.gm └── proj ├── Main.hs └── not-interpreted-error.cabal /.ghci: -------------------------------------------------------------------------------- 1 | :set -idist/build/autogen/ 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | dist-newstyle/ 3 | elisp/*.elc 4 | *~ 5 | /.cabal-sandbox/ 6 | /.stack-work/ 7 | /test/data/**/stack.yaml 8 | add-source-timestamps 9 | package.cache 10 | cabal.sandbox.config 11 | cabal.project.local 12 | # Mac OS generates 13 | # .DS_Store 14 | *.o 15 | *.dyn_o 16 | *.hi 17 | *.dyn_hi 18 | 19 | # Where do these files come from? They're not readable. 20 | # For instance, .#Help.page 21 | # .#* 22 | cabal-dev 23 | /TAGS 24 | /tags 25 | -------------------------------------------------------------------------------- /.gitlab-ci.yml: -------------------------------------------------------------------------------- 1 | stages: 2 | - build 3 | 4 | .before_script_template: &common_before_script 5 | before_script: 6 | - mkdir -p ~/.cabal /cache/store 7 | - rm -rf ~/.cabal/store 8 | - ln -s /cache/store ~/.cabal/store 9 | - ls -l .. 10 | - mkdir -p ../ghc-mod.sdist-$CI_PIPELINE_ID 11 | - cabal update 12 | - cabal install cabal-doctest 13 | - cabal act-as-setup -- sdist --output-directory=../ghc-mod.sdist-$CI_PIPELINE_ID 14 | - cd core && cabal act-as-setup -- sdist --output-directory=../../ghc-mod.sdist-$CI_PIPELINE_ID/core 15 | - cd ../../ghc-mod.sdist-$CI_PIPELINE_ID 16 | 17 | after_script: 18 | - rm -rf "$CI_PROJECT_DIR"/../ghc-mod.sdist-$CI_PIPELINE_ID 19 | 20 | .script_template: &common_script 21 | script: 22 | - echo $PWD 23 | - which cabal 24 | - cabal --version 25 | - cabal new-configure --enable-tests 26 | - cabal new-build 27 | - cabal new-test 28 | - cabal new-haddock 29 | 30 | .artifacts_template: &common_artifacts 31 | artifacts: 32 | paths: 33 | - ~/.cabal/logs 34 | when: always 35 | 36 | job-ghc802: 37 | image: registry.gitlab.com/dxld/ghc-mod:ghc8.2.2-cabal-install2.4.0.0 38 | stage: build 39 | <<: *common_before_script 40 | <<: *common_script 41 | <<: *common_artifacts 42 | 43 | job-ghc800: 44 | image: registry.gitlab.com/dxld/ghc-mod:ghc8.0.2-cabal-install2.4.0.0 45 | stage: build 46 | <<: *common_before_script 47 | <<: *common_script 48 | <<: *common_artifacts 49 | 50 | job-ghc710: 51 | image: registry.gitlab.com/dxld/ghc-mod:ghc7.10.3-cabal-install2.4.0.0 52 | stage: build 53 | <<: *common_before_script 54 | <<: *common_script 55 | <<: *common_artifacts 56 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: false 3 | 4 | cache: 5 | apt: true 6 | directories: 7 | - $HOME/.stack 8 | - $HOME/.ghc-mod 9 | 10 | addons: 11 | apt: 12 | packages: 13 | - libfcgi-dev 14 | - libgmp-dev 15 | 16 | before_install: 17 | - unset CC 18 | - mkdir -p ~/.local/bin 19 | - export PATH=$HOME/.local/bin:$PATH 20 | - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 21 | - stack --version 22 | 23 | install: 24 | # - git clone --depth=1 https://github.com/DanielG/cabal-helper.git 25 | - stack --no-terminal setup --resolver=ghc-$GHCVER 26 | - stack --no-terminal install cabal-install --resolver=$RES 27 | - travis_retry cabal update 28 | - stack --no-terminal install happy --resolver=$RES 29 | - | 30 | resf="ghc-$GHCVER.yaml" 31 | echo "resolver: ghc-$GHCVER" > "$resf" 32 | echo "packages: ['.']" >> "$resf" 33 | stack --no-terminal solver --update-config --stack-yaml="$resf" || exit 101 34 | sed -i 's/^resolver:/compiler:/;s/^extra-deps:/packages:/' "$resf" 35 | echo "resolver: { name: 'ghc-$GHCVER', location: './$resf' }" > stack.yaml 36 | echo "packages: ['.']" >> stack.yaml 37 | ir=$( stack path --snapshot-install-root ) 38 | ls -d ${ir%/custom-ghc-*}/custom-ghc-* | grep -v "${ir%/*}" | while read i; do 39 | rm -rfv "$i" 40 | done 41 | 42 | 43 | script: 44 | - cabal check 45 | - | 46 | case "$TRAVIS_BRANCH" in 47 | "release"*) 48 | touch ChangeLog 49 | sdistdir="$TRAVIS_BUILD_DIR/../sdist-test" 50 | mkdir -p "$sdistdir" 51 | tar zvxf $(stack sdist 2>&1 | tail -n1 | sed 's/.* //') --strip-components=1 -C "$sdistdir" 52 | cp "ghc-$GHCVER.yaml" stack.yaml "$sdistdir" 53 | cd "$sdistdir" 54 | ;; 55 | esac 56 | - stack --no-terminal build --test --no-run-tests 57 | - export DOCTEST_DIST_DIR="$(stack path --dist-dir)" 58 | - stack --no-terminal test 59 | 60 | matrix: 61 | matrix: 62 | include: 63 | - env: GHCVER=7.8.4 RES=lts-2.22 64 | compiler: ': #GHC 7.8.4' 65 | - env: GHCVER=7.10.3 RES=lts-6.9 66 | compiler: ': #GHC 7.10.3' 67 | - env: GHCVER=8.0.1 RES=nightly-2016-08-01 68 | compiler: ': #GHC 8.0.1' 69 | -------------------------------------------------------------------------------- /COPYING.BSD3: -------------------------------------------------------------------------------- 1 | Copyright (c) 2009, IIJ Innovation Institute Inc. 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in 12 | the documentation and/or other materials provided with the 13 | distribution. 14 | * Neither the name of the copyright holders nor the names of its 15 | contributors may be used to endorse or promote products derived 16 | from this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 21 | FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 22 | COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 23 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 24 | BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 25 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 26 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 27 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 28 | ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 29 | POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /CodingStyle: -------------------------------------------------------------------------------- 1 | * GHC support 2 | 3 | GHC 7.4, 7.6 and 7.8 are supported at this moment. If GHC 7.10 is 4 | released, the support for GHC 7.4 will be discontinued. 5 | 6 | 7 | * Compiler warnings 8 | 9 | All compiler warnings generated by the latest stable GHC with "-Wall" 10 | MUST be eliminated. 11 | 12 | 13 | * Deceleration style 14 | 15 | Try to use "where" instead of "let". 16 | 17 | 18 | * Error handling 19 | 20 | As a general rule of thumb anything that can fail (as in the Monad 21 | method) should get a surrounding catchError with a description of what 22 | the function was trying to do. If a function is trying to do more than 23 | one thing it should probably be split up into multiple seperate 24 | functions anyways. 25 | 26 | All uses of the major partial functions (i.e fromJust, fromLeft, head 27 | etc.) should probably be replaced by pattern matching in the do block 28 | (since pattern match failures are very easy to handle with 29 | catchError). 30 | 31 | We also have to be careful with anything that uses liftIO since that 32 | might introduce unexpected exceptions. For example parseCabalFile 33 | still uses IOError's for error reporting which would circumvent ErrorT 34 | and make handling that error with MonadError impossible. Stuff like 35 | that should probably be converted to GhcModT or return IO (Either 36 | String SomeThing) instead. It should be pretty easy to write a 37 | function to lift IO (Either e a) into a GhcModT a (where e could be 38 | String, ´GhcModError` or something like that). 39 | 40 | 41 | * #if 42 | 43 | "#if __GLASGOW_HASKELL__" should be used in "Gap.hs" and "Monad.hs" 44 | only. If it is used in another file, it should be moved into 45 | "Gap.hs". 46 | -------------------------------------------------------------------------------- /GhcMod.hs: -------------------------------------------------------------------------------- 1 | -- | The ghc-mod library. 2 | 3 | module GhcMod ( 4 | -- * Cradle 5 | Cradle(..) 6 | , Project(..) 7 | , findCradle 8 | -- * Options 9 | , Options(..) 10 | , LineSeparator(..) 11 | , OutputStyle(..) 12 | , FileMapping(..) 13 | , defaultOptions 14 | -- * Logging 15 | , GmLogLevel 16 | , increaseLogLevel 17 | , decreaseLogLevel 18 | , gmSetLogLevel 19 | , gmLog 20 | -- * Types 21 | , ModuleString 22 | , Expression(..) 23 | , GhcPkgDb 24 | , Symbol 25 | , SymbolDb 26 | , GhcModError(..) 27 | -- * Monad Types 28 | , GhcModT 29 | , IOish 30 | -- * Monad utilities 31 | , runGhcModT 32 | , withOptions 33 | , dropSession 34 | -- * 'GhcMod' utilities 35 | , boot 36 | , browse 37 | , check 38 | , checkSyntax 39 | , debugInfo 40 | , componentInfo 41 | , expandTemplate 42 | , info 43 | , lint 44 | , pkgDoc 45 | , rootInfo 46 | , types 47 | , test 48 | , splits 49 | , sig 50 | , refine 51 | , auto 52 | , modules 53 | , languages 54 | , flags 55 | , findSymbol 56 | , lookupSymbol 57 | , dumpSymbol 58 | -- * SymbolDb 59 | , loadSymbolDb 60 | , isOutdated 61 | -- * Output 62 | , gmPutStr 63 | , gmErrStr 64 | , gmPutStrLn 65 | , gmErrStrLn 66 | -- * FileMapping 67 | , loadMappedFile 68 | , loadMappedFileSource 69 | , unloadMappedFile 70 | ) where 71 | 72 | import GhcMod.Exe.Boot 73 | import GhcMod.Exe.Browse 74 | import GhcMod.Exe.CaseSplit 75 | import GhcMod.Exe.Check 76 | import GhcMod.Exe.Debug 77 | import GhcMod.Exe.FillSig 78 | import GhcMod.Exe.Find 79 | import GhcMod.Exe.Flag 80 | import GhcMod.Exe.Info 81 | import GhcMod.Exe.Lang 82 | import GhcMod.Exe.Lint 83 | import GhcMod.Exe.Modules 84 | import GhcMod.Exe.PkgDoc 85 | import GhcMod.Exe.Test 86 | import GhcMod.Cradle 87 | import GhcMod.FileMapping 88 | import GhcMod.Logging 89 | import GhcMod.Monad 90 | import GhcMod.Output 91 | import GhcMod.Target 92 | import GhcMod.Types 93 | -------------------------------------------------------------------------------- /GhcMod/Exe/Boot.hs: -------------------------------------------------------------------------------- 1 | module GhcMod.Exe.Boot where 2 | 3 | import Control.Applicative 4 | import Prelude 5 | 6 | import GhcMod.Exe.Browse 7 | import GhcMod.Exe.Flag 8 | import GhcMod.Exe.Lang 9 | import GhcMod.Exe.Modules 10 | import GhcMod.Monad 11 | import GhcMod.Types (defaultBrowseOpts) 12 | 13 | -- | Printing necessary information for front-end booting. 14 | boot :: IOish m => GhcModT m String 15 | boot = concat <$> sequence ms 16 | where 17 | ms = [modules False, languages, flags, concat <$> mapM (browse defaultBrowseOpts) preBrowsedModules] 18 | 19 | preBrowsedModules :: [String] 20 | preBrowsedModules = [ 21 | "Prelude" 22 | , "Control.Applicative" 23 | , "Control.Exception" 24 | , "Control.Monad" 25 | , "Data.Char" 26 | , "Data.List" 27 | , "Data.Maybe" 28 | , "System.IO" 29 | ] 30 | -------------------------------------------------------------------------------- /GhcMod/Exe/Check.hs: -------------------------------------------------------------------------------- 1 | module GhcMod.Exe.Check ( 2 | checkSyntax 3 | , check 4 | , expandTemplate 5 | , expand 6 | ) where 7 | 8 | import Control.Applicative 9 | import Prelude 10 | import GhcMod.DynFlags 11 | import qualified GhcMod.Gap as Gap 12 | import GhcMod.Logger 13 | import GhcMod.Monad 14 | 15 | ---------------------------------------------------------------- 16 | 17 | -- | Checking syntax of a target file using GHC. 18 | -- Warnings and errors are returned. 19 | checkSyntax :: IOish m 20 | => [FilePath] -- ^ The target files. 21 | -> GhcModT m String 22 | checkSyntax [] = return "" 23 | checkSyntax files = either id id <$> check files 24 | 25 | ---------------------------------------------------------------- 26 | 27 | -- | Checking syntax of a target file using GHC. 28 | -- Warnings and errors are returned. 29 | check :: IOish m 30 | => [FilePath] -- ^ The target files. 31 | -> GhcModT m (Either String String) 32 | check files = 33 | runGmlTWith 34 | (map Left files) 35 | return 36 | ((fmap fst <$>) . withLogger Gap.setNoMaxRelevantBindings) 37 | (return ()) 38 | 39 | ---------------------------------------------------------------- 40 | 41 | -- | Expanding Haskell Template. 42 | expandTemplate :: IOish m 43 | => [FilePath] -- ^ The target files. 44 | -> GhcModT m String 45 | expandTemplate [] = return "" 46 | expandTemplate files = either id id <$> expand files 47 | 48 | ---------------------------------------------------------------- 49 | 50 | -- | Expanding Haskell Template. 51 | expand :: IOish m => [FilePath] -> GhcModT m (Either String String) 52 | expand files = 53 | runGmlTWith 54 | (map Left files) 55 | return 56 | ((fmap fst <$>) . withLogger (Gap.setDumpSplices . setNoWarningFlags)) 57 | (return ()) 58 | -------------------------------------------------------------------------------- /GhcMod/Exe/Flag.hs: -------------------------------------------------------------------------------- 1 | module GhcMod.Exe.Flag where 2 | 3 | import qualified GhcMod.Gap as Gap 4 | import GhcMod.Convert 5 | import GhcMod.Monad 6 | 7 | -- | Listing of GHC flags, same as @ghc@\'s @--show-options@ with @ghc >= 7.10@. 8 | flags :: IOish m => GhcModT m String 9 | flags = convert' Gap.ghcCmdOptions 10 | -------------------------------------------------------------------------------- /GhcMod/Exe/Info.hs: -------------------------------------------------------------------------------- 1 | module GhcMod.Exe.Info ( 2 | info 3 | , types 4 | ) where 5 | 6 | import Data.Function (on) 7 | import Data.List (sortBy) 8 | import System.FilePath 9 | import Exception (ghandle, SomeException(..)) 10 | import GHC (GhcMonad, SrcSpan) 11 | import Prelude 12 | import qualified GHC as G 13 | 14 | import qualified GhcMod.Gap as Gap 15 | import GhcMod.Convert 16 | import GhcMod.Doc 17 | import GhcMod.DynFlags 18 | import GhcMod.Gap 19 | import GhcMod.Logging 20 | import GhcMod.Monad 21 | import GhcMod.SrcUtils 22 | import GhcMod.Types 23 | import GhcMod.Utils (mkRevRedirMapFunc) 24 | import GhcMod.FileMapping (fileModSummaryWithMapping) 25 | 26 | ---------------------------------------------------------------- 27 | 28 | -- | Obtaining information of a target expression. (GHCi's info:) 29 | info :: IOish m 30 | => FilePath -- ^ A target file. 31 | -> Expression -- ^ A Haskell expression. 32 | -> GhcModT m String 33 | info file expr = 34 | ghandle handler $ 35 | runGmlT' [Left file] deferErrors $ 36 | withInteractiveContext $ do 37 | convert' =<< body 38 | where 39 | handler (SomeException ex) = do 40 | gmLog GmException "info" $ text "" $$ nest 4 (showToDoc ex) 41 | convert' "Cannot show info" 42 | 43 | body :: (GhcMonad m, GmState m, GmEnv m) => m String 44 | body = do 45 | m <- mkRevRedirMapFunc 46 | sdoc <- Gap.infoThing m expr 47 | st <- getStyle 48 | dflag <- G.getSessionDynFlags 49 | return $ showPage dflag st sdoc 50 | 51 | ---------------------------------------------------------------- 52 | 53 | -- | Obtaining type of a target expression. (GHCi's type:) 54 | types :: IOish m 55 | => Bool -- ^ Include constraints into type signature 56 | -> FilePath -- ^ A target file. 57 | -> Int -- ^ Line number. 58 | -> Int -- ^ Column number. 59 | -> GhcModT m String 60 | types withConstraints file lineNo colNo = 61 | ghandle handler $ 62 | runGmlT' [Left file] deferErrors $ 63 | withInteractiveContext $ do 64 | crdl <- cradle 65 | modSum <- fileModSummaryWithMapping (cradleCurrentDir crdl file) 66 | srcSpanTypes <- getSrcSpanType withConstraints modSum lineNo colNo 67 | dflag <- G.getSessionDynFlags 68 | st <- getStyle 69 | convert' $ map (toTup dflag st) $ sortBy (cmp `on` fst) srcSpanTypes 70 | where 71 | handler (SomeException ex) = do 72 | gmLog GmException "types" $ showToDoc ex 73 | return [] 74 | 75 | getSrcSpanType :: (GhcMonad m) => Bool -> G.ModSummary -> Int -> Int -> m [(SrcSpan, G.Type)] 76 | getSrcSpanType withConstraints modSum lineNo colNo = 77 | G.parseModule modSum 78 | >>= G.typecheckModule 79 | >>= flip (collectSpansTypes withConstraints) (lineNo, colNo) 80 | -------------------------------------------------------------------------------- /GhcMod/Exe/Internal.hs: -------------------------------------------------------------------------------- 1 | -- | Low level access to the ghc-mod library. 2 | 3 | module GhcMod.Exe.Internal ( 4 | -- * Types 5 | GHCOption 6 | , IncludeDir 7 | , GmlT(..) 8 | , MonadIO(..) 9 | , GmEnv(..) 10 | -- * Various Paths 11 | , ghcLibDir 12 | , ghcModExecutable 13 | -- * Logging 14 | , withLogger 15 | , setNoWarningFlags 16 | , setAllWarningFlags 17 | -- * Environment, state and logging 18 | , GhcModEnv(..) 19 | , GhcModState 20 | , GhcModLog 21 | , GmLog(..) 22 | , GmLogLevel(..) 23 | , gmSetLogLevel 24 | -- * Monad utilities 25 | , runGhcModT' 26 | , hoistGhcModT 27 | , runGmlT 28 | , runGmlT' 29 | , gmlGetSession 30 | , gmlSetSession 31 | , loadTargets 32 | , cabalResolvedComponents 33 | -- ** Accessing 'GhcModEnv' and 'GhcModState' 34 | , options 35 | , cradle 36 | , targetGhcOptions 37 | , withOptions 38 | -- * 'GhcModError' 39 | , gmeDoc 40 | -- * World 41 | , World 42 | , getCurrentWorld 43 | , didWorldChange 44 | -- * Cabal Helper 45 | , ModulePath(..) 46 | , GmComponent(..) 47 | , GmComponentType(..) 48 | , GmModuleGraph(..) 49 | , prepareCabalHelper 50 | -- * Misc stuff 51 | , GHandler(..) 52 | , gcatches 53 | -- * FileMapping 54 | , module GhcMod.FileMapping 55 | ) where 56 | 57 | import GHC.Paths (libdir) 58 | 59 | import GhcMod.Target 60 | import GhcMod.DynFlags 61 | import GhcMod.Error 62 | import GhcMod.Logger 63 | import GhcMod.Logging 64 | import GhcMod.Monad 65 | import GhcMod.Types 66 | import GhcMod.World 67 | import GhcMod.CabalHelper 68 | import GhcMod.FileMapping 69 | import GhcMod.PathsAndFiles 70 | 71 | -- | Obtaining the directory for ghc system libraries. 72 | ghcLibDir :: FilePath 73 | ghcLibDir = libdir 74 | -------------------------------------------------------------------------------- /GhcMod/Exe/Lang.hs: -------------------------------------------------------------------------------- 1 | module GhcMod.Exe.Lang where 2 | 3 | import DynFlags (supportedLanguagesAndExtensions) 4 | import GhcMod.Convert 5 | import GhcMod.Monad 6 | 7 | -- | Listing language extensions. 8 | 9 | languages :: IOish m => GhcModT m String 10 | languages = convert' supportedLanguagesAndExtensions 11 | -------------------------------------------------------------------------------- /GhcMod/Exe/Lint.hs: -------------------------------------------------------------------------------- 1 | module GhcMod.Exe.Lint where 2 | 3 | import Exception (ghandle) 4 | import Control.Exception (SomeException(..)) 5 | import GhcMod.Logger (checkErrorPrefix) 6 | import GhcMod.Convert 7 | import GhcMod.Types 8 | import GhcMod.Monad 9 | import Language.Haskell.HLint3 10 | 11 | import GhcMod.Utils (withMappedFile) 12 | import Language.Haskell.Exts.SrcLoc (SrcSpan(..)) 13 | 14 | -- | Checking syntax of a target file using hlint. 15 | -- Warnings and errors are returned. 16 | lint :: IOish m 17 | => LintOpts -- ^ Configuration parameters 18 | -> FilePath -- ^ A target file. 19 | -> GhcModT m String 20 | lint opt file = ghandle handler $ 21 | withMappedFile file $ \tempfile -> do 22 | res <- liftIO $ hlint $ "--quiet" : tempfile : optLintHlintOpts opt 23 | pack . map (show . substFile file tempfile) $ res 24 | where 25 | pack = convert' . map init -- init drops the last \n. 26 | handler (SomeException e) = return $ checkErrorPrefix ++ show e ++ "\n" 27 | substFile orig temp idea 28 | | srcSpanFilename (ideaSpan idea) == temp 29 | = idea{ideaSpan=(ideaSpan idea){srcSpanFilename = orig}} 30 | substFile _ _ idea = idea 31 | -------------------------------------------------------------------------------- /GhcMod/Exe/Modules.hs: -------------------------------------------------------------------------------- 1 | module GhcMod.Exe.Modules (modules) where 2 | 3 | import Control.Arrow 4 | import Data.List 5 | import GhcMod.Convert 6 | import GhcMod.Types 7 | import GhcMod.Monad 8 | import GhcMod.Gap ( listVisibleModuleNames 9 | , lookupModulePackageInAllPackages 10 | ) 11 | 12 | import qualified GHC as G 13 | 14 | ---------------------------------------------------------------- 15 | 16 | -- | Listing installed modules. 17 | modules :: (IOish m, Gm m) 18 | => Bool -- ^ 'detailed', if 'True', also prints packages that modules belong to. 19 | -> m String 20 | modules detailed = do 21 | df <- runGmPkgGhc G.getSessionDynFlags 22 | let mns = listVisibleModuleNames df 23 | pmnss = map (first moduleNameString) $ zip mns (modulePkg df `map` mns) 24 | convert' $ nub [ if detailed then pkg ++ " " ++ mn else mn 25 | | (mn, pkgs) <- pmnss, pkg <- pkgs ] 26 | where 27 | modulePkg df = lookupModulePackageInAllPackages df 28 | -------------------------------------------------------------------------------- /GhcMod/Exe/PkgDoc.hs: -------------------------------------------------------------------------------- 1 | module GhcMod.Exe.PkgDoc (pkgDoc) where 2 | 3 | import GhcMod.Types 4 | import GhcMod.GhcPkg 5 | import GhcMod.Monad 6 | import GhcMod.Output 7 | 8 | import Control.Applicative 9 | import Prelude 10 | 11 | -- | Obtaining the package name and the doc path of a module. 12 | pkgDoc :: IOish m => String -> GhcModT m String 13 | pkgDoc mdl = do 14 | ghcPkg <- getGhcPkgProgram 15 | readProc <- gmReadProcess 16 | pkgDbStack <- getPackageDbStack 17 | pkg <- liftIO $ trim <$> readProc ghcPkg (toModuleOpts pkgDbStack) "" 18 | if pkg == "" then 19 | return "\n" 20 | else do 21 | htmlpath <- liftIO $ readProc ghcPkg (toDocDirOpts pkg pkgDbStack) "" 22 | let ret = pkg ++ " " ++ drop 14 htmlpath 23 | return ret 24 | where 25 | toModuleOpts dbs = ["find-module", mdl, "--simple-output"] 26 | ++ ghcPkgDbStackOpts dbs 27 | toDocDirOpts pkg dbs = ["field", pkg, "haddock-html"] 28 | ++ ghcPkgDbStackOpts dbs 29 | trim = takeWhile (`notElem` " \n") 30 | -------------------------------------------------------------------------------- /GhcMod/Exe/Test.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | module GhcMod.Exe.Test where 4 | 5 | import Control.Applicative 6 | import Data.List 7 | import System.FilePath 8 | import System.Directory 9 | import Prelude 10 | 11 | import GhcMod.Types 12 | import GhcMod.Monad 13 | import GhcMod.DynFlags 14 | 15 | import GHC 16 | import GHC.Exception 17 | import OccName 18 | 19 | test :: IOish m 20 | => FilePath -> GhcModT m String 21 | test f = runGmlT' [Left f] (fmap setHscInterpreted . deferErrors) $ do 22 | mg <- getModuleGraph 23 | root <- cradleRootDir <$> cradle 24 | f' <- makeRelative root <$> liftIO (canonicalizePath f) 25 | let Just ms = find ((==Just f') . ml_hs_file . ms_location) mg 26 | mdl = ms_mod ms 27 | mn = moduleName mdl 28 | 29 | Just mi <- getModuleInfo mdl 30 | let exs = map (occNameString . getOccName) $ modInfoExports mi 31 | cqs = filter ("prop_" `isPrefixOf`) exs 32 | 33 | setContext [ IIDecl $ simpleImportDecl mn 34 | , IIDecl $ simpleImportDecl $ mkModuleName "Test.QuickCheck" 35 | ] 36 | 37 | _res <- mapM runTest cqs 38 | 39 | return "" 40 | 41 | #if __GLASGOW_HASKELL__ >= 802 42 | runTest :: GhcMonad m => String -> m (Maybe SomeException) 43 | runTest fn = do 44 | res <- execStmt ("quickCheck " ++ fn) execOptions 45 | return $ case res of 46 | ExecComplete (Right _) _ -> Nothing 47 | ExecComplete (Left se) _ -> Just se 48 | _ -> error "runTest" 49 | #else 50 | runTest :: GhcMonad m => String -> m (Maybe SomeException) 51 | runTest fn = do 52 | res <- runStmt ("quickCheck " ++ fn) RunToCompletion 53 | return $ case res of 54 | RunOk [] -> Nothing 55 | RunException se -> Just se 56 | _ -> error "runTest" 57 | #endif 58 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | ghc-mod was originally licensed under the BSD3 but the primary license has been 2 | changed to the AGPL3, files originally contributed under the BSD3 license remain 3 | under this license and can generally be identified by the lack of a GPL header. 4 | 5 | See the files COPYING.BSD3 and COPYING.AGPL3 in the source distribution for 6 | copies of the two licenses. 7 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ghc-mod: Happy Haskell Hacking 2 | [![build status](https://gitlab.com/dxld/ghc-mod/badges/master/build.svg)](https://gitlab.com/dxld/ghc-mod/commits/master) 3 | 4 | ## Legacy 5 | 6 | Please note that using ghc-mod as a user facing tool for IDE/Editor integration 7 | is no longer supported or maintained. We are in the process of refocusing our 8 | efforts around 9 | [haskell-ide-engine](https://github.com/haskell/haskell-ide-engine) as the main 10 | user/IDE facing program. 11 | 12 | Currently haskell-ide-engine still uses ghc-mod as a library for GHC session 13 | setup, so this part will still be maintained. However moving forward we're 14 | hoping to move most of the functionality which remains in ghc-mod (the library) 15 | into GHC upstream rendering ghc-mod unceccesary. Meanwhile ghc-mod (the library) 16 | will remain. 17 | 18 | If someone feels like taking over maintainership of ghc-mod as a standalone 19 | development tool feel free to contact the maintainer. However I must warn you: a 20 | mountain of legacy baggage and scattered Editor/IDE plugins awaits. Your time is 21 | probably better spent improving haskell-ide-engine. 22 | 23 | For more information on what ghc-mod used to be have a look at the 24 | [old README](README_old.md). 25 | 26 | ## Reporting Bugs 27 | 28 | Please report bugs on the GitHub issue tracker for ghc-mod: 29 | https://github.com/DanielG/ghc-mod/issues 30 | 31 | Including general environment information like the operating system 32 | (distribution, version) you're using and the output of `$ ghc-mod debug` run in 33 | your project directory is probably a good idea. 34 | 35 | ## IRC 36 | 37 | If you have any problems, suggestions, comments swing by 38 | [\#ghc-mod (web client)](https://kiwiirc.com/client/irc.freenode.org/ghc-mod) on 39 | Freenode. If you're reporting a bug please also create an issue 40 | [here (GitHub issue tracker)](https://github.com/DanielG/ghc-mod/issues) so we 41 | have a way to contact you if you don't have time to stay. 42 | 43 | Do hang around for a while if no one answers, and repeat your question if you 44 | still haven't gotten any answer after a day or so (the maintainer was probably 45 | asleep). You're most likely to get an answer during the day in GMT+1. 46 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | #ifndef MIN_VERSION_cabal_doctest 4 | #error \ 5 | Your version of cabal-install does not seem to support the 'custom-setup' section. \ 6 | Please see https://github.com/DanielG/ghc-mod/wiki/Installing#checking-and-installing-prerequisites for instrutions on how to upgrade. \ 7 | It is also possible that you forgot to install cabal-doctest before running Setup.hs 8 | #endif 9 | 10 | import Distribution.Simple 11 | import Distribution.Simple.Program 12 | 13 | import Distribution.Extra.Doctest 14 | 15 | main :: IO () 16 | main = 17 | defaultMainWithHooks $ 18 | addDoctestsUserHook "doctest" $ 19 | simpleUserHooks { 20 | hookedPrograms = [ simpleProgram "shelltest" ] 21 | } 22 | -------------------------------------------------------------------------------- /bench/Bench.hs: -------------------------------------------------------------------------------- 1 | import Criterion.Main 2 | import GhcMod.Target 3 | import GhcMod.Monad 4 | import GhcMod.Types 5 | import Dir 6 | import System.IO.Temp 7 | import System.Process hiding (env) 8 | import Control.Monad 9 | 10 | main = defaultMain [ 11 | env setup $ \dir -> bgroup "simple-cabal" [ 12 | bench "nop" $ whnfIO (simpleCabalNop dir 1) 13 | , bench "nop10" $ whnfIO (simpleCabalNop dir 10) 14 | ] 15 | ] 16 | 17 | setup = do 18 | tdir <- createTempDirectory "/tmp" "ghc-mod-bench" 19 | system $ "cp -rv \"bench/data/simple-cabal/\" \""++ tdir ++"\"" 20 | 21 | simpleCabalNop tdir 1 -- warmup dist/ 22 | 23 | return tdir 24 | 25 | simpleCabalNop :: FilePath -> Int -> IO () 26 | simpleCabalNop dir n = withDirectory_ (dir "simple-cabal") $ do 27 | _ <- runGhcModT defaultOptions $ 28 | forM_ [1..n] $ \_ -> do 29 | runGmlT [Left "Main.hs"] (return ()) 30 | return () 31 | -------------------------------------------------------------------------------- /bench/data/simple-cabal/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | main :: IO () 4 | main = putStrLn "Hello, Haskell!" 5 | -------------------------------------------------------------------------------- /bench/data/simple-cabal/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /bench/data/simple-cabal/simple-cabal.cabal: -------------------------------------------------------------------------------- 1 | name: simple-cabal 2 | version: 0.1.0.0 3 | license: BSD3 4 | license-file: LICENSE 5 | author: Daniel Gröber 6 | maintainer: dxld@darkboxed.org 7 | build-type: Simple 8 | cabal-version: >=1.10 9 | 10 | executable simple-cabal 11 | main-is: Main.hs 12 | build-depends: base 13 | default-language: Haskell2010 14 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | ./core 3 | -------------------------------------------------------------------------------- /core/COPYING.BSD3: -------------------------------------------------------------------------------- 1 | Copyright (c) 2009, IIJ Innovation Institute Inc. 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in 12 | the documentation and/or other materials provided with the 13 | distribution. 14 | * Neither the name of the copyright holders nor the names of its 15 | contributors may be used to endorse or promote products derived 16 | from this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 21 | FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 22 | COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 23 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 24 | BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 25 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 26 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 27 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 28 | ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 29 | POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /core/GhcMod/Caching/Types.hs: -------------------------------------------------------------------------------- 1 | -- ghc-mod: Happy Haskell Hacking 2 | -- Copyright (C) 2015 Daniel Gröber 3 | -- 4 | -- This program is free software: you can redistribute it and/or modify 5 | -- it under the terms of the GNU Affero General Public License as published by 6 | -- the Free Software Foundation, either version 3 of the License, or 7 | -- (at your option) any later version. 8 | -- 9 | -- This program is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | -- GNU Affero General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Affero General Public License 15 | -- along with this program. If not, see . 16 | module GhcMod.Caching.Types where 17 | 18 | import Utils 19 | import Data.Label 20 | import System.Directory.ModTime 21 | import Distribution.Helper 22 | 23 | type CacheContents d a = Maybe (ModTime, [FilePath], d, a) 24 | type CacheLens s d a = s :-> CacheContents d a 25 | 26 | data Cached m s d a = Cached { 27 | cacheFile :: FilePath, 28 | cacheLens :: Maybe (CacheLens s d a), 29 | cachedAction :: TimedCacheFiles 30 | -> d 31 | -> Maybe a 32 | -> m ([FilePath], a) 33 | 34 | -- ^ @cachedAction tcf data ma@ 35 | -- 36 | -- * @tcf@: Input file timestamps. Not technically necessary, just an 37 | -- optimizazion when knowing which input files changed can make updating the 38 | -- cache faster 39 | -- 40 | -- * @data@: Arbitrary static input data to cache action. Can be used to 41 | -- invalidate the cache using something other than file timestamps 42 | -- i.e. environment tool version numbers 43 | -- 44 | -- * @ma@: Cached data if it existed 45 | -- 46 | -- Returns: 47 | -- 48 | -- * @fst@: Input files used in generating the cache 49 | -- 50 | -- * @snd@: Cache data, will be stored alongside the static input data in the 51 | -- 'cacheFile' 52 | -- 53 | -- The cached action, will only run if one of the following is true: 54 | -- 55 | -- * 'cacheFile' doesn\'t exist yet 56 | -- * 'cacheFile' exists and 'inputData' changed 57 | -- * any files returned by the cached action changed 58 | } 59 | 60 | data TimedCacheFiles = TimedCacheFiles { 61 | tcCreated :: ModTime, 62 | -- ^ 'cacheFile' timestamp 63 | tcFiles :: [TimedFile] 64 | -- ^ Timestamped files returned by the cached action 65 | } deriving (Eq, Ord) 66 | 67 | type ChCacheData = (Programs, FilePath, (String, String)) 68 | -------------------------------------------------------------------------------- /core/GhcMod/CustomPackageDb.hs: -------------------------------------------------------------------------------- 1 | -- ghc-mod: Happy Haskell Hacking 2 | -- Copyright (C) 2015 Daniel Gröber 3 | -- 4 | -- This program is free software: you can redistribute it and/or modify 5 | -- it under the terms of the GNU Affero General Public License as published by 6 | -- the Free Software Foundation, either version 3 of the License, or 7 | -- (at your option) any later version. 8 | -- 9 | -- This program is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | -- GNU Affero General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Affero General Public License 15 | -- along with this program. If not, see . 16 | module GhcMod.CustomPackageDb where 17 | 18 | import Control.Applicative 19 | import Control.Monad 20 | import Control.Category ((.)) 21 | import Data.Maybe 22 | import Data.Traversable 23 | import GhcMod.Types 24 | import GhcMod.Monad.Types 25 | import GhcMod.PathsAndFiles 26 | import Prelude hiding ((.)) 27 | 28 | parseCustomPackageDb :: String -> [GhcPkgDb] 29 | parseCustomPackageDb src = map parsePkgDb $ filter (not . null) $ lines src 30 | where 31 | parsePkgDb "global" = GlobalDb 32 | parsePkgDb "user" = UserDb 33 | parsePkgDb s = PackageDb s 34 | 35 | getCustomPkgDbStack :: (MonadIO m, GmEnv m) => m (Maybe [GhcPkgDb]) 36 | getCustomPkgDbStack = do 37 | mCusPkgDbFile <- liftIO . (traverse readFile <=< findCustomPackageDbFile) . cradleRootDir =<< cradle 38 | return $ parseCustomPackageDb <$> mCusPkgDbFile 39 | -------------------------------------------------------------------------------- /core/GhcMod/Doc.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | module GhcMod.Doc where 4 | 5 | import GHC 6 | import GhcMod.Gap (withStyle, showDocWith) 7 | import Outputable 8 | #if __GLASGOW_HASKELL__ >= 802 9 | import DynFlags 10 | #endif 11 | import Pretty (Mode(..)) 12 | 13 | showPage :: DynFlags -> PprStyle -> SDoc -> String 14 | showPage dflag style = showDocWith dflag PageMode . withStyle dflag style 15 | 16 | showOneLine :: DynFlags -> PprStyle -> SDoc -> String 17 | showOneLine dflag style = showDocWith dflag OneLineMode . withStyle dflag style 18 | 19 | getStyle :: GhcMonad m => m PprStyle 20 | getStyle = do 21 | unqual <- getPrintUnqual 22 | #if __GLASGOW_HASKELL__ >= 802 23 | dflags <- getDynFlags 24 | return $ mkUserStyle dflags unqual AllTheWay 25 | #else 26 | return $ mkUserStyle unqual AllTheWay 27 | #endif 28 | 29 | styleUnqualified :: DynFlags -> PprStyle 30 | styleUnqualified dflags = 31 | #if __GLASGOW_HASKELL__ >= 802 32 | mkUserStyle dflags neverQualify AllTheWay 33 | #else 34 | mkUserStyle neverQualify AllTheWay 35 | #endif 36 | -------------------------------------------------------------------------------- /core/GhcMod/DynFlags.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE StandaloneDeriving #-} 3 | {-# LANGUAGE CPP #-} 4 | 5 | module GhcMod.DynFlags where 6 | 7 | import Control.Applicative 8 | import Control.Monad 9 | import GHC 10 | import qualified GHC as G 11 | import GHC.Paths (libdir) 12 | import qualified GhcMod.Gap as Gap 13 | import GhcMod.Types 14 | import GhcMod.DebugLogger 15 | import GhcMod.DynFlagsTH 16 | import System.IO.Unsafe (unsafePerformIO) 17 | import Prelude 18 | 19 | -- For orphans 20 | #if __GLASGOW_HASKELL__ == 802 21 | import Util (OverridingBool(..)) 22 | import PprColour 23 | #endif 24 | 25 | setEmptyLogger :: DynFlags -> DynFlags 26 | setEmptyLogger df = 27 | Gap.setLogAction df $ \_ _ _ _ _ _ -> return () 28 | 29 | setDebugLogger :: (String -> IO ()) -> DynFlags -> DynFlags 30 | setDebugLogger put df = do 31 | Gap.setLogAction df (debugLogAction put) 32 | 33 | -- * Fast 34 | -- * Friendly to foreign export 35 | -- * Not friendly to -XTemplateHaskell and -XPatternSynonyms 36 | -- * Uses little memory 37 | setHscNothing :: DynFlags -> DynFlags 38 | setHscNothing df = df { 39 | ghcMode = CompManager 40 | , ghcLink = NoLink 41 | , hscTarget = HscNothing 42 | , optLevel = 0 43 | } 44 | 45 | -- * Slow 46 | -- * Not friendly to foreign export 47 | -- * Friendly to -XTemplateHaskell and -XPatternSynonyms 48 | -- * Uses lots of memory 49 | setHscInterpreted :: DynFlags -> DynFlags 50 | setHscInterpreted df = df { 51 | ghcMode = CompManager 52 | , ghcLink = LinkInMemory 53 | , hscTarget = HscInterpreted 54 | , optLevel = 0 55 | } 56 | 57 | -- | Parse command line ghc options and add them to the 'DynFlags' passed 58 | addCmdOpts :: GhcMonad m => [GHCOption] -> DynFlags -> m DynFlags 59 | addCmdOpts cmdOpts df = 60 | fst3 <$> G.parseDynamicFlags df (map G.noLoc cmdOpts) 61 | where 62 | fst3 (a,_,_) = a 63 | 64 | ---------------------------------------------------------------- 65 | 66 | withDynFlags :: GhcMonad m 67 | => (DynFlags -> DynFlags) 68 | -> m a 69 | -> m a 70 | withDynFlags setFlags body = G.gbracket setup teardown (\_ -> body) 71 | where 72 | setup = do 73 | dflags <- G.getSessionDynFlags 74 | void $ G.setSessionDynFlags (setFlags dflags) 75 | return dflags 76 | teardown = void . G.setSessionDynFlags 77 | 78 | withCmdFlags :: GhcMonad m => [GHCOption] -> m a -> m a 79 | withCmdFlags flags body = G.gbracket setup teardown (\_ -> body) 80 | where 81 | setup = do 82 | dflags <- G.getSessionDynFlags 83 | void $ G.setSessionDynFlags =<< addCmdOpts flags dflags 84 | return dflags 85 | teardown = void . G.setSessionDynFlags 86 | 87 | ---------------------------------------------------------------- 88 | 89 | -- | Set 'DynFlags' equivalent to "-w:". 90 | setNoWarningFlags :: DynFlags -> DynFlags 91 | setNoWarningFlags df = df { warningFlags = Gap.emptyWarnFlags} 92 | 93 | -- | Set 'DynFlags' equivalent to "-Wall". 94 | setAllWarningFlags :: DynFlags -> DynFlags 95 | setAllWarningFlags df = df { warningFlags = allWarningFlags } 96 | 97 | allWarningFlags :: Gap.WarnFlags 98 | allWarningFlags = unsafePerformIO $ 99 | G.runGhc (Just libdir) $ do 100 | df <- G.getSessionDynFlags 101 | df' <- addCmdOpts ["-Wall"] df 102 | return $ G.warningFlags df' 103 | 104 | ---------------------------------------------------------------- 105 | 106 | deferErrors :: Monad m => DynFlags -> m DynFlags 107 | deferErrors df = return $ 108 | Gap.setWarnTypedHoles $ Gap.setDeferTypedHoles $ 109 | Gap.setDeferTypeErrors $ setNoWarningFlags df 110 | 111 | ---------------------------------------------------------------- 112 | 113 | #if __GLASGOW_HASKELL__ == 802 114 | deriving instance Eq OverridingBool 115 | deriving instance Eq PprColour.Scheme 116 | deriving instance Eq PprColour.PprColour 117 | #endif 118 | 119 | deriveEqDynFlags [d| 120 | eqDynFlags :: DynFlags -> DynFlags -> [[(Bool, String)]] 121 | eqDynFlags = undefined 122 | |] 123 | -------------------------------------------------------------------------------- /core/GhcMod/FileMapping.hs: -------------------------------------------------------------------------------- 1 | module GhcMod.FileMapping 2 | ( loadMappedFile 3 | , loadMappedFileSource 4 | , unloadMappedFile 5 | , mapFile 6 | , fileModSummaryWithMapping 7 | ) where 8 | 9 | import GhcMod.Types 10 | import GhcMod.Monad.Types 11 | import GhcMod.Gap 12 | import GhcMod.HomeModuleGraph 13 | import GhcMod.Utils 14 | 15 | import System.IO 16 | import System.FilePath 17 | import System.Directory 18 | 19 | import Control.Monad.Trans.Maybe 20 | import GHC 21 | import Control.Monad 22 | 23 | {- | maps 'FilePath', given as first argument to take source from 24 | 'FilePath' given as second argument. Works exactly the same as 25 | first form of `--map-file` CLI option. 26 | 27 | \'from\' can be either full path, or path relative to project root. 28 | \'to\' has to be either relative to project root, or full path (preferred) 29 | -} 30 | loadMappedFile :: IOish m 31 | => FilePath -- ^ \'from\', file that will be mapped 32 | -> FilePath -- ^ \'to\', file to take source from 33 | -> GhcModT m () 34 | loadMappedFile from to = loadMappedFile' from to False 35 | 36 | {- | 37 | maps 'FilePath', given as first argument to have source as given 38 | by second argument. 39 | 40 | \'from\' may or may not exist, and should be either full path, 41 | or relative to project root. 42 | -} 43 | loadMappedFileSource :: IOish m 44 | => FilePath -- ^ \'from\', file that will be mapped 45 | -> String -- ^ \'src\', source 46 | -> GhcModT m () 47 | loadMappedFileSource from src = do 48 | tmpdir <- cradleTempDir `fmap` cradle 49 | enc <- liftIO . mkTextEncoding . optEncoding =<< options 50 | to <- liftIO $ do 51 | (fn, h) <- openTempFile tmpdir (takeFileName from) 52 | hSetEncoding h enc 53 | hPutStr h src 54 | hClose h 55 | return fn 56 | loadMappedFile' from to True 57 | 58 | loadMappedFile' :: IOish m => FilePath -> FilePath -> Bool -> GhcModT m () 59 | loadMappedFile' from to isTemp = do 60 | cfn <- getCanonicalFileNameSafe from 61 | unloadMappedFile' cfn 62 | crdl <- cradle 63 | let to' = makeRelative (cradleRootDir crdl) to 64 | addMMappedFile cfn (FileMapping to' isTemp) 65 | 66 | mapFile :: (IOish m, GmState m) => HscEnv -> Target -> m Target 67 | mapFile _ (Target tid@(TargetFile filePath _) taoc _) = do 68 | mapping <- lookupMMappedFile filePath 69 | return $ mkMappedTarget (Just filePath) tid taoc mapping 70 | mapFile env (Target tid@(TargetModule moduleName) taoc _) = do 71 | (fp, mapping) <- do 72 | filePath <- fmap (fmap mpPath) (liftIO $ findModulePath env moduleName) 73 | mmf <- runMaybeT $ MaybeT (return filePath) >>= MaybeT . lookupMMappedFile 74 | return (filePath, mmf) 75 | return $ mkMappedTarget fp tid taoc mapping 76 | 77 | mkMappedTarget :: Maybe FilePath -> TargetId -> Bool -> Maybe FileMapping -> Target 78 | mkMappedTarget _ _ taoc (Just to) = 79 | mkTarget (TargetFile (fmPath to) Nothing) taoc Nothing 80 | mkMappedTarget _ tid taoc _ = 81 | mkTarget tid taoc Nothing 82 | 83 | {-| 84 | unloads previously mapped file \'file\', so that it's no longer mapped, 85 | and removes any temporary files created when file was 86 | mapped. 87 | 88 | \'file\' should be either full path, or relative to project root. 89 | -} 90 | unloadMappedFile :: IOish m 91 | => FilePath -- ^ \'file\', file to unmap 92 | -> GhcModT m () 93 | unloadMappedFile = getCanonicalFileNameSafe >=> unloadMappedFile' 94 | 95 | unloadMappedFile' :: IOish m => FilePath -> GhcModT m () 96 | unloadMappedFile' cfn = void $ runMaybeT $ do 97 | fm <- MaybeT $ lookupMMappedFile cfn 98 | liftIO $ when (fmTemp fm) $ removeFile (fmPath fm) 99 | delMMappedFile cfn 100 | 101 | fileModSummaryWithMapping :: (IOish m, GmState m, GhcMonad m, GmEnv m) => 102 | FilePath -> m ModSummary 103 | fileModSummaryWithMapping fn = 104 | withMappedFile fn $ \fn' -> fileModSummary fn' 105 | -------------------------------------------------------------------------------- /core/GhcMod/LightGhc.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | module GhcMod.LightGhc where 4 | 5 | import Control.Monad 6 | import Control.Monad.Reader (runReaderT) 7 | import Data.IORef 8 | 9 | import GHC 10 | import GHC.Paths (libdir) 11 | #if __GLASGOW_HASKELL__ < 802 12 | import StaticFlags 13 | #endif 14 | import SysTools 15 | import DynFlags 16 | import HscMain 17 | import HscTypes 18 | 19 | import GhcMod.Types 20 | import GhcMod.Monad.Types 21 | import GhcMod.DynFlags 22 | import qualified GhcMod.Gap as Gap 23 | 24 | #if __GLASGOW_HASKELL__ >= 802 25 | initStaticOpts :: Monad m => m () 26 | initStaticOpts = return () 27 | #endif 28 | 29 | -- We have to be more careful about tearing down 'HscEnv's since GHC 8 added an 30 | -- out of process GHCI server which has to be shutdown. 31 | newLightEnv :: IOish m => (DynFlags -> LightGhc DynFlags) -> m HscEnv 32 | newLightEnv mdf = do 33 | df <- liftIO $ do 34 | initStaticOpts 35 | settings <- initSysTools (Just libdir) 36 | initDynFlags $ defaultDynFlags settings 37 | 38 | hsc_env <- liftIO $ newHscEnv df 39 | df' <- runLightGhc hsc_env $ mdf df 40 | return $ hsc_env { 41 | hsc_dflags = df', 42 | hsc_IC = (hsc_IC hsc_env) { ic_dflags = df' } 43 | } 44 | 45 | teardownLightEnv :: MonadIO m => HscEnv -> m () 46 | teardownLightEnv env = runLightGhc env $ do 47 | Gap.withCleanupSession $ return () 48 | 49 | withLightHscEnv' 50 | :: IOish m => (DynFlags -> LightGhc DynFlags) -> (HscEnv -> m a) -> m a 51 | withLightHscEnv' mdf action = gbracket (newLightEnv mdf) teardownLightEnv action 52 | 53 | withLightHscEnv :: IOish m => [GHCOption] -> (HscEnv -> m a) -> m a 54 | withLightHscEnv opts = withLightHscEnv' (f <=< liftIO . newHscEnv) 55 | where 56 | f env = runLightGhc env $ do 57 | -- HomeModuleGraph and probably all other clients get into all sorts of 58 | -- trouble if the package state isn't initialized here 59 | _ <- setSessionDynFlags =<< addCmdOpts opts =<< getSessionDynFlags 60 | getSessionDynFlags 61 | 62 | runLightGhc :: MonadIO m => HscEnv -> LightGhc a -> m a 63 | runLightGhc env action = liftIO $ do 64 | renv <- newIORef env 65 | flip runReaderT renv $ unLightGhc action 66 | 67 | runLightGhc' :: MonadIO m => IORef HscEnv -> LightGhc a -> m a 68 | runLightGhc' renv action = liftIO $ do 69 | flip runReaderT renv $ unLightGhc action 70 | -------------------------------------------------------------------------------- /core/GhcMod/Logging.hs: -------------------------------------------------------------------------------- 1 | -- ghc-mod: Happy Haskell Hacking 2 | -- Copyright (C) 2015 Daniel Gröber 3 | -- 4 | -- This program is free software: you can redistribute it and/or modify 5 | -- it under the terms of the GNU Affero General Public License as published by 6 | -- the Free Software Foundation, either version 3 of the License, or 7 | -- (at your option) any later version. 8 | -- 9 | -- This program is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | -- GNU Affero General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Affero General Public License 15 | -- along with this program. If not, see . 16 | 17 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 18 | 19 | module GhcMod.Logging ( 20 | module GhcMod.Logging 21 | , module GhcMod.Pretty 22 | , GmLogLevel(..) 23 | , module Data.Monoid 24 | , module Pretty 25 | ) where 26 | 27 | import Control.Applicative hiding (empty) 28 | import Control.Monad 29 | import Control.Monad.Trans.Class 30 | import Data.List 31 | import Data.Char 32 | import Data.Monoid 33 | import Data.Maybe 34 | import System.IO 35 | import System.FilePath 36 | import Prelude 37 | 38 | import Pretty hiding (style, (<>)) 39 | 40 | import GhcMod.Monad.Types 41 | import GhcMod.Types 42 | import GhcMod.Pretty 43 | import GhcMod.Output 44 | 45 | gmSetLogLevel :: GmLog m => GmLogLevel -> m () 46 | gmSetLogLevel level = 47 | gmlJournal $ GhcModLog (Just level) (Last Nothing) [] 48 | 49 | gmGetLogLevel :: forall m. GmLog m => m GmLogLevel 50 | gmGetLogLevel = do 51 | GhcModLog { gmLogLevel = Just level } <- gmlHistory 52 | return level 53 | 54 | gmSetDumpLevel :: GmLog m => Bool -> m () 55 | gmSetDumpLevel level = 56 | gmlJournal $ GhcModLog Nothing (Last (Just level)) [] 57 | 58 | 59 | increaseLogLevel :: GmLogLevel -> GmLogLevel 60 | increaseLogLevel l | l == maxBound = l 61 | increaseLogLevel l = succ l 62 | 63 | decreaseLogLevel :: GmLogLevel -> GmLogLevel 64 | decreaseLogLevel l | l == minBound = l 65 | decreaseLogLevel l = pred l 66 | 67 | -- | 68 | -- >>> Just GmDebug <= Nothing 69 | -- False 70 | -- >>> Just GmException <= Just GmDebug 71 | -- True 72 | -- >>> Just GmDebug <= Just GmException 73 | -- False 74 | gmLog :: (MonadIO m, GmLog m, GmOut m) => GmLogLevel -> String -> Doc -> m () 75 | gmLog level loc' doc = do 76 | GhcModLog { gmLogLevel = Just level' } <- gmlHistory 77 | 78 | let loc | loc' == "" = empty 79 | | otherwise = text loc' <+>: empty 80 | msgDoc = sep [loc, doc] 81 | msg = dropWhileEnd isSpace $ renderGm $ gmLogLevelDoc level <+>: msgDoc 82 | 83 | when (level <= level') $ gmErrStrLn msg 84 | gmLogQuiet level loc' doc 85 | 86 | gmLogQuiet :: GmLog m => GmLogLevel -> String -> Doc -> m () 87 | gmLogQuiet level loc doc = 88 | gmlJournal (GhcModLog Nothing (Last Nothing) [(level, loc, doc)]) 89 | 90 | gmAppendLogQuiet :: GmLog m => GhcModLog -> m () 91 | gmAppendLogQuiet GhcModLog { gmLogMessages } = 92 | forM_ gmLogMessages $ \(level, loc, doc) -> gmLogQuiet level loc doc 93 | 94 | gmVomit :: (MonadIO m, GmLog m, GmOut m, GmEnv m) => String -> Doc -> String -> m () 95 | gmVomit filename doc content = do 96 | gmLog GmVomit "" $ doc <+>: text content 97 | 98 | GhcModLog { gmLogVomitDump = Last mdump } 99 | <- gmlHistory 100 | 101 | dir <- cradleTempDir `liftM` cradle 102 | when (fromMaybe False mdump) $ 103 | liftIO $ writeFile (dir filename) content 104 | 105 | 106 | newtype LogDiscardT m a = LogDiscardT { runLogDiscard :: m a } 107 | deriving (Functor, Applicative, Monad) 108 | 109 | instance MonadTrans LogDiscardT where 110 | lift = LogDiscardT 111 | 112 | instance Monad m => GmLog (LogDiscardT m) where 113 | gmlJournal = const $ return () 114 | gmlHistory = return mempty 115 | gmlClear = return () 116 | -------------------------------------------------------------------------------- /core/GhcMod/Monad/Compat.hs_h: -------------------------------------------------------------------------------- 1 | -- ghc-mod: Making Haskell development *more* fun 2 | -- Copyright (C) 2015,2016 Daniel Gröber 3 | -- 4 | -- This program is free software: you can redistribute it and/or modify 5 | -- it under the terms of the GNU Affero General Public License as published by 6 | -- the Free Software Foundation, either version 3 of the License, or 7 | -- (at your option) any later version. 8 | -- 9 | -- This program is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | -- GNU Affero General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Affero General Public License 15 | -- along with this program. If not, see . 16 | 17 | -- MonadUtils of GHC 7.6 or earlier defines its own MonadIO. 18 | -- RWST does not automatically become an instance of MonadIO. 19 | -- MonadUtils of GHC 7.8 or later imports MonadIO in Monad.Control.IO.Class. 20 | -- So, RWST automatically becomes an instance of 21 | #if __GLASGOW_HASKELL__ < 708 22 | -- 'CoreMonad.MonadIO' and 'Control.Monad.IO.Class.MonadIO' are different 23 | -- classes before ghc 7.8 24 | #define DIFFERENT_MONADIO 1 25 | 26 | -- RWST doen't have a MonadIO instance before ghc 7.8 27 | #define MONADIO_INSTANCES 1 28 | #endif 29 | -------------------------------------------------------------------------------- /core/GhcMod/Monad/Env.hs: -------------------------------------------------------------------------------- 1 | -- ghc-mod: Happy Haskell Hacking 2 | -- Copyright (C) 2015,2016 Daniel Gröber 3 | -- 4 | -- This program is free software: you can redistribute it and/or modify 5 | -- it under the terms of the GNU Affero General Public License as published by 6 | -- the Free Software Foundation, either version 3 of the License, or 7 | -- (at your option) any later version. 8 | -- 9 | -- This program is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | -- GNU Affero General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Affero General Public License 15 | -- along with this program. If not, see . 16 | 17 | {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-} 18 | {-# LANGUAGE FlexibleInstances, UndecidableInstances #-} 19 | 20 | module GhcMod.Monad.Env where 21 | 22 | import GhcMod.Types 23 | import GhcMod.Monad.Newtypes 24 | 25 | import Control.Monad 26 | import Control.Monad.Trans.Journal (JournalT) 27 | import Control.Monad.State.Strict (StateT(..)) 28 | import Control.Monad.Error (ErrorT(..)) 29 | import Control.Monad.Reader.Class 30 | import Control.Monad.Trans.Class (MonadTrans(..)) 31 | import Prelude 32 | 33 | class Monad m => GmEnv m where 34 | gmeAsk :: m GhcModEnv 35 | gmeAsk = gmeReader id 36 | 37 | gmeReader :: (GhcModEnv -> a) -> m a 38 | gmeReader f = f `liftM` gmeAsk 39 | 40 | gmeLocal :: (GhcModEnv -> GhcModEnv) -> m a -> m a 41 | {-# MINIMAL (gmeAsk | gmeReader), gmeLocal #-} 42 | 43 | instance Monad m => GmEnv (GmT m) where 44 | gmeAsk = GmT ask 45 | gmeReader = GmT . reader 46 | gmeLocal f a = GmT $ local f (unGmT a) 47 | 48 | instance GmEnv m => GmEnv (GmOutT m) where 49 | gmeAsk = lift gmeAsk 50 | gmeReader = lift . gmeReader 51 | gmeLocal f ma = gmLiftWithInner (\run -> gmeLocal f (run ma)) 52 | 53 | instance GmEnv m => GmEnv (StateT s m) where 54 | gmeAsk = lift gmeAsk 55 | gmeReader = lift . gmeReader 56 | gmeLocal f ma = gmLiftWithInner (\run -> gmeLocal f (run ma)) 57 | 58 | instance GmEnv m => GmEnv (JournalT GhcModLog m) where 59 | gmeAsk = lift gmeAsk 60 | gmeReader = lift . gmeReader 61 | gmeLocal f ma = gmLiftWithInner (\run -> gmeLocal f (run ma)) 62 | 63 | instance GmEnv m => GmEnv (ErrorT GhcModError m) where 64 | gmeAsk = lift gmeAsk 65 | gmeReader = lift . gmeReader 66 | gmeLocal f ma = gmLiftWithInner (\run -> gmeLocal f (run ma)) 67 | 68 | deriving instance (Monad m, GmEnv (GhcModT m)) => GmEnv (GmlT m) 69 | -------------------------------------------------------------------------------- /core/GhcMod/Monad/Log.hs: -------------------------------------------------------------------------------- 1 | -- ghc-mod: Happy Haskell Hacking 2 | -- Copyright (C) 2015,2016 Daniel Gröber 3 | -- 4 | -- This program is free software: you can redistribute it and/or modify 5 | -- it under the terms of the GNU Affero General Public License as published by 6 | -- the Free Software Foundation, either version 3 of the License, or 7 | -- (at your option) any later version. 8 | -- 9 | -- This program is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | -- GNU Affero General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Affero General Public License 15 | -- along with this program. If not, see . 16 | 17 | {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-} 18 | {-# LANGUAGE FlexibleInstances, UndecidableInstances #-} 19 | 20 | module GhcMod.Monad.Log where 21 | 22 | import GhcMod.Types 23 | import GhcMod.Monad.Newtypes 24 | 25 | import Control.Monad 26 | import Control.Monad.Trans.Journal (JournalT) 27 | import Control.Monad.Reader (ReaderT(..)) 28 | import Control.Monad.State.Strict (StateT(..)) 29 | import Control.Monad.Error (Error, ErrorT(..)) 30 | import Control.Monad.Trans.Maybe (MaybeT(..)) 31 | import Control.Monad.Journal.Class (MonadJournal(..)) 32 | import Control.Monad.Trans.Class (MonadTrans(..)) 33 | import Prelude 34 | 35 | class Monad m => GmLog m where 36 | gmlJournal :: GhcModLog -> m () 37 | gmlHistory :: m GhcModLog 38 | gmlClear :: m () 39 | 40 | instance Monad m => GmLog (JournalT GhcModLog m) where 41 | gmlJournal = journal 42 | gmlHistory = history 43 | gmlClear = clear 44 | 45 | instance Monad m => GmLog (GmT m) where 46 | gmlJournal = GmT . lift . lift . journal 47 | gmlHistory = GmT $ lift $ lift history 48 | gmlClear = GmT $ lift $ lift clear 49 | 50 | instance (Monad m, GmLog m) => GmLog (ReaderT r m) where 51 | gmlJournal = lift . gmlJournal 52 | gmlHistory = lift gmlHistory 53 | gmlClear = lift gmlClear 54 | 55 | instance (Monad m, GmLog m) => GmLog (StateT s m) where 56 | gmlJournal = lift . gmlJournal 57 | gmlHistory = lift gmlHistory 58 | gmlClear = lift gmlClear 59 | 60 | instance (Monad m, GmLog m, Error e) => GmLog (ErrorT e m) where 61 | gmlJournal = lift . gmlJournal 62 | gmlHistory = lift gmlHistory 63 | gmlClear = lift gmlClear 64 | 65 | instance (Monad m, GmLog m) => GmLog (MaybeT m) where 66 | gmlJournal = lift . gmlJournal 67 | gmlHistory = lift gmlHistory 68 | gmlClear = lift gmlClear 69 | 70 | deriving instance GmLog m => GmLog (GmOutT m) 71 | deriving instance (Monad m, GmLog (GhcModT m)) => GmLog (GmlT m) 72 | -------------------------------------------------------------------------------- /core/GhcMod/Monad/Orphans.hs: -------------------------------------------------------------------------------- 1 | -- ghc-mod: Happy Haskell Hacking 2 | -- Copyright (C) 2015,2016 Daniel Gröber 3 | -- 4 | -- This program is free software: you can redistribute it and/or modify 5 | -- it under the terms of the GNU Affero General Public License as published by 6 | -- the Free Software Foundation, either version 3 of the License, or 7 | -- (at your option) any later version. 8 | -- 9 | -- This program is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | -- GNU Affero General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Affero General Public License 15 | -- along with this program. If not, see . 16 | 17 | {-# LANGUAGE CPP, UndecidableInstances, StandaloneDeriving #-} 18 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 19 | 20 | {-# OPTIONS_GHC -fno-warn-orphans #-} 21 | module GhcMod.Monad.Orphans where 22 | 23 | #include "Compat.hs_h" 24 | 25 | import GhcMod.Types 26 | import GhcMod.Monad.Newtypes 27 | 28 | #if DIFFERENT_MONADIO 29 | import qualified MonadUtils as GHC (MonadIO(..)) 30 | #endif 31 | import qualified Control.Monad.IO.Class as MTL 32 | 33 | import Control.Monad.Reader (ReaderT(..)) 34 | import Control.Monad.State.Strict (StateT(..)) 35 | import Control.Monad.Trans.Journal (JournalT) 36 | import Control.Monad.Trans.Maybe (MaybeT(..)) 37 | import Control.Monad.Error (Error(..), ErrorT(..)) 38 | 39 | -------------------------------------------------- 40 | -- Miscellaneous instances 41 | 42 | #if DIFFERENT_MONADIO 43 | instance MTL.MonadIO m => GHC.MonadIO (ReaderT x m) where 44 | liftIO = MTL.liftIO 45 | instance MTL.MonadIO m => GHC.MonadIO (StateT x m) where 46 | liftIO = MTL.liftIO 47 | instance (Error e, MTL.MonadIO m) => GHC.MonadIO (ErrorT e m) where 48 | liftIO = MTL.liftIO 49 | instance MTL.MonadIO m => GHC.MonadIO (JournalT x m) where 50 | liftIO = MTL.liftIO 51 | instance MTL.MonadIO m => GHC.MonadIO (MaybeT m) where 52 | liftIO = MTL.liftIO 53 | deriving instance MTL.MonadIO m => GHC.MonadIO (GmOutT m) 54 | deriving instance MTL.MonadIO m => GHC.MonadIO (GmT m) 55 | deriving instance MTL.MonadIO m => GHC.MonadIO (GmlT m) 56 | deriving instance GHC.MonadIO LightGhc 57 | #endif 58 | 59 | deriving instance MTL.MonadIO m => MTL.MonadIO (GmOutT m) 60 | deriving instance MTL.MonadIO m => MTL.MonadIO (GmT m) 61 | deriving instance MTL.MonadIO m => MTL.MonadIO (GmlT m) 62 | deriving instance MTL.MonadIO LightGhc 63 | 64 | instance MonadIO IO where 65 | liftIO = id 66 | instance MonadIO m => MonadIO (ReaderT x m) where 67 | liftIO = MTL.liftIO 68 | instance MonadIO m => MonadIO (StateT x m) where 69 | liftIO = MTL.liftIO 70 | instance (Error e, MonadIO m) => MonadIO (ErrorT e m) where 71 | liftIO = MTL.liftIO 72 | instance MonadIO m => MonadIO (JournalT x m) where 73 | liftIO = MTL.liftIO 74 | instance MonadIO m => MonadIO (MaybeT m) where 75 | liftIO = MTL.liftIO 76 | instance MonadIOC m => MonadIO (GmOutT m) where 77 | liftIO = MTL.liftIO 78 | instance MonadIOC m => MonadIO (GmT m) where 79 | liftIO = MTL.liftIO 80 | instance MonadIOC m => MonadIO (GmlT m) where 81 | liftIO = MTL.liftIO 82 | instance MonadIO LightGhc where 83 | liftIO = MTL.liftIO 84 | -------------------------------------------------------------------------------- /core/GhcMod/Monad/Out.hs: -------------------------------------------------------------------------------- 1 | -- ghc-mod: Happy Haskell Hacking 2 | -- Copyright (C) 2015,2016 Daniel Gröber 3 | -- 4 | -- This program is free software: you can redistribute it and/or modify 5 | -- it under the terms of the GNU Affero General Public License as published by 6 | -- the Free Software Foundation, either version 3 of the License, or 7 | -- (at your option) any later version. 8 | -- 9 | -- This program is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | -- GNU Affero General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Affero General Public License 15 | -- along with this program. If not, see . 16 | 17 | {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-} 18 | {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} 19 | 20 | module GhcMod.Monad.Out where 21 | 22 | import GhcMod.Types 23 | import GhcMod.Monad.Newtypes 24 | 25 | import Control.Monad 26 | import Control.Monad.State.Strict (StateT(..)) 27 | import Control.Monad.Trans.Journal (JournalT) 28 | import Control.Monad.Trans.Maybe (MaybeT(..)) 29 | import Control.Monad.Reader.Class 30 | import Control.Monad.Trans.Class (MonadTrans(..)) 31 | import Prelude 32 | 33 | class Monad m => GmOut m where 34 | gmoAsk :: m GhcModOut 35 | 36 | instance Monad m => GmOut (GmOutT m) where 37 | gmoAsk = GmOutT ask 38 | 39 | instance Monad m => GmOut (GmlT m) where 40 | gmoAsk = GmlT $ lift $ GmOutT ask 41 | 42 | instance GmOut m => GmOut (GmT m) where 43 | gmoAsk = lift gmoAsk 44 | 45 | instance GmOut m => GmOut (StateT s m) where 46 | gmoAsk = lift gmoAsk 47 | 48 | instance GmOut m => GmOut (JournalT w m) where 49 | gmoAsk = lift gmoAsk 50 | 51 | instance GmOut m => GmOut (MaybeT m) where 52 | gmoAsk = lift gmoAsk 53 | -------------------------------------------------------------------------------- /core/GhcMod/Monad/State.hs: -------------------------------------------------------------------------------- 1 | -- ghc-mod: Happy Haskell Hacking 2 | -- Copyright (C) 2015,2016 Daniel Gröber 3 | -- 4 | -- This program is free software: you can redistribute it and/or modify 5 | -- it under the terms of the GNU Affero General Public License as published by 6 | -- the Free Software Foundation, either version 3 of the License, or 7 | -- (at your option) any later version. 8 | -- 9 | -- This program is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | -- GNU Affero General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Affero General Public License 15 | -- along with this program. If not, see . 16 | 17 | {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-} 18 | {-# LANGUAGE FlexibleInstances, UndecidableInstances #-} 19 | 20 | module GhcMod.Monad.State where 21 | 22 | import GhcMod.Types 23 | import GhcMod.Monad.Newtypes 24 | 25 | import Control.Monad 26 | import Control.Monad.State.Strict (StateT(..)) 27 | import Control.Monad.Trans.Maybe (MaybeT(..)) 28 | import Control.Monad.State.Class (MonadState(..)) 29 | import Control.Monad.Trans.Class (MonadTrans(..)) 30 | import Prelude 31 | 32 | class Monad m => GmState m where 33 | gmsGet :: m GhcModState 34 | gmsGet = gmsState (\s -> (s, s)) 35 | 36 | gmsPut :: GhcModState -> m () 37 | gmsPut s = gmsState (\_ -> ((), s)) 38 | 39 | gmsState :: (GhcModState -> (a, GhcModState)) -> m a 40 | gmsState f = do 41 | s <- gmsGet 42 | let ~(a, s') = f s 43 | gmsPut s' 44 | return a 45 | {-# MINIMAL gmsState | gmsGet, gmsPut #-} 46 | 47 | instance GmState m => GmState (StateT s m) where 48 | gmsGet = lift gmsGet 49 | gmsPut = lift . gmsPut 50 | gmsState = lift . gmsState 51 | 52 | instance Monad m => GmState (StateT GhcModState m) where 53 | gmsGet = get 54 | gmsPut = put 55 | gmsState = state 56 | 57 | instance Monad m => GmState (GmT m) where 58 | gmsGet = GmT get 59 | gmsPut = GmT . put 60 | gmsState = GmT . state 61 | 62 | instance GmState m => GmState (MaybeT m) where 63 | gmsGet = MaybeT $ Just `liftM` gmsGet 64 | gmsPut = MaybeT . (Just `liftM`) . gmsPut 65 | gmsState = MaybeT . (Just `liftM`) . gmsState 66 | 67 | deriving instance (Monad m, GmState (GhcModT m)) => GmState (GmlT m) 68 | -------------------------------------------------------------------------------- /core/GhcMod/Options/DocUtils.hs: -------------------------------------------------------------------------------- 1 | -- ghc-mod: Happy Haskell Hacking 2 | -- Copyright (C) 2015 Nikolay Yakimov 3 | -- 4 | -- This program is free software: you can redistribute it and/or modify 5 | -- it under the terms of the GNU Affero General Public License as published by 6 | -- the Free Software Foundation, either version 3 of the License, or 7 | -- (at your option) any later version. 8 | -- 9 | -- This program is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | -- GNU Affero General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Affero General Public License 15 | -- along with this program. If not, see . 16 | 17 | module GhcMod.Options.DocUtils ( 18 | ($$), 19 | ($$$), 20 | (<=>), 21 | (<$$>), 22 | (<||>) 23 | ) where 24 | 25 | import Options.Applicative 26 | import Data.Monoid 27 | import Prelude 28 | 29 | infixl 6 <||> 30 | infixr 7 <$$> 31 | infixr 7 $$ 32 | infixr 8 <=> 33 | infixr 9 $$$ 34 | 35 | ($$) :: (a -> b) -> a -> b 36 | ($$) = ($) 37 | 38 | ($$$) :: (a -> b) -> a -> b 39 | ($$$) = ($) 40 | 41 | (<||>) :: Alternative a => a b -> a b -> a b 42 | (<||>) = (<|>) 43 | 44 | (<=>) :: Monoid m => m -> m -> m 45 | (<=>) = (<>) 46 | 47 | (<$$>) :: Functor f => (a -> b) -> f a -> f b 48 | (<$$>) = (<$>) 49 | -------------------------------------------------------------------------------- /core/GhcMod/Options/Help.hs: -------------------------------------------------------------------------------- 1 | -- ghc-mod: Happy Haskell Hacking 2 | -- Copyright (C) 2015 Nikolay Yakimov 3 | -- 4 | -- This program is free software: you can redistribute it and/or modify 5 | -- it under the terms of the GNU Affero General Public License as published by 6 | -- the Free Software Foundation, either version 3 of the License, or 7 | -- (at your option) any later version. 8 | -- 9 | -- This program is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | -- GNU Affero General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Affero General Public License 15 | -- along with this program. If not, see . 16 | {-# LANGUAGE OverloadedStrings, FlexibleInstances, GeneralizedNewtypeDeriving #-} 17 | 18 | module GhcMod.Options.Help where 19 | 20 | import Options.Applicative 21 | import Options.Applicative.Help.Pretty (Doc) 22 | import qualified Options.Applicative.Help.Pretty as PP 23 | import Control.Monad.State 24 | import GHC.Exts( IsString(..) ) 25 | import Data.Maybe 26 | import Data.Monoid 27 | import Prelude 28 | 29 | newtype MyDocM s a = MyDoc {unwrapState :: State s a} 30 | deriving (Monad, Functor, Applicative, MonadState s) 31 | type MyDoc = MyDocM (Maybe Doc) () 32 | 33 | instance IsString (MyDocM (Maybe Doc) a) where 34 | fromString = append . para 35 | 36 | instance Monoid (MyDocM (Maybe Doc) ()) where 37 | mappend a b = append $ doc a <> doc b 38 | mempty = append PP.empty 39 | 40 | para :: String -> Doc 41 | para = PP.fillSep . map PP.text . words 42 | 43 | append :: Doc -> MyDocM (Maybe Doc) a 44 | append s = modify m >> return undefined 45 | where 46 | m :: Maybe Doc -> Maybe Doc 47 | m Nothing = Just s 48 | m (Just old) = Just $ old PP..$. s 49 | 50 | infixr 7 \\ 51 | (\\) :: MyDoc -> MyDoc -> MyDoc 52 | (\\) a b = append $ doc a PP.<+> doc b 53 | 54 | doc :: MyDoc -> Doc 55 | doc = fromMaybe PP.empty . flip execState Nothing . unwrapState 56 | 57 | help' :: MyDoc -> Mod f a 58 | help' = helpDoc . Just . doc 59 | 60 | desc :: MyDoc -> InfoMod a 61 | desc = footerDoc . Just . doc . indent 2 62 | 63 | code :: MyDoc -> MyDoc 64 | code x = do 65 | _ <- " " 66 | indent 4 x 67 | " " 68 | 69 | progDesc' :: MyDoc -> InfoMod a 70 | progDesc' = progDescDoc . Just . doc 71 | 72 | indent :: Int -> MyDoc -> MyDoc 73 | indent n = append . PP.indent n . doc 74 | 75 | int' :: Int -> MyDoc 76 | int' = append . PP.int 77 | 78 | para' :: String -> MyDoc 79 | para' = append . para 80 | -------------------------------------------------------------------------------- /core/GhcMod/Pretty.hs: -------------------------------------------------------------------------------- 1 | -- ghc-mod: Happy Haskell Hacking 2 | -- Copyright (C) 2015 Daniel Gröber 3 | -- 4 | -- This program is free software: you can redistribute it and/or modify 5 | -- it under the terms of the GNU Affero General Public License as published by 6 | -- the Free Software Foundation, either version 3 of the License, or 7 | -- (at your option) any later version. 8 | -- 9 | -- This program is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | -- GNU Affero General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Affero General Public License 15 | -- along with this program. If not, see . 16 | 17 | {-# LANGUAGE CPP #-} 18 | 19 | module GhcMod.Pretty 20 | ( renderGm 21 | , renderSDoc 22 | , gmComponentNameDoc 23 | , gmLogLevelDoc 24 | , (<+>:) 25 | , fnDoc 26 | , showToDoc 27 | , warnDoc 28 | , strLnDoc 29 | , strDoc 30 | ) where 31 | 32 | import Control.Arrow hiding ((<+>)) 33 | import Data.Char 34 | import Data.List 35 | import Distribution.Helper 36 | import Pretty 37 | import GHC 38 | import Outputable (SDoc, withPprStyleDoc) 39 | 40 | import GhcMod.Types 41 | import GhcMod.Doc 42 | import GhcMod.Gap (renderGm) 43 | 44 | renderSDoc :: GhcMonad m => SDoc -> m Doc 45 | renderSDoc sdoc = do 46 | df <- getSessionDynFlags 47 | ppsty <- getStyle 48 | return $ withPprStyleDoc df ppsty sdoc 49 | 50 | gmComponentNameDoc :: ChComponentName -> Doc 51 | gmComponentNameDoc ChSetupHsName = text $ "Setup.hs" 52 | #if MIN_VERSION_cabal_helper(0,8,0) 53 | gmComponentNameDoc ChLibName = text $ "library" 54 | gmComponentNameDoc (ChSubLibName _)= text $ "library" 55 | gmComponentNameDoc (ChFLibName _) = text $ "flibrary" 56 | #else 57 | gmComponentNameDoc (ChLibName "") = text $ "library" 58 | gmComponentNameDoc (ChLibName n) = text $ "library:" ++ n 59 | #endif 60 | gmComponentNameDoc (ChExeName n) = text $ "exe:" ++ n 61 | gmComponentNameDoc (ChTestName n) = text $ "test:" ++ n 62 | gmComponentNameDoc (ChBenchName n) = text $ "bench:" ++ n 63 | 64 | gmLogLevelDoc :: GmLogLevel -> Doc 65 | gmLogLevelDoc GmSilent = error "GmSilent MUST not be used for log messages" 66 | gmLogLevelDoc GmPanic = text "PANIC" 67 | gmLogLevelDoc GmException = text "EXCEPTION" 68 | gmLogLevelDoc GmError = text "ERROR" 69 | gmLogLevelDoc GmWarning = text "Warning" 70 | gmLogLevelDoc GmInfo = text "info" 71 | gmLogLevelDoc GmDebug = text "DEBUG" 72 | gmLogLevelDoc GmVomit = text "VOMIT" 73 | 74 | infixl 6 <+>: 75 | (<+>:) :: Doc -> Doc -> Doc 76 | a <+>: b = (a <> colon) <+> b 77 | 78 | fnDoc :: FilePath -> Doc 79 | fnDoc = doubleQuotes . text 80 | 81 | showToDoc :: Show a => a -> Doc 82 | showToDoc = strLnDoc . show 83 | 84 | warnDoc :: Doc -> Doc 85 | warnDoc d = text "Warning" <+>: d 86 | 87 | strLnDoc :: String -> Doc 88 | strLnDoc str = doc (dropWhileEnd isSpace str) 89 | where 90 | doc = lines >>> map text >>> foldr ($+$) empty 91 | 92 | strDoc :: String -> Doc 93 | strDoc str = doc (dropWhileEnd isSpace str) 94 | where 95 | doc :: String -> Doc 96 | doc = lines 97 | >>> map (words >>> map text >>> fsep) 98 | >>> \l -> case l of (x:xs) -> hang x 4 (vcat xs); [] -> empty 99 | -------------------------------------------------------------------------------- /core/GhcMod/Stack.hs: -------------------------------------------------------------------------------- 1 | -- ghc-mod: Happy Haskell Hacking 2 | -- Copyright (C) 2015 Daniel Gröber 3 | -- 4 | -- This program is free software: you can redistribute it and/or modify 5 | -- it under the terms of the GNU Affero General Public License as published by 6 | -- the Free Software Foundation, either version 3 of the License, or 7 | -- (at your option) any later version. 8 | -- 9 | -- This program is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | -- GNU Affero General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Affero General Public License 15 | -- along with this program. If not, see . 16 | 17 | module GhcMod.Stack where 18 | 19 | import Safe 20 | import Control.Applicative 21 | import Control.Exception as E 22 | import Control.Monad 23 | import Control.Monad.Trans.Maybe 24 | import Control.Monad.Trans.Class 25 | import Data.List 26 | import Data.List.Split 27 | import Data.Maybe 28 | import System.Directory 29 | import System.FilePath 30 | import System.Info.Extra 31 | import Exception 32 | 33 | import GhcMod.Types 34 | import GhcMod.Monad.Types 35 | import GhcMod.Output 36 | import GhcMod.Logging 37 | import GhcMod.Error 38 | import qualified GhcMod.Utils as U 39 | import Prelude 40 | 41 | patchStackPrograms :: (IOish m, GmOut m) => Cradle -> Programs -> m Programs 42 | patchStackPrograms Cradle { cradleProject = (StackProject senv) } progs = do 43 | Just ghc <- getStackGhcPath senv 44 | Just ghcPkg <- getStackGhcPkgPath senv 45 | return $ progs { 46 | ghcProgram = ghc 47 | , ghcPkgProgram = ghcPkg 48 | } 49 | patchStackPrograms _crdl progs = return progs 50 | 51 | getStackEnv :: (IOish m, GmOut m, GmLog m) 52 | => FilePath -> FilePath -> m (Maybe StackEnv) 53 | getStackEnv projdir stackProg = U.withDirectory_ projdir $ runMaybeT $ do 54 | env <- map (liToTup . splitOn ": ") . lines <$> readStack stackProg ["path"] 55 | let look k = fromJustNote "getStackEnv" $ lookup k env 56 | return StackEnv { 57 | seDistDir = look "dist-dir" 58 | , seBinPath = splitSearchPath $ look "bin-path" 59 | , seSnapshotPkgDb = look "snapshot-pkg-db" 60 | , seLocalPkgDb = look "local-pkg-db" 61 | } 62 | where 63 | liToTup [k,v] = (k,v) 64 | liToTup [k] = (k, error "getStackEnv: missing key '"++k++"'") 65 | liToTup _ = error "getStackEnv" 66 | 67 | getStackGhcPath :: IOish m => StackEnv -> m (Maybe FilePath) 68 | getStackGhcPath = findExecutablesInStackBinPath "ghc" 69 | 70 | getStackGhcPkgPath :: IOish m => StackEnv -> m (Maybe FilePath) 71 | getStackGhcPkgPath = findExecutablesInStackBinPath "ghc-pkg" 72 | 73 | findExecutablesInStackBinPath :: IOish m => String -> StackEnv -> m (Maybe FilePath) 74 | findExecutablesInStackBinPath exe StackEnv {..} = 75 | liftIO $ listToMaybe <$> findExecutablesInDirectories' seBinPath exe 76 | 77 | findExecutablesInDirectories' :: [FilePath] -> String -> IO [FilePath] 78 | findExecutablesInDirectories' path binary = 79 | U.findFilesWith' isExecutable path (binary <.> exeExtension') 80 | where isExecutable file = do 81 | perms <- getPermissions file 82 | return $ executable perms 83 | 84 | exeExtension' = if isWindows then "exe" else "" 85 | 86 | readStack :: (IOish m, GmOut m, GmLog m) 87 | => FilePath -> [String] -> MaybeT m String 88 | readStack exe args = do 89 | stack <- MaybeT $ liftIO $ findExecutable exe 90 | readProc <- lift gmReadProcess 91 | flip gcatch handler $ do 92 | liftIO $ evaluate =<< readProc stack args "" 93 | where 94 | handler (e :: IOError) = do 95 | gmLog GmWarning "readStack" $ gmeDoc $ exToErr e 96 | mzero 97 | exToErr = GMEStackBootstrap . GMEString . show 98 | -------------------------------------------------------------------------------- /core/GhcMod/World.hs: -------------------------------------------------------------------------------- 1 | module GhcMod.World where 2 | 3 | import GhcMod.GhcPkg 4 | import GhcMod.PathsAndFiles 5 | import GhcMod.Types 6 | import GhcMod.Monad.Types 7 | import GhcMod.Utils 8 | 9 | import Control.Applicative 10 | import Data.Maybe 11 | import Data.Traversable hiding (mapM) 12 | import System.FilePath (()) 13 | 14 | import GHC.Paths (libdir) 15 | import Prelude 16 | 17 | data World = World { 18 | worldPackageCaches :: [TimedFile] 19 | , worldCabalFile :: Maybe TimedFile 20 | , worldCabalConfig :: Maybe TimedFile 21 | , worldCabalSandboxConfig :: Maybe TimedFile 22 | , worldMappedFiles :: FileMappingMap 23 | } deriving (Eq) 24 | 25 | timedPackageCaches :: IOish m => GhcModT m [TimedFile] 26 | timedPackageCaches = do 27 | fs <- mapM (liftIO . mightExist) . map ( packageCache) 28 | =<< getPackageCachePaths libdir 29 | (liftIO . timeFile) `mapM` catMaybes fs 30 | 31 | getCurrentWorld :: IOish m => GhcModT m World 32 | getCurrentWorld = do 33 | crdl <- cradle 34 | pkgCaches <- timedPackageCaches 35 | mCabalFile <- liftIO $ timeFile `traverse` cradleCabalFile crdl 36 | mCabalConfig <- liftIO $ timeMaybe (setupConfigFile crdl) 37 | mCabalSandboxConfig <- liftIO $ timeMaybe (sandboxConfigFile crdl) 38 | mFileMap <- getMMappedFiles 39 | 40 | return World { 41 | worldPackageCaches = pkgCaches 42 | , worldCabalFile = mCabalFile 43 | , worldCabalConfig = mCabalConfig 44 | , worldCabalSandboxConfig = mCabalSandboxConfig 45 | , worldMappedFiles = mFileMap 46 | } 47 | 48 | didWorldChange :: IOish m => World -> GhcModT m Bool 49 | didWorldChange world = do 50 | (world /=) <$> getCurrentWorld 51 | 52 | isYoungerThanSetupConfig :: FilePath -> World -> IO Bool 53 | isYoungerThanSetupConfig file World {..} = do 54 | tfile <- timeFile file 55 | return $ worldCabalConfig < Just tfile 56 | -------------------------------------------------------------------------------- /core/GhcModCore.hs: -------------------------------------------------------------------------------- 1 | -- | The ghc-mod library. 2 | 3 | module GhcModCore ( 4 | -- * Cradle 5 | Cradle(..) 6 | , Project(..) 7 | , findCradle 8 | -- * Options 9 | , Options(..) 10 | , LineSeparator(..) 11 | , OutputStyle(..) 12 | , FileMapping(..) 13 | , defaultOptions 14 | -- * Logging 15 | , GmLogLevel 16 | , increaseLogLevel 17 | , decreaseLogLevel 18 | , gmSetLogLevel 19 | , gmLog 20 | -- * Types 21 | , ModuleString 22 | , Expression(..) 23 | , GhcPkgDb 24 | -- , Symbol 25 | -- , SymbolDb 26 | , GhcModError(..) 27 | -- * Monad Types 28 | , GhcModT 29 | , IOish 30 | -- * Monad utilities 31 | , runGhcModT 32 | , withOptions 33 | , dropSession 34 | -- * Output 35 | , gmPutStr 36 | , gmErrStr 37 | , gmPutStrLn 38 | , gmErrStrLn 39 | -- * FileMapping 40 | , loadMappedFile 41 | , loadMappedFileSource 42 | , unloadMappedFile 43 | ) where 44 | 45 | import GhcMod.Cradle 46 | import GhcMod.FileMapping 47 | import GhcMod.Logging 48 | import GhcMod.Monad 49 | import GhcMod.Output 50 | import GhcMod.Target 51 | import GhcMod.Types 52 | -------------------------------------------------------------------------------- /core/LICENSE: -------------------------------------------------------------------------------- 1 | ghc-mod was originally licensed under the BSD3 but the primary license has been 2 | changed to the AGPL3, files originally contributed under the BSD3 license remain 3 | under this license and can generally be identified by the lack of a GPL header. 4 | 5 | See the files COPYING.BSD3 and COPYING.AGPL3 in the source distribution for 6 | copies of the two licenses. 7 | -------------------------------------------------------------------------------- /core/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /core/shared/System/Directory/ModTime.hs: -------------------------------------------------------------------------------- 1 | -- ghc-mod: Happy Haskell Hacking 2 | -- Copyright (C) 2015 Daniel Gröber 3 | -- 4 | -- This program is free software: you can redistribute it and/or modify 5 | -- it under the terms of the GNU Affero General Public License as published by 6 | -- the Free Software Foundation, either version 3 of the License, or 7 | -- (at your option) any later version. 8 | -- 9 | -- This program is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | -- GNU Affero General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Affero General Public License 15 | -- along with this program. If not, see . 16 | {-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} 17 | module System.Directory.ModTime where 18 | 19 | import Control.Applicative 20 | import Control.DeepSeq 21 | import Data.Binary 22 | #if MIN_VERSION_directory(1,2,0) 23 | import Data.Time (UTCTime(..), Day(..), getCurrentTime) 24 | #else 25 | import System.Time (ClockTime(..), getClockTime) 26 | #endif 27 | import System.Directory 28 | import Prelude 29 | 30 | #if MIN_VERSION_directory(1,2,0) 31 | 32 | newtype ModTime = ModTime UTCTime 33 | deriving (Eq, Ord, NFData) 34 | getCurrentModTime = ModTime <$> getCurrentTime 35 | 36 | instance Binary ModTime where 37 | put (ModTime (UTCTime (ModifiedJulianDay day) difftime)) = 38 | put day >> put (toRational difftime) 39 | get = 40 | ModTime <$> (UTCTime <$> (ModifiedJulianDay <$> get) <*> (fromRational <$> get)) 41 | 42 | #else 43 | 44 | newtype ModTime = ModTime ClockTime 45 | deriving (Eq, Ord) 46 | getCurrentModTime = ModTime <$> getClockTime 47 | 48 | instance Binary ModTime where 49 | put (ModTime (TOD s ps)) = 50 | put s >> put ps 51 | get = 52 | ModTime <$> (TOD <$> get <*> get) 53 | 54 | instance NFData ModTime where 55 | rnf (ModTime (TOD s ps)) = 56 | s `seq` ps `seq` (ModTime $! TOD s ps) `seq` () 57 | 58 | #endif 59 | 60 | getCurrentModTime :: IO ModTime 61 | 62 | getModTime :: FilePath -> IO ModTime 63 | getModTime f = ModTime <$> getModificationTime f 64 | -------------------------------------------------------------------------------- /core/shared/Utils.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module Utils where 3 | 4 | import Control.Applicative 5 | import Data.Traversable 6 | import System.Directory 7 | import System.Directory.ModTime 8 | 9 | import Prelude 10 | 11 | data TimedFile = TimedFile { tfPath :: FilePath, tfTime :: ModTime } 12 | deriving (Eq) 13 | 14 | instance Ord TimedFile where 15 | compare (TimedFile _ a) (TimedFile _ b) = compare a b 16 | 17 | timeFile :: FilePath -> IO TimedFile 18 | timeFile f = TimedFile <$> pure f <*> getModTime f 19 | 20 | mightExist :: FilePath -> IO (Maybe FilePath) 21 | mightExist f = do 22 | exists <- doesFileExist f 23 | return $ if exists then (Just f) else (Nothing) 24 | 25 | timeMaybe :: FilePath -> IO (Maybe TimedFile) 26 | timeMaybe f = traverse timeFile =<< mightExist f 27 | -------------------------------------------------------------------------------- /doc/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | piki template.html index.piki > index.html 3 | piki template.html install.piki > install.html 4 | piki template.html ghc-mod.piki > ghc-mod.html 5 | piki template.html ghc-modi.piki > ghc-modi.html 6 | piki template.html emacs.piki > emacs.html 7 | piki template.html preparation.piki > preparation.html 8 | piki template.html copyright.piki > copyright.html 9 | piki template.html history.piki > history.html 10 | piki template.html bug.piki > bug.html 11 | -------------------------------------------------------------------------------- /doc/bug.piki: -------------------------------------------------------------------------------- 1 | *Bugs 2 | 3 | If you found a bug relating the ghc-mod/ghc-modi commands or the ghc-mod library or the haskell-mode sub module, please record a ["issue on github" https://github.com/kazu-yamamoto/ghc-mod/issues]. 4 | 5 | **ghc-mod 6 | 7 | ***ghc-mod cannot work if a ".hsc" file exist 8 | 9 | Please convert it to ".hs" by "cabal build" or by hand with "hsc2hs". 10 | 11 | ***ghc-mod cannot work if "Paths_.hs" is missing 12 | 13 | Please create "Paths_.hs" by "cabal build". If you want to create it by hand, please install the [cab http://www.mew.org/~kazu/proj/cab/en/] command. 14 | Typing "cab genpaths" in your package directory would help you. 15 | 16 | 17 | **ghc-modi 18 | 19 | ***Ctr-c does not terminate ghc-modi 20 | 21 | ghc-modi uses multiple threads of Ghc monad. 22 | Ghc monad installs its own signal handlers 23 | and multiple threads of Ghc monad make the world messy. 24 | I cannot find a workaround. 25 | Just type RET to terminate ghc-modi. 26 | 27 | 28 | 29 | 30 | **Emacs front end 31 | 32 | ***C-xC-s modifies the timestamp of the file even if there is no modification. 33 | 34 | In order to reload the file and check the syntax with GHC API (ghc-modi), 35 | it is necessary to update the timestamp of the file. 36 | A temporary file cannot maintain consistency of module dependency graph. 37 | If you know a workaround, please let me know. 38 | 39 | ***M-C-d on a function or type cannot display it but the top of the page is displayed 40 | 41 | For instance, "open" on Mac removes "#anchor" from the "file:///" URL. So, the top of the file is displayed. Please use C-uM-C-d as workaround. 42 | -------------------------------------------------------------------------------- /doc/copyright.piki: -------------------------------------------------------------------------------- 1 | *Copyright and license 2 | 3 | Copyright of this package belongs to ["IIJ Innovation Institute Inc" http://www.iij-ii.co.jp/en/]. 4 | This package is available under BSD3 license. 5 | 6 | -------------------------------------------------------------------------------- /doc/ghc-mod.piki: -------------------------------------------------------------------------------- 1 | *The ghc-mod command 2 | 3 | ?ghc-mod list 4 | !Displays a list of modules 5 | ?ghc-mod lang 6 | !Displays a list of language extensions 7 | ?ghc-mod flag 8 | !Displays a list of GHC flags 9 | ?ghc-mod browse \[:\] 10 | !Displays symbols of 11 | ?ghc-mod check 12 | !Checks syntax with GHC 13 | ?ghc-mod expand 14 | !Expands Template Haskell 15 | ?ghc-mod debug 16 | !Displays debug information 17 | ?ghc-mod info 18 | !Displays information about the expression 19 | ?ghc-mod type 20 | !Displays the types of all expressions including the expression 21 | ?ghc-mod find 22 | !Finds all module names exporting 23 | ?ghc-mod lint 24 | !Checks synstax with Hlint 25 | ?ghc-mod root 26 | !Finds the root directory for the Haskell file 27 | ?ghc-mod doc 28 | !Finds the html document for the module 29 | ?ghc-mod boot 30 | !Displays boot information for Emacs front-end 31 | ?ghc-mod version 32 | !Displays the version of ghc-mod 33 | ?ghc-mod help 34 | !Displays help messages 35 | 36 | for "info" and "type" is not used, anything is OK. 37 | It is necessary to maintain backward compatibility. 38 | 39 | -------------------------------------------------------------------------------- /doc/ghc-modi.piki: -------------------------------------------------------------------------------- 1 | *The ghc-modi command 2 | 3 | ** Example 4 | 5 | >| 6 | % ghc-modi 7 | check Foo.hs 8 | Foo.hs:7:15:Not in scope: `B.append' 9 | OK 10 | bye 11 | NG quit 12 | % 13 | |< 14 | 15 | ** Commands 16 | 17 | ? check 18 | ! Checks syntax with GHC 19 | ? find 20 | ! Finds all module names exporting 21 | ? info 22 | ! Displays information about the expression 23 | ? type 24 | ! Displays the types of all expressions including the expression 25 | ? lint \[hlint options\] 26 | ! Checks synstax with Hlint 27 | ? boot 28 | ! Displays boot information for Emacs front-end 29 | ? browse \[:\] 30 | ! Displays symbols of 31 | ? quit (or empty string) 32 | ! Terminate ghc-modi 33 | 34 | ** Options 35 | 36 | Option should be the form of Haskell's list of String (\[String\]). 37 | Here is an example: 38 | 39 | >| 40 | lint ["--ignore=Use camelCase", "--ignore=Eta reduce"] Foo.hs 41 | |< 42 | 43 | ** Session separators 44 | 45 | ?OK 46 | ! The session succeeded. 47 | ?NG 48 | ! The session fails. ghc-modi gets finished. 49 | -------------------------------------------------------------------------------- /doc/history.piki: -------------------------------------------------------------------------------- 1 | *History 2 | 3 | Please see [ChangeLog https://github.com/kazu-yamamoto/ghc-mod/blob/master/ChangeLog]. 4 | -------------------------------------------------------------------------------- /doc/index.piki: -------------------------------------------------------------------------------- 1 | *Happy Haskell Programming 2 | 3 | The ["ghc-mod command" ghc-mod.html] and ["ghc-modi command" ghc-modi.html] are backend commands to enrich Haskell programming on editors 4 | including Emacs, Vim, Atom, and Sublime. 5 | ghc-mod and ghc-modi are based on the ["ghc-mod library" http://hackage.haskell.org/packages/archive/ghc-mod/latest/doc/html/Language-Haskell-GhcMod.html] 6 | which is a wrapper of ["GHC API" http://www.haskell.org/ghc/docs/latest/html/libraries/ghc/] and [Cabal http://hackage.haskell.org/package/Cabal]. 7 | 8 | The ["ghc-mod package" http://hackage.haskell.org/package/ghc-mod] on Hackage 9 | includes 10 | the ghc-mod command, the ghc-modi command, the ghc-mod library, and 11 | ["Emacs front-end" emacs.html] (for historical reasons). 12 | The ["source repository of ghc-mod" https://github.com/kazu-yamamoto/ghc-mod] is on github. 13 | 14 | **Emacs 15 | 16 | ["Emacs front-end" emacs.html] is an extension of ["Haskell mode" https://github.com/haskell/haskell-mode]. They enable to complete Haskell symbols and to browse documents of modules. Syntax error highlighting with GHC/Hlint is also integrated. Moreover, you are free from "import hell". 17 | 18 | **Vim 19 | 20 | -[ghcmod-vim https://github.com/eagletmt/ghcmod-vim] 21 | -[syntastic https://github.com/scrooloose/syntastic] 22 | 23 | **Atom 24 | 25 | -[ide-haskell https://atom.io/packages/ide-haskell] 26 | 27 | **Sublime 28 | 29 | -[SublimeHaskell https://github.com/SublimeHaskell/SublimeHaskell] 30 | 31 | -------------------------------------------------------------------------------- /doc/install.piki: -------------------------------------------------------------------------------- 1 | *Installing "ghc-mod" 2 | 3 | This page assumes that you are a Haskell programmer and you know the "cabal" command well. 4 | 5 | **Installing the ghc-mod package 6 | 7 | First of all, update Cabal's database: 8 | 9 | >| 10 | % cabal update 11 | |< 12 | 13 | Now install "ghc-mod": 14 | 15 | >| 16 | % cabal install ghc-mod 17 | |< 18 | 19 | This command installs the followings: 20 | 21 | ?~/.cabal/bin/ghc-mod 22 | !The ghc-mod commnad 23 | ?~/.cabal/bin/ghc-modi 24 | !The ghc-modi commnad 25 | ?~/.cabal/lib/ghc-mod-x.y.z/* 26 | !The ghc-mod library 27 | ?~/.cabal/share/ghc-mod-x.y.z/ghc*.el 28 | !Elisp files to extend Haskell mode 29 | -------------------------------------------------------------------------------- /doc/preparation.piki: -------------------------------------------------------------------------------- 1 | * Preparing Emacs front-end 2 | 3 | **Downloading 4 | 5 | Please use *stable* [MELPA https://stable.melpa.org/] to download Emacs front-end. So, your "~/.emacs" should be: 6 | 7 | >| 8 | (require 'package) 9 | (add-to-list 'package-archives 10 | '("melpa" . "https://stable.melpa.org/packages/")) 11 | (package-initialize) 12 | |< 13 | 14 | The package name is "ghc". 15 | Please don't forget ["install the latest cabal command" install.html]. 16 | 17 | **Configuring "~/.emacs.el" 18 | 19 | Then, put the followings to your "~/.emacs.el" or "~/.emacs.d/init.el": 20 | 21 | >| 22 | (autoload 'ghc-init "ghc" nil t) 23 | (autoload 'ghc-debug "ghc" nil t) 24 | (add-hook 'haskell-mode-hook (lambda () (ghc-init))) 25 | |< 26 | 27 | IMPORTANT: if your haskell-mode-hook includes (flymake-mode), please remove it. 28 | 29 | **Testing 30 | 31 | Executes Emacs and opens a Haskell file by C-xC-f. And try to complete any keywords by M-C-i. 32 | 33 | **Debugging 34 | 35 | ghc-mod/ghc-modi must be compiled by GHC which you are actually using from Emacs. The version of Emacs front-end and ghc-mod/ghc-modi must be the same. To confirm this, type M-x ghc-debug. 36 | 37 | >| 38 | Path: check if you are using intended programs. 39 | ghc.el path: /Users/kazu/work/ghc-mod/elisp/ghc.el 40 | ghc-mod path: /Users/kazu/Library/Haskell/bin/ghc-mod 41 | ghc-modi path: /Users/kazu/Library/Haskell/bin/ghc-modi 42 | ghc path: /usr/local/ghc-7.8/bin/ghc 43 | 44 | Version: all versions must be the same. 45 | ghc.el version 4.1.0 46 | ghc-mod version 4.1.0 compiled by GHC 7.8.2 47 | ghc-modi version 4.1.0 compiled by GHC 7.8.2 48 | The Glorious Glasgow Haskell Compilation System, version 7.8.2 49 | |< 50 | 51 | If you put (setq ghc-debug t) to your ".emacs", you can watch the communication between Emacs front-end and ghc-modi in the "*GHC Debug*" buffer. 52 | 53 | **Customizing 54 | 55 | If you want to specify GHC options from Emacs, set "ghc-ghc-options". 56 | The following is an example to specify the "-i" options to GHC. 57 | 58 | >| 59 | (setq ghc-ghc-options '("-idir1" "-idir2")) 60 | |< 61 | 62 | An example to specify HLint options: 63 | 64 | >| 65 | (setq ghc-hlint-options '("--ignore=Use camelCase")) 66 | |< 67 | 68 | -------------------------------------------------------------------------------- /doc/presentation/Rokkitt.otf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DanielG/ghc-mod/391e187a5dfef4421aab2508fa6ff7875cc8259d/doc/presentation/Rokkitt.otf -------------------------------------------------------------------------------- /doc/presentation/architecture.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DanielG/ghc-mod/391e187a5dfef4421aab2508fa6ff7875cc8259d/doc/presentation/architecture.pdf -------------------------------------------------------------------------------- /doc/presentation/architecture.tex: -------------------------------------------------------------------------------- 1 | \documentclass{article} 2 | \usepackage{polyglossia} 3 | \usepackage{xcolor} 4 | \usepackage{fontspec} 5 | \usepackage{tikz} 6 | 7 | \begin{document} 8 | 9 | % \begin{tikzpicture} 10 | % \draw (-1,0) -- (1,0); 11 | % \draw (0,-1) -- (0,1); 12 | 13 | % \draw (-0.5,-0.5) rectangle (-1,-1); 14 | % \end{tikzpicture}. 15 | 16 | \begin{tikzpicture}[every node/.style={draw}] 17 | \matrix [draw=red,column sep=1cm] 18 | { 19 | \node {8}; & \node{1}; & \node {6}; \\ 20 | \node {3}; & \node{5}; & \node {7}; \\ 21 | \node {4}; & \node{9}; & \node {2}; \\ 22 | }; 23 | \end{tikzpicture} 24 | 25 | \begin{tikzpicture} 26 | \matrix[draw=black,nodes=draw,column sep=1mm] at (0, 0) { 27 | \node {check}; & 28 | \node {type}; & 29 | \node {browse}; & 30 | \node {find}; & 31 | \node {refine}; \\ 32 | }; 33 | 34 | \matrix[draw=black,nodes=draw,column sep=1mm] at (0, 0) { 35 | \node {check}; & 36 | \node {type}; & 37 | \node {browse}; & 38 | \node {find}; & 39 | \node {refine}; \\ 40 | }; 41 | \end{tikzpicture} 42 | 43 | 44 | \end{document} -------------------------------------------------------------------------------- /doc/presentation/auto/main.el: -------------------------------------------------------------------------------- 1 | (TeX-add-style-hook 2 | "main" 3 | (lambda () 4 | (TeX-run-style-hooks 5 | "latex2e" 6 | "beamer" 7 | "beamer10" 8 | "polyglossia" 9 | "xcolor" 10 | "fontspec") 11 | (TeX-add-symbols 12 | "gm" 13 | "gms"))) 14 | 15 | -------------------------------------------------------------------------------- /doc/presentation/current-architecture.dia: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DanielG/ghc-mod/391e187a5dfef4421aab2508fa6ff7875cc8259d/doc/presentation/current-architecture.dia -------------------------------------------------------------------------------- /doc/presentation/current-architecture.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DanielG/ghc-mod/391e187a5dfef4421aab2508fa6ff7875cc8259d/doc/presentation/current-architecture.png -------------------------------------------------------------------------------- /doc/presentation/gh-stars.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DanielG/ghc-mod/391e187a5dfef4421aab2508fa6ff7875cc8259d/doc/presentation/gh-stars.png -------------------------------------------------------------------------------- /doc/presentation/hackage-dls.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DanielG/ghc-mod/391e187a5dfef4421aab2508fa6ff7875cc8259d/doc/presentation/hackage-dls.png -------------------------------------------------------------------------------- /doc/presentation/logo.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DanielG/ghc-mod/391e187a5dfef4421aab2508fa6ff7875cc8259d/doc/presentation/logo.pdf -------------------------------------------------------------------------------- /doc/presentation/main.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DanielG/ghc-mod/391e187a5dfef4421aab2508fa6ff7875cc8259d/doc/presentation/main.pdf -------------------------------------------------------------------------------- /doc/presentation/planned-architecture.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DanielG/ghc-mod/391e187a5dfef4421aab2508fa6ff7875cc8259d/doc/presentation/planned-architecture.png -------------------------------------------------------------------------------- /elisp/Makefile: -------------------------------------------------------------------------------- 1 | SRCS = ghc.el ghc-func.el ghc-doc.el ghc-comp.el ghc-check.el ghc-process.el \ 2 | ghc-command.el ghc-info.el ghc-ins-mod.el ghc-indent.el ghc-rewrite.el 3 | EMACS = emacs 4 | 5 | TEMPFILE = temp.el 6 | TEMPFILE2 = temp2.el 7 | 8 | all: $(TEMPFILE) ghc.el 9 | $(EMACS) -batch -q -no-site-file -l ./$(TEMPFILE) -f ghc-compile 10 | rm -f $(TEMPFILE) 11 | 12 | lint: $(TEMPFILE2) ghc.el 13 | $(EMACS) -batch -q -no-site-file -l ./$(TEMPFILE2) -f ghc-compile 14 | rm -f $(TEMPFILE2) 15 | 16 | $(TEMPFILE): 17 | @echo '(setq load-path (cons "." load-path))' >> $(TEMPFILE) 18 | @echo '(defun ghc-compile () (mapcar (lambda (x) (byte-compile-file x)) (list ' >> $(TEMPFILE) 19 | @echo $(SRCS)| sed -e 's/\(ghc[^ ]*\.el\)/"\1"/g' >> $(TEMPFILE) 20 | @echo ')))' >> $(TEMPFILE) 21 | 22 | $(TEMPFILE2): 23 | @echo '(setq load-path (cons "." load-path))' >> $(TEMPFILE2) 24 | @echo '(setq hack-local-variables-hook (lambda () (setq lexical-binding t)))' >> $(TEMPFILE2) 25 | @echo '(defun ghc-compile () (mapcar (lambda (x) (byte-compile-file x)) (list ' >> $(TEMPFILE2) 26 | @echo $(SRCS)| sed -e 's/\(ghc[^ ]*\.el\)/"\1"/g' >> $(TEMPFILE2) 27 | @echo ')))' >> $(TEMPFILE2) 28 | 29 | clean: 30 | rm -f *.elc $(TEMPFILE) $(TEMPFILE2) 31 | 32 | VERSION = `grep version ghc.el | sed -e 's/[^0-9\.]//g'` 33 | 34 | bump: 35 | echo "(define-package\n \"ghc-mod\"\n $(VERSION)\n \"Sub mode for Haskell mode\"\n nil)" > ghc-pkg.el 36 | 37 | archive: 38 | git archive master -o ~/ghc-$(VERSION).tar --prefix=ghc-$(VERSION)/ 39 | -------------------------------------------------------------------------------- /elisp/ghc-command.el: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;;; 3 | ;;; ghc-command.el 4 | ;;; 5 | 6 | ;; Author: Kazu Yamamoto 7 | ;; Created: Apr 13, 2010 8 | ;; License: BSD-3-clause 9 | 10 | ;;; Code: 11 | 12 | (require 'ghc-process) 13 | (require 'ghc-check) 14 | 15 | (defun ghc-insert-template () 16 | (interactive) 17 | (cond 18 | ((bobp) 19 | (ghc-insert-module-template)) 20 | ((ghc-check-overlay-at (point)) 21 | (or (ghc-check-insert-from-warning) 22 | (ghc-try-case-split))) 23 | (t 24 | (unless (ghc-try-case-split) 25 | (message "Nothing to be done"))))) 26 | 27 | (defun ghc-insert-module-template () 28 | (let* ((fullname (file-name-sans-extension (buffer-file-name))) 29 | (rootdir (ghc-get-project-root)) 30 | (len (length rootdir)) 31 | (name (substring fullname (1+ len))) 32 | (file (file-name-sans-extension (buffer-name))) 33 | (case-fold-search nil) 34 | (mod (if (string-match "^[A-Z]" name) 35 | (ghc-replace-character name ?/ ?.) 36 | (if (string-match "^[a-z]" file) 37 | "Main" 38 | file)))) 39 | (while (looking-at "^{-#") 40 | (forward-line)) 41 | (insert "module " mod " where\n"))) 42 | 43 | ;; (defun ghc-capitalize (str) 44 | ;; (let ((ret (copy-sequence str))) 45 | ;; (aset ret 0 (upcase (aref ret 0))) 46 | ;; ret)) 47 | 48 | (defun ghc-sort-lines (beg end) 49 | (interactive "r") 50 | (save-excursion 51 | (save-restriction 52 | (narrow-to-region beg end) 53 | (goto-char (point-min)) 54 | (let ((inhibit-field-text-motion t)) 55 | (sort-subr nil 'forward-line 'end-of-line 56 | (lambda () 57 | (re-search-forward "^import +\\(qualified\\)? *" nil t) 58 | nil) 59 | 'end-of-line)) 60 | (ghc-merge-lines)))) 61 | 62 | (defun ghc-merge-lines () 63 | (let ((case-fold-search nil)) 64 | (goto-char (point-min)) 65 | (while (not (eolp)) 66 | ;; qualified modlues are not merged at this moment. 67 | ;; fixme if it is improper. 68 | (if (looking-at "^import +\\([A-Z][^ \n]+\\) *(\\(.*\\))$") 69 | (let ((mod (match-string-no-properties 1)) 70 | (syms (match-string-no-properties 2)) 71 | (beg (point))) 72 | (forward-line) 73 | (ghc-merge-line beg mod syms)) 74 | (forward-line))))) 75 | 76 | (defun ghc-merge-line (beg mod syms) 77 | (let ((regex (concat "^import +" (regexp-quote mod) " *(\\(.*\\))$")) 78 | duplicated) 79 | (while (looking-at regex) 80 | (setq duplicated t) 81 | (setq syms (concat syms ", " (match-string-no-properties 1))) 82 | (forward-line)) 83 | (when duplicated 84 | (delete-region beg (point)) 85 | (insert "import " mod " (" syms ")\n")))) 86 | 87 | (defun ghc-save-buffer () 88 | (interactive) 89 | ;; fixme: better way then saving? 90 | (if ghc-check-command ;; hlint 91 | (if (buffer-modified-p) 92 | (call-interactively 'save-buffer)) 93 | (unless buffer-read-only 94 | (set-buffer-modified-p t) 95 | (call-interactively 'save-buffer))) 96 | (ghc-check-syntax)) 97 | 98 | (provide 'ghc-command) 99 | -------------------------------------------------------------------------------- /elisp/ghc-indent.el: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;;; 3 | ;;; ghc-indent.el 4 | ;;; 5 | 6 | ;; Author: Kazu Yamamoto 7 | ;; Created: Feb 28, 2012 8 | ;; License: BSD-3-clause 9 | 10 | ;;; Code: 11 | 12 | (defvar ghc-indent-offset 4) 13 | 14 | (defun ghc-make-indent-shallower (_beg _end) 15 | (interactive "r") 16 | (indent-rigidly (region-beginning) (region-end) (- ghc-indent-offset))) 17 | 18 | (defun ghc-make-indent-deeper (_beg _end) 19 | (interactive "r") 20 | (indent-rigidly (region-beginning) (region-end) ghc-indent-offset)) 21 | 22 | (provide 'ghc-indent) 23 | -------------------------------------------------------------------------------- /elisp/ghc-ins-mod.el: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;;; 3 | ;;; ghc-ins-mod.el 4 | ;;; 5 | 6 | ;; Author: Kazu Yamamoto 7 | ;; Created: Dec 27, 2011 8 | ;; License: BSD-3-clause 9 | 10 | (require 'ghc-process) 11 | 12 | ;;; Code: 13 | 14 | (defun ghc-insert-module () 15 | (interactive) 16 | (let* ((expr0 (ghc-things-at-point)) 17 | (expr (ghc-read-expression expr0))) 18 | (ghc-ins-mod expr))) 19 | 20 | (defvar ghc-preferred-modules '("Control.Applicative" 21 | "Data.ByteString" 22 | "Data.Text" 23 | "Text.Parsec" 24 | "System.FilePath" 25 | "System.Directory")) 26 | 27 | (defun ghc-reorder-modules (mods) 28 | (catch 'loop 29 | (dolist (pmod ghc-preferred-modules) 30 | (if (member pmod mods) 31 | (throw 'loop (cons pmod (delete pmod mods))))) 32 | mods)) 33 | 34 | (defun ghc-ins-mod (expr) 35 | (let (prefix fun mods) 36 | (if (not (string-match "^\\([^.]+\\)\\\.\\([^.]+\\)$" expr)) 37 | (setq fun expr) 38 | (setq prefix (match-string 1 expr)) 39 | (setq fun (match-string 2 expr))) 40 | (setq mods (ghc-reorder-modules (ghc-function-to-modules fun))) 41 | (if (null mods) 42 | (message "No module guessed") 43 | (let* ((key (or prefix fun)) 44 | (fmt (concat "Module name for \"" key "\" (%s): ")) 45 | (mod (ghc-completing-read fmt mods))) 46 | (save-excursion 47 | (ghc-goto-module-position) 48 | (if prefix 49 | (insert-before-markers "import qualified " mod " as " prefix "\n") 50 | (insert-before-markers "import " mod " (" (ghc-enclose expr) ")\n"))))))) 51 | 52 | (defun ghc-completing-read (fmt lst) 53 | (let* ((def (car lst)) 54 | (prompt (format fmt def)) 55 | (inp (completing-read prompt lst))) 56 | (if (string= inp "") def inp))) 57 | 58 | (defun ghc-goto-module-position () 59 | (goto-char (point-max)) 60 | (if (re-search-backward "^import +" nil t) 61 | (ghc-goto-empty-line) 62 | (if (not (re-search-backward "^module" nil t)) 63 | (goto-char (point-min)) 64 | (ghc-goto-empty-line) 65 | (forward-line) 66 | (unless (eolp) 67 | ;; save-excursion is not proper due to insert-before-markers. 68 | (let ((beg (point))) 69 | (insert-before-markers "\n") 70 | (goto-char beg)))))) 71 | 72 | (defun ghc-goto-empty-line () 73 | (unless (re-search-forward "^$" nil t) 74 | (forward-line))) 75 | 76 | (defun ghc-function-to-modules (fun) 77 | (let ((cmd (format "find %s\n" fun))) 78 | (ghc-sync-process cmd))) 79 | 80 | (provide 'ghc-ins-mod) 81 | -------------------------------------------------------------------------------- /elisp/ghc-pkg.el: -------------------------------------------------------------------------------- 1 | (define-package 2 | "ghc" 3 | 2.0.0 4 | "Sub mode for Haskell mode" 5 | '((haskell-mode "13.0"))) 6 | -------------------------------------------------------------------------------- /ghcmodHappyHaskellProgram-Dg.tex: -------------------------------------------------------------------------------- 1 | % ghcmodHappyHaskellProgram-Dg.tex 2 | \begin{hcarentry}[updated]{ghc-mod --- Happy Haskell Programming} 3 | \report{Daniel Gr\"ober}%05/15 4 | \status{open source, actively developed} 5 | \makeheader 6 | 7 | \texttt{ghc-mod} is both a backend program for enhancing editors and other kinds 8 | of development environments with support for Haskell, and an Emacs package 9 | providing the user facing functionality, internally called \texttt{ghc} for 10 | historical reasons. Others have developed front ends for Vim, Atom and a few 11 | other proprietary editors. 12 | 13 | This summer's two month \texttt{ghc-mod} hacking session was mostly spent 14 | (finally) getting a release supporting GHC 7.10 out the door as well as fixing 15 | bugs and adding full support for the \textit{Stack} build tool. 16 | 17 | Since the last report the \textit{haskell-ide} project has seen the light of day 18 | (or rather been revived). There we are planning to adopt \texttt{ghc-mod} as a 19 | core component to use its environment abstraction. 20 | 21 | The \textit{haskell-ide} project itself (maybe soon to be called 22 | \textit{ghc-ide-engine}) is aiming to be the central component of a unified 23 | Haskell Tooling landscape. 24 | 25 | \texttt{ghc-mod}'s mission statement remains the same but in the future it will 26 | be but one, important, component in a larger ecosystem of Haskell Tools. 27 | 28 | We are looking forward to \textit{haskell-ide} making the Haskell Tooling 29 | landscape a lot less fragmented. However until this project produces meaningful 30 | results life goes on and \texttt{ghc-mod} needs to be maintained. 31 | 32 | Right now \texttt{ghc-mod} has only one core developer and only a handful of 33 | occasional contributors. If \textit{you} want to help make Haskell development 34 | even more fun come and join us! 35 | 36 | \FurtherReading 37 | \url{https://github.com/kazu-yamamoto/ghc-mod} 38 | \end{hcarentry} 39 | -------------------------------------------------------------------------------- /scripts/bounds.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | import Control.Arrow 3 | import Data.List 4 | import Data.List.Split 5 | import Data.Maybe 6 | import Data.Function 7 | import Data.Map (Map) 8 | import qualified Data.Map as M 9 | import System.Environment 10 | import System.FilePath 11 | import System.Directory 12 | 13 | import Distribution.Verbosity 14 | import Distribution.PackageDescription.Parse (readPackageDescription) 15 | import Distribution.PackageDescription.Configuration (flattenPackageDescription) 16 | import Distribution.PackageDescription 17 | import Distribution.Package 18 | import Distribution.Version 19 | import Distribution.Text 20 | import Text.PrettyPrint 21 | import System.Environment 22 | 23 | 24 | datadir = "hackage-metadata" 25 | 26 | main = do 27 | [pkg,v] <- getArgs 28 | 29 | let pkg_id = pkg ++ "-" ++ v 30 | cabal_file = datadir pkg_id <.> "cabal" 31 | 32 | pkg_time <- getTime pkg v 33 | 34 | ps <- 35 | mapMaybe (\case (p, "-any") -> Just p 36 | _ -> Nothing) 37 | 38 | <$> getDeps cabal_file 39 | vs <- mapM (getClosestVersion pkg_time) ps 40 | print $ ps `zip` vs 41 | return () 42 | 43 | check :: VersionRange -> Version -> Bool 44 | check vr v = withinRange v vr 45 | 46 | getClosestVersion :: Integer -> String -> IO String 47 | getClosestVersion pkg_time dep = do 48 | vs <- getVersions dep 49 | ts <- mapM (getTime dep) vs 50 | let vtalist = sortBy (flip compare `on` snd) $ vs `zip` ts 51 | ((v,_t):_) = filter (( IO [String] 56 | getVersions p = do 57 | fs <- listDirectory datadir 58 | return $ nub 59 | $ map snd 60 | $ filter ((==p) . fst) 61 | $ map (parsePkgId . dropExtension) 62 | $ filter (p `isPrefixOf`) fs 63 | 64 | getTime :: String -> String -> IO Integer 65 | getTime p v = do 66 | let pkg_id = p ++ "-" ++ v 67 | file = datadir pkg_id <.> "upload-date" 68 | read <$> readFile file 69 | 70 | getDeps f = do 71 | pd <- flattenPackageDescription <$> readPackageDescription silent f 72 | return $ --nubBy ((==) `on` fst) $ 73 | [ (unPackageName n, (render . disp) v) 74 | | (Dependency n v) <- buildDepends pd 75 | , not $ unPackageName n `elem` [ 76 | "ghc-mod", 77 | "ghc", 78 | "array", 79 | "base", 80 | "bin-package-db", 81 | "binary", 82 | "bytestring", 83 | "containers", 84 | "deepseq", 85 | "directory", 86 | "filepath", 87 | "ghc-binary", 88 | "ghc-boot", 89 | "ghc-boot-th", 90 | "ghc-prim", 91 | "ghci", 92 | "haskelline", 93 | "haskell2010", 94 | "haskell98", 95 | "haskell98", 96 | "hoopl", 97 | "hpc", 98 | "integer-gmp", 99 | "old-locale", 100 | "old-time", 101 | "pretty", 102 | "process", 103 | "random", 104 | "rts", 105 | "template-haskell", 106 | "terminfo", 107 | "time", 108 | "transformers", 109 | "unix", 110 | "xhtml" 111 | ] 112 | ] 113 | 114 | parsePkgId pkg_id = let 115 | v:pkgcs = reverse $ splitOn "-" pkg_id 116 | in 117 | (intercalate "-" $ reverse pkgcs, v) 118 | -------------------------------------------------------------------------------- /scripts/bump.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | if [ -z "$1" ]; then 6 | echo "Usage: $0 VERSION" >&2 7 | exit 1 8 | fi 9 | 10 | VERSION=$1 11 | 12 | if ! echo $VERSION | grep -Eq "^[0-9.]*(-.+)?$"; then 13 | echo "invalid version"; 14 | exit 1 15 | fi 16 | 17 | cd $(dirname $0)/.. 18 | 19 | git checkout release-$VERSION 20 | 21 | sed -i 's/(defconst ghc-version ".*")/(defconst ghc-version "'"$VERSION"'")/' \ 22 | elisp/ghc.el 23 | 24 | sed -r -i 's/^(Version:[[:space:]]*)[0-9.]+/\1'"$VERSION"'/' ghc-mod.cabal 25 | 26 | git add elisp/ghc.el ghc-mod.cabal 27 | 28 | git update-index -q --ignore-submodules --refresh 29 | # If there are uncommitted changes do the bump commit 30 | if ! git diff-index --cached --quiet HEAD --ignore-submodules -- 31 | then 32 | git commit -m "Bump version to $VERSION" --allow-empty 33 | fi 34 | 35 | git checkout release 36 | #git merge release-VER branch into 'release' 37 | git merge -s recursive -X theirs release-$VERSION 38 | 39 | ( tac ChangeLog; echo "\n$(date '+%Y-%m-%d') v$VERSION" ) | tac \ 40 | > ChangeLog.tmp 41 | 42 | mv ChangeLog.tmp ChangeLog 43 | 44 | emacs -q -nw ChangeLog 45 | 46 | git add ChangeLog 47 | git commit -m "ChangeLog" 48 | 49 | git tag -f "v$VERSION" 50 | -------------------------------------------------------------------------------- /scripts/collect-debug-info.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | ( 4 | set -e 5 | 6 | cd $(dirname $0)/.. 7 | 8 | echo "======== ghc-pkg list ========" 9 | ghc_ver=$(ghc --version | sed -r 's/.*[[:space:]]([0-9.]+)/\1/') 10 | ghc-pkg list -v \ 11 | --global --user \ 12 | --package-db .cabal-sandbox/*-ghc-$ghc_ver-packages.conf.d 2>&1 13 | 14 | echo "======== cabal reconfigure ========" 15 | cabal clean -v3 16 | cabal configure -v3 --enable-tests 2>&1 17 | echo "======== END cabal reconfigure ========" 18 | 19 | echo "======== cabal setup/config ========" 20 | cat dist/setup-config 21 | echo "\n======== END cabal setup/config ========" 22 | 23 | echo "======== cabal build ========" 24 | cabal build -v 2>&1 25 | echo "======== END cabal build ========" 26 | 27 | echo "======== spec ========" 28 | ./dist/build/spec/spec 2>&1 29 | echo "======== END spec ========" 30 | 31 | echo "======== doctest ========" 32 | ./dist/build/doctest/doctest 2>&1 33 | echo "======== END doctest ========" 34 | ) | tee /tmp/ghc-mod-debug-info.log 35 | echo 36 | echo 37 | echo "Debug info written to: /tmp/ghc-mod-debug-info.log" 38 | -------------------------------------------------------------------------------- /scripts/compare-versions.sh: -------------------------------------------------------------------------------- 1 | ################################################################################ 2 | # # 3 | # Find version differences in common packages of `ghc-pkg list` dumps. # 4 | # # 5 | # Copyright (C) 2015 Daniel Gröber # 6 | # # 7 | # Copying and distribution of this file, with or without modification, # 8 | # are permitted in any medium without royalty provided the copyright # 9 | # notice and this notice are preserved. This file is offered as-is, # 10 | # without any warranty. # 11 | # # 12 | # Usage: sh compare-versions.sh FILE1 FILE2 # 13 | # # 14 | # Example: # 15 | # sh compare-versions.sh =(ghc-pkg list) =(ssh some-host ghc-pkg list) # 16 | # # 17 | # Where `=(command)` is equivalent to: # 18 | # `(tmp=$(mktemp); command > $tmp; echo $tmp)` # 19 | # # 20 | # # 21 | # The output consists of lines in the format: # 22 | # # 23 | # VERSION1 is the version from FILE1 and VERSION2 is the version from FILE2 # 24 | # # 25 | ################################################################################ 26 | 27 | t1=$(mktemp) 28 | t2=$(mktemp) 29 | 30 | grep "^ " "$1" | sed 's/ *\(.*\)-\([0-9.]\+\)/\1 \2/' | sort > $t1 31 | grep "^ " "$2" | sed 's/ *\(.*\)-\([0-9.]\+\)/\1 \2/' | sort > $t2 32 | 33 | comm -3 -2 $t1 $t2 | sort -k 1b,1 > $t1.diff 34 | comm -3 -1 $t1 $t2 | sort -k 1b,1 > $t2.diff 35 | 36 | join $t1.diff $t2.diff | sort | uniq 37 | -------------------------------------------------------------------------------- /scripts/diff.hs: -------------------------------------------------------------------------------- 1 | import Data.Tuple 2 | import System.FilePath 3 | import System.Environment 4 | import System.Process 5 | 6 | main = do 7 | vs <- lines <$> getContents 8 | [pkg, dir] <- getArgs 9 | mapM_ system $ map (\(v1, v2) -> "diff -u --color=always " ++ file pkg dir v1 ++ " " ++ file pkg dir v2 ++ "; echo; echo; echo") $ map swap $ drop 1 vs `zip` vs 10 | where 11 | file pkg dir v = dir (pkg ++ "-" ++ v) <.> "cabal" 12 | -------------------------------------------------------------------------------- /scripts/download-metadata.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | ################################################################################ 3 | # # 4 | # Download package metadata for all versions on Hackage # 5 | # # 6 | # Copyright (C) 2015 Daniel Gröber # 7 | # # 8 | # Copying and distribution of this file, with or without modification, # 9 | # are permitted in any medium without royalty provided the copyright # 10 | # notice and this notice are preserved. This file is offered as-is, # 11 | # without any warranty. # 12 | # # 13 | # Usage: ./download-metadata.sh PACKAGE OUTPUT_DIRECTORY # 14 | # # 15 | ################################################################################ 16 | 17 | PACKAGE=$1 18 | OUTDIR=$2 19 | 20 | versions="$(wget -O - https://hackage.haskell.org/package/"$PACKAGE"/preferred.json | jq '(."normal-version" + ."deprecated-version")[]' -r)" 21 | #versions="$(wget -O - https://hackage.haskell.org/package/"$PACKAGE"/preferred.json | jq '."deprecated-version"[]' -r)" 22 | 23 | 24 | 25 | mkdir -p "$OUTDIR" 26 | 27 | for v in $versions; do 28 | 29 | wget https://hackage.haskell.org/package/"$PACKAGE-$v"/"$PACKAGE".cabal -O "$OUTDIR/${PACKAGE}-${v}.cabal" & 30 | 31 | done 32 | -------------------------------------------------------------------------------- /scripts/edit-bounds-macros.el: -------------------------------------------------------------------------------- 1 | 2 | (fset 'goto-lib-dep 3 | (lambda (&optional arg) "Keyboard macro." (interactive "p") (kmacro-exec-ring-item (quote ([134217788 21 19 94 108 105 98 114 97 114 121 13 19 98 117 105 108 100 45 100 101 112 101 110 100 115 58 13 19 44 32 25 13 18 44 13 6 6] 0 "%d")) arg))) 4 | 5 | 6 | (fset 'copy-dep-name 7 | (lambda (&optional arg) "Keyboard macro." (interactive "p") (kmacro-exec-ring-item (quote ([1 19 44 32 return 67108896 134217830 134217847 24 24 67108896 67108896] 0 "%d")) arg))) 8 | 9 | (fset 'replace-with-lib-dep 10 | [?\C-a ?\M-x ?c ?o ?p ?y ?- ?d ?e ?p ?- ?n ?a ?m ?e ?\C-m ?\C-x ?r ? ?r ?\M-x ?g ?o ?t ?o ?- ?l ?i ?b ?- ?d ?e ?p ?\C-m ?\C- ?\C-e ?\M-w ?\C-x ?r ?j ?r ?\C-y ?\C-k ?\C-x ?\C-x ?\C- ?\C- ]) 11 | 12 | (fset 'yank-kill-replace 13 | [?\C- ?\C- ?\C-y ?\C-k ?\C-x ?\C-x ?\M-w]) 14 | 15 | (global-set-key (kbd "C-c C-r") 'replace-with-lib-dep) 16 | (global-set-key (kbd "C-c C-k") 'yank-kill-replace) 17 | -------------------------------------------------------------------------------- /scripts/extract-build-deps.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Verbosity 2 | import Distribution.PackageDescription.Parse (readPackageDescription) 3 | import Distribution.PackageDescription.Configuration (flattenPackageDescription) 4 | import Distribution.PackageDescription 5 | import Distribution.Package 6 | import Distribution.Text 7 | import Text.PrettyPrint 8 | import System.Environment 9 | 10 | main = do 11 | [f] <- getArgs 12 | pd <- flattenPackageDescription <$> readPackageDescription silent f 13 | mapM_ putStrLn $ map (\(Dependency n v) -> unPackageName n ++ "\t" ++ render (disp v)) $ buildDepends pd 14 | -------------------------------------------------------------------------------- /scripts/extract-upload-date.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | PACKAGE=$1 4 | OUTDIR=$2 5 | 6 | versions="$(wget -O - https://hackage.haskell.org/package/"$PACKAGE"/preferred.json | jq '(."normal-version" + ."deprecated-version")[]' -r)" 7 | 8 | mkdir -p "$OUTDIR" 9 | 10 | for v in $versions; do 11 | date=$(wget -O - https://hackage.haskell.org/package/"$PACKAGE-$v" \ 12 | | w3m -dump -T text/html \ 13 | | grep Uploaded \ 14 | | sed -r 's/^\s+Uploaded\s+(.*) by .*$/\1/') 15 | 16 | date --date="$date" '+%s' > "$OUTDIR"/"$PACKAGE-$v".upload-date 17 | done 18 | -------------------------------------------------------------------------------- /scripts/upload-metadata.hs: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | is_term() { 4 | [ -t 0 ] 5 | } 6 | 7 | # Disable echo while typing the password if in a terminal 8 | hidden_prompt() { 9 | if is_term; then 10 | settings=$(stty -g) 11 | trap "stty '$settings'" 0 12 | stty -echo 13 | echo -n "$1: " 14 | IFS="" read -r $2 15 | echo 16 | stty "$settings" 17 | else 18 | IFS="" read -r $2 19 | fi 20 | } 21 | 22 | 23 | 24 | set -e 25 | 26 | PACKAGE=$1 27 | OUTDIR=$2 28 | VERSIONS="$@" 29 | 30 | read -p "Username: " user 31 | hidden_prompt "Password" pw 32 | 33 | if [ -z "$VERSIONS" ]; then 34 | VERSIONS="$(curl https://hackage.haskell.org/package/"$PACKAGE"/preferred.json | jq '."normal-version"[]' -r)" 35 | #versions="$(curl https://hackage.haskell.org/package/"$PACKAGE"/preferred.json | jq '."deprecated-version"[]' -r)" 36 | fi 37 | 38 | 39 | 40 | echo "Versions: $VERSIONS" 41 | 42 | for v in $VERSIONS; do 43 | rev=$(cat $OUTDIR/$PACKAGE-$v.cabal | grep -i "^x-revision:" | tr -s '[:blank:]*' '\t' | cut -f 2) 44 | 45 | if [ -z "$rev" ]; then 46 | rev=0 47 | fi 48 | 49 | echo -n "$PACKAGE v$v rev:$rev..." 50 | 51 | content=$( ( echo "X-Revision: $((rev + 1))"; cat $OUTDIR/$PACKAGE-$v.cabal | sed '/^X-Revision:/Id' ) ) 52 | 53 | resp=$(curl -s --form-string "cabalfile=$content" -F "publish=Publish new revision" https://hackage.haskell.org/package/"${PACKAGE}-${v}"/"${PACKAGE}.cabal"/edit -u "$user:$pw") 54 | 55 | changes=$(printf '%s\n' "$resp" | sed -n '/Changes in this revision/,/<\/ul>/p' | w3m -dump -T text/html) 56 | 57 | errors=$(printf '%s\n' "$resp" | sed -n '/Errors/,/<\/form>/p') 58 | 59 | if printf '%s\n' "$resp" | grep -q "Cannot publish new revision"; then 60 | notpublished=1 61 | fi 62 | 63 | printf 'Changes:\n%s\n' "$changes" 64 | if [ -z "$changes" -o -n "$notpublished" ]; then 65 | if printf '%s\n' "$errors" | grep -q "No changes"; then 66 | continue; 67 | fi 68 | 69 | printf '%s\n' "$resp" > /tmp/hackage-metadata-error 70 | printf '%s\n' "$errors" | w3m -dump -T text/html 71 | 72 | exit 1 73 | fi 74 | done 75 | -------------------------------------------------------------------------------- /shelltest/ShellTest.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | -- ghc-mod: Happy Haskell Hacking 3 | -- Copyright (C) 2017 Daniel Gröber 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU Affero General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- (at your option) any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU Affero General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU Affero General Public License 16 | -- along with this program. If not, see . 17 | 18 | module Main where 19 | 20 | import System.Exit 21 | import System.Process 22 | 23 | main = exitWith =<< rawSystem "shelltest" [ "--execdir", "shelltest/" ] 24 | -------------------------------------------------------------------------------- /shelltest/browse.test: -------------------------------------------------------------------------------- 1 | cabal exec -- ghc-mod browse Data.Map 2 | >>> /differenceWithKey/ 3 | >>>= 0 4 | 5 | cabal exec -- ghc-mod browse -d Data.Either 6 | >>> /^either :: \(a -> c\) -> \(b -> c\) -> Either a b -> c$/ 7 | >>>= 0 8 | 9 | cabal exec -- ghc-mod browse -d Data.Either 10 | >>> /^Left :: a -> Either a b$/ 11 | >>>= 0 12 | -------------------------------------------------------------------------------- /shelltest/browse/MyModule.hs: -------------------------------------------------------------------------------- 1 | module MyModule where 2 | 3 | data MyType = MyConstructor1 4 | | MyConstructor2 5 | 6 | some_num = 0 7 | some_char = ' ' 8 | some_string = "bar" 9 | 10 | ($?>>/) :: Int -> Int -> Int 11 | a $?>>/ b = a + b 12 | -------------------------------------------------------------------------------- /shelltest/browse/browse-project.testtpl: -------------------------------------------------------------------------------- 1 | 2 | cabal exec -- ghc-mod browse MyModule | sort 3 | >>> 4 | MyConstructor1 5 | MyConstructor2 6 | MyType 7 | some_char 8 | some_num 9 | some_string 10 | >>>= 0 11 | 12 | cabal exec -- ghc-mod browse -q MyModule | sort 13 | >>> 14 | MyModule.MyConstructor1 15 | MyModule.MyConstructor2 16 | MyModule.MyType 17 | MyModule.some_char 18 | MyModule.some_num 19 | MyModule.some_string 20 | >>>= 0 21 | 22 | cabal exec -- ghc-mod browse -d MyModule | sort 23 | >>> 24 | MyConstructor1 :: MyType 25 | MyConstructor2 :: MyType 26 | MyType :: data MyType 27 | some_char :: Char 28 | some_num :: Integer 29 | some_string :: [Char] 30 | >>>= 0 31 | 32 | cabal exec -- ghc-mod browse -o MyModule | sort 33 | >>> 34 | ($?>>/) 35 | MyConstructor1 36 | MyConstructor2 37 | MyType 38 | some_char 39 | some_num 40 | some_string 41 | >>>= 0 42 | 43 | cabal exec -- ghc-mod browse -p MyModule | sort 44 | >>> 45 | MyConstructor1 -- from:MyType 46 | MyConstructor2 -- from:MyType 47 | MyType 48 | some_char 49 | some_num 50 | some_string 51 | >>>= 0 52 | 53 | cabal exec -- ghc-mod browse -odpq MyModule | sort 54 | >>> 55 | MyModule.($?>>/) :: Int -> Int -> Int 56 | MyModule.MyConstructor1 :: MyType -- from:MyType 57 | MyModule.MyConstructor2 :: MyType -- from:MyType 58 | MyModule.MyType :: data MyType 59 | MyModule.some_char :: Char 60 | MyModule.some_num :: Integer 61 | MyModule.some_string :: [Char] 62 | >>>= 0 63 | -------------------------------------------------------------------------------- /shelltest/browse/cabal/MyModule.hs: -------------------------------------------------------------------------------- 1 | ../MyModule.hs -------------------------------------------------------------------------------- /shelltest/browse/cabal/browse-cabal.cabal: -------------------------------------------------------------------------------- 1 | name: browse-cabal 2 | version: 0 3 | build-type: Simple 4 | cabal-version: >=1.2 5 | 6 | library 7 | hs-source-dirs: . 8 | build-depends: base 9 | exposed-modules: MyModule 10 | -------------------------------------------------------------------------------- /shelltest/browse/cabal/browse-cabal.test: -------------------------------------------------------------------------------- 1 | ../browse-project.testtpl -------------------------------------------------------------------------------- /shelltest/browse/plain/MyModule.hs: -------------------------------------------------------------------------------- 1 | ../MyModule.hs -------------------------------------------------------------------------------- /shelltest/browse/plain/browse-plain.test: -------------------------------------------------------------------------------- 1 | # # TODO: make this work 2 | # cabal exec -- ghc-mod browse MyModule 3 | # >>> 4 | # >>>= !0 5 | -------------------------------------------------------------------------------- /shelltest/browse/sandbox/MyModule.hs: -------------------------------------------------------------------------------- 1 | ../MyModule.hs -------------------------------------------------------------------------------- /shelltest/browse/sandbox/browse-sandbox.test: -------------------------------------------------------------------------------- 1 | # # TODO: make this work 2 | # cabal exec -- ghc-mod browse MyModule 3 | # >>> 4 | # >>>= !0 5 | -------------------------------------------------------------------------------- /shelltest/browse/sandbox/test-setup.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | rm cabal.sandbox.config 6 | rm -r .cabal-sandbox 7 | 8 | cabal sandbox init 9 | -------------------------------------------------------------------------------- /shelltest/version.test: -------------------------------------------------------------------------------- 1 | cabal exec -- ghc-mod version 2 | >>> /^ghc-mod version [0-9.]+ compiled by GHC [0-9.]+/ 3 | >>>= 0 4 | 5 | cabal exec -- ghc-mod --version 6 | >>> /^ghc-mod version [0-9.]+ compiled by GHC [0-9.]+/ 7 | >>>= 0 8 | -------------------------------------------------------------------------------- /src/GhcMod/Exe/Options.hs: -------------------------------------------------------------------------------- 1 | -- ghc-mod: Happy Haskell Hacking 2 | -- Copyright (C) 2015 Nikolay Yakimov 3 | -- 4 | -- This program is free software: you can redistribute it and/or modify 5 | -- it under the terms of the GNU Affero General Public License as published by 6 | -- the Free Software Foundation, either version 3 of the License, or 7 | -- (at your option) any later version. 8 | -- 9 | -- This program is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | -- GNU Affero General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Affero General Public License 15 | -- along with this program. If not, see . 16 | {-# LANGUAGE OverloadedStrings #-} 17 | {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} 18 | 19 | module GhcMod.Exe.Options ( 20 | parseArgs, 21 | parseArgsInteractive, 22 | GhcModCommands(..) 23 | ) where 24 | 25 | import Options.Applicative 26 | import Options.Applicative.Types 27 | 28 | import GhcMod.Exe.Options.Commands 29 | import GhcMod.Exe.Options.ShellParse 30 | import GhcMod.Exe.Version 31 | import GhcMod.Options.DocUtils 32 | import GhcMod.Options.Options 33 | import GhcMod.Types 34 | 35 | parseArgs :: IO (Options, GhcModCommands) 36 | parseArgs = 37 | execParser opts 38 | where 39 | opts = info (argAndCmdSpec <**> helpVersion) 40 | $$ fullDesc 41 | <=> header "ghc-mod: Happy Haskell Hacking" 42 | 43 | parseArgsInteractive :: String -> Either String GhcModCommands 44 | parseArgsInteractive args = 45 | handle $ execParserPure (prefs idm) opts $ parseCmdLine args 46 | where 47 | opts = info interactiveCommandsSpec $$ fullDesc 48 | handle (Success a) = Right a 49 | handle (Failure failure) = 50 | Left $ fst $ renderFailure failure "" 51 | handle _ = Left "Completion invoked" 52 | 53 | helpVersion :: Parser (a -> a) 54 | helpVersion = 55 | helper 56 | <*> abortOption (InfoMsg ghcModVersion) 57 | $$ long "version" 58 | <=> help "Print the version of the program." 59 | <*> argument r 60 | $$ value id 61 | <=> metavar "" 62 | where 63 | r :: ReadM (a -> a) 64 | r = do 65 | v <- readerAsk 66 | readerAbort $ case v of 67 | "help" -> ShowHelpText 68 | "version" -> InfoMsg ghcModVersion 69 | _ -> UnexpectedError v (SomeParser argAndCmdSpec) 70 | 71 | argAndCmdSpec :: Parser (Options, GhcModCommands) 72 | argAndCmdSpec = (,) <$> globalArgSpec <*> commandsSpec 73 | -------------------------------------------------------------------------------- /src/GhcMod/Exe/Options/ShellParse.hs: -------------------------------------------------------------------------------- 1 | -- ghc-mod: Happy Haskell Hacking 2 | -- Copyright (C) 2015 Nikolay Yakimov 3 | -- 4 | -- This program is free software: you can redistribute it and/or modify 5 | -- it under the terms of the GNU Affero General Public License as published by 6 | -- the Free Software Foundation, either version 3 of the License, or 7 | -- (at your option) any later version. 8 | -- 9 | -- This program is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | -- GNU Affero General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Affero General Public License 15 | -- along with this program. If not, see . 16 | module GhcMod.Exe.Options.ShellParse (parseCmdLine) where 17 | 18 | import Data.Char 19 | import Data.List 20 | 21 | go :: String -> String -> [String] -> Bool -> [String] 22 | -- result 23 | go [] curarg accargs _ = reverse $ reverse curarg : accargs 24 | go (c:cl) curarg accargs quotes 25 | -- open quotes 26 | | c == '\STX', not quotes 27 | = go cl curarg accargs True 28 | -- close quotes 29 | | c == '\ETX', quotes 30 | = go cl curarg accargs False 31 | -- space separates arguments outside quotes 32 | | isSpace c, not quotes 33 | = if null curarg 34 | then go cl curarg accargs quotes 35 | else go cl [] (reverse curarg : accargs) quotes 36 | -- general character 37 | | otherwise = go cl (c:curarg) accargs quotes 38 | 39 | parseCmdLine :: String -> [String] 40 | parseCmdLine comline' 41 | | Just comline <- stripPrefix "ascii-escape " $ dropWhile isSpace comline' 42 | = go (dropWhile isSpace comline) [] [] False 43 | parseCmdLine [] = [""] 44 | parseCmdLine comline = words comline 45 | -------------------------------------------------------------------------------- /src/GhcMod/Exe/Version.hs: -------------------------------------------------------------------------------- 1 | -- ghc-mod: Happy Haskell Hacking 2 | -- Copyright (C) 2015 Nikolay Yakimov 3 | -- 4 | -- This program is free software: you can redistribute it and/or modify 5 | -- it under the terms of the GNU Affero General Public License as published by 6 | -- the Free Software Foundation, either version 3 of the License, or 7 | -- (at your option) any later version. 8 | -- 9 | -- This program is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | -- GNU Affero General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Affero General Public License 15 | -- along with this program. If not, see . 16 | 17 | module GhcMod.Exe.Version where 18 | 19 | import Paths_ghc_mod 20 | import Data.Version (showVersion) 21 | import Config (cProjectVersion) 22 | 23 | progVersion :: String -> String 24 | progVersion pf = 25 | "ghc-mod"++pf++" version " ++ showVersion version ++ " compiled by GHC " 26 | ++ cProjectVersion 27 | 28 | ghcModVersion :: String 29 | ghcModVersion = progVersion "" 30 | 31 | ghcModiVersion :: String 32 | ghcModiVersion = progVersion "i" 33 | -------------------------------------------------------------------------------- /src/GhcModi.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | 3 | -- | WARNING 4 | -- This program is deprecated, use `ghc-mod legacy-interactive` instead. 5 | 6 | module Main where 7 | 8 | import Control.Applicative 9 | import Control.Monad 10 | import Control.Exception 11 | import Data.Version 12 | import Data.Maybe 13 | import System.IO 14 | import System.Exit 15 | import System.Process 16 | import System.FilePath 17 | import System.Environment 18 | import Paths_ghc_mod 19 | import Utils 20 | import Prelude 21 | 22 | main :: IO () 23 | main = do 24 | hPutStrLn stderr $ 25 | "Warning: ghc-modi is deprecated please use 'ghc-mod legacy-interactive' instead" 26 | 27 | args <- getArgs 28 | bindir <- getBinDir 29 | let installedExe = bindir "ghc-mod" 30 | mexe <- mplus <$> mightExist installedExe <*> pathExe 31 | case mexe of 32 | Nothing -> do 33 | hPutStrLn stderr $ 34 | "ghc-modi: Could not find '"++installedExe++"', check your installation!" 35 | exitWith $ ExitFailure 1 36 | 37 | Just exe -> do 38 | (_, _, _, h) <- 39 | createProcess $ proc exe $ ["legacy-interactive"] ++ args 40 | exitWith =<< waitForProcess h 41 | 42 | pathExe :: IO (Maybe String) 43 | pathExe = do 44 | ev <- try $ words <$> readProcess "ghc-mod" ["--version"] "" 45 | let mexe = case ev of 46 | Left (SomeException _) -> Nothing 47 | Right ["ghc-mod", "version", ver 48 | , "compiled", "by", "GHC", _] 49 | | showVersion version == ver -> do 50 | Just "ghc-mod" 51 | Right _ -> Nothing 52 | 53 | when (isNothing mexe) $ 54 | hPutStrLn stderr "ghc-modi: ghc-mod executable on PATH has different version, check your installation!" 55 | return mexe 56 | -------------------------------------------------------------------------------- /test-elisp/inp.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | test1 :: Int 4 | 5 | test2 :: a -> a -> Complex a 6 | test2 = (:+) 7 | 8 | test25 :: NFData a => a 9 | test25 = undefined 10 | 11 | test3 :: (b -> b -> c) -> (a -> b) -> a -> a -> c 12 | test3 = on 13 | 14 | test4 = putStrLn "Bar" 15 | 16 | test5 :: [t] -> () 17 | test5 (_:_) = () 18 | 19 | -- hlint 20 | test6 :: [Integer] -> [Integer] 21 | test6 = map (+ 1) . map (* 2) 22 | -------------------------------------------------------------------------------- /test-elisp/out.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Control.DeepSeq (NFData) 4 | import Data.Complex (Complex((:+))) 5 | import Data.Function (on) 6 | 7 | test1 :: Int 8 | test1 = undefined 9 | 10 | test2 :: a -> a -> Complex a 11 | test2 = (:+) 12 | 13 | test25 :: NFData a => a 14 | test25 = undefined 15 | 16 | test3 :: (b -> b -> c) -> (a -> b) -> a -> a -> c 17 | test3 = on 18 | 19 | test4 :: IO () 20 | test4 = putStrLn "Bar" 21 | 22 | test5 :: [t] -> () 23 | test5 (_:_) = () 24 | test5 _ = error "test5" 25 | 26 | -- hlint 27 | test6 :: [Integer] -> [Integer] 28 | test6 = map ((+ 1) . (* 2)) 29 | -------------------------------------------------------------------------------- /test/BrowseSpec.hs: -------------------------------------------------------------------------------- 1 | module BrowseSpec where 2 | 3 | import Control.Applicative 4 | import GhcMod 5 | import Test.Hspec 6 | import Prelude 7 | 8 | import TestUtils 9 | import Dir 10 | 11 | spec :: Spec 12 | spec = do 13 | describe "browse Data.Map" $ do 14 | it "contains at least `differenceWithKey'" $ do 15 | syms <- runD $ lines <$> browse defaultBrowseOpts "Data.Map" 16 | syms `shouldContain` ["differenceWithKey"] 17 | 18 | describe "browse -d Data.Either" $ do 19 | it "contains functions (e.g. `either') including their type signature" $ do 20 | syms <- runD 21 | $ lines <$> browse defaultBrowseOpts{ optBrowseDetailed = True } "Data.Either" 22 | syms `shouldContain` ["either :: (a -> c) -> (b -> c) -> Either a b -> c"] 23 | 24 | it "contains type constructors (e.g. `Left') including their type signature" $ do 25 | syms <- runD 26 | $ lines <$> browse defaultBrowseOpts{ optBrowseDetailed = True } "Data.Either" 27 | syms `shouldContain` ["Left :: a -> Either a b"] 28 | 29 | describe "`browse' in a project directory" $ do 30 | it "can list symbols defined in a a local module" $ do 31 | withDirectory_ "test/data/ghc-mod-check/" $ do 32 | syms <- runD $ lines <$> browse defaultBrowseOpts "Data.Foo" 33 | syms `shouldContain` ["foo"] 34 | syms `shouldContain` ["fibonacci"] 35 | -------------------------------------------------------------------------------- /test/CabalHelperSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module CabalHelperSpec where 3 | 4 | import Control.Arrow 5 | import Control.Applicative 6 | import Data.Char 7 | import Data.List 8 | import Data.List.Split (splitOn) 9 | import Distribution.Helper hiding ( (<.>) ) 10 | import GhcMod.CabalHelper 11 | import GhcMod.PathsAndFiles 12 | import GhcMod.Error 13 | import Test.Hspec 14 | import System.Directory 15 | import System.FilePath 16 | import System.Process 17 | import Prelude 18 | 19 | import Dir 20 | import TestUtils 21 | 22 | import Config (cProjectVersionInt) 23 | 24 | ghcVersion :: Int 25 | ghcVersion = read cProjectVersionInt 26 | 27 | gmeProcessException :: GhcModError -> Bool 28 | gmeProcessException GMEProcess {} = True 29 | gmeProcessException _ = False 30 | 31 | pkgOptions :: [String] -> [String] 32 | pkgOptions [] = [] 33 | pkgOptions (_:[]) = [] 34 | pkgOptions (x:y:xs) | x == "-package-id" = [pkgName y] ++ pkgOptions xs 35 | | otherwise = pkgOptions (y:xs) 36 | 37 | 38 | pkgName :: String -> String 39 | pkgName n = intercalate "-" $ reverse $ 40 | case reverse $ splitOn "-" n of 41 | hash : ver : rest@(_:_) | isHash hash, isVer ver -> rest 42 | ver : rest@(_:_) | isVer ver -> rest 43 | rest -> rest 44 | where 45 | isHash = all isAlphaNum 46 | isVer = all (`elem` "1234567890.") 47 | 48 | idirOpts :: [(c, [String])] -> [(c, [String])] 49 | idirOpts = map (second $ map (drop 2) . filter ("-i"`isPrefixOf`)) 50 | 51 | spec :: Spec 52 | spec = do 53 | describe "getComponents" $ do 54 | it "throws an exception if the cabal file is broken" $ do 55 | let tdir = "test/data/broken-cabal" 56 | runD' tdir getComponents `shouldThrow` anyIOException 57 | 58 | it "handles sandboxes correctly" $ do 59 | let tdir = "test/data/cabal-project" 60 | cwd <- getCurrentDirectory 61 | 62 | -- TODO: ChSetupHsName should also have sandbox stuff, see related 63 | -- comment in cabal-helper 64 | opts <- map gmcGhcOpts . filter ((/= ChSetupHsName) . gmcName) <$> runD' tdir getComponents 65 | 66 | bp <- buildPlatform readProcess 67 | if ghcVersion < 706 68 | then forM_ opts (\o -> o `shouldContain` ["-no-user-package-conf","-package-conf", cwd "test/data/cabal-project/.cabal-sandbox/"++ghcSandboxPkgDbDir bp]) 69 | else forM_ opts (\o -> o `shouldContain` ["-no-user-package-db","-package-db",cwd "test/data/cabal-project/.cabal-sandbox/"++ghcSandboxPkgDbDir bp]) 70 | 71 | #if !MIN_VERSION_ghc(7,8,0) 72 | it "handles stack project" $ do 73 | let tdir = "test/data/stack-project" 74 | [ghcOpts] <- map gmcGhcOpts . filter ((==ChExeName "new-template-exe") . gmcName) <$> runD' tdir getComponents 75 | let pkgs = sort $ pkgOptions ghcOpts 76 | pkgs `shouldBe` ["base", "bytestring"] 77 | #endif 78 | 79 | it "extracts build dependencies" $ do 80 | let tdir = "test/data/cabal-project" 81 | opts <- map gmcGhcOpts <$> runD' tdir getComponents 82 | let ghcOpts:_ = opts 83 | pkgs = sort $ pkgOptions ghcOpts 84 | pkgs `shouldBe` ["Cabal","base","template-haskell"] 85 | 86 | it "uses non default flags and preserves them across reconfigures" $ do 87 | let tdir = "test/data/cabal-flags" 88 | _ <- withDirectory_ tdir $ 89 | readProcess "cabal" ["configure", "-ftest-flag"] "" 90 | 91 | let test = do 92 | opts <- map gmcGhcOpts <$> runD' tdir getComponents 93 | let ghcOpts = head opts 94 | pkgs = sort $ pkgOptions ghcOpts 95 | pkgs `shouldBe` ["Cabal","base"] 96 | 97 | test 98 | 99 | touch $ tdir "cabal-flags.cabal" 100 | 101 | test 102 | 103 | touch :: FilePath -> IO () 104 | touch fn = do 105 | f <- readFile fn 106 | writeFile (fn <.> "tmp") f 107 | renameFile (fn <.> "tmp") fn 108 | -------------------------------------------------------------------------------- /test/CaseSplitSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module CaseSplitSpec where 3 | 4 | import GhcMod 5 | import Test.Hspec 6 | import TestUtils 7 | import Dir 8 | 9 | main :: IO () 10 | main = do 11 | hspec spec 12 | 13 | spec :: Spec 14 | spec = do 15 | describe "case split" $ do 16 | #if __GLASGOW_HASKELL__ >= 708 17 | it "does not blow up on HsWithBndrs panic" $ do 18 | withDirectory_ "test/data/case-split" $ do 19 | res <- runD $ splits "Vect.hs" 24 10 20 | res `shouldBe` "24 1 24 30"++ 21 | " \"mlAppend Nil y = _mlAppend_body\NUL"++ 22 | "mlAppend (Cons x1 x2) y = _mlAppend_body\"\n" 23 | 24 | it "works with case expressions" $ do 25 | withDirectory_ "test/data/case-split" $ do 26 | res <- runD $ splits "Vect.hs" 28 20 27 | res `shouldBe` "28 19 28 39"++ 28 | " \"Nil -> _mlAppend_body\NUL"++ 29 | " (Cons x'1 x'2) -> _mlAppend_body\"\n" 30 | 31 | it "works with where clauses" $ do 32 | withDirectory_ "test/data/case-split" $ do 33 | res <- runD $ splits "Vect.hs" 34 17 34 | res `shouldBe` "34 5 34 43"++ 35 | " \"mlReverse' Nil accum = _mlReverse_body\NUL"++ 36 | " mlReverse' (Cons xs'1 xs'2) accum = _mlReverse_body\"\n" 37 | 38 | it "works with let bindings" $ do 39 | withDirectory_ "test/data/case-split" $ do 40 | res <- runD $ splits "Vect.hs" 38 33 41 | res `shouldBe` "38 21 38 59"++ 42 | " \"mlReverse' Nil accum = _mlReverse_body\NUL"++ 43 | " mlReverse' (Cons xs'1 xs'2) accum = _mlReverse_body\"\n" 44 | #else 45 | it "does not blow up on HsWithBndrs panic" $ do 46 | withDirectory_ "test/data/case-split" $ do 47 | res <- runD $ splits "Vect706.hs" 24 10 48 | res `shouldBe` "24 1 24 25"++ 49 | " \"mlAppend Nil y = undefined\NUL"++ 50 | "mlAppend (Cons x1 x2) y = undefined\"\n" 51 | 52 | it "works with case expressions" $ do 53 | withDirectory_ "test/data/case-split" $ do 54 | res <- runD $ splits "Vect706.hs" 28 20 55 | res `shouldBe` "28 19 28 34"++ 56 | " \"Nil -> undefined\NUL"++ 57 | " (Cons x'1 x'2) -> undefined\"\n" 58 | 59 | it "works with where clauses" $ do 60 | withDirectory_ "test/data/case-split" $ do 61 | res <- runD $ splits "Vect706.hs" 34 17 62 | res `shouldBe` "34 5 34 37"++ 63 | " \"mlReverse' Nil accum = undefined\NUL"++ 64 | " mlReverse' (Cons xs'1 xs'2) accum = undefined\"\n" 65 | 66 | it "works with let bindings" $ do 67 | withDirectory_ "test/data/case-split" $ do 68 | res <- runD $ splits "Vect706.hs" 38 33 69 | res `shouldBe` "38 21 38 53"++ 70 | " \"mlReverse' Nil accum = undefined\NUL"++ 71 | " mlReverse' (Cons xs'1 xs'2) accum = undefined\"\n" 72 | 73 | #endif 74 | it "doesn't crash when source doesn't make sense" $ 75 | withDirectory_ "test/data/case-split" $ do 76 | res <- runD $ splits "Crash.hs" 4 6 77 | #if __GLASGOW_HASKELL__ < 710 78 | res `shouldBe` "4 1 4 19 \"test x = undefined\"\n" 79 | #else 80 | res `shouldBe` "" 81 | #endif 82 | -------------------------------------------------------------------------------- /test/CheckSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module CheckSpec where 3 | 4 | import GhcMod 5 | 6 | import Data.List 7 | import System.Process 8 | import Test.Hspec 9 | 10 | import TestUtils 11 | import Dir 12 | 13 | spec :: Spec 14 | spec = do 15 | describe "checkSyntax" $ do 16 | it "works even if an executable depends on the library defined in the same cabal file" $ do 17 | withDirectory_ "test/data/ghc-mod-check" $ do 18 | res <- runD $ checkSyntax ["main.hs"] 19 | res `shouldBe` "main.hs:5:1:Warning: Top-level binding with no type signature: main :: IO ()\n" 20 | 21 | 22 | it "works even if a module imports another module from a different directory" $ do 23 | withDirectory_ "test/data/check-test-subdir" $ do 24 | _ <- system "cabal configure --enable-tests" 25 | res <- runD $ checkSyntax ["test/Bar/Baz.hs"] 26 | res `shouldSatisfy` (("test" "Foo.hs:3:1:Warning: Top-level binding with no type signature: foo :: [Char]\n") `isSuffixOf`) 27 | 28 | it "detects cyclic imports" $ do 29 | withDirectory_ "test/data/import-cycle" $ do 30 | res <- runD $ checkSyntax ["Mutual1.hs"] 31 | res `shouldSatisfy` ("Module imports form a cycle" `isInfixOf`) 32 | 33 | it "works with modules using QuasiQuotes" $ do 34 | withDirectory_ "test/data/quasi-quotes" $ do 35 | res <- runD $ checkSyntax ["QuasiQuotes.hs"] 36 | res `shouldSatisfy` ("QuasiQuotes.hs:6:1:Warning:" `isInfixOf`) 37 | 38 | #if __GLASGOW_HASKELL__ >= 708 39 | it "works with modules using PatternSynonyms" $ do 40 | withDirectory_ "test/data/pattern-synonyms" $ do 41 | res <- runD $ checkSyntax ["B.hs"] 42 | res `shouldSatisfy` ("B.hs:6:9:Warning:" `isPrefixOf`) 43 | #endif 44 | 45 | it "works with foreign exports" $ do 46 | withDirectory_ "test/data/foreign-export" $ do 47 | res <- runD $ checkSyntax ["ForeignExport.hs"] 48 | res `shouldBe` "" 49 | 50 | context "when no errors are found" $ do 51 | it "doesn't output an empty line" $ do 52 | withDirectory_ "test/data/ghc-mod-check/lib/Data" $ do 53 | res <- runD $ checkSyntax ["Foo.hs"] 54 | res `shouldBe` "" 55 | 56 | #if __GLASGOW_HASKELL__ >= 708 57 | -- See https://github.com/kazu-yamamoto/ghc-mod/issues/507 58 | it "emits warnings generated in GHC's desugar stage" $ do 59 | withDirectory_ "test/data/check-missing-warnings" $ do 60 | res <- runD $ checkSyntax ["DesugarWarnings.hs"] 61 | res `shouldSatisfy` ("DesugarWarnings.hs:4:9:Warning: Pattern match(es) are non-exhaustive\NULIn a case alternative: Patterns not matched:" `isPrefixOf`) 62 | #endif 63 | 64 | it "works with cabal builtin preprocessors" $ do 65 | withDirectory_ "test/data/cabal-preprocessors" $ do 66 | _ <- system "cabal clean" 67 | _ <- system "cabal build" 68 | res <- runD $ checkSyntax ["Main.hs"] 69 | res `shouldBe` "Preprocessed.hsc:3:1:Warning: Top-level binding with no type signature: warning :: ()\n" 70 | 71 | it "Uses the right qualification style" $ do 72 | withDirectory_ "test/data/nice-qualification" $ do 73 | res <- runD $ checkSyntax ["NiceQualification.hs"] 74 | #if __GLASGOW_HASKELL__ >= 800 75 | res `shouldBe` "NiceQualification.hs:4:8:\8226 Couldn't match expected type \8216IO ()\8217 with actual type \8216[Char]\8217\NUL\8226 In the expression: \"wrong type\"\NUL In an equation for \8216main\8217: main = \"wrong type\"\n" 76 | #elif __GLASGOW_HASKELL__ >= 708 77 | res `shouldBe` "NiceQualification.hs:4:8:Couldn't match expected type \8216IO ()\8217 with actual type \8216[Char]\8217\NULIn the expression: \"wrong type\"\NULIn an equation for \8216main\8217: main = \"wrong type\"\n" 78 | #else 79 | res `shouldBe` "NiceQualification.hs:4:8:Couldn't match expected type `IO ()' with actual type `[Char]'\NULIn the expression: \"wrong type\"\NULIn an equation for `main': main = \"wrong type\"\n" 80 | #endif 81 | -------------------------------------------------------------------------------- /test/CradleSpec.hs: -------------------------------------------------------------------------------- 1 | module CradleSpec where 2 | 3 | import Control.Applicative 4 | import Data.List (isSuffixOf) 5 | import GhcMod.Cradle 6 | import GhcMod.Types 7 | import System.Directory (canonicalizePath) 8 | import System.FilePath (pathSeparator) 9 | import Test.Hspec 10 | import TestUtils 11 | import Prelude 12 | 13 | import Dir 14 | 15 | clean_ :: IO Cradle -> IO Cradle 16 | clean_ f = do 17 | crdl <- f 18 | cleanupCradle crdl 19 | return crdl 20 | 21 | relativeCradle :: FilePath -> Cradle -> Cradle 22 | relativeCradle dir crdl = crdl { 23 | cradleCurrentDir = toRelativeDir dir $ cradleCurrentDir crdl 24 | , cradleRootDir = toRelativeDir dir $ cradleRootDir crdl 25 | , cradleCabalFile = toRelativeDir dir <$> cradleCabalFile crdl 26 | } 27 | 28 | -- Work around GHC 7.2.2 where `canonicalizePath "/"` returns "/.". 29 | stripLastDot :: FilePath -> FilePath 30 | stripLastDot path 31 | | (pathSeparator:'.':"") `isSuffixOf` path = init path 32 | | otherwise = path 33 | 34 | spec :: Spec 35 | spec = do 36 | describe "findCradle" $ do 37 | it "returns the current directory" $ do 38 | withDirectory_ "/" $ do 39 | curDir <- stripLastDot <$> canonicalizePath "/" 40 | res <- clean_ $ runGmOutDef $ findCradleNoLog $ optPrograms defaultOptions 41 | cradleCurrentDir res `shouldBe` curDir 42 | cradleRootDir res `shouldBe` curDir 43 | cradleCabalFile res `shouldBe` Nothing 44 | 45 | it "finds a cabal file and a sandbox" $ do 46 | withDirectory "test/data/cabal-project/subdir1/subdir2" $ \dir -> do 47 | res <- relativeCradle dir <$> clean_ (runGmOutDef $ findCradleNoLog $ optPrograms defaultOptions) 48 | 49 | cradleCurrentDir res `shouldBe` 50 | "test/data/cabal-project/subdir1/subdir2" 51 | 52 | cradleRootDir res `shouldBe` "test/data/cabal-project" 53 | 54 | cradleCabalFile res `shouldBe` 55 | Just ("test/data/cabal-project/cabalapi.cabal") 56 | 57 | it "works even if a sandbox config file is broken" $ do 58 | withDirectory "test/data/broken-sandbox" $ \dir -> do 59 | res <- relativeCradle dir <$> clean_ (runGmOutDef $ findCradleNoLog $ optPrograms defaultOptions) 60 | cradleCurrentDir res `shouldBe` 61 | "test" "data" "broken-sandbox" 62 | 63 | cradleRootDir res `shouldBe` 64 | "test" "data" "broken-sandbox" 65 | 66 | cradleCabalFile res `shouldBe` 67 | Just ("test" "data" "broken-sandbox" "dummy.cabal") 68 | -------------------------------------------------------------------------------- /test/CustomPackageDbSpec.hs: -------------------------------------------------------------------------------- 1 | module CustomPackageDbSpec where 2 | 3 | import GhcMod.CabalHelper 4 | import GhcMod.CustomPackageDb 5 | import GhcMod.Error 6 | import System.Process 7 | import Test.Hspec 8 | import Prelude 9 | 10 | import Dir 11 | import TestUtils 12 | 13 | spec :: Spec 14 | spec = do 15 | describe "getCustomPkgDbStack" $ do 16 | it "works" $ do 17 | let tdir = "test/data/custom-cradle" 18 | Just stack <- runD' tdir $ getCustomPkgDbStack 19 | stack `shouldBe` [ GlobalDb 20 | , UserDb 21 | , PackageDb "package-db-a" 22 | , PackageDb "package-db-b" 23 | , PackageDb "package-db-c" 24 | ] 25 | 26 | describe "getPackageDbStack'" $ do 27 | it "fixes out of sync custom pkg-db stack" $ do 28 | withDirectory_ "test/data/custom-cradle" $ do 29 | _ <- system "cabal configure" 30 | (s, s') <- runD $ do 31 | Just stack <- getCustomPkgDbStack 32 | withCabal $ do 33 | stack' <- getCabalPackageDbStack 34 | return (stack, stack') 35 | s' `shouldBe` s 36 | -------------------------------------------------------------------------------- /test/Dir.hs: -------------------------------------------------------------------------------- 1 | module Dir ( 2 | module Dir 3 | , getCurrentDirectory 4 | , () 5 | ) where 6 | 7 | import Control.Exception as E 8 | import Data.List (isPrefixOf) 9 | import System.Directory 10 | import System.FilePath (addTrailingPathSeparator,()) 11 | 12 | 13 | 14 | withDirectory_ :: FilePath -> IO a -> IO a 15 | withDirectory_ dir action = bracket getCurrentDirectory 16 | setCurrentDirectory 17 | (\_ -> setCurrentDirectory dir >> action) 18 | 19 | withDirectory :: FilePath -> (FilePath -> IO a) -> IO a 20 | withDirectory dir action = bracket getCurrentDirectory 21 | setCurrentDirectory 22 | (\d -> setCurrentDirectory dir >> action d) 23 | 24 | toRelativeDir :: FilePath -> FilePath -> FilePath 25 | toRelativeDir dir file 26 | | dir' `isPrefixOf` file = drop len file 27 | | otherwise = file 28 | where 29 | dir' = addTrailingPathSeparator dir 30 | len = length dir' 31 | -------------------------------------------------------------------------------- /test/FindSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module FindSpec where 3 | 4 | import GhcMod.Exe.Find 5 | import Test.Hspec 6 | import TestUtils 7 | import Dir 8 | 9 | spec :: Spec 10 | spec = do 11 | describe "db <- loadSymbolDb" $ do 12 | it "lookupSymbol' db \"head\" contains at least `Data.List'" $ do 13 | withDirectory_ "test/data/ghc-mod-check" $ do 14 | db <- runD $ loadSymbolDb 15 | lookupSym "head" db `shouldContain` [ModuleString "Data.List"] 16 | -------------------------------------------------------------------------------- /test/FlagSpec.hs: -------------------------------------------------------------------------------- 1 | module FlagSpec where 2 | 3 | import Control.Applicative 4 | import GhcMod 5 | import Test.Hspec 6 | import TestUtils 7 | import Prelude 8 | 9 | spec :: Spec 10 | spec = do 11 | describe "flags" $ do 12 | it "contains at least `-fprint-explicit-foralls" $ do 13 | f <- runD $ lines <$> flags 14 | f `shouldContain` ["-fprint-explicit-foralls"] 15 | -------------------------------------------------------------------------------- /test/GhcPkgSpec.hs: -------------------------------------------------------------------------------- 1 | module GhcPkgSpec where 2 | 3 | import GhcMod.GhcPkg 4 | import GhcMod.CabalHelper 5 | import GhcMod.CustomPackageDb 6 | import Test.Hspec 7 | import System.Process (system) 8 | 9 | import Dir 10 | import TestUtils 11 | 12 | spec :: Spec 13 | spec = do 14 | describe "getPackageDbStack'" $ do 15 | it "fixes out of sync custom pkg-db stack" $ do 16 | withDirectory_ "test/data/custom-cradle" $ do 17 | _ <- system "cabal configure" 18 | (s, s') <- runD $ do 19 | Just stack <- getCustomPkgDbStack 20 | withCabal $ do 21 | stack' <- getPackageDbStack 22 | return (stack, stack') 23 | s' `shouldBe` s 24 | -------------------------------------------------------------------------------- /test/InfoSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module InfoSpec where 3 | 4 | import Control.Applicative 5 | import Data.List (isPrefixOf) 6 | import GhcMod 7 | #if __GLASGOW_HASKELL__ < 706 8 | import System.Environment.Executable (getExecutablePath) 9 | #else 10 | import System.Environment (getExecutablePath) 11 | #endif 12 | import System.FilePath 13 | import Test.Hspec 14 | import TestUtils 15 | import Prelude 16 | 17 | spec :: Spec 18 | spec = do 19 | describe "types" $ do 20 | it "shows types of the expression and its outers" $ do 21 | let tdir = "test/data/ghc-mod-check" 22 | res <- runD' tdir $ types False "lib/Data/Foo.hs" 9 5 23 | #if __GLASGOW_HASKELL__ >= 800 24 | res `shouldBe` "9 5 11 40 \"Int -> t -> t -> t\"\n7 1 11 40 \"Int -> Integer\"\n" 25 | #else 26 | res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n" 27 | #endif 28 | 29 | 30 | it "shows types of the expression with constraints and its outers" $ do 31 | let tdir = "test/data/ghc-mod-check" 32 | res <- runD' tdir $ types True "lib/Data/Foo.hs" 9 5 33 | #if __GLASGOW_HASKELL__ >= 800 34 | res `shouldBe` "9 5 11 40 \"Num t => Int -> t -> t -> t\"\n7 1 11 40 \"Int -> Integer\"\n" 35 | #else 36 | res `shouldBe` "9 5 11 40 \"Num a => Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n" 37 | #endif 38 | 39 | it "works with a module using TemplateHaskell" $ do 40 | let tdir = "test/data/template-haskell" 41 | res <- runD' tdir $ types False "Bar.hs" 5 1 42 | res `shouldBe` unlines ["5 1 5 20 \"[Char]\""] 43 | 44 | it "works with a module that imports another module using TemplateHaskell" $ do 45 | let tdir = "test/data/template-haskell" 46 | res <- runD' tdir $ types False "ImportsTH.hs" 3 8 47 | res `shouldBe` unlines ["3 8 3 16 \"String -> IO ()\"", "3 8 3 20 \"IO ()\"", "3 1 3 20 \"IO ()\""] 48 | 49 | describe "info" $ do 50 | it "works for non exported functions" $ do 51 | let tdir = "test/data/non-exported" 52 | res <- runD' tdir $ info "Fib.hs" $ Expression "fib" 53 | res `shouldSatisfy` ("fib :: Int -> Int" `isPrefixOf`) 54 | 55 | it "works with a module using TemplateHaskell" $ do 56 | let tdir = "test/data/template-haskell" 57 | res <- runD' tdir $ info "Bar.hs" $ Expression "foo" 58 | res `shouldSatisfy` ("foo :: ExpQ" `isPrefixOf`) 59 | 60 | it "works with a module that imports another module using TemplateHaskell" $ do 61 | let tdir = "test/data/template-haskell" 62 | res <- runD' tdir $ info "ImportsTH.hs" $ Expression "bar" 63 | res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`) 64 | 65 | getDistDir :: IO FilePath 66 | getDistDir = takeDirectory . takeDirectory . takeDirectory <$> getExecutablePath 67 | -------------------------------------------------------------------------------- /test/LangSpec.hs: -------------------------------------------------------------------------------- 1 | module LangSpec where 2 | 3 | import Control.Applicative 4 | import GhcMod 5 | import Test.Hspec 6 | import TestUtils 7 | import Prelude 8 | 9 | spec :: Spec 10 | spec = do 11 | describe "languages" $ do 12 | it "contains at lest `OverloadedStrings'" $ do 13 | exts <- runD $ lines <$> languages 14 | exts `shouldContain` ["OverloadedStrings"] 15 | -------------------------------------------------------------------------------- /test/LintSpec.hs: -------------------------------------------------------------------------------- 1 | module LintSpec where 2 | 3 | import GhcMod 4 | import Test.Hspec 5 | import TestUtils 6 | 7 | spec :: Spec 8 | spec = do 9 | describe "lint" $ do 10 | it "can detect a redundant import" $ do 11 | res <- runD $ lint lintOpts "test/data/hlint/hlint.hs" 12 | res `shouldBe` "test/data/hlint/hlint.hs:4:8: Warning: Redundant do\NULFound:\NUL do putStrLn \"Hello, world!\"\NULWhy not:\NUL putStrLn \"Hello, world!\"\n" 13 | 14 | context "when no suggestions are given" $ do 15 | it "doesn't output an empty line" $ do 16 | res <- runD $ lint lintOpts "test/data/ghc-mod-check/lib/Data/Foo.hs" 17 | res `shouldBe` "" 18 | 19 | lintOpts :: LintOpts 20 | lintOpts = 21 | defaultLintOpts { optLintHlintOpts = ["--ignore=Use module export list"] } 22 | -------------------------------------------------------------------------------- /test/ListSpec.hs: -------------------------------------------------------------------------------- 1 | module ListSpec where 2 | 3 | import Control.Applicative 4 | import GhcMod 5 | import Test.Hspec 6 | import TestUtils 7 | import Prelude 8 | 9 | spec :: Spec 10 | spec = do 11 | describe "modules" $ do 12 | it "contains at least `Data.Map'" $ do 13 | mdls <- runD $ lines <$> modules False 14 | mdls `shouldContain` ["Data.Map"] 15 | -------------------------------------------------------------------------------- /test/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP, ScopedTypeVariables #-} 2 | import Dir 3 | 4 | import Control.Exception as E 5 | import Control.Monad (void) 6 | import GhcMod (debugInfo) 7 | import System.Process 8 | import System.Environment 9 | import Test.Hspec 10 | import TestUtils 11 | 12 | import qualified BrowseSpec 13 | import qualified CabalHelperSpec 14 | import qualified CaseSplitSpec 15 | import qualified CheckSpec 16 | import qualified CradleSpec 17 | import qualified CustomPackageDbSpec 18 | import qualified FileMappingSpec 19 | import qualified FindSpec 20 | import qualified FlagSpec 21 | import qualified GhcPkgSpec 22 | import qualified HomeModuleGraphSpec 23 | import qualified InfoSpec 24 | import qualified LangSpec 25 | import qualified LintSpec 26 | import qualified ListSpec 27 | import qualified MonadSpec 28 | import qualified PathsAndFilesSpec 29 | import qualified ShellParseSpec 30 | import qualified TargetSpec 31 | 32 | spec :: Spec 33 | spec = do 34 | describe "Browse" BrowseSpec.spec 35 | describe "CabalHelper" CabalHelperSpec.spec 36 | describe "CaseSplit" CaseSplitSpec.spec 37 | describe "Check" CheckSpec.spec 38 | describe "Cradle" CradleSpec.spec 39 | describe "CustomPackageDb" CustomPackageDbSpec.spec 40 | describe "FileMapping" FileMappingSpec.spec 41 | describe "Find" FindSpec.spec 42 | describe "Flag" FlagSpec.spec 43 | describe "GhcPkg" GhcPkgSpec.spec 44 | describe "HomeModuleGraph" HomeModuleGraphSpec.spec 45 | describe "Info" InfoSpec.spec 46 | describe "Lang" LangSpec.spec 47 | describe "Lint" LintSpec.spec 48 | describe "List" ListSpec.spec 49 | describe "Monad" MonadSpec.spec 50 | describe "PathsAndFiles" PathsAndFilesSpec.spec 51 | describe "ShellParse" ShellParseSpec.spec 52 | describe "Target" TargetSpec.spec 53 | 54 | main :: IO () 55 | main = do 56 | #if __GLASGOW_HASKELL__ >= 708 57 | unsetEnv "GHC_PACKAGE_PATH" 58 | #endif 59 | let sandboxes = [ "test/data/cabal-project" 60 | , "test/data/check-packageid" 61 | , "test/data/duplicate-pkgver/" 62 | , "test/data/broken-cabal/" 63 | ] 64 | genSandboxCfg dir = withDirectory dir $ \cwdir -> do 65 | system ("rm cabal.sandbox.config; cabal sandbox init") 66 | pkgDirs = 67 | [ "test/data/cabal-project/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d" 68 | , "test/data/check-packageid/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d" 69 | , "test/data/duplicate-pkgver/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"] 70 | genGhcPkgCache dir = system $ "ghc-pkg recache --force -f" ++ dir 71 | 72 | let cleanCmd = "git clean -dXf test/data/" 73 | putStrLn $ "$ " ++ cleanCmd 74 | void $ system cleanCmd 75 | void $ system "cabal --version" 76 | void $ system "ghc --version" 77 | 78 | genSandboxCfg `mapM_` sandboxes 79 | genGhcPkgCache `mapM_` pkgDirs 80 | 81 | let stackDir = "test/data/stack-project" 82 | void $ withDirectory_ stackDir $ do 83 | let ghcver = let gvn = show (__GLASGOW_HASKELL__ :: Int) 84 | (major, minor') = splitAt (length gvn - 2) gvn 85 | minor = case dropWhile (=='0') minor' of 86 | "" -> "0" 87 | x -> x 88 | in major ++ "." ++ minor 89 | void $ system $ "sed '$ a resolver: ghc-" ++ ghcver ++ "' stack.yaml.in > stack.yaml" 90 | void $ system "stack setup" 91 | void $ system "stack build" 92 | 93 | (putStrLn =<< runD debugInfo) 94 | `E.catch` (\(_ :: E.SomeException) -> return () ) 95 | 96 | hspec spec 97 | -------------------------------------------------------------------------------- /test/MonadSpec.hs: -------------------------------------------------------------------------------- 1 | module MonadSpec where 2 | 3 | import Test.Hspec 4 | import TestUtils 5 | import Control.Monad.Error.Class 6 | import Control.Concurrent 7 | import Control.Exception 8 | 9 | spec :: Spec 10 | spec = do 11 | describe "When using GhcModT in a do block" $ 12 | it "a pattern match failure causes a call to `fail` on ErrorT in the monad stack" $ do 13 | (a, _h) 14 | <- runGmOutDef $ runGhcModT defaultOptions $ 15 | do 16 | Just _ <- return Nothing 17 | return "hello" 18 | `catchError` (const $ fail "oh noes") 19 | a `shouldBe` (Left $ GMEString "oh noes") 20 | 21 | describe "runGhcModT" $ 22 | it "throws an exception when run in multiple threads" $ do 23 | 24 | mv_ex :: MVar (Either SomeException ()) 25 | <- newEmptyMVar 26 | mv_startup_barrier :: MVar () 27 | <- newEmptyMVar 28 | 29 | _t1 <- forkOS $ do 30 | -- wait (inside GhcModT) for t2 to receive the exception 31 | _ <- runD $ liftIO $ do 32 | putMVar mv_startup_barrier () 33 | readMVar mv_ex 34 | return () 35 | 36 | _t2 <- forkOS $ do 37 | readMVar mv_startup_barrier -- wait for t1 to be in GhcModT 38 | res <- try $ runD $ return () 39 | res' <- evaluate res 40 | putMVar mv_ex res' 41 | 42 | ex <- takeMVar mv_ex 43 | 44 | isLeft ex `shouldBe` True 45 | 46 | isLeft :: Either a b -> Bool 47 | isLeft (Right _) = False 48 | isLeft (Left _) = True 49 | -------------------------------------------------------------------------------- /test/PathsAndFilesSpec.hs: -------------------------------------------------------------------------------- 1 | module PathsAndFilesSpec where 2 | 3 | 4 | import GhcMod.PathsAndFiles 5 | import GhcMod.Cradle 6 | import qualified GhcMod.Utils as U 7 | 8 | import Control.Monad.Trans.Maybe 9 | import System.Directory 10 | import System.FilePath 11 | import Test.Hspec 12 | import TestUtils 13 | 14 | spec :: Spec 15 | spec = do 16 | describe "getSandboxDb" $ do 17 | it "can parse a config file and extract the sandbox package-db" $ do 18 | cwd <- getCurrentDirectory 19 | Just crdl <- runLogDef $ runMaybeT $ plainCradle "test/data/cabal-project" 20 | Just db <- getSandboxDb crdl 21 | db `shouldSatisfy` isPkgDbAt (cwd "test/data/cabal-project/.cabal-sandbox") 22 | 23 | it "returns Nothing if the sandbox config file is broken" $ do 24 | Just crdl <- runLogDef $ runMaybeT $ plainCradle "test/data/broken-sandbox" 25 | getSandboxDb crdl `shouldReturn` Nothing 26 | 27 | describe "findCabalFile" $ do 28 | it "works" $ do 29 | p <- U.makeAbsolute' "test/data/cabal-project/cabalapi.cabal" 30 | findCabalFile "test/data/cabal-project" `shouldReturn` Just p 31 | 32 | it "finds cabal files in parent directories" $ do 33 | p <- U.makeAbsolute' "test/data/cabal-project/cabalapi.cabal" 34 | findCabalFile "test/data/cabal-project/subdir1/subdir2" `shouldReturn` Just p 35 | 36 | describe "findStackConfigFile" $ do 37 | it "works" $ do 38 | p <- U.makeAbsolute' "test/data/stack-project/stack.yaml" 39 | findStackConfigFile "test/data/stack-project" `shouldReturn` Just p 40 | 41 | describe "findCabalSandboxDir" $ do 42 | it "works" $ do 43 | p <- U.makeAbsolute' "test/data/cabal-project" 44 | findCabalSandboxDir "test/data/cabal-project" `shouldReturn` Just p 45 | 46 | it "finds sandboxes in parent directories" $ do 47 | p <- U.makeAbsolute' "test/data/cabal-project" 48 | findCabalSandboxDir "test/data/cabal-project/subdir1/subdir2" `shouldReturn` Just p 49 | -------------------------------------------------------------------------------- /test/ShellParseSpec.hs: -------------------------------------------------------------------------------- 1 | module ShellParseSpec where 2 | 3 | 4 | import GhcMod.Exe.Options.ShellParse 5 | 6 | import Test.Hspec 7 | 8 | spec :: Spec 9 | spec = 10 | describe "parseCmdLine" $ do 11 | it "splits arguments" $ do 12 | parseCmdLine "test command line" `shouldBe` ["test", "command", "line"] 13 | parseCmdLine "ascii-escape test command line" `shouldBe` ["test", "command", "line"] 14 | it "honors quoted segments if turned on" $ 15 | parseCmdLine "ascii-escape test command line \STXwith quoted segment\ETX" 16 | `shouldBe` ["test", "command", "line", "with quoted segment"] 17 | it "doesn't honor quoted segments if turned off" $ 18 | parseCmdLine "test command line \STXwith quoted segment\ETX" 19 | `shouldBe` words "test command line \STXwith quoted segment\ETX" 20 | it "squashes multiple spaces" $ do 21 | parseCmdLine "test command" 22 | `shouldBe` ["test", "command"] 23 | parseCmdLine "ascii-escape test command" 24 | `shouldBe` ["test", "command"] 25 | it "ingores leading spaces" $ do 26 | parseCmdLine " test command" 27 | `shouldBe` ["test", "command"] 28 | parseCmdLine " ascii-escape test command" 29 | `shouldBe` ["test", "command"] 30 | it "parses empty string as no argument" $ do 31 | parseCmdLine "" 32 | `shouldBe` [""] 33 | parseCmdLine "ascii-escape " 34 | `shouldBe` [""] 35 | -------------------------------------------------------------------------------- /test/TargetSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module TargetSpec where 3 | 4 | import GhcMod.Target 5 | import GhcMod.LightGhc 6 | import GhcMod.Gap 7 | import Test.Hspec 8 | 9 | import TestUtils 10 | 11 | import GHC 12 | import Data.List 13 | import Data.Maybe 14 | import System.Directory 15 | import System.FilePath 16 | 17 | spec :: Spec 18 | spec = do 19 | describe "runLightGhc" $ do 20 | it "works at all" $ do 21 | withLightHscEnv [] $ \env -> 22 | runLightGhc env (return ()) `shouldReturn` () 23 | 24 | it "has modules in scope" $ do 25 | (withLightHscEnv [] $ \env -> 26 | runLightGhc env $ do 27 | dflags <- getSessionDynFlags 28 | let i = intersect (listVisibleModuleNames dflags) 29 | ["Control.Applicative", "Control.Arrow" 30 | ,"Control.Exception", "GHC.Exts", "GHC.Float"] 31 | liftIO $ i `shouldSatisfy` not . null) :: IO () 32 | 33 | it "can get module info" $ do 34 | (withLightHscEnv [] $ \env -> 35 | runLightGhc env $ do 36 | mdl <- findModule "Data.List" Nothing 37 | mmi <- getModuleInfo mdl 38 | liftIO $ isJust mmi `shouldBe` True) :: IO () 39 | 40 | 41 | describe "resolveModule" $ do 42 | it "Works when a module given as path uses CPP" $ do 43 | dir <- getCurrentDirectory 44 | let srcDirs = [dir "test/data/target/src"] 45 | x <- withLightHscEnv [] $ \env -> runD $ do 46 | resolveModule env srcDirs (Left $ dir "test/data/target/Cpp.hs") 47 | liftIO $ x `shouldBe` Just (ModulePath "Cpp" $ dir "test/data/target/Cpp.hs") 48 | -------------------------------------------------------------------------------- /test/TestUtils.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | module TestUtils ( 3 | run 4 | , runD 5 | , runD' 6 | , runE 7 | , runNullLog 8 | , runGmOutDef 9 | , runLogDef 10 | , shouldReturnError 11 | , isPkgDbAt 12 | , isPkgConfDAt 13 | , module GhcMod.Monad 14 | , module GhcMod.Types 15 | ) where 16 | 17 | import GhcMod.Logging 18 | import GhcMod.Monad 19 | import GhcMod.Cradle 20 | import GhcMod.Types 21 | 22 | import Control.Arrow 23 | import Control.Category 24 | import Control.Applicative 25 | import Control.Monad.Error (ErrorT, runErrorT) 26 | import Control.Monad.Trans.Journal 27 | import Data.List.Split 28 | import Data.Label 29 | import Data.String 30 | import System.FilePath 31 | import System.Directory 32 | import Test.Hspec 33 | import Prelude hiding ((.)) 34 | 35 | import Exception 36 | 37 | testLogLevel :: GmLogLevel 38 | testLogLevel = GmDebug 39 | 40 | extract :: Show e => IO (Either e a, w) -> IO a 41 | extract action = do 42 | (r,_) <- action 43 | case r of 44 | Right a -> return a 45 | Left e -> error $ show e 46 | 47 | runGhcModTSpec :: Options -> GhcModT IO a -> IO (Either GhcModError a, GhcModLog) 48 | runGhcModTSpec opt action = do 49 | dir <- getCurrentDirectory 50 | runGhcModTSpec' dir opt action 51 | 52 | runGhcModTSpec' :: IOish m 53 | => FilePath -> Options -> GhcModT m b -> m (Either GhcModError b, GhcModLog) 54 | runGhcModTSpec' dir opt action = liftIO (canonicalizePath dir) >>= \dir' -> do 55 | runGmOutT opt $ 56 | withGhcModEnv' withSpecCradle dir' opt $ \(env,_) -> do 57 | first (fst <$>) <$> runGhcModT' env defaultGhcModState 58 | (gmSetLogLevel (ooptLogLevel $ optOutput opt) >> action) 59 | where 60 | withSpecCradle :: (IOish m, GmOut m) => FilePath -> ((Cradle, GhcModLog) -> m a) -> m a 61 | withSpecCradle cradledir f = 62 | gbracket 63 | (runJournalT $ findSpecCradle (optPrograms opt) cradledir) 64 | (liftIO . cleanupCradle . fst) f 65 | 66 | 67 | -- | Run GhcMod 68 | run :: Options -> GhcModT IO a -> IO a 69 | run opt a = extract $ runGhcModTSpec opt a 70 | 71 | -- | Run GhcMod with default options 72 | runD :: GhcModT IO a -> IO a 73 | runD = 74 | extract . runGhcModTSpec (setLogLevel testLogLevel defaultOptions) 75 | 76 | runD' :: FilePath -> GhcModT IO a -> IO a 77 | runD' dir = 78 | extract . runGhcModTSpec' dir (setLogLevel testLogLevel defaultOptions) 79 | 80 | setLogLevel :: GmLogLevel -> Options -> Options 81 | setLogLevel = set (lOoptLogLevel . lOptOutput) 82 | 83 | runE :: ErrorT e IO a -> IO (Either e a) 84 | runE = runErrorT 85 | 86 | runNullLog :: MonadIO m => JournalT GhcModLog m a -> m a 87 | runNullLog action = do 88 | (a,w) <- runJournalT action 89 | liftIO $ print w 90 | return a 91 | 92 | runGmOutDef :: IOish m => GmOutT m a -> m a 93 | runGmOutDef = runGmOutT defaultOptions 94 | 95 | runLogDef :: IOish m => GmOutT (JournalT GhcModLog m) a -> m a 96 | runLogDef = fmap fst . runJournalT . runGmOutDef 97 | 98 | shouldReturnError :: Show a 99 | => IO (Either GhcModError a, GhcModLog) 100 | -> Expectation 101 | shouldReturnError action = do 102 | (a,_) <- action 103 | a `shouldSatisfy` isLeft 104 | where 105 | isLeft (Left _) = True 106 | isLeft _ = False 107 | 108 | isPkgConfD :: FilePath -> Bool 109 | isPkgConfD d = let 110 | (_dir, pkgconfd) = splitFileName d 111 | in case splitOn "-" pkgconfd of 112 | [_arch, _platform, _compiler, _compver, "packages.conf.d"] -> True 113 | _ -> False 114 | 115 | isPkgConfDAt :: FilePath -> FilePath -> Bool 116 | isPkgConfDAt d d' | d == takeDirectory d' && isPkgConfD d' = True 117 | isPkgConfDAt _ _ = False 118 | 119 | isPkgDbAt :: FilePath -> GhcPkgDb -> Bool 120 | isPkgDbAt d (PackageDb dir) = isPkgConfDAt d dir 121 | isPkgDbAt _ _ = False 122 | 123 | instance IsString ModuleName where 124 | fromString = mkModuleName 125 | -------------------------------------------------------------------------------- /test/data/annotations/With.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | {-# ANN module ["this", "can", "be", "anything"] #-} 4 | 5 | main :: IO () 6 | main = putStrLn "Hello world!" 7 | -------------------------------------------------------------------------------- /test/data/broken-cabal/.cabal-sandbox/packages/00-index.cache: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DanielG/ghc-mod/391e187a5dfef4421aab2508fa6ff7875cc8259d/test/data/broken-cabal/.cabal-sandbox/packages/00-index.cache -------------------------------------------------------------------------------- /test/data/broken-cabal/broken.cabal: -------------------------------------------------------------------------------- 1 | broken cabal 2 | -------------------------------------------------------------------------------- /test/data/broken-cabal/cabal.sandbox.config.in: -------------------------------------------------------------------------------- 1 | -- This is a Cabal package environment file. 2 | -- THIS FILE IS AUTO-GENERATED. DO NOT EDIT DIRECTLY. 3 | -- Please create a 'cabal.config' file in the same directory 4 | -- if you want to change the default settings for this sandbox. 5 | 6 | 7 | local-repo: @CWD@/test/data/broken-cabal/.cabal-sandbox/packages 8 | logs-dir: @CWD@/test/data/broken-cabal/.cabal-sandbox/logs 9 | world-file: @CWD@/test/data/broken-cabal/.cabal-sandbox/world 10 | user-install: False 11 | package-db: @CWD@/test/data/broken-cabal/.cabal-sandbox/x86_64-linux-ghc-7.8.3-packages.conf.d 12 | build-summary: @CWD@/test/data/broken-cabal/.cabal-sandbox/logs/build.log 13 | 14 | install-dirs 15 | prefix: @CWD@/test/data/broken-cabal/.cabal-sandbox 16 | bindir: $prefix/bin 17 | libdir: $prefix/lib 18 | libsubdir: $arch-$os-$compiler/$pkgid 19 | libexecdir: $prefix/libexec 20 | datadir: $prefix/share 21 | datasubdir: $arch-$os-$compiler/$pkgid 22 | docdir: $datadir/doc/$arch-$os-$compiler/$pkgid 23 | htmldir: $docdir/html 24 | haddockdir: $htmldir 25 | sysconfdir: $prefix/etc 26 | -------------------------------------------------------------------------------- /test/data/broken-sandbox/cabal.sandbox.config: -------------------------------------------------------------------------------- 1 | broken 2 | -------------------------------------------------------------------------------- /test/data/broken-sandbox/dummy.cabal: -------------------------------------------------------------------------------- 1 | dummy 2 | -------------------------------------------------------------------------------- /test/data/cabal-flags/cabal-flags.cabal: -------------------------------------------------------------------------------- 1 | name: cabal-flags 2 | version: 0.1.0 3 | build-type: Simple 4 | cabal-version: >= 1.8 5 | 6 | flag test-flag 7 | default: False 8 | 9 | library 10 | build-depends: base 11 | 12 | if flag(test-flag) 13 | build-depends: Cabal >= 1.10 14 | -------------------------------------------------------------------------------- /test/data/cabal-preprocessors/Main.hs: -------------------------------------------------------------------------------- 1 | import Preprocessed 2 | 3 | main :: IO () 4 | main = return warning 5 | -------------------------------------------------------------------------------- /test/data/cabal-preprocessors/Preprocessed.hsc: -------------------------------------------------------------------------------- 1 | module Preprocessed where 2 | 3 | warning = () 4 | -------------------------------------------------------------------------------- /test/data/cabal-preprocessors/cabal-preprocessors.cabal: -------------------------------------------------------------------------------- 1 | name: cabal-preprocessors 2 | version: 0.1.0.0 3 | license-file: LICENSE 4 | author: asd 5 | maintainer: asd 6 | build-type: Simple 7 | cabal-version: >=1.10 8 | 9 | executable cabal-preprocessors 10 | main-is: Main.hs 11 | build-depends: base 12 | default-language: Haskell2010 13 | other-modules: Preprocessed 14 | ghc-options: -Wall -------------------------------------------------------------------------------- /test/data/cabal-project/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/Cabal-1.18.1.3-2b161c6bf77657aa17e1681d83cb051b.conf: -------------------------------------------------------------------------------- 1 | name: Cabal 2 | version: 1.18.1.3 3 | id: Cabal-1.18.1.3-2b161c6bf77657aa17e1681d83cb051b 4 | exposed: True 5 | -------------------------------------------------------------------------------- /test/data/cabal-project/.cabal-sandbox/packages/00-index.cache: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DanielG/ghc-mod/391e187a5dfef4421aab2508fa6ff7875cc8259d/test/data/cabal-project/.cabal-sandbox/packages/00-index.cache -------------------------------------------------------------------------------- /test/data/cabal-project/Baz.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes #-} 2 | module Baz (baz) where 3 | import Foo (fooQ) 4 | 5 | baz = [fooQ| foo bar baz |] 6 | -------------------------------------------------------------------------------- /test/data/cabal-project/Foo.hs: -------------------------------------------------------------------------------- 1 | module Foo (foo, fooQ) where 2 | import Language.Haskell.TH 3 | import Language.Haskell.TH.Quote (QuasiQuoter(..)) 4 | 5 | foo :: ExpQ 6 | foo = stringE "foo" 7 | 8 | fooQ :: QuasiQuoter 9 | fooQ = QuasiQuoter (litE . stringL) undefined undefined undefined 10 | -------------------------------------------------------------------------------- /test/data/cabal-project/Info.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} -- for HscInterpreted 2 | 3 | module Info () where 4 | 5 | fib :: Int -> Int 6 | fib 0 = 0 7 | fib 1 = 1 8 | fib n = fib (n - 1) + fib (n - 2) 9 | -------------------------------------------------------------------------------- /test/data/cabal-project/Main.hs: -------------------------------------------------------------------------------- 1 | import Bar (bar) 2 | 3 | main = putStrLn bar 4 | -------------------------------------------------------------------------------- /test/data/cabal-project/cabal.sandbox.config.in: -------------------------------------------------------------------------------- 1 | -- This is a Cabal package environment file. 2 | -- THIS FILE IS AUTO-GENERATED. DO NOT EDIT DIRECTLY. 3 | -- Please create a 'cabal.config' file in the same directory 4 | -- if you want to change the default settings for this sandbox. 5 | 6 | 7 | local-repo: @CWD@/test/data/cabal-project/.cabal-sandbox/packages 8 | logs-dir: @CWD@/test/data/cabal-project/.cabal-sandbox/logs 9 | world-file: @CWD@/test/data/cabal-project/.cabal-sandbox/world 10 | user-install: False 11 | package-db: @CWD@/test/data/cabal-project/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d 12 | build-summary: @CWD@/test/data/cabal-project/.cabal-sandbox/logs/build.log 13 | 14 | install-dirs 15 | prefix: @CWD@/test/data/cabal-project/.cabal-sandbox 16 | bindir: $prefix/bin 17 | libdir: $prefix/lib 18 | libsubdir: $arch-$os-$compiler/$pkgid 19 | libexecdir: $prefix/libexec 20 | datadir: $prefix/share 21 | datasubdir: $arch-$os-$compiler/$pkgid 22 | docdir: $datadir/doc/$arch-$os-$compiler/$pkgid 23 | htmldir: $docdir/html 24 | haddockdir: $htmldir 25 | sysconfdir: $prefix/etc 26 | -------------------------------------------------------------------------------- /test/data/cabal-project/cabalapi.cabal: -------------------------------------------------------------------------------- 1 | Name: ghc-mod 2 | Version: 1.11.3 3 | Author: Kazu Yamamoto 4 | Maintainer: Kazu Yamamoto 5 | License: BSD3 6 | License-File: LICENSE 7 | Homepage: http://www.mew.org/~kazu/proj/ghc-mod/ 8 | Synopsis: Happy Haskell programming on Emacs/Vim 9 | Description: This packages includes Elisp files 10 | and a Haskell command, "ghc-mod". 11 | "ghc*.el" enable completion of 12 | Haskell symbols on Emacs. 13 | Flymake is also integrated. 14 | "ghc-mod" is a backend of "ghc*.el". 15 | It lists up all installed modules 16 | or extracts names of functions, classes, 17 | and data declarations. 18 | To use "ghc-mod" on Vim, 19 | see or 20 | 21 | Category: Development 22 | Cabal-Version: >= 1.6 23 | Build-Type: Simple 24 | Data-Dir: elisp 25 | Data-Files: Makefile ghc.el ghc-func.el ghc-doc.el ghc-comp.el 26 | ghc-flymake.el ghc-command.el ghc-info.el 27 | ghc-ins-mod.el ghc-indent.el 28 | Executable ghc-mod 29 | Main-Is: GHCMod.hs 30 | Other-Modules: Browse 31 | CabalApi 32 | Cabal 33 | CabalDev 34 | Check 35 | ErrMsg 36 | Flag 37 | GHCApi 38 | GHCChoice 39 | Gap 40 | Info 41 | Lang 42 | Lint 43 | List 44 | Paths_ghc_mod 45 | Types 46 | GHC-Options: -Wall 47 | Build-Depends: base 48 | , Cabal >= 1.10 49 | , template-haskell 50 | 51 | Test-Suite spec 52 | Main-Is: Spec.hs 53 | Hs-Source-Dirs: test, . 54 | Type: exitcode-stdio-1.0 55 | Other-Modules: Expectation 56 | BrowseSpec 57 | CabalApiSpec 58 | FlagSpec 59 | LangSpec 60 | LintSpec 61 | ListSpec 62 | Build-Depends: base 63 | , Cabal >= 1.10 64 | 65 | Source-Repository head 66 | Type: git 67 | Location: git://github.com/kazu-yamamoto/ghc-mod.git 68 | -------------------------------------------------------------------------------- /test/data/cabal-project/subdir1/subdir2/dummy: -------------------------------------------------------------------------------- 1 | dummy 2 | -------------------------------------------------------------------------------- /test/data/case-split/Crash.hs: -------------------------------------------------------------------------------- 1 | module Crash where 2 | 3 | test :: Maybe a 4 | test x = undefined 5 | -------------------------------------------------------------------------------- /test/data/case-split/Vect.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds, TypeFamilies, TypeOperators, GADTs, KindSignatures #-} 2 | 3 | module Vect where 4 | 5 | data Nat = Z | S Nat 6 | 7 | type family (n :: Nat) :+ (m :: Nat) :: Nat 8 | type instance Z :+ m = m 9 | type instance S n :+ m = S (n :+ m) 10 | 11 | data Vect :: Nat -> * -> * where 12 | VNil :: Vect Z a 13 | (:::) :: a -> Vect n a -> Vect (S n) a 14 | 15 | vAppend :: Vect n a -> Vect m a -> Vect (n :+ m) a 16 | vAppend x y = _vAppend_body 17 | 18 | lAppend :: [a] -> [a] -> [a] 19 | lAppend x y = _lAppend_body 20 | 21 | data MyList a = Nil | Cons a (MyList a) 22 | 23 | mlAppend :: MyList a -> MyList a -> MyList a 24 | mlAppend x y = _mlAppend_body 25 | 26 | mlAppend2 :: MyList a -> MyList a -> MyList a 27 | mlAppend2 x y = case x of 28 | x' -> _mlAppend_body 29 | 30 | mlReverse :: MyList a -> MyList a 31 | mlReverse xs = mlReverse' xs Nil 32 | where 33 | mlReverse' :: MyList a -> MyList a -> MyList a 34 | mlReverse' xs' accum = _mlReverse_body 35 | 36 | mlReverse2 :: MyList a -> MyList a 37 | mlReverse2 xs = let mlReverse' :: MyList a -> MyList a -> MyList a 38 | mlReverse' xs' accum = _mlReverse_body 39 | in mlReverse' xs Nil 40 | -------------------------------------------------------------------------------- /test/data/case-split/Vect706.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds, TypeFamilies, TypeOperators, GADTs, KindSignatures #-} 2 | 3 | module Vect706 where 4 | 5 | data Nat = Z | S Nat 6 | 7 | type family (n :: Nat) :+ (m :: Nat) :: Nat 8 | type instance Z :+ m = m 9 | type instance S n :+ m = S (n :+ m) 10 | 11 | data Vect :: Nat -> * -> * where 12 | VNil :: Vect Z a 13 | (:::) :: a -> Vect n a -> Vect (S n) a 14 | 15 | vAppend :: Vect n a -> Vect m a -> Vect (n :+ m) a 16 | vAppend x y = undefined 17 | 18 | lAppend :: [a] -> [a] -> [a] 19 | lAppend x y = undefined 20 | 21 | data MyList a = Nil | Cons a (MyList a) 22 | 23 | mlAppend :: MyList a -> MyList a -> MyList a 24 | mlAppend x y = undefined 25 | 26 | mlAppend2 :: MyList a -> MyList a -> MyList a 27 | mlAppend2 x y = case x of 28 | x' -> undefined 29 | 30 | mlReverse :: MyList a -> MyList a 31 | mlReverse xs = mlReverse' xs Nil 32 | where 33 | mlReverse' :: MyList a -> MyList a -> MyList a 34 | mlReverse' xs' accum = undefined 35 | 36 | mlReverse2 :: MyList a -> MyList a 37 | mlReverse2 xs = let mlReverse' :: MyList a -> MyList a -> MyList a 38 | mlReverse' xs' accum = undefined 39 | in mlReverse' xs Nil 40 | -------------------------------------------------------------------------------- /test/data/check-missing-warnings/DesugarWarnings.hs: -------------------------------------------------------------------------------- 1 | module Warnings (zoo) where 2 | 3 | zoo :: [a] -> () 4 | zoo x = case x of 5 | [] -> undefined 6 | -------------------------------------------------------------------------------- /test/data/check-packageid/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c.conf: -------------------------------------------------------------------------------- 1 | name: template-haskell 2 | version: 2.8.0.0 3 | id: template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c 4 | exposed: True 5 | -------------------------------------------------------------------------------- /test/data/check-packageid/cabal.sandbox.config.in: -------------------------------------------------------------------------------- 1 | -- This is a Cabal package environment file. 2 | -- THIS FILE IS AUTO-GENERATED. DO NOT EDIT DIRECTLY. 3 | -- Please create a 'cabal.config' file in the same directory 4 | -- if you want to change the default settings for this sandbox. 5 | 6 | 7 | local-repo: @CWD@/test/data/check-packageid/.cabal-sandbox/packages 8 | logs-dir: @CWD@/test/data/check-packageid/.cabal-sandbox/logs 9 | world-file: @CWD@/test/data/check-packageid/.cabal-sandbox/world 10 | user-install: False 11 | package-db: @CWD@/test/data/check-packageid/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d 12 | build-summary: @CWD@/test/data/check-packageid/.cabal-sandbox/logs/build.log 13 | 14 | install-dirs 15 | prefix: @CWD@/test/data/check-packageid/.cabal-sandbox 16 | bindir: $prefix/bin 17 | libdir: $prefix/lib 18 | libsubdir: $arch-$os-$compiler/$pkgid 19 | libexecdir: $prefix/libexec 20 | datadir: $prefix/share 21 | datasubdir: $arch-$os-$compiler/$pkgid 22 | docdir: $datadir/doc/$arch-$os-$compiler/$pkgid 23 | htmldir: $docdir/html 24 | haddockdir: $htmldir 25 | sysconfdir: $prefix/etc 26 | -------------------------------------------------------------------------------- /test/data/check-test-subdir/check-test-subdir.cabal: -------------------------------------------------------------------------------- 1 | name: check-test-subdir 2 | version: 0.1.0 3 | build-type: Simple 4 | cabal-version: >= 1.8 5 | 6 | library 7 | build-depends: base == 4.* 8 | hs-source-dirs: src 9 | exposed-modules: Check.Test.Subdir 10 | 11 | test-suite test 12 | type: exitcode-stdio-1.0 13 | build-depends: base == 4.* 14 | hs-source-dirs: test 15 | main-is: Main.hs 16 | ghc-options: -Wall 17 | -------------------------------------------------------------------------------- /test/data/check-test-subdir/src/Check/Test/Subdir.hs: -------------------------------------------------------------------------------- 1 | module Check.Test.Subdir (subdir) where 2 | 3 | subdir :: String 4 | subdir = "subdir" 5 | -------------------------------------------------------------------------------- /test/data/check-test-subdir/test/Bar/Baz.hs: -------------------------------------------------------------------------------- 1 | module Bar.Baz (baz) where 2 | import Foo (foo) 3 | 4 | baz :: String 5 | baz = unwords [foo, "baz"] 6 | -------------------------------------------------------------------------------- /test/data/check-test-subdir/test/Foo.hs: -------------------------------------------------------------------------------- 1 | module Foo (foo) where 2 | 3 | foo = "foo" 4 | -------------------------------------------------------------------------------- /test/data/check-test-subdir/test/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | import Bar.Baz (baz) 3 | 4 | main :: IO () 5 | main = putStrLn baz 6 | -------------------------------------------------------------------------------- /test/data/custom-cradle/custom-cradle.cabal: -------------------------------------------------------------------------------- 1 | name: custom-cradle 2 | version: 0.1.0.0 3 | homepage: asd 4 | license-file: LICENSE 5 | author: asd 6 | maintainer: asd 7 | build-type: Simple 8 | cabal-version: >=1.10 9 | 10 | library 11 | build-depends: base 12 | default-language: Haskell2010 -------------------------------------------------------------------------------- /test/data/custom-cradle/ghc-mod.package-db-stack: -------------------------------------------------------------------------------- 1 | global 2 | user 3 | package-db-a 4 | package-db-b 5 | package-db-c 6 | -------------------------------------------------------------------------------- /test/data/custom-cradle/package-db-a/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DanielG/ghc-mod/391e187a5dfef4421aab2508fa6ff7875cc8259d/test/data/custom-cradle/package-db-a/.gitkeep -------------------------------------------------------------------------------- /test/data/custom-cradle/package-db-b/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DanielG/ghc-mod/391e187a5dfef4421aab2508fa6ff7875cc8259d/test/data/custom-cradle/package-db-b/.gitkeep -------------------------------------------------------------------------------- /test/data/custom-cradle/package-db-c/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DanielG/ghc-mod/391e187a5dfef4421aab2508fa6ff7875cc8259d/test/data/custom-cradle/package-db-c/.gitkeep -------------------------------------------------------------------------------- /test/data/duplicate-pkgver/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/template-haskell-1.0-7c59d13f32294d1ef6dc6233c24df961.conf: -------------------------------------------------------------------------------- 1 | name: template-haskell 2 | version: 1.0 3 | id: template-haskell-1.0-7c59d13f32294d1ef6dc6233c24df961 4 | exposed: True 5 | -------------------------------------------------------------------------------- /test/data/duplicate-pkgver/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/template-haskell-2.8.0.0-14e543bdae2da4d2aeff5386892c9112.conf: -------------------------------------------------------------------------------- 1 | name: template-haskell 2 | version: 2.8.0.0 3 | id: template-haskell-2.8.0.0-14e543bdae2da4d2aeff5386892c9112 4 | exposed: True 5 | -------------------------------------------------------------------------------- /test/data/duplicate-pkgver/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c.conf: -------------------------------------------------------------------------------- 1 | name: template-haskell 2 | version: 2.8.0.0 3 | id: template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c 4 | exposed: True 5 | -------------------------------------------------------------------------------- /test/data/duplicate-pkgver/cabal.sandbox.config.in: -------------------------------------------------------------------------------- 1 | -- This is a Cabal package environment file. 2 | -- THIS FILE IS AUTO-GENERATED. DO NOT EDIT DIRECTLY. 3 | -- Please create a 'cabal.config' file in the same directory 4 | -- if you want to change the default settings for this sandbox. 5 | 6 | 7 | local-repo: @CWD@/test/data/duplicate-pkgver/.cabal-sandbox/packages 8 | logs-dir: @CWD@/test/data/duplicate-pkgver/.cabal-sandbox/logs 9 | world-file: @CWD@/test/data/duplicate-pkgver/.cabal-sandbox/world 10 | user-install: False 11 | package-db: @CWD@/test/data/duplicate-pkgver/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d 12 | build-summary: @CWD@/test/data/duplicate-pkgver/.cabal-sandbox/logs/build.log 13 | 14 | install-dirs 15 | prefix: @CWD@/test/data/duplicate-pkgver/.cabal-sandbox 16 | bindir: $prefix/bin 17 | libdir: $prefix/lib 18 | libsubdir: $arch-$os-$compiler/$pkgid 19 | libexecdir: $prefix/libexec 20 | datadir: $prefix/share 21 | datasubdir: $arch-$os-$compiler/$pkgid 22 | docdir: $datadir/doc/$arch-$os-$compiler/$pkgid 23 | htmldir: $docdir/html 24 | haddockdir: $htmldir 25 | sysconfdir: $prefix/etc 26 | -------------------------------------------------------------------------------- /test/data/duplicate-pkgver/duplicate-pkgver.cabal: -------------------------------------------------------------------------------- 1 | name: duplicate-pkgver 2 | version: 0.1.0 3 | build-type: Simple 4 | cabal-version: >= 1.8 5 | 6 | library 7 | build-depends: base == 4.* 8 | -------------------------------------------------------------------------------- /test/data/file-mapping/File.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Hello World!" 3 | -------------------------------------------------------------------------------- /test/data/file-mapping/File_Redir.hs: -------------------------------------------------------------------------------- 1 | main = putStrLn "Hello World!" 2 | -------------------------------------------------------------------------------- /test/data/file-mapping/File_Redir_Lint.hs: -------------------------------------------------------------------------------- 1 | module File where 2 | 3 | func :: Num a => a -> a -> a 4 | func a b = (*) a b 5 | -------------------------------------------------------------------------------- /test/data/file-mapping/duplicate-main/Main.hs: -------------------------------------------------------------------------------- 1 | main = return () 2 | -------------------------------------------------------------------------------- /test/data/file-mapping/duplicate-main/Main_Redir.hs: -------------------------------------------------------------------------------- 1 | main = return () 2 | -------------------------------------------------------------------------------- /test/data/file-mapping/duplicate-main/OtherMain.hs: -------------------------------------------------------------------------------- 1 | main = return () 2 | -------------------------------------------------------------------------------- /test/data/file-mapping/duplicate-main/OtherMain_Redir.hs: -------------------------------------------------------------------------------- 1 | main = return () 2 | -------------------------------------------------------------------------------- /test/data/file-mapping/duplicate-main/duplicate-main.cabal: -------------------------------------------------------------------------------- 1 | name: duplicate-main 2 | version: 0.1.0.0 3 | synopsis: Defines two executables 4 | license: BSD3 5 | license-file: LICENSE 6 | author: Foo 7 | maintainer: foo@example.com 8 | build-type: Simple 9 | cabal-version: >=1.10 10 | 11 | executable hie-test-project 12 | main-is: Main.hs 13 | build-depends: base 14 | hs-source-dirs: . 15 | default-language: Haskell2010 16 | 17 | executable hie-test-project2 18 | main-is: OtherMain.hs 19 | build-depends: base 20 | hs-source-dirs: . 21 | default-language: Haskell2010 22 | -------------------------------------------------------------------------------- /test/data/file-mapping/lhs/File.lhs: -------------------------------------------------------------------------------- 1 | > main :: IO () 2 | > main = putStrLn "Hello World!" 3 | -------------------------------------------------------------------------------- /test/data/file-mapping/lhs/File_Redir.lhs: -------------------------------------------------------------------------------- 1 | > main = putStrLn "Hello World!" 2 | -------------------------------------------------------------------------------- /test/data/file-mapping/lhs/File_Redir_Lint.lhs: -------------------------------------------------------------------------------- 1 | > module File where 2 | 3 | > func :: Num a => a -> a -> a 4 | > func a b = (*) a b 5 | -------------------------------------------------------------------------------- /test/data/file-mapping/preprocessor/File.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | #ifndef NOTHING 3 | main :: IO () 4 | main = putStrLn "Hello World!" 5 | #else 6 | INVALID 7 | #endif 8 | -------------------------------------------------------------------------------- /test/data/file-mapping/preprocessor/File_Redir.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | #ifndef NOTHING 3 | main = putStrLn "Hello World!" 4 | #else 5 | INVALID 6 | #endif 7 | -------------------------------------------------------------------------------- /test/data/file-mapping/preprocessor/File_Redir_Lint.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | #ifndef NOTHING 3 | module File where 4 | 5 | func :: Num a => a -> a -> a 6 | func a b = (*) a b 7 | #else 8 | INVALID 9 | #endif 10 | -------------------------------------------------------------------------------- /test/data/foreign-export/ForeignExport.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | module ForeignExport where 4 | 5 | import Foreign.C.Types 6 | 7 | foreign export ccall foo :: CUInt 8 | 9 | foo :: CUInt 10 | foo = 123 11 | -------------------------------------------------------------------------------- /test/data/ghc-mod-check/ghc-mod-check.cabal: -------------------------------------------------------------------------------- 1 | -- Initial ghc-mod-check.cabal generated by cabal init. For further 2 | -- documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | name: ghc-mod-check 5 | version: 0.1.0.0 6 | synopsis: check test 7 | -- description: 8 | license: BSD3 9 | license-file: LICENSE 10 | author: Kazu Yamamoto 11 | maintainer: kazu@iij.ad.jp 12 | -- copyright: 13 | category: Data 14 | build-type: Simple 15 | cabal-version: >=1.8 16 | 17 | library 18 | HS-Source-Dirs: lib 19 | build-depends: base 20 | exposed-modules: Data.Foo 21 | 22 | executable foo 23 | Main-Is: main.hs 24 | GHC-Options: -Wall 25 | Build-Depends: base 26 | , ghc-mod-check 27 | -------------------------------------------------------------------------------- /test/data/ghc-mod-check/lib/Data/Foo.hs: -------------------------------------------------------------------------------- 1 | module Data.Foo where 2 | 3 | foo :: Int 4 | foo = undefined 5 | 6 | fibonacci :: Int -> Integer 7 | fibonacci n = fib 1 0 1 8 | where 9 | fib m x y 10 | | n == m = y 11 | | otherwise = fib (m+1) y (x + y) 12 | -------------------------------------------------------------------------------- /test/data/ghc-mod-check/main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Data.Foo 4 | 5 | main = print foo 6 | -------------------------------------------------------------------------------- /test/data/hlint/hlint.hs: -------------------------------------------------------------------------------- 1 | module Hlist where 2 | 3 | main :: IO () 4 | main = do 5 | putStrLn "Hello, world!" 6 | -------------------------------------------------------------------------------- /test/data/home-module-graph/cpp/A.hs: -------------------------------------------------------------------------------- 1 | module A where 2 | import A1 3 | import A2 4 | import A3 5 | -------------------------------------------------------------------------------- /test/data/home-module-graph/cpp/A1.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module A1 where 3 | #elif 4 | import B 5 | -------------------------------------------------------------------------------- /test/data/home-module-graph/cpp/A2.hs: -------------------------------------------------------------------------------- 1 | module A2 where 2 | -------------------------------------------------------------------------------- /test/data/home-module-graph/cpp/A3.hs: -------------------------------------------------------------------------------- 1 | module A3 where 2 | import B 3 | -------------------------------------------------------------------------------- /test/data/home-module-graph/cpp/B.hs: -------------------------------------------------------------------------------- 1 | module B where 2 | -------------------------------------------------------------------------------- /test/data/home-module-graph/cycle/A.hs: -------------------------------------------------------------------------------- 1 | module A where 2 | import B 3 | -------------------------------------------------------------------------------- /test/data/home-module-graph/cycle/B.hs: -------------------------------------------------------------------------------- 1 | module B where 2 | import A 3 | -------------------------------------------------------------------------------- /test/data/home-module-graph/errors/A.hs: -------------------------------------------------------------------------------- 1 | module A where 2 | import A1 3 | import A2 4 | import A3 5 | -------------------------------------------------------------------------------- /test/data/home-module-graph/errors/A1.hs: -------------------------------------------------------------------------------- 1 | module A1 where 2 | psogduapzs9 3 | import B 4 | lx,vLMCks 5 | -------------------------------------------------------------------------------- /test/data/home-module-graph/errors/A2.hs: -------------------------------------------------------------------------------- 1 | module A2 where 2 | -------------------------------------------------------------------------------- /test/data/home-module-graph/errors/A3.hs: -------------------------------------------------------------------------------- 1 | module A3 where 2 | import B 3 | -------------------------------------------------------------------------------- /test/data/home-module-graph/errors/B.hs: -------------------------------------------------------------------------------- 1 | module B where 2 | -------------------------------------------------------------------------------- /test/data/home-module-graph/indirect-update/A.hs: -------------------------------------------------------------------------------- 1 | module A where 2 | import A1 3 | import A2 4 | import A3 5 | -------------------------------------------------------------------------------- /test/data/home-module-graph/indirect-update/A1.hs: -------------------------------------------------------------------------------- 1 | module A1 where 2 | import B 3 | -------------------------------------------------------------------------------- /test/data/home-module-graph/indirect-update/A2.hs: -------------------------------------------------------------------------------- 1 | module A2 where 2 | -------------------------------------------------------------------------------- /test/data/home-module-graph/indirect-update/A3.hs: -------------------------------------------------------------------------------- 1 | module A3 where 2 | import B 3 | -------------------------------------------------------------------------------- /test/data/home-module-graph/indirect-update/B.hs: -------------------------------------------------------------------------------- 1 | module B where 2 | -------------------------------------------------------------------------------- /test/data/home-module-graph/indirect-update/C.hs: -------------------------------------------------------------------------------- 1 | module C where 2 | -------------------------------------------------------------------------------- /test/data/home-module-graph/indirect/A.hs: -------------------------------------------------------------------------------- 1 | module A where 2 | import A1 3 | import A2 4 | import A3 5 | -------------------------------------------------------------------------------- /test/data/home-module-graph/indirect/A1.hs: -------------------------------------------------------------------------------- 1 | module A1 where 2 | import B 3 | -------------------------------------------------------------------------------- /test/data/home-module-graph/indirect/A2.hs: -------------------------------------------------------------------------------- 1 | module A2 where 2 | import C 3 | -------------------------------------------------------------------------------- /test/data/home-module-graph/indirect/A3.hs: -------------------------------------------------------------------------------- 1 | module A3 where 2 | import B 3 | -------------------------------------------------------------------------------- /test/data/home-module-graph/indirect/B.hs: -------------------------------------------------------------------------------- 1 | module B where 2 | -------------------------------------------------------------------------------- /test/data/home-module-graph/indirect/C.hs: -------------------------------------------------------------------------------- 1 | module C where 2 | -------------------------------------------------------------------------------- /test/data/import-cycle/Mutual1.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} -- for HscInterpreted 2 | 3 | module Mutual1 where 4 | 5 | import Mutual2 6 | -------------------------------------------------------------------------------- /test/data/import-cycle/Mutual2.hs: -------------------------------------------------------------------------------- 1 | module Mutual2 where 2 | 3 | import Mutual1 4 | -------------------------------------------------------------------------------- /test/data/nice-qualification/NiceQualification.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | main :: IO () 4 | main = "wrong type" 5 | -------------------------------------------------------------------------------- /test/data/non-exported/Fib.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} -- for HscInterpreted 2 | 3 | module Fib () where 4 | 5 | fib :: Int -> Int 6 | fib 0 = 0 7 | fib 1 = 1 8 | fib n = fib (n - 1) + fib (n - 2) 9 | -------------------------------------------------------------------------------- /test/data/pattern-synonyms/A.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE PatternSynonyms #-} 2 | 3 | module A where 4 | 5 | data SomeType a b = SomeType (a,b) 6 | 7 | pattern MyPat x y <- SomeType (x,y) 8 | -------------------------------------------------------------------------------- /test/data/pattern-synonyms/B.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE PatternSynonyms #-} 2 | module B where 3 | import A 4 | 5 | foo :: SomeType Int Char -> String 6 | foo x = case x of 7 | MyPat a b -> show a ++ " " ++ [b] 8 | -------------------------------------------------------------------------------- /test/data/pattern-synonyms/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /test/data/pattern-synonyms/pattern-synonyms.cabal: -------------------------------------------------------------------------------- 1 | -- Initial pattern-synonyms.cabal generated by cabal init. For further 2 | -- documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | name: pattern-synonyms 5 | version: 0.1.0.0 6 | -- synopsis: 7 | -- description: 8 | -- license: 9 | license-file: LICENSE 10 | author: Daniel Gröber 11 | maintainer: dxld@darkboxed.org 12 | -- copyright: 13 | -- category: 14 | build-type: Simple 15 | -- extra-source-files: 16 | cabal-version: >=1.10 17 | 18 | library 19 | exposed-modules: A, B 20 | -- other-modules: 21 | other-extensions: PatternSynonyms 22 | build-depends: base 23 | -- hs-source-dirs: 24 | default-language: Haskell2010 25 | ghc-options: -Wall 26 | if impl(ghc >= 8.0.1) 27 | ghc-options: -Wno-missing-pattern-synonym-signatures -------------------------------------------------------------------------------- /test/data/quasi-quotes/FooQ.hs: -------------------------------------------------------------------------------- 1 | module FooQ (fooQ) where 2 | import Language.Haskell.TH 3 | import Language.Haskell.TH.Quote (QuasiQuoter(..)) 4 | 5 | fooQ :: QuasiQuoter 6 | fooQ = QuasiQuoter (litE . stringL) undefined undefined undefined 7 | -------------------------------------------------------------------------------- /test/data/quasi-quotes/QuasiQuotes.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes #-} 2 | module QuasiQuotes where 3 | 4 | import FooQ 5 | 6 | bar = [fooQ| foo bar baz |] 7 | -------------------------------------------------------------------------------- /test/data/stack-project/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /test/data/stack-project/app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Lib 4 | 5 | main :: IO () 6 | main = someFunc 7 | -------------------------------------------------------------------------------- /test/data/stack-project/new-template.cabal: -------------------------------------------------------------------------------- 1 | name: new-template 2 | version: 0.1.0.0 3 | synopsis: Initial project template from stack 4 | description: Please see README.md 5 | homepage: http://github.com/name/project 6 | -- license: BSD3 7 | -- license-file: LICENSE 8 | author: Your name here 9 | maintainer: your.address@example.com 10 | -- copyright: 11 | category: Web 12 | build-type: Simple 13 | -- extra-source-files: 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: Lib 19 | build-depends: base 20 | default-language: Haskell2010 21 | 22 | executable new-template-exe 23 | hs-source-dirs: app 24 | main-is: Main.hs 25 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 26 | build-depends: base 27 | , new-template 28 | , bytestring 29 | default-language: Haskell2010 30 | 31 | test-suite new-template-test 32 | type: exitcode-stdio-1.0 33 | hs-source-dirs: test 34 | main-is: Spec.hs 35 | build-depends: base 36 | , new-template 37 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 38 | default-language: Haskell2010 39 | 40 | source-repository head 41 | type: git 42 | location: https://github.com/name/project 43 | -------------------------------------------------------------------------------- /test/data/stack-project/src/Lib.hs: -------------------------------------------------------------------------------- 1 | module Lib 2 | ( someFunc 3 | ) where 4 | 5 | someFunc :: IO () 6 | someFunc = putStrLn "someFunc" 7 | -------------------------------------------------------------------------------- /test/data/stack-project/stack.yaml.in: -------------------------------------------------------------------------------- 1 | flags: {} 2 | packages: 3 | - '.' 4 | extra-deps: [] 5 | -------------------------------------------------------------------------------- /test/data/stack-project/test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /test/data/target/Cpp.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | #undef NOTHING 3 | #ifdef NOTHING 4 | module WRONG_MODULE where 5 | #else 6 | module Cpp where 7 | #endif 8 | -------------------------------------------------------------------------------- /test/data/template-haskell/Bar.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | module Bar (bar) where 3 | import Foo (foo) 4 | 5 | bar = $foo ++ "bar" 6 | -------------------------------------------------------------------------------- /test/data/template-haskell/Foo.hs: -------------------------------------------------------------------------------- 1 | module Foo (foo, fooQ) where 2 | import Language.Haskell.TH 3 | import Language.Haskell.TH.Quote (QuasiQuoter(..)) 4 | 5 | foo :: ExpQ 6 | foo = stringE "foo" 7 | 8 | fooQ :: QuasiQuoter 9 | fooQ = QuasiQuoter (litE . stringL) undefined undefined undefined 10 | -------------------------------------------------------------------------------- /test/data/template-haskell/ImportsTH.hs: -------------------------------------------------------------------------------- 1 | import Bar (bar) 2 | 3 | main = putStrLn bar 4 | -------------------------------------------------------------------------------- /test/doctests.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Build_doctests (flags, pkgs, module_sources) 4 | import Data.Foldable (traverse_) 5 | import Test.DocTest (doctest) 6 | 7 | main :: IO () 8 | main = do 9 | traverse_ putStrLn args -- optionally print arguments 10 | doctest $ ["--no-magic"] ++ args 11 | where 12 | args = flags ++ pkgs ++ module_sources 13 | -------------------------------------------------------------------------------- /test/manual/not-interpreted-error/GhcTestcase.hs: -------------------------------------------------------------------------------- 1 | -- $ ghc -package ghc -package ghc-paths GhcTestcase.hs 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | module Main where 4 | 5 | import GHC 6 | import GHC.Paths (libdir) 7 | import DynFlags 8 | 9 | import System.Environment 10 | 11 | main :: IO () 12 | main = do 13 | args <- getArgs 14 | defaultErrorHandler defaultFatalMessager defaultFlushOut $ 15 | runGhc (Just libdir) $ 16 | doStuff "Main.hs" "Main" args 17 | 18 | doStuff :: String -> String -> [String] -> Ghc () 19 | doStuff targetFile targetModule args = do 20 | dflags0 <- getSessionDynFlags 21 | let dflags1 = dflags0 { 22 | ghcMode = CompManager 23 | , ghcLink = LinkInMemory 24 | , hscTarget = HscInterpreted 25 | , optLevel = 0 26 | } 27 | (dflags2, _, _) <- parseDynamicFlags dflags1 (map noLoc args) 28 | _ <- setSessionDynFlags dflags2 29 | 30 | target <- guessTarget targetFile Nothing 31 | setTargets [target { targetAllowObjCode = True }] 32 | 33 | _ <- load LoadAllTargets 34 | 35 | setContext [IIModule $ mkModuleName targetModule] 36 | 37 | return () 38 | -------------------------------------------------------------------------------- /test/manual/not-interpreted-error/proj/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import A 4 | 5 | main = print foo 6 | -------------------------------------------------------------------------------- /test/manual/not-interpreted-error/proj/not-interpreted-error.cabal: -------------------------------------------------------------------------------- 1 | name: not-interpreted-error 2 | version: 0.1.0.0 3 | license-file: LICENSE 4 | author: asdf 5 | maintainer: asdf 6 | build-type: Simple 7 | cabal-version: >=1.10 8 | 9 | executable main 10 | main-is: Main.hs 11 | build-depends: base 12 | default-language: Haskell2010 --------------------------------------------------------------------------------