diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE QuasiQuotes #-} module Main where @@ -8,9 +7,6 @@ import qualified Data.ByteString.Lazy as BSL import Data.List (find) import Data.Maybe (isJust) -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative (pure, (<$>), (<*>)) -#endif import Control.Concurrent (threadDelay) import System.Console.Docopt import System.Environment (getArgs, getEnv, getEnvironment) @@ -35,11 +31,13 @@ return (ciName, jId) _ -> error "Unsupported CI service." where ciEnvVars = [ - ("TRAVIS", ("travis-ci", "TRAVIS_JOB_ID")), - ("CIRCLECI", ("circleci", "CIRCLE_BUILD_NUM")), - ("SEMAPHORE", ("semaphore", "REVISION")), - ("JENKINS_URL", ("jenkins", "BUILD_ID")), - ("CI_NAME", ("codeship", "CI_BUILD_NUMBER"))] + ("GITHUB_ACTIONS", ("github-actions", "GITHUB_RUN_NUMBER")), + ("TRAVIS", ("travis-ci", "TRAVIS_JOB_ID")), + ("CIRCLECI", ("circleci", "CIRCLE_BUILD_NUM")), + ("SEMAPHORE", ("semaphore", "REVISION")), + ("JENKINS_URL", ("jenkins", "BUILD_ID")), + ("CI_NAME", ("codeship", "CI_BUILD_NUMBER")), + ("BUILDKITE", ("buildkite", "BUILDKITE_BUILD_NUMBER"))] patterns :: Docopt patterns = [docoptFile|USAGE.txt|] @@ -54,15 +52,11 @@ getConfig args = do pn <- args `getArgOrExit` argument "package-name" let suites = args `getAllArgs` argument "suite-name" - unless (not $ null suites) $ + when (null suites) $ putStrLn "Error: provide at least one test-suite name" >> exitFailure (sn, jId) <- getServiceAndJobId - Config <$> pure pn - <*> pure suites - <*> pure sn - <*> pure jId - <*> pure (args `getArg` longOption "repo-token") - <*> getGitInfo + Config pn suites sn jId (args `getArg` longOption "repo-token") + <$> getGitInfo <*> defaultOr args (longOption "hpc-dir") (getHpcDir pn) <*> pure (args `getArg` longOption "mix-dir") <*> pure (if args `isPresent` longOption "partial-coverage" diff --git a/src/SHC/Api.hs b/src/SHC/Api.hs --- a/src/SHC/Api.hs +++ b/src/SHC/Api.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} + -- | -- Module: SHC.Lix -- Copyright: (c) 2015 Michele Lacchia @@ -15,18 +15,14 @@ where import Codec.Binary.UTF8.String (decode) -import Control.Exception (catch) import Data.Aeson (Value, encode) import Data.Aeson.Lens (key, _Double, _String) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative ((<$>)) -#endif import Control.Lens import Network.HTTP.Client (RequestBody (RequestBodyLBS)) -import Network.HTTP.Client.MultipartFormData (partFileRequestBody) +import Network.HTTP.Client.MultipartFormData (PartM, partFileRequestBody) import Network.Wreq import SHC.Types (Config (..), @@ -39,14 +35,14 @@ -> Value -- ^ The JSON object -> IO PostResult sendData conf url json = do - r <- postWith httpOptions url [partFileRequestBody "json_file" fileName requestBody] + r <- postWith httpOptions url [partFileRequestBody "json_file" fileName requestBody :: PartM IO] if r ^. responseStatus . statusCode == 200 then return $ readResponse r else return . PostFailure $ formatResponseError r where fileName = serviceName conf ++ "-" ++ jobId conf ++ ".json" requestBody = RequestBodyLBS $ encode json - httpOptions = defaults & checkStatus .~ Just noCheck - noCheck _ _ _ = Nothing + httpOptions = defaults & checkResponse ?~ noCheck + noCheck _ _ = return () readResponse :: Response LBS.ByteString -> PostResult readResponse r = diff --git a/src/SHC/Coverage.hs b/src/SHC/Coverage.hs --- a/src/SHC/Coverage.hs +++ b/src/SHC/Coverage.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -14,9 +13,6 @@ module SHC.Coverage where -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative -#endif import Data.Aeson import Data.Aeson.Types () import qualified Data.ByteString.Char8 as BS diff --git a/src/SHC/Lix.hs b/src/SHC/Lix.hs --- a/src/SHC/Lix.hs +++ b/src/SHC/Lix.hs @@ -52,5 +52,5 @@ -> [CoverageEntry] -- ^ Mix entries and associated hit count -> Lix -- ^ Line coverage toLix lineCount entries = map toHit $ groupByIndex lineCount sortedLineHits - where sortedLineHits = sortBy (comparing fst) lineHits + where sortedLineHits = sortOn fst lineHits lineHits = map (toLineHit . adjust) entries diff --git a/src/SHC/Stack.hs b/src/SHC/Stack.hs --- a/src/SHC/Stack.hs +++ b/src/SHC/Stack.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} -- | -- Module: SHC.Stack -- Copyright: (c) 2014-2015 Guillaume Nargeot, (c) 2015-2016 Felipe Lessa @@ -12,12 +11,9 @@ where import Data.Version -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative ((<$>), (<*>)) -#endif import Control.Monad (forM, guard) import System.Directory (makeRelativeToCurrentDirectory) -import System.FilePath ((), equalFilePath) +import System.FilePath ((), equalFilePath, splitPath) import qualified Data.ByteString.Char8 as BS8 import qualified Data.Yaml as Y @@ -49,7 +45,7 @@ -- | Get relevant information from @stack query@. Used to find -- package filepaths. getStackQuery :: IO StackQuery -getStackQuery = (Y.decodeEither' . BS8.pack <$> stack ["query"]) >>= either err return +getStackQuery = either err return . Y.decodeEither' . BS8.pack =<< stack ["query"] where err = fail . (++) "getStackQuery: Couldn't decode the result of 'stack query' as YAML: " . show -- | Get the key that GHC uses for the given package. @@ -64,7 +60,9 @@ forM (stackQueryLocals sq) $ \(pkgName, filepath) -> do relfp <- makeRelativeToCurrentDirectory filepath let mpath = guard (not $ relfp `equalFilePath` ".") >> Just relfp - key <- getProjectKey pkgName + key <- if ".stack-work/" `elem` splitPath relfp + then return pkgName + else getProjectKey pkgName return StackProject { stackProjectName = pkgName diff --git a/src/SHC/Types.hs b/src/SHC/Types.hs --- a/src/SHC/Types.hs +++ b/src/SHC/Types.hs @@ -5,12 +5,19 @@ import Control.Monad (forM) import Data.Aeson -import qualified Data.HashMap.Strict as HM -import qualified Data.Text as T import Trace.Hpc.Mix +import qualified GHC.Exts as IsList (IsList(..)) -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative ((<$>)) +#if MIN_VERSION_aeson(2,0,0) +import qualified Data.Aeson.Key as Aeson (Key, toString) + +keyToString :: Aeson.Key -> String +keyToString = Aeson.toString +#else +import qualified Data.Text as T + +keyToString :: T.Text -> String +keyToString = T.unpack #endif @@ -91,7 +98,7 @@ ] -- | Data returned by the @stack query@ command. -data StackQuery = +newtype StackQuery = StackQuery { stackQueryLocals :: [(String, FilePath)] -- ^ A list of pairs of @(package-name, filepath)@, where the @@ -104,9 +111,9 @@ where parseLocals = withObject "StackQuery/locals" $ \o -> - forM (HM.toList o) $ \(pkgName, val) -> do + forM (IsList.toList o) $ \(pkgName, val) -> do filepath <- withObject "StackQuery/locals/package" (.: "path") val - return (T.unpack pkgName, filepath) + return (keyToString pkgName, filepath) -- | Information we've collected about a stack project. diff --git a/src/SHC/Utils.hs b/src/SHC/Utils.hs --- a/src/SHC/Utils.hs +++ b/src/SHC/Utils.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} -- | -- Module: SHC.Utils -- Copyright: (c) 2014-2015 Guillaume Nargeot @@ -15,9 +14,6 @@ import Data.Function (on) import Data.List import Data.Version -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative ((<$>), (<*>)) -#endif import Text.ParserCombinators.ReadP import System.Process (readProcess) diff --git a/stack-hpc-coveralls.cabal b/stack-hpc-coveralls.cabal --- a/stack-hpc-coveralls.cabal +++ b/stack-hpc-coveralls.cabal @@ -1,5 +1,6 @@ +cabal-version: 1.18 name: stack-hpc-coveralls -version: 0.0.4.0 +version: 0.0.7.0 synopsis: Initial project template from stack description: Please see README.md homepage: http://github.com/rubik/stack-hpc-coveralls @@ -7,13 +8,13 @@ license-file: LICENSE author: Michele Lacchia maintainer: michelelacchia@gmail.com -copyright: Copyright (c) 2015 Michele Lacchia +copyright: Copyright (c) 2015 Michele Lacchia, + Copyright (c) 2021-2023 Alexey Kuleshevich category: Control build-type: Simple extra-source-files: stack.yaml USAGE.txt -cabal-version: >=1.18 library hs-source-dirs: src @@ -23,20 +24,19 @@ SHC.Lix SHC.Api SHC.Stack - build-depends: base >=4.7 && <5 + build-depends: base >=4.9 && <5 , hpc >=0.6 , directory >=1.0 , filepath >=1.3 , process >=1.2 , pureMD5 >=2.1 , containers >=0.5 - , aeson >=0.8 + , aeson (>=0.8 && <2) || >=2.0.2.0 , bytestring >=0.10 - , unordered-containers >=0.2 , utf8-string >=1 , text >=1.2 - , wreq >=0.3 - , http-client >=0.4 + , wreq >=0.5.3.2 + , http-client >=0.6 , lens >=4.7 , lens-aeson >=1.0 , yaml >=0.8 @@ -71,15 +71,6 @@ , time >=1.4 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 - -test-suite style - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: HLint.hs - build-depends: base >=4.7 && <5 - , hlint ==1.* - default-language: Haskell2010 - ghc-options: -Wall source-repository head type: git diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,33 +1,7 @@ -# For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md - -# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: nightly-2016-06-15 - -# Local packages, usually specified by relative directory name +resolver: lts-20.9 +system-ghc: true packages: - '.' - -# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) extra-deps: -- docopt-0.7.0.4 - -# 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: >= 0.1.4.0 - -# 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] +- github: gelisam/docopt.hs + commit: 16dc7bc596c0ea4fa4466b12f474b1abfa72c885 diff --git a/test/HLint.hs b/test/HLint.hs deleted file mode 100644 --- a/test/HLint.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Main (main) where - -import Language.Haskell.HLint (hlint) -import System.Exit (exitFailure, exitSuccess) - -arguments :: [String] -arguments = - [ "app" - , "src" - , "test" - ] - -main :: IO () -main = do - hints <- hlint arguments - if null hints then exitSuccess else exitFailure diff --git a/test/SHCSpec.hs b/test/SHCSpec.hs --- a/test/SHCSpec.hs +++ b/test/SHCSpec.hs @@ -19,7 +19,6 @@ import SHCHUnits -import SHC.Api import SHC.Coverage import SHC.Lix import SHC.Types