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 +12/−0
- README.md +158/−27
- app/hpc-codecov.hs +4/−0
- exec/hpc-codecov.hs +0/−4
- hpc-codecov.cabal +21/−7
- src/Trace/Hpc/Codecov/Discover.hs +280/−0
- src/Trace/Hpc/Codecov/Error.hs +0/−78
- src/Trace/Hpc/Codecov/Exception.hs +85/−0
- src/Trace/Hpc/Codecov/Main.hs +7/−8
- src/Trace/Hpc/Codecov/Options.hs +127/−40
- src/Trace/Hpc/Codecov/Report.hs +52/−21
- test/Test/Main.hs +361/−78
- test/data/project1/ChangeLog.md +3/−0
- test/data/project1/LICENSE +30/−0
- test/data/project1/README.md +1/−0
- test/data/project1/Setup.hs +2/−0
- test/data/project1/app/Main.hs +6/−0
- test/data/project1/package.yaml +48/−0
- test/data/project1/project1.cabal +62/−0
- test/data/project1/src/Lib.hs +9/−0
- test/data/project1/stack.yaml +67/−0
- test/data/project1/test/Spec.hs +4/−0
- test/data/reciprocal.tar binary
- test/data/reciprocal/.hpc/Main.mix +1/−0
- test/data/reciprocal/reciprocal.hs +31/−0
- test/data/reciprocal/reciprocal.tix +1/−0
- test/data/self.tar binary
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 @@ [](https://travis-ci.com/8c6794b6/hpc-codecov) [](https://circleci.com/gh/8c6794b6/hpc-codecov) [](https://ci.appveyor.com/project/8c6794b6/hpc-codecov)-[](https://github.com/8c6794b6/hpc-codecov/actions?query=workflow%3ci)+[](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)