packages feed

hpc-codecov 0.2.0.2 → 0.3.0.0

raw patch · 27 files changed

+1372/−263 lines, 27 filesdep +processdep −tarPVP ok

version bump matches the API change (PVP)

Dependencies added: process

Dependencies removed: tar

API changes (from Hackage documentation)

- Trace.Hpc.Codecov.Error: InvalidArgs :: [String] -> HpcCodecovError
- Trace.Hpc.Codecov.Error: MixNotFound :: FilePath -> [FilePath] -> HpcCodecovError
- Trace.Hpc.Codecov.Error: NoTixFile :: HpcCodecovError
- Trace.Hpc.Codecov.Error: SrcNotFound :: FilePath -> [FilePath] -> HpcCodecovError
- Trace.Hpc.Codecov.Error: TixNotFound :: FilePath -> HpcCodecovError
- Trace.Hpc.Codecov.Error: data HpcCodecovError
- Trace.Hpc.Codecov.Error: instance GHC.Exception.Type.Exception Trace.Hpc.Codecov.Error.HpcCodecovError
- Trace.Hpc.Codecov.Error: instance GHC.Show.Show Trace.Hpc.Codecov.Error.HpcCodecovError
- Trace.Hpc.Codecov.Error: withBriefUsageOnError :: IO a -> IO a
+ Trace.Hpc.Codecov.Discover: Cabal :: BuildTool
+ Trace.Hpc.Codecov.Discover: DiscoverArgs :: BuildTool -> String -> FilePath -> Maybe String -> [String] -> Bool -> DiscoverArgs
+ Trace.Hpc.Codecov.Discover: Stack :: BuildTool
+ Trace.Hpc.Codecov.Discover: [da_builddir] :: DiscoverArgs -> Maybe String
+ Trace.Hpc.Codecov.Discover: [da_rootdir] :: DiscoverArgs -> FilePath
+ Trace.Hpc.Codecov.Discover: [da_skipdirs] :: DiscoverArgs -> [String]
+ Trace.Hpc.Codecov.Discover: [da_testsuite] :: DiscoverArgs -> String
+ Trace.Hpc.Codecov.Discover: [da_tool] :: DiscoverArgs -> BuildTool
+ Trace.Hpc.Codecov.Discover: [da_verbose] :: DiscoverArgs -> Bool
+ Trace.Hpc.Codecov.Discover: data BuildTool
+ Trace.Hpc.Codecov.Discover: data DiscoverArgs
+ Trace.Hpc.Codecov.Discover: defaultIgnored :: [String]
+ Trace.Hpc.Codecov.Discover: discover :: DiscoverArgs -> IO Report
+ Trace.Hpc.Codecov.Discover: foldDir :: (FilePath -> a -> IO a) -> a -> [FilePath] -> IO a
+ Trace.Hpc.Codecov.Discover: foldDirWithIgnoring :: [String] -> (FilePath -> a -> IO a) -> a -> [FilePath] -> IO a
+ Trace.Hpc.Codecov.Discover: instance GHC.Classes.Eq Trace.Hpc.Codecov.Discover.BuildTool
+ Trace.Hpc.Codecov.Discover: instance GHC.Show.Show Trace.Hpc.Codecov.Discover.BuildTool
+ Trace.Hpc.Codecov.Exception: InvalidArgs :: [String] -> HpcCodecovError
+ Trace.Hpc.Codecov.Exception: InvalidBuildTool :: String -> HpcCodecovError
+ Trace.Hpc.Codecov.Exception: MixNotFound :: FilePath -> [FilePath] -> HpcCodecovError
+ Trace.Hpc.Codecov.Exception: NoTarget :: HpcCodecovError
+ Trace.Hpc.Codecov.Exception: SrcNotFound :: FilePath -> [FilePath] -> HpcCodecovError
+ Trace.Hpc.Codecov.Exception: TestSuiteNotFound :: String -> HpcCodecovError
+ Trace.Hpc.Codecov.Exception: TixNotFound :: FilePath -> HpcCodecovError
+ Trace.Hpc.Codecov.Exception: data HpcCodecovError
+ Trace.Hpc.Codecov.Exception: instance GHC.Exception.Type.Exception Trace.Hpc.Codecov.Exception.HpcCodecovError
+ Trace.Hpc.Codecov.Exception: instance GHC.Show.Show Trace.Hpc.Codecov.Exception.HpcCodecovError
+ Trace.Hpc.Codecov.Exception: withBriefUsageOnError :: IO a -> IO a
+ Trace.Hpc.Codecov.Main: defaultMain :: IO ()
+ Trace.Hpc.Codecov.Report: instance GHC.Base.Monoid Trace.Hpc.Codecov.Report.Report
+ Trace.Hpc.Codecov.Report: instance GHC.Base.Semigroup Trace.Hpc.Codecov.Report.Report

Files

