packages feed

hpc-coveralls (empty) → 0.1.0

raw patch · 9 files changed

+393/−0 lines, 9 filesdep +Cabaldep +HUnitdep +aesonsetup-changed

Dependencies added: Cabal, HUnit, aeson, base, bytestring, curl, hpc, process, regex-posix

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Guillaume Nargeot++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 Guillaume Nargeot 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hpc-coveralls.cabal view
@@ -0,0 +1,101 @@+name:           hpc-coveralls+version:        0.1.0+synopsis:       Coveralls.io support for Haskell.+description:+  This utility converts and sends Haskell projects hpc code coverage to <http://coveralls.io/ coverall.io>.+  .+  At the moment, only <http://travis-ci.org Travis CI> is supported, but other CI services will be supported soon.+  .+  /Usage/+  .+  Commands to add to your project .travis.yml:+  .+  > before_install:+  >   - cabal install hpc-coveralls+  > script:+  >   - cabal configure --enable-tests --enable-library-coverage && cabal build+  >   - run-cabal-test [optional-cabal-test-arguments]+  > after_script:+  >   - hpc-coveralls [your-test-suite-name]+  .+  /The run-cabal-test command/+  .+  When using hpc 0.6, 'cabal test' outputs an error message and exits with the error code 1, which results in a build failure.+  .+  In order to prevent this from happening, hpc-coveralls provides the 'run-cabal-test' command which runs 'cabal test' and returns with 0 if the regex '^Test suite .*: FAIL$' never matches any line of the output.+  .+  This hpc issue should be fixed in version 0.7, which is provided by GHC 7.8 (Travis CI currently only provides GHC 7.6).+  .+  /Limitations/+  .+  As Coveralls doesn't support yet partial-line coverage, the following convention is used to represent line coverage with line hit counts:+  .+  * 0 : the line is never hit,+  .+  * 1 : the line is partially covered,+  .+  * 2 : the line is fully covered.+  .+  Further information can be found in the <https://github.com/guillaume-nargeot/hpc-coveralls README>.++license:        BSD3+license-file:   LICENSE+author:         Guillaume Nargeot+maintainer:     Guillaume Nargeot <guillaume+hackage@nargeot.com>+copyright:      (c) 2014 Guillaume Nargeot+category:       Control+build-type:     Simple+stability:      experimental+cabal-version:  >= 1.8+tested-with:    GHC == 7.6.3++source-repository head+  type: git+  location: https://github.com/guillaume-nargeot/hpc-coveralls.git++library+  hs-source-dirs:      src+  exposed-modules:+    Trace.Hpc.Coveralls,+    Trace.Hpc.Coveralls.Curl,+    Trace.Hpc.Lix+  build-depends:+    aeson,+    base < 5,+    bytestring >= 0.10,+    curl >= 1.3.8,+    hpc >= 0.6.0.0++executable hpc-coveralls+  hs-source-dirs: src+  main-is:        HpcCoverallsMain.hs+  build-depends:+    aeson,+    base < 5,+    bytestring >= 0.10,+    curl >= 1.3.8,+    hpc >= 0.6.0.0+  ghc-options:   -Wall -fwarn-tabs++executable run-cabal-test+  hs-source-dirs: src+  main-is:        RunCabalTestMain.hs+  build-depends:+    base < 5,+    process,+    regex-posix+  ghc-options:    -Wall -fwarn-tabs++test-suite test-all+  hs-source-dirs: src, test+  type:           exitcode-stdio-1.0+  main-is:        TestAll.hs+  build-depends:+    aeson,+    base < 5,+    bytestring >= 0.10,+    curl >= 1.3.8,+    hpc >= 0.6.0.0,+    HUnit,+    Cabal >= 1.9.2+  ghc-options:    -Wall
+ src/HpcCoverallsMain.hs view
@@ -0,0 +1,37 @@+module Main where++import Data.Aeson+import Trace.Hpc.Coveralls+import Trace.Hpc.Coveralls.Curl+import System.Environment (getArgs, getEnv, getEnvironment)+import System.Exit (exitSuccess)+import qualified Data.ByteString.Lazy.Char8 as BSL++getServiceAndJobID :: IO (String, String)+getServiceAndJobID = do+    env <- getEnvironment+    case lookup "TRAVIS" env of+        Just _ -> do+            jobId <- getEnv "TRAVIS_JOB_ID"+            return ("travis-ci", jobId)+        _ -> error "Unsupported CI service."++writeJson :: String -> Value -> IO ()+writeJson filePath = BSL.writeFile filePath . encode++main :: IO ()+main = do+    args <- getArgs+    case args of+        ["--help"] -> usage >> exitSuccess+        ["-h"] -> usage >> exitSuccess+        [testName] -> do+            (serviceName, jobId) <- getServiceAndJobID+            coverallsJson <- generateCoverallsFromTix serviceName jobId testName+            let filePath = serviceName ++ "-" ++ jobId ++ ".json"+            writeJson filePath coverallsJson+            response <- postJson filePath "https://coveralls.io/api/v1/jobs"+            putStrLn response >> exitSuccess+        _ -> usage >> exitSuccess+    where+        usage = putStrLn "Usage: hpc-coveralls [testName]"
+ src/RunCabalTestMain.hs view
@@ -0,0 +1,39 @@+module Main where++import Control.Monad+import GHC.IO.Handle+import System.Exit (exitFailure, exitSuccess)+import System.Environment (getArgs)+import System.Process+import Text.Regex.Posix++isTestFailure :: String -> Bool+isTestFailure line = line =~ "^Test suite .*: FAIL$"++readLines :: Handle -> IO [String]+readLines h = do+    isEOF <- hIsEOF h+    if isEOF+        then return []+        else do+            x <- hGetLine h+            putStrLn x+            xs <- readLines h+            return (x : xs)++runCabalTest :: [String] -> IO Bool+runCabalTest args = do+    (_, out, _, _) <- runInteractiveCommand ("cabal test " ++ unwords args)+    liftM (not . any isTestFailure) (readLines out)++main :: IO ()+main = do+    args <- getArgs+    case args of+        ["--help"] -> usage >> exitSuccess+        ["-h"] -> usage >> exitSuccess+        options -> do+            result <- runCabalTest options+            if result then exitSuccess else exitFailure+    where+        usage = putStrLn "Usage: run-cabal-test [options]"
+ src/Trace/Hpc/Coveralls.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module:      Trace.Hpc.Coveralls+-- Copyright:   (c) 2014 Guillaume Nargeot+-- License:     BSD3+-- Maintainer:  Guillaume Nargeot <guillaume+hackage@nargeot.com>+-- Stability:   experimental+--+-- Types and functions for converting and sending hpc output to coveralls.io.++module Trace.Hpc.Coveralls ( generateCoverallsFromTix ) where++import Data.Aeson+import Data.Aeson.Types ()+import Trace.Hpc.Lix+import Trace.Hpc.Mix+import Trace.Hpc.Tix++type CoverageData = (+    String,    -- file source code+    Mix,       -- module index data+    TixModule) -- tixs recorded by hpc++-- single file coverage data in the format defined by coveralls.io+type SimpleCoverage = [CoverageEntry]++-- Is there a way to restrict this to only Number and Null?+type CoverageEntry = Value++hpcDir :: String+hpcDir = "dist/hpc/"++tixDir :: String+tixDir = hpcDir ++ "tix/"++mixDir :: String+mixDir = hpcDir ++ "mix/"++lixToSimpleCoverage :: Lix -> SimpleCoverage+lixToSimpleCoverage = map conv+    where conv Full    = Number 2+          conv Partial = Number 1+          conv None    = Number 0+          conv Irrelevant = Null++toSimpleCoverage :: Int -> [(MixEntry, Integer)] -> SimpleCoverage+toSimpleCoverage lineCount = lixToSimpleCoverage . toLix lineCount++coverageToJson :: CoverageData -> Value+coverageToJson (source, mix, tix) = object [+    "name" .= getFilePath mix,+    "source" .= source,+    "coverage" .= coverage]+    where coverage = toSimpleCoverage lineCount mixEntryTixs+          lineCount = length $ lines source+          mixEntryTixs = zip (getMixEntries mix) (tixModuleTixs tix)+          getMixEntries (Mix _ _ _ _ mixEntries) = mixEntries+          getFilePath (Mix filePath _ _ _ _) = filePath++toCoverallsJson :: String -> String -> [CoverageData] -> Value+toCoverallsJson serviceName jobId coverageData = object [+    "service_job_id" .= jobId,+    "service_name" .= serviceName,+    "source_files" .= map coverageToJson coverageData]++toCoverageData :: String -> Tix -> IO [CoverageData]+toCoverageData name (Tix tixs) = do+    mixs <- mapM readMix' tixs+    sources <- mapM readSource mixs+    return $ zip3 sources mixs tixs+    where readMix' tix = readMix [mixPath] (Right tix)+          mixPath = mixDir ++ name ++ "/"+          readSource (Mix filePath _ _ _ _) = readFile filePath++-- | Generate coveralls json formatted code coverage from hpc coverage data+generateCoverallsFromTix :: String   -- ^ CI name+                         -> String   -- ^ CI Job ID+                         -> String   -- ^ test suite name+                         -> IO Value -- ^ code coverage result in json format+generateCoverallsFromTix serviceName jobId name = do+    mtix <- readTix tixPath+    case mtix of+        Nothing -> error $ "Couldn't find the file " ++ tixPath+        Just tixs -> do+            coverageDatas <- toCoverageData name tixs+            return $ toCoverallsJson serviceName jobId coverageDatas+    where tixPath = tixDir ++ name ++ "/" ++ getTixFileName name
+ src/Trace/Hpc/Coveralls/Curl.hs view
@@ -0,0 +1,30 @@+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}++-- |+-- Module:      Trace.Hpc.Coveralls.Curl+-- Copyright:   (c) 2014 Guillaume Nargeot+-- License:     BSD3+-- Maintainer:  Guillaume Nargeot <guillaume+hackage@nargeot.com>+-- Stability:   experimental+--+-- Functions for sending coverage report files over http.++module Trace.Hpc.Coveralls.Curl (postJson) where++import Network.Curl++httpPost :: String -> [HttpPost]+httpPost path = [HttpPost "json_file" Nothing (ContentFile path) [] Nothing]++showResponse :: CurlResponse -> String+showResponse r = show (respCurlCode r) ++ show (respBody r)++-- | Send file content over HTTP using POST request+postJson :: String -> URLString -> IO String+postJson path url = do+    h <- initialize+    setopt h (CurlVerbose True)+    setopt h (CurlURL url)+    setopt h (CurlHttpPost $ httpPost path)+    r <- perform_with_response_ h+    return $ showResponse r
+ src/Trace/Hpc/Lix.hs view
@@ -0,0 +1,51 @@+-- |+-- Module:      Trace.Hpc.Lix+-- Copyright:   (c) 2014 Guillaume Nargeot+-- License:     BSD3+-- Maintainer:  Guillaume Nargeot <guillaume+hackage@nargeot.com>+-- Stability:   experimental+-- Portability: portable+--+-- Types and functions for converting hpc output to line-based code coverage data.++module Trace.Hpc.Lix where++import Data.List+import Data.Ord+import Prelude hiding (getLine)+import Trace.Hpc.Mix+import Trace.Hpc.Util++data Hit = Full | Partial | None | Irrelevant deriving (Eq, Show)++type Lix = [Hit]++groupByIndex :: Int -> [(Int, a)] -> [[a]]+groupByIndex size = take size . flip (++) (repeat []) . groupByIndex' 0 []+    where groupByIndex' _ ys [] = [ys]+          groupByIndex' i ys xx@((xi, x) : xs) = if xi == i+              then groupByIndex' i (x : ys) xs+              else ys : groupByIndex' (i + 1) [] xx++toHit :: [Bool] -> Hit+toHit [] = Irrelevant+toHit [x] = if x then Full else None+toHit xs+    | and xs = Full+    | or xs = Partial+    | otherwise = None++getLine :: MixEntry -> Int+getLine = fffst . fromHpcPos . fst+    where fffst (x, _, _, _) = x++toLineHit :: (MixEntry, Integer) -> (Int, Bool)+toLineHit (entry, cnt) = (getLine entry - 1, cnt > 0)++-- | Convert hpc coverage entries into a line based coverage format+toLix :: Int                   -- ^ Source line count+      -> [(MixEntry, Integer)] -- ^ Mix entries and associated hit count+      -> Lix                   -- ^ Line coverage+toLix lineCount entries = map toHit (groupByIndex lineCount sortedLineHits)+    where sortedLineHits = sortBy (comparing fst) lineHits+          lineHits = map toLineHit entries
+ test/TestAll.hs view
@@ -0,0 +1,15 @@+module Main where++import System.Exit ( exitFailure, exitSuccess )+import Test.HUnit+import TestHpcLix++allTests :: [Test]+allTests = [testHpcLix]++main :: IO Counts+main = do+    cnt <- runTestTT (test allTests)+    if errors cnt + failures cnt == 0+        then exitSuccess+        else exitFailure