CHANGELOG.md view
@@ -1,5 +1,17 @@ # Revision history for hpc-codecov +## 0.3.0.0 -- 2021-04-02++Modify command-line argument to support TOOL:TEST_SUITE style target,+support searching .tix and .mix files made by cabal-install and+stack. Add options to customize the search for .mix and .tix files+with temporary directories made with cabal-install and stack.++Add new module ``Trace.Hpc.Codecov.Discover``. Rename module+``Trace.Hpc.Codecov.Error`` to ``Trace.Hpc.Codecov.Exception``.+Rename function ``main`` to ``defaultMain`` in+``Trace.Hpc.Codecov.Main``.+ ## 0.2.0.2 -- 2021-03-25  Minor modification to support ghc 9.0.1.
README.md view
@@ -4,27 +4,157 @@ [![Travis](http://img.shields.io/travis/8c6794b6/codecov-haskell/master.svg?logo=travis)](https://travis-ci.com/8c6794b6/hpc-codecov) [![CircleCI](https://img.shields.io/circleci/build/gh/8c6794b6/hpc-codecov/master?logo=circleci)](https://circleci.com/gh/8c6794b6/hpc-codecov) [![AppVeyor](https://ci.appveyor.com/api/projects/status/dijqtsoqgc26oghj?svg=true)](https://ci.appveyor.com/project/8c6794b6/hpc-codecov)-[![GitHub](https://img.shields.io/github/workflow/status/8c6794b6/hpc-codecov/ci?logo=github)](https://github.com/8c6794b6/hpc-codecov/actions?query=workflow%3ci)+[![GitHub](https://img.shields.io/github/workflow/status/8c6794b6/hpc-codecov/ci?logo=github)](https://github.com/8c6794b6/hpc-codecov/actions/workflows/ci.yml)  The ``hpc-codecov`` package contains an executable and library codes for generating [Codecov](https://codecov.io) JSON coverage report from ``.tix`` and ``.mix`` files made with-[hpc](https://hackage.haskell.org/package/hpc).+[hpc](https://hackage.haskell.org/package/hpc). The generated report+is ready to be uploaded to Codecov with other tools such as [Codecov+Bash+uploader](https://docs.codecov.io/docs/about-the-codecov-bash-uploader). -The ``hpc-codecov`` executable does not try to find out the location-of ``.tix`` and ``mix`` files. Instead, let the user to explicitly-specify the file paths and directories. The rational behind the-decision is to support multiple versions of multiple build tools, such-as [cabal-install](http://hackage.haskell.org/package/cabal-install)-legacy v1-style build, v2-style build, and-[stack](https://docs.haskellstack.org/en/stable/README/).+The ``hpc-codecov`` executable can search ``.tix`` and ``mix`` files+under the directories made by the+[cabal-install](http://hackage.haskell.org/package/cabal-install) and+[stack](https://docs.haskellstack.org/en/stable/README/) build tools.+The executable also has options to explicitly specify the file paths+and directories for ``.tix`` and ``mix`` files, to support generating+reports with test data made by other build tools than+``cabal-install`` and ``stack``.  +Installing+----------++### From Package Repository++``hpc-codecov`` is available from+[Hackage](https://hackage.haskell.org/package/hpc-codecov) and+[Stackage](https://www.stackage.org/lts/package/hpc-codecov).  To+install with ``cabal-install``, run:++```console+$ cabal install hpc-codecov+```++To install with ``stack``, run:++```console+$ stack install hpc-codecov+```++### Pre-compiled binaries++For Windows, MacOS, and Linux (with glibc and libgmp), pre-compiled+binary executables are available+[here](https://github.com/8c6794b6/hpc-codecov/releases/latest).+++QuickStart+----------++To illustrate an example, initializing sample project named+``my-project`` with ``cabal-install``:++```console+$ cabal --version+cabal-install version 3.4.0.0+compiled using version 3.4.0.0 of the Cabal library+$ cabal init --simple --tests --test-dir=test -p my-project+```++Directory contents look like below:++```console+.+├── app+│   └── Main.hs+├── CHANGELOG.md+├── my-project.cabal+├── src+│   └── MyLib.hs+└── tests+    └── MyLibTest.hs+```++Run tests with coverage option:++```console+$ cabal test --enable-coverage+```++Write Codecov coverage report to ``codecov.json``:++```console+$ hpc-codecov cabal:my-project-test -X my-project -o codecov.json+```++Show coverage report contents:++```console+$ cat codecov.json+{"coverage":{"test/MyLibTest.hs":{"4":1}}}+```+++Using in GitHub workflow+------------------------++See+[hpc-codecov-action](https://github.com/8c6794b6/hpc-codecov-action)+to generate Codecov coverage report from GitHub workflow.++ Examples -------- -Following shows two examples for generating test coverage report of-the ``hpc-codecov`` package itself, one with ``cabal-install``+### Showing help++Show usage information:++```console+$ hpc-codecov --help+```++### Project using cabal-install++Search under directory made by ``cabal-install`` , generating a report+for test suite named ``my-project-test``. Skip searching under the+directories with base name ``my-project``, and exclude modules named+``Main`` and ``Paths_my_project`` from the report. Note the use of+comma to separate multiple values for the ``-x`` option:++```console+$ hpc-codecov -X my-project -x Main,Paths_my_project cabal:my-project-test+```++### Project using stack++Search under directory made by ``stack`` for test suite named+``my-project-test``, show verbose information, and write output to+``codecov.json``:++```console+$ hpc-codecov --verbose -o codecov.json stack:my-project-test+```++### Project using stack, with multiple packages++Search under directory made by ``stack`` for combined report of+multiple cabal packages, and write output to ``codecov.json``:++```consle+$ hpc-codecov stack:all -o codecov.json+```+++Low-level examples+------------------++The following shows two examples for generating a test coverage report+of the ``hpc-codecov`` package itself without specifying the build+tool. One with using the build artifacts made by ``cabal-install`` Nix-style local build commands, and another with ``stack``.  ### With cabal-install@@ -34,8 +164,8 @@  ```console $ cabal --version-cabal-install version 3.0.0.0-compiled using version 3.0.0.0 of the Cabal library+cabal-install version 3.4.0.0+compiled using version 3.4.0.0 of the Cabal library $ cabal v2-configure --enable-test --enable-coverage $ cabal v2-test ```@@ -44,7 +174,7 @@ ``.mix`` files:  ```console-$ proj=hpc-codecov-0.1.0.0+$ proj=hpc-codecov-0.3.0.0 $ tix=$(find ./dist-newstyle -name $proj.tix) $ mix=$(find ./dist-newstyle -name vanilla -print -quit)/mix/$proj $ hpc-codecov --mix=$mix --exclude=Paths_hpc_codecov --out=codecov.json $tix@@ -58,14 +188,14 @@ $ jq . codecov.json | head -10 {   "coverage": {-    "src/Trace/Hpc/Codecov/Error.hs": {-      "27": 1,-      "30": 1,-      "31": 1,-      "32": 1,-      "33": 1,-      "34": 1,-      "51": 0,+    "src/Trace/Hpc/Codecov/Options.hs": {+      "48": 1,+      "50": 1,+      "52": 1,+      "54": 1,+      "56": 1,+      "59": 1,+      "63": 1, ```  Send the resulting JSON report file to Codecov with the [bash@@ -80,10 +210,11 @@  According to the Codecov [FAQ](https://docs.codecov.io/docs/frequently-asked-questions), the-uploader should work from [Travis](https://travis-ci.org/),-[CircleCI](https://circleci.com/), and-[AppVeyor](https://www.appveyor.com/) for public projects without-Codecov token.+uploader should work from [Travis](https://travis-ci.com/),+[CircleCI](https://circleci.com/),+[Azure](https://azure.microsoft.com/en-us/services/devops/pipelines),+and [GitHub Actions](https://github.com/features/actions) for public+projects without the Codecov token.   ### With stack@@ -92,7 +223,7 @@  ```console $ stack --numeric-version-2.3.3+2.5.1 $ stack build --test --coverage ``` 
+ app/hpc-codecov.hs view
@@ -0,0 +1,4 @@+import Trace.Hpc.Codecov.Main++main :: IO ()+main = defaultMain
− exec/hpc-codecov.hs
@@ -1,4 +0,0 @@-import qualified Trace.Hpc.Codecov.Main as LibMain--main :: IO ()-main = LibMain.main
hpc-codecov.cabal view
@@ -1,6 +1,6 @@ cabal-version:       2.0 name:                hpc-codecov-version:             0.2.0.2+version:             0.3.0.0 synopsis:            Generate codecov report from hpc data license:             BSD3 license-file:        LICENSE@@ -22,8 +22,21 @@ extra-source-files:   README.md   CHANGELOG.md-  test/data/self.tar-  test/data/reciprocal.tar+  --+  test/data/reciprocal/reciprocal.hs+  test/data/reciprocal/reciprocal.tix+  test/data/reciprocal/.hpc/Main.mix+  --+  test/data/project1/ChangeLog.md+  test/data/project1/LICENSE+  test/data/project1/README.md+  test/data/project1/Setup.hs+  test/data/project1/app/Main.hs+  test/data/project1/package.yaml+  test/data/project1/src/Lib.hs+  test/data/project1/test/Spec.hs+  test/data/project1/project1.cabal+  test/data/project1/stack.yaml  tested-with:           GHC == 8.2.2                      , GHC == 8.4.4@@ -34,11 +47,12 @@  library   hs-source-dirs:      src-  exposed-modules:     Trace.Hpc.Codecov.Error+  exposed-modules:     Trace.Hpc.Codecov.Exception+                       Trace.Hpc.Codecov.Discover                        Trace.Hpc.Codecov.Main-                       Trace.Hpc.Codecov.Options                        Trace.Hpc.Codecov.Report                        Paths_hpc_codecov+  other-modules:       Trace.Hpc.Codecov.Options   autogen-modules:     Paths_hpc_codecov   build-depends:       base        >= 4.10  && < 5                      , array       >= 0.1   && < 0.6@@ -50,7 +64,7 @@   ghc-options:         -Wall  executable hpc-codecov-  hs-source-dirs:      exec+  hs-source-dirs:      app   main-is:             hpc-codecov.hs   build-depends:       base                      , hpc-codecov@@ -67,7 +81,7 @@                      , filepath                      , hpc-codecov                        ---                     , tar         >= 0.5   && < 0.6+                     , process     >= 1.6   && < 1.7                      , tasty       >= 1.0   && < 1.5                      , tasty-hunit >= 0.8   && < 1.0   default-language:    Haskell2010
+ src/Trace/Hpc/Codecov/Discover.hs view
@@ -0,0 +1,280 @@+-- |+-- Module:     Trace.Hpc.Codecov.Discover+-- Copyright:  (c) 2021 8c6794b6+-- License:    BSD3+-- Maintainer: 8c6794b6 <8c6794b6@gmail.com>+--+-- Walk through directories and find hpc data.++module Trace.Hpc.Codecov.Discover+  ( -- * Discover function and types+    discover+  , DiscoverArgs(..)+  , BuildTool(..)++    -- * Auxiliary+  , foldDir+  , defaultIgnored+  , foldDirWithIgnoring+  ) where++-- base+import Control.Exception           (throwIO)+import Control.Monad               (when)+import Data.Maybe                  (isNothing)+import System.IO                   (hPutStrLn, stderr)++-- directory+import System.Directory            (doesDirectoryExist, doesFileExist,+                                    listDirectory)++-- filepath+import System.FilePath             (splitFileName, takeExtension,+                                    takeFileName, (<.>), (</>))++-- Internal+import Trace.Hpc.Codecov.Exception+import Trace.Hpc.Codecov.Report+++-- ------------------------------------------------------------------------+--+-- Types+--+-- ------------------------------------------------------------------------++-- | Data type to hold arguments of 'discover' function.+data DiscoverArgs = DiscoverArgs+  { da_tool      :: BuildTool+    -- ^ Tool used to build Haskell cabal package.+  , da_testsuite :: String+    -- ^ Test suite name to search for @.tix@ file.+  , da_rootdir      :: FilePath+    -- ^ The project root directory.+  , da_builddir  :: Maybe String+    -- ^ Name of the temporary build directory made by the build tool.+  , da_skipdirs  :: [String]+    -- ^ Directories to skip while searching for scanning data.+  , da_verbose   :: Bool+    -- ^ Flag for shwoing verbose information.+  }++-- | Tool used for building Haskell package source codes.+data BuildTool+  = Cabal+  -- ^ For <https://www.haskell.org/cabal/index.html cabal-install>.+  | Stack+  -- ^ For <https://docs.haskellstack.org/en/stable/README/ stack>.+  deriving (Eq)++instance Show BuildTool where+  show tool = case tool of+    Cabal -> "cabal"+    Stack -> "stack"++-- | Walk thorugh directory and search for @.mix@ directories, Haskell+-- source code directories, and @.tix@ file.+discover :: DiscoverArgs -> IO Report+discover da = do+  let build_dir = case da_builddir da of+        Nothing  -> defaultBuildDirName (da_tool da)+        Just dir -> dir+      list_msg = concatMap (\p -> "    - " ++ p ++ "\n")+      skipped_dirs_msg =+        if null (da_skipdirs da)+           then "No directory specified to skip during discover"+           else "Skipping directories: " ++ unwords (da_skipdirs da)++  say da $+    "Starting discover for " ++ show (da_tool da) ++ "\n" +++    "Scanning under \"" ++ da_rootdir da ++ "\"" +++    " for .cabal files and \"" ++ build_dir ++ "\"\n" +++    skipped_dirs_msg++  (src_dirs, build_dirs) <- findSrcDirsAndBuildDirs da build_dir+  say da $+    "Scanned:\n" +++    "  Directories containing .cabal files:\n" ++ list_msg src_dirs +++    "  Build dirs:\n" ++ list_msg build_dirs++  tix_path <- parseTixish (da_testsuite da)+  (mb_tix, mixs) <- findTixAndMix da tix_path build_dirs++  found_tix_path <- case mb_tix of+    Just tix -> pure tix+    Nothing  -> throwIO $ TestSuiteNotFound (da_testsuite da)++  say da $+    "Discovered:\n" +++    "  Tix file: \n" ++ list_msg [found_tix_path] +++    "  Mix dirs: \n" ++ list_msg mixs++  return $ mempty+    { reportTix = found_tix_path+    , reportMixDirs = mixs+    , reportSrcDirs = src_dirs+    }++data TixPath+  = UnresolvedTixPath FilePath+  | ResolvedTixPath FilePath++parseTixish :: String -> IO TixPath+parseTixish str = do+  let tix1 = if takeExtension str == ".tix"+                then str+                else str <.> "tix"+  tix1_found <- doesFileExist tix1+  if tix1_found+     then return $ ResolvedTixPath tix1+     else return $ UnresolvedTixPath tix1++defaultBuildDirName :: BuildTool -> String+defaultBuildDirName tool = case tool of+  Cabal -> "dist-newstyle"+  Stack -> ".stack-work"++-- | Show mssage to 'stdrr'.+say :: DiscoverArgs -> String -> IO ()+say da msg = when (da_verbose da) $ hPutStrLn stderr msg++findSrcDirsAndBuildDirs+  :: DiscoverArgs -> String -> IO ([FilePath], [FilePath])+findSrcDirsAndBuildDirs da build_dir = do+    ds <- if null $ da_rootdir da+        then listDirectory "."+        else pure [da_rootdir da]+    foldDirWithIgnoring ignored f z ds+  where+    z = ([], [])+    f p acc@(src_dirs, dirs)+      | takeExtension p_file == ".cabal" = pure (p_dir:src_dirs, dirs)+      | p_file == build_dir  = pure (src_dirs, p:dirs)+      | otherwise = pure acc+      where+        (p_dir, p_file) = splitFileName p+    ignored = build_dir : (defaultIgnored ++ da_skipdirs da)++findTixAndMix+  :: DiscoverArgs -> TixPath -> [FilePath]+  -> IO (Maybe FilePath, [FilePath])+findTixAndMix da tixish build_dirs = case da_tool da of+  Stack -> findForStack excludes tixish build_dirs+  Cabal -> findForCabal excludes tixish build_dirs+  where+    excludes = defaultIgnored ++ da_skipdirs da+++-- ------------------------------------------------------------------------+--+-- Searching mix and tix for stack+--+-- ------------------------------------------------------------------------++findForStack+  :: [String] -> TixPath -> [FilePath] -> IO (Maybe FilePath, [FilePath])+findForStack excludes tx dirs = do+  mb_tix <- case tx of+    ResolvedTixPath path   -> pure $ Just path+    UnresolvedTixPath name -> findStackTix excludes name dirs+  mixs <- findStackMix excludes dirs+  pure (mb_tix, mixs)++findStackMix :: [String] -> [FilePath] -> IO [FilePath]+findStackMix ignored dirs = foldDirWithIgnoring ignored f [] dist_dirs+  where+    dist_dirs = map (</> "dist") dirs+    f p acc =+        pure $ if takeFileName p == "hpc"+                 then p : acc+                 else acc++findStackTix :: [String] -> String -> [FilePath] -> IO (Maybe FilePath)+findStackTix ignored tix_name dirs = go f Nothing install_dirs+  where+    go = foldDirWithIgnoring ignored+    install_dirs = map (</> "install") dirs+    f _ (Just tix) = return (Just tix)+    f p Nothing = if takeFileName p == tix_name+        then return (Just p)+        else return Nothing+++-- ------------------------------------------------------------------------+--+-- Searching mix and tix for cabal-install+--+-- ------------------------------------------------------------------------++findForCabal+  :: [String] -> TixPath -> [FilePath] -> IO (Maybe FilePath, [FilePath])+findForCabal ignored tx = foldDirWithIgnoring ignored f z+  where+    f = case tx of+      ResolvedTixPath _ -> findVanilla ignored+      UnresolvedTixPath tix_name -> \p acc@(mb_tix, dirs) -> do+        if isNothing mb_tix && takeFileName p == tix_name+          then return (Just p, dirs)+          else findVanilla ignored p acc++    z = case tx of+      ResolvedTixPath path -> (Just path, [])+      _                    -> (Nothing, [])++findVanilla+  :: [String] -> FilePath -> (Maybe FilePath, [FilePath])+  -> IO (Maybe FilePath, [FilePath])+findVanilla ignored p acc@(mb_tix, dirs) = do+  if takeFileName p == "vanilla"+    then do+      let mix = p </> "mix"+      mix_exist <- doesDirectoryExist mix+      if mix_exist+         then do+           let f xs = [mix </> x| x <- xs, x `notElem` ignored]+           contents <- f <$> listDirectory mix+           return (mb_tix, contents ++ dirs)+         else return (mb_tix, dirs)+    else return acc+++-- ------------------------------------------------------------------------+--+-- Simple directory walker+--+-- ------------------------------------------------------------------------++-- | Variant of 'foldDirWithIgnoring' with 'defaultIgnored'.+foldDir :: (FilePath -> a -> IO a) -> a -> [FilePath] -> IO a+foldDir = foldDirWithIgnoring defaultIgnored++-- | Default directory base names to ignore.+defaultIgnored :: [String]+defaultIgnored = [".git", ".github"]++-- | Fold under given directory.+foldDirWithIgnoring+  :: [String]+  -- ^ Directory base names to skip.+  -> (FilePath -> a -> IO a)+  -- ^ Accumulator function.+  -> a+  -- ^ Initial accumulator value.+  -> [FilePath]+  -- ^ Directories to walk through.+  -> IO a+foldDirWithIgnoring ignored f = go+  where+    go acc0 [] = return acc0+    go acc0 (dir:dirs) = do+      acc1 <- f dir acc0+      if takeFileName dir `elem` ignored+         then go acc1 dirs+         else do+           is_dir <- doesDirectoryExist dir+           if not is_dir+             then go acc1 dirs+             else do+               contents <- map (dir </>) <$> listDirectory dir+               acc2 <- go acc1 contents+               go acc2 dirs
− src/Trace/Hpc/Codecov/Error.hs
@@ -1,78 +0,0 @@--- |--- Module:     Trace.Hpc.Codecov.Error--- Copyright:  (c) 2020 8c6794b6--- License:    BSD3--- Maintainer: 8c6794b6 <8c6794b6@gmail.com>------ Error and exception related codes.--module Trace.Hpc.Codecov.Error-  (-    -- * Exception data type and handler-    HpcCodecovError(..)-  , withBriefUsageOnError-  ) where---- base-import Control.Exception  (Exception (..), handle)-import System.Environment (getProgName)-import System.Exit        (exitFailure)---- | Run the given action with a handler for 'HpcCodecovError'.------ The handler will show a brief usage and call 'exitFailure' when an--- exception was caught.-withBriefUsageOnError :: IO a   -- ^ Action to perform.-                      -> IO a-withBriefUsageOnError = handle handler-  where-    handler :: HpcCodecovError -> IO a-    handler e =-      do putStr ("Error: " ++ displayException e)-         name <- getProgName-         putStrLn ("Run '" ++ name ++ " --help' for usage.")-         exitFailure---- | Exceptions thrown during coverage report generation.-data HpcCodecovError-  = NoTixFile-   -- ^ Tix file path was not given.-  | TixNotFound FilePath-   -- ^ Tix file path was given, but not found.-  | MixNotFound FilePath [FilePath]-   -- ^ Mix file not found. The first field is the path specified by a-   -- tix file. The second is the searched paths.-  | SrcNotFound FilePath [FilePath]-   -- ^ Like 'MixNotFound', but for source code specified by a mix-   -- file.-  | InvalidArgs [String]-   -- ^ Some errors in command line argument, e.g., required value not-   -- specified.-  deriving (Show)--instance Exception HpcCodecovError where-  displayException = hpcCodecovErrorMessage--hpcCodecovErrorMessage :: HpcCodecovError -> String-hpcCodecovErrorMessage e =-  case e of-    NoTixFile -> "no .tix file given\n"-    TixNotFound tix -> "cannot find tix: " ++ show tix ++ "\n"-    MixNotFound mix locs -> searchedLocations "mix" mix locs-    SrcNotFound src locs -> searchedLocations "src" src locs-    InvalidArgs msgs ->-      case msgs of-        [x] -> x-        _   -> '\n' : concatMap ("  - " ++) msgs--searchedLocations :: String -> FilePath -> [FilePath] -> String-searchedLocations what path locs =-  "cannot find " ++ what ++ ": " ++ show path ++ locs'-  where-    locs' =-      case locs of-       [_] -> searched ""-       _   -> searched "s"-    searched post =-      "\nsearched location" ++ post ++ ":\n" ++-      unlines (map ("  " ++) locs)
+ src/Trace/Hpc/Codecov/Exception.hs view
@@ -0,0 +1,85 @@+-- |+-- Module:     Trace.Hpc.Codecov.Exception+-- Copyright:  (c) 2020 8c6794b6+-- License:    BSD3+-- Maintainer: 8c6794b6 <8c6794b6@gmail.com>+--+-- Error and exception related codes.++module Trace.Hpc.Codecov.Exception+  (+    -- * Exception data type and handler+    HpcCodecovError(..)+  , withBriefUsageOnError+  ) where++-- base+import Control.Exception  (Exception (..), handle)+import System.Environment (getProgName)+import System.Exit        (exitFailure)++-- | Run the given action with a handler for 'HpcCodecovError'.+--+-- The handler will show a brief usage and call 'exitFailure' when an+-- exception was caught.+withBriefUsageOnError :: IO a   -- ^ Action to perform.+                      -> IO a+withBriefUsageOnError = handle handler+  where+    handler :: HpcCodecovError -> IO a+    handler e =+      do putStr ("Error: " ++ displayException e)+         name <- getProgName+         putStrLn ("Run '" ++ name ++ " --help' for usage.")+         exitFailure++-- | Exceptions thrown during coverage report generation.+data HpcCodecovError+  = NoTarget+   -- ^ Target was not given.+  | TixNotFound FilePath+   -- ^ Tix file path was given, but not found.+  | MixNotFound FilePath [FilePath]+   -- ^ Mix file not found. The first field is the path specified by a+   -- tix file. The second is the searched paths.+  | SrcNotFound FilePath [FilePath]+   -- ^ Like 'MixNotFound', but for source code specified by a mix+   -- file.+  | InvalidBuildTool String+   -- ^ Invalid build tool.+  | TestSuiteNotFound String+   -- ^ Test suite was given, but not found.+  | InvalidArgs [String]+   -- ^ Some errors in command line argument, e.g., required value not+   -- specified.+  deriving (Show)++instance Exception HpcCodecovError where+  displayException = hpcCodecovErrorMessage++hpcCodecovErrorMessage :: HpcCodecovError -> String+hpcCodecovErrorMessage e =+  case e of+    NoTarget -> "no TARGET was given\n"+    TixNotFound tix -> "cannot find tix: " ++ show tix ++ "\n"+    MixNotFound mix locs -> searchedLocations "mix" mix locs+    SrcNotFound src locs -> searchedLocations "src" src locs+    InvalidBuildTool tool-> "invalid build tool: `" ++ tool ++ "'\n"+    TestSuiteNotFound name ->+      "cannot find tix for test suite: " ++ show name ++ "\n"+    InvalidArgs msgs ->+      case msgs of+        [x] -> x+        _   -> '\n' : concatMap ("  - " ++) msgs++searchedLocations :: String -> FilePath -> [FilePath] -> String+searchedLocations what path locs =+  "cannot find " ++ what ++ ": " ++ show path ++ locs'+  where+    locs' =+      case locs of+       [_] -> searched ""+       _   -> searched "s"+    searched post =+      "\nsearched location" ++ post ++ ":\n" +++      unlines (map ("  " ++) locs)
src/Trace/Hpc/Codecov/Main.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_HADDOCK hide #-} -- | -- Module:     Trace.Hpc.Codecov.Main -- Copyright:  (c) 2020 8c6794b6@@ -7,25 +6,25 @@ -- -- Main function for @hpc-codecov@. ---module Trace.Hpc.Codecov.Main (main) where+module Trace.Hpc.Codecov.Main (defaultMain) where  -- base-import Control.Exception         (throwIO)-import System.Environment        (getArgs)+import Control.Exception           (throwIO)+import System.Environment          (getArgs)  -- Internal-import Trace.Hpc.Codecov.Error+import Trace.Hpc.Codecov.Exception import Trace.Hpc.Codecov.Options import Trace.Hpc.Codecov.Report  -- | The main function for @hpc-codecov@ executable.-main :: IO ()-main = withBriefUsageOnError (getArgs >>= go)+defaultMain :: IO ()+defaultMain = withBriefUsageOnError (getArgs >>= go)   where     go args =       case parseOptions args of         Right opts | optShowHelp opts    -> printHelp                    | optShowVersion opts -> printVersion                    | optShowNumeric opts -> putStrLn versionString-                   | otherwise           -> genReport (opt2rpt opts)+                   | otherwise           -> opt2rpt opts >>= genReport         Left errs -> throwIO (InvalidArgs errs)
src/Trace/Hpc/Codecov/Options.hs view
@@ -27,15 +27,20 @@   ) where  -- base-import Control.Exception        (throw)-import Data.Version             (showVersion)-import System.Console.GetOpt    (ArgDescr (..), ArgOrder (..),-                                 OptDescr (..), getOpt, usageInfo)-import System.Environment       (getProgName)+import Control.Exception           (throw, throwIO)+import Data.Version                (showVersion)+import System.Console.GetOpt       (ArgDescr (..), ArgOrder (..),+                                    OptDescr (..), getOpt, usageInfo)+import System.Environment          (getProgName) +-- directory+import System.Directory            (doesFileExist)++ -- Internal-import Paths_hpc_codecov        (version)-import Trace.Hpc.Codecov.Error+import Paths_hpc_codecov           (version)+import Trace.Hpc.Codecov.Discover+import Trace.Hpc.Codecov.Exception import Trace.Hpc.Codecov.Report  -- | Options for generating test coverage report.@@ -50,26 +55,38 @@     -- ^ Module name strings to exclude from coverage report.   , optOutFile     :: Maybe FilePath     -- ^ Output file to write JSON report, if given.+   , optVerbose     :: Bool     -- ^ Flag for showing verbose message during coverage report     -- generation.++  , optRootDir :: FilePath+    -- ^ Project root directory for the build tool.+  , optBuildDir    :: Maybe FilePath+    -- ^ Name of the build directory used by the build tool+  , optSkipDirs    :: [String]+    -- ^ Directories to ignore while discovering.+   , optShowVersion :: Bool     -- ^ Flag for showing version.   , optShowNumeric :: Bool     -- ^ Flag for showing numeric version.   , optShowHelp    :: Bool     -- ^ Flag for showing help message.-  } deriving (Eq, Show)+  }  -- | Empty 'Options'. emptyOptions :: Options emptyOptions = Options-  { optTix = throw NoTixFile+  { optTix = throw NoTarget   , optMixDirs = []   , optSrcDirs = []   , optExcludes = []   , optOutFile = Nothing   , optVerbose = False+  , optRootDir = ""+  , optBuildDir = Nothing+  , optSkipDirs = []   , optShowVersion = False   , optShowNumeric = False   , optShowHelp = False@@ -85,36 +102,57 @@ -- | Commandline option oracle. options :: [OptDescr (Options -> Options)] options =-  [ Option ['m'] ["mixdir"]-            (ReqArg (\d o -> o {optMixDirs = d : optMixDirs o})-                    "DIR")+  [ Option ['m'] ["mix"]+           (ReqArg (\d o -> o {optMixDirs = uncommas d ++ optMixDirs o})+                   "DIR")             ".mix file directory, can repeat\n\-            \default is .hpc"-  , Option ['s'] ["srcdir"]-           (ReqArg (\d o -> o {optSrcDirs = d : optSrcDirs o})+            \(default: .hpc)"+  , Option ['s'] ["src"]+           (ReqArg (\d o -> o {optSrcDirs = uncommas d ++ optSrcDirs o})                    "DIR")-           "source directory, can repeat\n\-           \default is current directory"+           "Source directory, can repeat\n\+           \(default: current directory)"   , Option ['x'] ["exclude"]-           (ReqArg (\m o -> o {optExcludes = m : optExcludes o})+           (ReqArg (\m o -> o {optExcludes = uncommas m ++ optExcludes o})                    "MODULE")-           "module name to exclude, can repeat"+           "Module name to exclude, can repeat"   , Option ['o'] ["out"]            (ReqArg (\p o -> o {optOutFile = Just p}) "FILE")-           "output file\n\-           \default is stdout"+           "Output file\n\+           \(default: stdout)"++  , Option ['r'] ["root"]+           (ReqArg (\d o -> o {optRootDir = d})+                   "DIR")+           "Project root directory for TOOL\n\+           \Usually the directory containing\n\+           \'stack.yaml' or 'cabal.project'\n\+           \(default: current directory)"+  , Option ['b'] ["build"]+           (ReqArg (\d o -> o {optBuildDir = Just d})+                   "DIR")+           "Build directory made by the TOOL\n\+           \(default:\n\+           \ - '.stack-work' for stack\n\+           \ - 'dist-newstyle' for cabal)"+  , Option ['X'] ["skip"]+           (ReqArg (\d o -> o {optSkipDirs = uncommas d ++ optSkipDirs o})+                   "DIR")+           "Basename of directory to skip while\n\+           \searching data for TOOL, can repeat"+   , Option ['v'] ["verbose"]            (NoArg (\o -> o {optVerbose = True}))-           "show verbose output"+           "Show verbose output"   , Option [] ["version"]            (NoArg (\o -> o {optShowVersion = True}))-           "show versoin and exit"+           "Show versoin and exit"   , Option [] ["numeric-version"]            (NoArg (\o -> o {optShowNumeric = True}))-           "show numeric version and exit"+           "Show numeric version and exit"   , Option ['h'] ["help"]            (NoArg (\o -> o {optShowHelp = True}))-           "show this help"+           "Show this help and exit"   ]  -- | Parse command line argument and return either error messages or@@ -146,16 +184,56 @@              then fld defaultOptions              else orig +-- | Representation of @TARGET@ argument.+data Target+  = TixFile FilePath+  | TestSuite BuildTool String++parseTarget :: String -> IO Target+parseTarget str = do+  -- Detecting file existence before separating with ':', to support+  -- directory path containing ':' under Windows.+  file_found <- doesFileExist str+  if file_found+     then pure $ TixFile str+     else case break (== ':') str of+       ("cabal", ':':name) -> pure $ TestSuite Cabal name+       ("stack", ':':name) -> pure $ TestSuite Stack name+       (tool, ':':_)       -> throwIO $ InvalidBuildTool tool+       _                   -> pure $ TixFile str++uncommas :: String -> [String]+uncommas = go+  where+    go str = case break (== ',') str of+      (cs, ',':rest) -> cs : go rest+      (cs, _)        -> [cs]+ -- | Make a 'Report' value from 'Optoins'.-opt2rpt :: Options -> Report-opt2rpt opt = Report-  { reportTix = optTix opt-  , reportMixDirs = optMixDirs opt-  , reportSrcDirs = optSrcDirs opt-  , reportExcludes = optExcludes opt-  , reportOutFile = optOutFile opt-  , reportVerbose = optVerbose opt-  }+opt2rpt :: Options -> IO Report+opt2rpt opt = do+  let rpt1 = mempty+        { reportMixDirs = optMixDirs opt+        , reportSrcDirs = optSrcDirs opt+        , reportExcludes = optExcludes opt+        , reportOutFile = optOutFile opt+        , reportVerbose = verbose+        }+      tix = optTix opt+      verbose = optVerbose opt+  target <- parseTarget tix+  case target of+    TixFile path -> pure (rpt1 {reportTix = path})+    TestSuite tool name -> do+      rpt2 <- discover DiscoverArgs+        { da_tool = tool+        , da_testsuite = name+        , da_rootdir = optRootDir opt+        , da_builddir = optBuildDir opt+        , da_skipdirs = optSkipDirs opt+        , da_verbose = verbose+        }+      pure $ rpt1 `mappend` rpt2  -- | Print help messages. printHelp :: IO ()@@ -170,16 +248,25 @@ -- | Help message for command line output. helpMessage :: String -- ^ Executable program name.             -> String-helpMessage name = usageInfo header options+helpMessage name = usageInfo header options ++ footer   where-    header = "\-\Generate Codecov JSON coverage report from .tix and .mix files\n\+    header = "USAGE: " ++ name ++ " [OPTIONS] TARGET\n\ \\n\-\Usage: \n\+\Generate Codecov JSON coverage report for Haskell source codes\n\+\from .tix and .mix files made with hpc.\n\ \\n\-\   " ++ name ++ " [OPTIONS] TIX_FILE\n\+\TARGET is either a path to .tix file or 'TOOL:TEST_SUITE'.\n\+\Supported TOOL values are 'stack' and 'cabal'. When the TOOL is\n\+\'stack' and building project with multiple packages, use 'all' as\n\+\TEST_SUITE value to refer the combined report.\n\ \\n\-\Options:\n"+\OPTIONS:\n"+    footer = "\+\\n\+\For more info, see:\n\+\\n\+\  https://github.com/8c6794b6/hpc-codecov#readme\n\+\\n"  -- | String representation of the version number of this package. versionString :: String
src/Trace/Hpc/Codecov/Report.hs view
@@ -21,41 +21,42 @@   ) where  -- base-import Control.Exception       (ErrorCall, handle, throwIO)-import Control.Monad           (when)-import Control.Monad.ST        (ST)-import Data.List               (foldl', intersperse)-import System.IO               (IOMode (..), hPutStrLn, stderr, stdout,-                                withFile)+import Control.Exception           (ErrorCall, handle, throw, throwIO)+import Control.Monad               (mplus, when)+import Control.Monad.ST            (ST)+import Data.Function               (on)+import Data.List                   (foldl', intersperse)+import System.IO                   (IOMode (..), hPutStrLn, stderr, stdout,+                                    withFile) #if !MIN_VERSION_base(4,11,0)-import Data.Monoid             ((<>))+import Data.Monoid                 ((<>)) #endif  -- array-import Data.Array.Base         (unsafeAt)-import Data.Array.IArray       (bounds, listArray, range, (!))-import Data.Array.MArray       (newArray, readArray, writeArray)-import Data.Array.ST           (STUArray, runSTUArray)-import Data.Array.Unboxed      (UArray)+import Data.Array.Base             (unsafeAt)+import Data.Array.IArray           (bounds, listArray, range, (!))+import Data.Array.MArray           (newArray, readArray, writeArray)+import Data.Array.ST               (STUArray, runSTUArray)+import Data.Array.Unboxed          (UArray)  -- bytestring-import Data.ByteString.Builder (Builder, char7, hPutBuilder, intDec,-                                string7, stringUtf8)+import Data.ByteString.Builder     (Builder, char7, hPutBuilder, intDec,+                                    string7, stringUtf8)  -- directory-import System.Directory        (doesFileExist)+import System.Directory            (doesFileExist)  -- filepath-import System.FilePath         ((<.>), (</>))+import System.FilePath             ((<.>), (</>))  -- hpc-import Trace.Hpc.Mix           (BoxLabel (..), Mix (..), MixEntry, readMix)-import Trace.Hpc.Tix           (Tix (..), TixModule (..), readTix)-import Trace.Hpc.Util          (HpcPos, fromHpcPos)+import Trace.Hpc.Mix               (BoxLabel (..), Mix (..), MixEntry,+                                    readMix)+import Trace.Hpc.Tix               (Tix (..), TixModule (..), readTix)+import Trace.Hpc.Util              (HpcPos, fromHpcPos)  -- Internal-import Trace.Hpc.Codecov.Error--- import Trace.Hpc.Codecov.Options+import Trace.Hpc.Codecov.Exception   -- ------------------------------------------------------------------------@@ -80,6 +81,36 @@  , reportVerbose  :: Bool    -- ^ Flag for showing verbose message during report generation.  } deriving (Eq, Show)++#if MIN_VERSION_base(4,11,0)+instance Semigroup Report where+  (<>) = mappendReport+#endif++instance Monoid Report where+  mempty = emptyReport+  mappend = mappendReport++emptyReport :: Report+emptyReport = Report+  { reportTix = throw NoTarget+  , reportMixDirs = []+  , reportSrcDirs = []+  , reportExcludes = []+  , reportOutFile = Nothing+  , reportVerbose = False+  }++mappendReport :: Report -> Report -> Report+mappendReport r1 r2 =+  let extend f = ((<>) `on` f) r1 r2+  in  Report { reportTix = reportTix r2+             , reportMixDirs = extend reportMixDirs+             , reportSrcDirs = extend reportSrcDirs+             , reportExcludes = extend reportExcludes+             , reportOutFile = (mplus `on` reportOutFile) r1 r2+             , reportVerbose = ((||) `on` reportVerbose) r1 r2+             }  -- | Single file entry in coverage report. --
test/Test/Main.hs view
@@ -1,29 +1,49 @@+{-# LANGUAGE CPP #-} -- | Test codes for running @hpc-codecov@ executable. module Test.Main (main) where  -- base-import           Control.Exception         (SomeException (..), try)-import           System.Environment        (withArgs)-import           System.IO                 (hClose, openTempFile)+import           Control.Exception          (SomeException (..), try)+import           Control.Monad              (when)+import           Data.List                  (isSubsequenceOf)+import           Data.Maybe                 (fromMaybe, isJust)+import           System.Environment         (getExecutablePath, lookupEnv,+                                             setEnv, unsetEnv, withArgs)+import           System.Exit                (ExitCode)+import           System.IO                  (hClose, openTempFile) +#if !MIN_VERSION_base(4,11,0)+import           Data.Monoid                ((<>))+#endif++ -- filepath-import           System.FilePath           (dropExtension, (<.>), (</>))+import           System.FilePath            (takeFileName, (</>))  -- directory-import           System.Directory          (removeDirectoryRecursive,-                                            removeFile)+import           System.Directory           (canonicalizePath,+                                             doesDirectoryExist,+                                             listDirectory,+                                             removeDirectoryRecursive,+                                             removeFile,+                                             withCurrentDirectory) --- tar-import           Codec.Archive.Tar         (extract)+-- process+import           System.Process             (CreateProcess (..),+                                             callProcess, shell,+                                             waitForProcess,+                                             withCreateProcess)  -- tasty-import           Test.Tasty                (TestTree, defaultMain,-                                            testGroup, withResource)-import           Test.Tasty.HUnit+import           Test.Tasty                 (TestTree, defaultMain,+                                             testGroup, withResource)+import           Test.Tasty.HUnit           (assertEqual, assertFailure,+                                             testCase)  -- Internal-import qualified Trace.Hpc.Codecov.Main    as HpcCodecov-import           Trace.Hpc.Codecov.Options+import           Trace.Hpc.Codecov.Discover+import qualified Trace.Hpc.Codecov.Main     as HpcCodecov+import           Trace.Hpc.Codecov.Report   -- ------------------------------------------------------------------------@@ -33,16 +53,38 @@ -- ------------------------------------------------------------------------  main :: IO ()-main = defaultMain tests+main = do+  test_in_test <- isTestInTest+  mb_tool <- getBuildTool -tests :: TestTree-tests =-  testGroup "main"-            [ cmdline-            , withTestTarData "self.tar" selfReport-            , withTestTarData "reciprocal.tar" recipReport-            ]+  when test_in_test $ putStr $ unlines+    [ ""+    , "================================="+    , "Running test to generate hpc data"+    , "================================="+    , "" ] +  defaultMain $ testGroup "main" $+    [reportTest , cmdline, recipReport] +++    [selfReportTest | not test_in_test, isJust mb_tool] +++    [discoverStackTest | not test_in_test, mb_tool == Just Stack] +++    [discoverCabalTest | not test_in_test, mb_tool == Just Cabal]++reportTest :: TestTree+reportTest = testGroup "report"+  [ testCase "mempty" $ do+      shouldFail (print $ reportTix mempty)+      assertEqual "empty mix dirs" (reportMixDirs mempty) []+      assertEqual "empty src dirs" (reportSrcDirs mempty) []+      assertEqual "non verbose" (reportVerbose mempty) False+      let r1 = mempty { reportExcludes = ["M1"] }+          r2 = mempty { reportExcludes = ["M2", "M3"]+                      , reportVerbose = True }+          r3 = r1 <> r2+      assertEqual "<> for verbose" (reportVerbose r3) True+      assertEqual "<> for excludes" (reportExcludes r3) ["M1","M2","M3"]+  ]+ cmdline :: TestTree cmdline = testGroup "cmdline"   [ testCase "non-existing-option"@@ -50,36 +92,20 @@   , testCase "non-existing-options"              (shouldFail (main' ["--foo", "--bar", "--buzz"]))   , testCase "mixdir-without-argument"-             (shouldFail (main' ["--mixdir"]))+             (shouldFail (main' ["--mix"]))   , testCase "no-tix-file"              (shouldFail (main' []))   , testCase "non-existing-tix"              (shouldFail (main' ["no_such_file.tix"]))+  , testCase "invalid-build-tool"+              (shouldFail (main' ["foo:tests"]))+  , testCase "invalid-test-suite"+              (shouldFail (main' ["cabal:no-such-test"]))   , testCase "help" (main' ["--help"])   , testCase "version" (main' ["--version"])   , testCase "numeric-version" (main' ["--numeric-version"])   ] -selfReport :: TestTree-selfReport = testGroup "self"-  [ testCase "self-data-to-stdout"-             (main' selfHpcDataArgs)-  , testCase "self-data-to-stdout-verbose"-             (main' ("--verbose":selfHpcDataArgs))-  , withTempFile-      (\getPath ->-         testCase "self-data-to-file-verbose"-                  (do path <- getPath-                      main' (["--out=" ++ path, "--verbose"] ++-                             selfHpcDataArgs)))-  , testCase "self-data-no-mix-none"-             (shouldFail (main' [selfTix]))-  , testCase "self-data-no-mix-one"-             (shouldFail (main' ["--mix=foo", selfTix]))-  , testCase "self-data-no-all-two"-             (shouldFail (main' ["--mix=foo", "--mix=bar", selfTix]))-  ]- recipReport :: TestTree recipReport = testGroup "recip"   [ testCase "recip-data-to-stdout"@@ -97,30 +123,291 @@                        ,"test/data/reciprocal/reciprocal.tix"]))   ] +-- Note: Running test to generate .mix and .tix of hpc-codecov package+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- The test recursively runs itself to generate .mix and .tix files of+-- the hpc-codecov package itself.+--+-- To terminate the recursive run, the "main" function in this module+-- is looking up an environment variable to check whether the test is+-- running inside the test or not. Recursive run is done only for the+-- known build tool (e.g.: cabal install, stack).++selfReportTest :: TestTree+selfReportTest = withTempDir work1+  where+    work1 getDir =+      withResource (acquire getDir) release selfReport+    acquire getDir =+      setEnv testInTestKey "TRUE" >> getDir >>= getSelfReportArgs+    release _ =+      unsetEnv testInTestKey++-- | Self Report Arguments+data SRA =+  SRA { sra_tix      :: FilePath+      , sra_mixs     :: [FilePath]+      , sra_excludes :: [String]+      , sra_verbose  :: Bool+      , sra_out      :: Maybe FilePath+      }++emptySRA :: SRA+emptySRA = SRA { sra_tix = ""+               , sra_mixs = []+               , sra_excludes = []+               , sra_verbose = False+               , sra_out = Nothing }++getBuildTool :: IO (Maybe BuildTool)+getBuildTool = do+  path <- getExecutablePath+  if ".stack-work" `isSubsequenceOf` path+     then return $ Just Stack+     else if "dist-newstyle" `isSubsequenceOf` path+       then return $ Just Cabal+       else return Nothing++getSelfReportArgs :: FilePath -> IO SRA+getSelfReportArgs builddir = do+  mb_tool <- getBuildTool+  case mb_tool of+    Just Stack -> getSelfReportStackArgs builddir+    Just Cabal -> getSelfReportCabalArgs setupV2 builddir+    _          -> error "Cannot determine build tool"++getSelfReportStackArgs :: FilePath -> IO SRA+getSelfReportStackArgs wd = do+  callProcess "stack" [ "--work-dir=" ++ wd, "test", "--coverage"]+  mb_tix <- findUnder (\p -> takeFileName p == "test-main.tix") wd+  mb_mix <- findUnder (\p -> takeFileName p == "hpc") (wd </> "dist")+  case (mb_tix, mb_mix) of+    (Just tix, Just mix) -> do+      return emptySRA { sra_tix = tix+                      , sra_mixs = [mix]+                      , sra_excludes = ["Paths_hpc_codecov"] }+    _ -> error "getting arguments for self test with stack failed"++-- setupV1 :: FilePath -> IO ()+-- setupV1 bd = bracket acquire release work+--   where+--     -- Cabal v1 style build complains when "GHC_PACKAGE_PATH"+--     -- environment were set, manually removing the variable.+--     key = "GHC_PACKAGE_PATH"++--     acquire = do+--       mb_ghc_pkg_path <- lookupEnv key+--       putStrLn $ "GHC_PACKAGE_PATH: " ++ show mb_ghc_pkg_path+--       unsetEnv key+--       pure mb_ghc_pkg_path++--     release = mapM_ (setEnv key)++--     work _ = do+--       let setup args = callProcess "runhaskell" ("Setup.hs" : args)++--       setup [ "configure", "--builddir=" ++ bd+--             , "--enable-test", "--enable-coverage"+--             , "--package-db=/build/package.conf.d" ]++--       setup ["build", "--builddir=" ++ bd]+--       setup ["test", "--builddir=" ++ bd]++setupV2 :: FilePath -> IO ()+setupV2 bd =+  callProcess "cabal" [ "test", "--builddir=" ++ bd, "--enable-coverage"]++getSelfReportCabalArgs :: (FilePath -> IO ()) -> FilePath -> IO SRA+getSelfReportCabalArgs setup bd = do+  setup bd+  mb_tix <- findUnder (\p -> takeFileName p == "test-main.tix") bd+  putStrLn $ "tix: " ++ show mb_tix+  mb_vanilla <- findUnder (\p -> takeFileName p == "vanilla") bd+  putStrLn $ "vanilla: " ++ show mb_vanilla+  case (mb_tix, mb_vanilla) of+    (Nothing, Nothing) -> error "failed to find tix and vanilla"+    (Nothing, _) -> error "failed to find tix"+    (_, Nothing) -> error "failed to find vanilla"+    (Just tix, Just vanilla) -> do+      let mixdir = vanilla </> "mix"+      mixs <- map (mixdir </>) <$> listDirectory mixdir+      return emptySRA { sra_tix = tix+                      , sra_mixs = mixs+                      , sra_excludes = ["Main", "Paths_hpc_codecov"] }++selfReport :: IO SRA -> TestTree+selfReport getArgs = testGroup "self"+  [ testCase "self-data-to-stdout"+             (getArgs >>= sraMain)+  , testCase "self-data-to-stdout-verbose"+             (do args <- getArgs+                 sraMain (args {sra_verbose=True}))+  , withTempFile+      (\getPath ->+         testCase "self-data-to-file-verbose"+                  (do path <- getPath+                      args <- getArgs+                      sraMain (args {sra_out=Just path+                                    ,sra_verbose=True})))+  , testCase "self-data-no-mix-none"+             (getArgs >>= shouldFail . sraMain . tixOnly)+  , testCase "self-data-no-mix-one"+             (do args <- getArgs+                 shouldFail (sraMain ((tixOnly args) {sra_mixs=["foo"]})))+  , testCase "self-data-no-all-two"+             (do args <- getArgs+                 let args' = (tixOnly args) { sra_mixs = ["foo", "bar"] }+                 shouldFail (sraMain args'))+  ]+  where+    tixOnly sra = emptySRA { sra_tix = sra_tix sra }++ -- ------------------------------------------------------------------------ --+-- Discover tests+--+-- ------------------------------------------------------------------------++discoverStackTest :: TestTree+discoverStackTest =+  let t = buildAndTestWithStack+      withProject name act = case getAcquireAndRelease Stack name [] of+        (a,r) -> withResource a r (const act)+  in  testGroup "discover_stack"+        [ t "project1"+          [ "--root=" ++ testData "project1"+          , "--verbose"+          , "stack:project1-test"]+          []+        , t "project1"+          [ "--root=" ++ testData "project1"+          , "--verbose"+          , "--build=dot-stack-work"+          , "stack:project1-test.tix"]+          ["--work-dir=dot-stack-work"]++        , withProject "project1" $+            testCase "project1" $+              withCurrentDirectory (testData "project1") $ main'+                [ "--verbose", "stack:project1-test" ]++        , withProject "project1" $+            withResource+              (findUnder (\p -> takeFileName p == "project1-test.tix")+                         (testData "project1" </> ".stack-work"))+              (\_ -> pure ())+              (\getTixPath -> testCase "project1" $ do+                 tix_path <- fromMaybe "project1-test.tix" <$> getTixPath+                 canonical_tix_path <- canonicalizePath tix_path+                 putStrLn $+                   "tix_path: " ++ tix_path ++ "\n" +++                   "canonical_tix_path: " ++ canonical_tix_path+                 main' [ "--verbose", "stack:" ++ canonical_tix_path ])+        ]++discoverCabalTest :: TestTree+discoverCabalTest =+  let t = buildAndTestWithCabal+      withProject name act = case getAcquireAndRelease Stack name [] of+        (a,r) -> withResource a r (const act)+  in  testGroup "discover_cabal"+        [ t "project1"+          [ "--root=" ++ testData "project1"+          , "--verbose"+          , "-x", "Paths_project1"+          , "-X", "project1-exe"+          , "cabal:project1-test" ]+          []++        , withProject "project1" $+            withResource+              (findUnder (\p -> takeFileName p == "project1-test.tix")+                (testData "project1" </> "dist-newstyle"))+              (\_ -> pure ())+              (\getTixPath -> testCase "project1" $ do+                  tix_path <- fromMaybe "project1-test.tix" <$> getTixPath+                  canonical_tix_path <- canonicalizePath tix_path+                  main' [ "--verbose"+                        , "-x", "Main,Paths_project1"+                        , "cabal:" ++ canonical_tix_path])+        ]++buildAndTestWithStack :: String -> [String] -> [String] -> TestTree+buildAndTestWithStack = buildAndTestWith Stack++buildAndTestWithCabal :: String -> [String] -> [String] -> TestTree+buildAndTestWithCabal = buildAndTestWith Cabal++buildAndTestWith :: BuildTool -> String -> [String] -> [String] -> TestTree+buildAndTestWith tool name args tool_args = withResource acquire release work+  where+    (acquire, release) = getAcquireAndRelease tool name tool_args+    work _ec = testCase name $ main' args++getAcquireAndRelease+  :: BuildTool -> String -> [String] -> (IO ExitCode, ExitCode -> IO ())+getAcquireAndRelease tool name tool_args = (acquire, release)+  where+    dir = testData name++    acq_cmd = case tool of+      Stack -> ("stack", ["test", "--coverage"])+      Cabal -> ("cabal", ["test", "--enable-coverage"])++    call (cmd,args) = callProcessIn dir cmd (tool_args ++ args)++    acquire = do+      putStrLn $ "Testing " ++ name ++ " with " ++ show tool ++ " ..."+      ec <- call acq_cmd+      putStrLn $ "ec: " ++ show ec+      return ec++    release _ec = pure ()++callProcessIn :: FilePath -> String -> [String] -> IO ExitCode+callProcessIn dir cmd args = withCreateProcess cp f+  where+    f _ _ _ = waitForProcess+    cp = (shell (unwords (cmd : args))) {cwd = Just dir}+++-- ------------------------------------------------------------------------+-- -- Auxiliary functions -- -- ------------------------------------------------------------------------ +isTestInTest :: IO Bool+isTestInTest = isJust <$> lookupEnv testInTestKey++testInTestKey :: String+testInTestKey = "HPC_CODECOV_TEST_IN_TEST"++findUnder :: (FilePath -> Bool) -> FilePath -> IO (Maybe FilePath)+findUnder test root = foldDir f Nothing [root]+  where+    f _    acc@(Just _) = return acc+    f path Nothing =+      if test path+         then return (Just path)+         else return Nothing+ -- | Wrapper to run 'Trace.Hpc.Codecov.Main.main' with given argument -- strings. main' :: [String] -> IO ()-main' args = withArgs args HpcCodecov.main+main' args = withArgs args HpcCodecov.defaultMain --- | Run given test with mix and tix files of tar file.------ The mix and tix packages are archived as 'test/data/XXX.tar' and--- added as extra source file in cabal configuration. Unpacked tar--- contents are removed after running given tests.-withTestTarData :: String   -- ^ Tar file name under 'testDataDir'-                -> TestTree -- ^ Test using the tar contents-                -> TestTree-withTestTarData dot_tar tt = withResource acquire release (const tt)+sraMain :: SRA -> IO ()+sraMain sra = main' args   where-    acquire = do extract testDataDir (testDataDir </> dot_tar)-                 return (testDataDir </> dropExtension dot_tar)-    release = removeDirectoryRecursive+    args =+      map ("--mix=" ++) (sra_mixs sra) +++      map ("--exclude=" ++) (sra_excludes sra) +++      maybe [] (\p -> ["--out=" ++ p]) (sra_out sra) +++      ["--verbose" | sra_verbose sra] +++      [sra_tix sra]  -- | Run test with path to temporary file. withTempFile :: (IO FilePath -> TestTree) -> TestTree@@ -131,27 +418,19 @@                  return path     release path = removeFile path --- | My package name-me :: String-me = "hpc-codecov-" ++ versionString---- | Directory path of extracted @self.tar@.-selfDir :: FilePath-selfDir = testDataDir </> "self"---- | Relative path of tix file in @self.tar@ from project root.-selfTix :: FilePath-selfTix = selfDir </> "tix" </> me </> me <.> "tix"---- | Arguments for running test with @self.tar@ contents.-selfHpcDataArgs :: [String]-selfHpcDataArgs =-  let mix = selfDir </> "mix" </> me-  in  ["--mix=" ++ mix, "--exclude=Paths_hpc_codecov", selfTix]---- | Directory containing test data.-testDataDir :: FilePath-testDataDir = "test" </> "data"+withTempDir :: (IO FilePath -> TestTree) -> TestTree+withTempDir = withResource acquire release+  where+     acquire = do+       mb_tool <- getBuildTool+       dir <- case mb_tool of+         Just Stack -> pure ".hpc_codecov_test_tmp_stack"+         Just Cabal -> pure ".hpc_codecov_test_tmp_cabal_v2"+         _          -> error "Cannot determine build tool"+       exists <- doesDirectoryExist dir+       when exists $ removeDirectoryRecursive dir+       pure dir+     release _ = return ()  -- | Pass the HUnit test when an exception was thrown, otherwise a -- test failure.@@ -159,5 +438,9 @@ shouldFail act =   do et_err <- try act      case et_err of-       Left (SomeException {}) -> return ()-       _                       -> assertFailure "should fail"+       Left SomeException {} -> return ()+       _                     -> assertFailure "should fail"++-- | Get directory under test data.+testData :: String -> FilePath+testData dir = "test" </> "data" </> dir
+ test/data/project1/ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for project1++## Unreleased changes
+ test/data/project1/LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2021++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ test/data/project1/README.md view
@@ -0,0 +1,1 @@+# project1
+ test/data/project1/Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ test/data/project1/app/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import Lib++main :: IO ()+main = someFunc 42
+ test/data/project1/package.yaml view
@@ -0,0 +1,48 @@+name:                project1+version:             0.1.0.0+github:              "githubuser/project1"+license:             BSD3+author:              "Author name here"+maintainer:          "example@example.com"+copyright:           "2021 Author name here"++extra-source-files:+- README.md+- ChangeLog.md++# Metadata used when publishing your package+# synopsis:            Short description of your package+# category:            Web++# To avoid duplicated efforts in documentation and dealing with the+# complications of embedding Haddock markup inside cabal files, it is+# common to point users to the README.md file.+description:         Please see the README on GitHub at <https://github.com/githubuser/project1#readme>++dependencies:+- base >= 4.7 && < 5++library:+  source-dirs: src++executables:+  project1-exe:+    main:                Main.hs+    source-dirs:         app+    ghc-options:+    - -threaded+    - -rtsopts+    - -with-rtsopts=-N+    dependencies:+    - project1++tests:+  project1-test:+    main:                Spec.hs+    source-dirs:         test+    ghc-options:+    - -threaded+    - -rtsopts+    - -with-rtsopts=-N+    dependencies:+    - project1
+ test/data/project1/project1.cabal view
@@ -0,0 +1,62 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 2a82452cb1b1a322c856e7d346b38bfb8136930e2638507eb703234a0658f2dc++name:           project1+version:        0.1.0.0+description:    Please see the README on GitHub at <https://github.com/githubuser/project1#readme>+homepage:       https://github.com/githubuser/project1#readme+bug-reports:    https://github.com/githubuser/project1/issues+author:         Author name here+maintainer:     example@example.com+copyright:      2021 Author name here+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/githubuser/project1++library+  exposed-modules:+      Lib+  other-modules:+      Paths_project1+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+  default-language: Haskell2010++executable project1-exe+  main-is: Main.hs+  other-modules:+      Paths_project1+  hs-source-dirs:+      app+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , project1+  default-language: Haskell2010++test-suite project1-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_project1+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , project1+  default-language: Haskell2010
+ test/data/project1/src/Lib.hs view
@@ -0,0 +1,9 @@+module Lib+    ( someFunc+    ) where++someFunc :: Int -> IO ()+someFunc n =+    if even n+      then putStrLn "got even number"+      else putStrLn "not a even number"
+ test/data/project1/stack.yaml view
@@ -0,0 +1,67 @@+# This file was automatically generated by 'stack init'+#+# Some commonly used options have been documented as comments in this file.+# For advanced use and comprehensive documentation of the format, please see:+# https://docs.haskellstack.org/en/stable/yaml_configuration/++# Resolver to choose a 'specific' stackage snapshot or a compiler version.+# A snapshot resolver dictates the compiler version and the set of packages+# to be used for project dependencies. For example:+#+# resolver: lts-3.5+# resolver: nightly-2015-09-21+# resolver: ghc-7.10.2+#+# The location of a snapshot can be provided as a file or url. Stack assumes+# a snapshot provided as a file might change, whereas a url resource does not.+#+# resolver: ./custom-snapshot.yaml+# resolver: https://example.com/snapshots/2018-01-01.yaml+resolver:+  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/7.yaml++# User packages to be built.+# Various formats can be used as shown in the example below.+#+# packages:+# - some-directory+# - https://example.com/foo/bar/baz-0.0.2.tar.gz+#   subdirs:+#   - auto-update+#   - wai+packages:+- .+# Dependency packages to be pulled from upstream that are not in the resolver.+# These entries can reference officially published versions as well as+# forks / in-progress versions pinned to a git hash. For example:+#+# extra-deps:+# - acme-missiles-0.3+# - git: https://github.com/commercialhaskell/stack.git+#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a+#+# extra-deps: []++# Override default flag values for local packages and extra-deps+# flags: {}++# Extra package databases containing global packages+# extra-package-dbs: []++# Control whether we use the GHC we find on the path+# system-ghc: true+#+# Require a specific version of stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: ">=2.5"+#+# Override the architecture used by stack, especially useful on Windows+# arch: i386+# arch: x86_64+#+# Extra directories used by stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]+#+# Allow a newer minor version of GHC than the snapshot specifies+# compiler-check: newer-minor
+ test/data/project1/test/Spec.hs view
@@ -0,0 +1,4 @@+import Lib++main :: IO ()+main = someFunc 42
− test/data/reciprocal.tar

binary file changed (10240 → absent bytes)

+ test/data/reciprocal/.hpc/Main.mix view
@@ -0,0 +1,1 @@+Mix "reciprocal.hs" 2020-02-05 11:44:49.181788328 UTC 2523442504 8 [(17:21-17:21,ExpBox False),(17:26-17:26,ExpBox False),(17:21-17:26,ExpBox False),(17:21-17:26,BinBox GuardBinBox True),(17:21-17:26,BinBox GuardBinBox False),(17:33-17:33,ExpBox True),(18:21-18:29,ExpBox False),(18:21-18:29,BinBox GuardBinBox True),(18:21-18:29,BinBox GuardBinBox False),(18:33-18:33,ExpBox False),(18:46-18:46,ExpBox False),(18:48-18:49,ExpBox False),(18:37-18:49,ExpBox False),(18:33-18:49,ExpBox True),(17:1-18:49,TopLevelBox ["position"]),(13:16-13:16,ExpBox False),(13:18-13:19,ExpBox False),(13:15-13:20,ExpBox False),(13:32-13:32,ExpBox False),(13:15-13:32,ExpBox False),(14:31-14:31,ExpBox False),(14:33-14:33,ExpBox False),(14:36-14:36,ExpBox False),(14:38-14:39,ExpBox False),(14:35-14:40,ExpBox False),(14:24-14:40,ExpBox False),(9:17-9:17,ExpBox False),(9:26-9:27,ExpBox False),(9:17-9:27,ExpBox False),(9:17-9:27,BinBox GuardBinBox True),(9:17-9:27,BinBox GuardBinBox False),(9:32-9:33,ExpBox False),(9:45-9:45,ExpBox False),(9:47-9:48,ExpBox False),(9:36-9:48,ExpBox False),(9:31-9:49,ExpBox True),(10:17-10:17,ExpBox False),(10:22-10:22,ExpBox False),(10:17-10:22,ExpBox False),(10:17-10:22,BinBox GuardBinBox True),(10:17-10:22,BinBox GuardBinBox False),(10:37-10:37,ExpBox False),(10:32-10:37,ExpBox False),(10:40-10:40,ExpBox False),(10:31-10:41,ExpBox True),(11:17-11:17,ExpBox False),(11:22-11:22,ExpBox False),(11:17-11:22,ExpBox False),(11:17-11:22,BinBox GuardBinBox True),(11:17-11:22,BinBox GuardBinBox False),(11:37-11:37,ExpBox False),(11:32-11:37,ExpBox False),(11:42-11:47,ExpBox False),(11:32-11:47,ExpBox False),(11:50-11:54,ExpBox False),(11:31-11:55,ExpBox True),(9:1-14:40,TopLevelBox ["divide"]),(6:30-6:30,ExpBox False),(6:32-6:32,ExpBox False),(6:34-6:35,ExpBox False),(6:23-6:35,ExpBox False),(2:16-2:16,ExpBox False),(2:20-2:20,ExpBox False),(2:16-2:20,ExpBox False),(2:16-2:20,BinBox GuardBinBox True),(2:16-2:20,BinBox GuardBinBox False),(2:25-2:27,ExpBox False),(2:31-2:33,ExpBox False),(2:37-2:42,ExpBox False),(2:31-2:42,ExpBox False),(2:25-2:42,ExpBox False),(2:45-2:49,ExpBox False),(2:24-2:50,ExpBox True),(3:16-3:24,ExpBox False),(3:16-3:24,BinBox GuardBinBox True),(3:16-3:24,BinBox GuardBinBox False),(4:18-4:66,ExpBox False),(3:28-4:66,ExpBox True),(2:1-6:35,TopLevelBox ["reciprocal"]),(26:25-26:25,ExpBox False),(26:14-26:25,ExpBox False),(25:16-25:16,ExpBox False),(25:9-25:16,ExpBox False),(25:20-25:20,ExpBox False),(25:9-25:20,ExpBox False),(25:5-25:20,LocalBox ["showRecip","p"]),(22:3-22:6,ExpBox False),(22:16-22:16,ExpBox False),(22:11-22:16,ExpBox False),(22:21-22:25,ExpBox False),(23:6-23:6,ExpBox False),(23:11-23:11,ExpBox False),(23:6-23:11,ExpBox False),(23:6-23:11,BinBox CondBinBox True),(23:6-23:11,BinBox CondBinBox False),(23:18-23:18,ExpBox True),(23:30-23:30,ExpBox False),(23:32-23:32,ExpBox False),(23:25-23:32,ExpBox False),(23:37-23:39,ExpBox False),(23:49-23:49,ExpBox False),(23:51-23:51,ExpBox False),(23:44-23:51,ExpBox False),(23:56-23:58,ExpBox False),(23:44-23:58,ExpBox False),(23:37-23:58,ExpBox False),(23:25-23:58,ExpBox True),(23:3-23:58,ExpBox False),(22:21-23:58,ExpBox False),(22:11-23:58,ExpBox False),(22:3-23:58,ExpBox False),(21:1-26:25,TopLevelBox ["showRecip"]),(29:8-29:13,ExpBox False),(30:23-30:23,ExpBox False),(30:12-30:24,ExpBox False),(30:3-30:24,ExpBox False),(31:3-31:6,ExpBox False),(28:8-31:6,ExpBox False),(28:1-31:6,TopLevelBox ["main"])]
+ test/data/reciprocal/reciprocal.hs view
@@ -0,0 +1,31 @@+reciprocal :: Int -> (String, Int)+reciprocal n | n > 1 = ('0' : '.' : digits, recur)+             | otherwise = error+                 "attempting to compute reciprocal of number <= 1"+  where+    (digits, recur) = divide n 1 []++divide :: Int -> Int -> [Int] -> (String, Int)+divide n c cs | c `elem` cs = ([], position c cs)+              | r == 0      = (show q, 0)+              | r /= 0      = (show q ++ digits, recur)+  where+     (q, r) = (c*10) `quotRem` n+     (digits, recur) = divide n r (c:cs)++position :: Int -> [Int] -> Int+position n (x:xs) | n == x    = 1+                  | otherwise = 1 + position n xs++showRecip :: Int -> String+showRecip n =+  "1/" ++ show n ++ " = " +++  if r == 0 then d else take p d ++ "(" ++ drop p d ++ ")"+  where+    p = length d - r+    (d, r) = reciprocal n++main = do+  n <- readLn+  putStrLn (showRecip n)+  main
+ test/data/reciprocal/reciprocal.tix view
@@ -0,0 +1,1 @@+Tix [ TixModule "Main" 2523442504 119 [6,6,6,1,5,1,5,5,0,5,5,5,5,5,6,6,6,6,6,6,5,6,6,6,6,6,6,7,7,1,6,1,1,1,1,1,6,6,6,0,6,0,0,0,0,6,6,6,6,0,6,6,6,6,6,6,7,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]]
− test/data/self.tar

binary file changed (51200 → absent bytes)