diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,13 @@ +Copyright Michele Lacchia (c) 2015 + +Permission to use, copy, modify, and/or distribute this software for any +purpose with or without fee is hereby granted, provided that the above +copyright notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE QuasiQuotes #-} +module Main + where + +import Data.List (find) +import Data.Maybe (isJust) +import Data.Aeson (encode) +import qualified Data.ByteString.Lazy as BSL +import Control.Concurrent (threadDelay) +import System.Console.Docopt +import System.Environment (getArgs, getEnv, getEnvironment) +import System.Exit (exitFailure) + +import SHC + + +urlApiV1 :: String +urlApiV1 = "https://coveralls.io/api/v1/jobs" + +getServiceAndJobId :: IO (String, String) +getServiceAndJobId = do + env <- getEnvironment + case snd <$> find (isJust . flip lookup env . fst) ciEnvVars of + Just (ciName, jobIdVarName) -> do + jId <- getEnv jobIdVarName + 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"))] + +patterns :: Docopt +patterns = [docoptFile|USAGE.txt|] + +getArgOrExit :: Arguments -> Option -> IO String +getArgOrExit = getArgOrExitWith patterns + +defaultOr :: Arguments -> Option -> IO String -> IO String +defaultOr args opt action = maybe action return $ args `getArg` opt + +getConfig :: Arguments -> IO Config +getConfig args = do + -- TODO: Read from Cabal? + pn <- args `getArgOrExit` (argument "package-name") + (sn, jId) <- getServiceAndJobId + Config <$> args `getArgOrExit` (argument "suite-name") + <*> pure sn + <*> pure jId + <*> pure (args `getArg` (longOption "repo-token")) + <*> getGitInfo + <*> defaultOr args (longOption "hpc-dir") (getHpcDir pn) + <*> defaultOr args (longOption "hpc-dir") getMixDir + <*> pure (if args `isPresent` (longOption "partial-coverage") + then PartialLines + else FullLines) + +main :: IO () +main = do + args <- parseArgsOrExit patterns =<< getArgs + conf <- getConfig args + coverallsJson <- generateCoverallsFromTix conf + if args `isPresent` (longOption "dont-send") + then BSL.putStr $ encode coverallsJson + else do + response <- sendData conf urlApiV1 coverallsJson + case response of + PostSuccess url -> do + putStrLn $ "URL: " ++ url + -- wait 5 seconds until the page is available + threadDelay $ 5 * 1000 * 1000 + coverageResult <- readCoverageResult url + case coverageResult of + Just totalCov -> putStrLn $ "Coverage: " ++ totalCov + Nothing -> putStrLn "Failed to read total coverage" + PostFailure msg -> do + putStrLn $ "Error: " ++ msg + exitFailure diff --git a/src/SHC.hs b/src/SHC.hs new file mode 100644 --- /dev/null +++ b/src/SHC.hs @@ -0,0 +1,18 @@ +module SHC ( + Config(..) + , ConversionType(..) + , PostResult(..) + , generateCoverallsFromTix + , sendData + , readCoverageResult + , getHpcDir + , getMixDir + , getGitInfo + ) + where + + +import SHC.Types +import SHC.Api +import SHC.Utils +import SHC.Coveralls diff --git a/src/SHC/Api.hs b/src/SHC/Api.hs new file mode 100644 --- /dev/null +++ b/src/SHC/Api.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedStrings #-} +module SHC.Api (sendData, readCoverageResult) + where + +import Safe (atMay, headMay) +import Data.Aeson (Value, encode) +import Data.Aeson.Lens (key, _String) +import qualified Data.Text as T +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import Codec.Binary.UTF8.String (decode) +import Control.Lens +import Network.Wreq +import Network.HTTP.Client (RequestBody(RequestBodyLBS)) +import Network.HTTP.Client.MultipartFormData (partFileRequestBody) + +import SHC.Types + + +sendData :: Config -> String -> Value -> IO PostResult +sendData conf url json = do + r <- post url [partFileRequestBody "json_file" fileName requestBody] + if r ^. responseStatus . statusCode == 200 + then return $ readResponse r + else return . PostFailure $ + "Error: " ++ decode (BS.unpack $ r ^. responseStatus . statusMessage) + where fileName = serviceName conf ++ "-" ++ jobId conf ++ ".json" + requestBody = RequestBodyLBS $ encode json + +readResponse :: Response LBS.ByteString -> PostResult +readResponse r = + case r ^? responseBody . key "error" . _String of + Just err -> PostFailure $ T.unpack err + Nothing -> case r ^? responseBody . key "url" . _String of + Just url -> PostSuccess $ T.unpack url + Nothing -> PostFailure "Error: malformed response body" + +-- | Extract the total coverage percentage value from coveralls coverage result +-- page content. The current implementation is kept as low level as possible +-- in order not to increase the library build time, by not relying on +-- additional packages. +extractCoverage :: T.Text -> Maybe T.Text +extractCoverage body = T.splitOn "<" + <$> T.splitOn prefix body `atMay` 1 >>= headMay + where prefix = "div class='run-statistics'>\n" + +-- | Read the coveraege result page from coveralls.io +readCoverageResult :: String -> IO (Maybe String) +readCoverageResult url = do + r <- get url + return . fmap T.unpack . extractCoverage $ + r ^. responseBody . _String diff --git a/src/SHC/Coveralls.hs b/src/SHC/Coveralls.hs new file mode 100644 --- /dev/null +++ b/src/SHC/Coveralls.hs @@ -0,0 +1,134 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: SHC.Coveralls +-- Copyright: (c) 2015 Michele Lacchia +-- License: ISC +-- Maintainer: Michele Lacchia +-- Stability: experimental +-- +-- Functions for reading, converting and sending HPC output to coveralls.io. + +module SHC.Coveralls (generateCoverallsFromTix) + where + +import Control.Applicative +import Data.Aeson +import Data.Aeson.Types () +import qualified Data.ByteString.Lazy.Char8 as LBS +import Data.Digest.Pure.MD5 +import Data.Function +import Data.List +import qualified Data.Map.Strict as M +import System.Exit (exitFailure) +import SHC.Types +import SHC.Utils +import SHC.Lix +import SHC.Paths +import Trace.Hpc.Mix +import Trace.Hpc.Tix +import Trace.Hpc.Util + +type ModuleCoverageData = ( + String, -- file source code + Mix, -- module index data + [Integer]) -- tixs recorded by hpc + +type TestSuiteCoverageData = M.Map FilePath ModuleCoverageData + +-- Is there a way to restrict this to only Number and Null? +type CoverageValue = Value + +-- Single file coverage data in the format defined by coveralls.io +type SimpleCoverage = [CoverageValue] +type LixConverter = Lix -> SimpleCoverage + +strictConverter :: LixConverter +strictConverter = map $ \lix -> case lix of + Full -> Number 1 + Partial -> Number 0 + None -> Number 0 + Irrelevant -> Null + +looseConverter :: LixConverter +looseConverter = map $ \lix -> case lix of + Full -> Number 2 + Partial -> Number 1 + None -> Number 0 + Irrelevant -> Null + +toSimpleCoverage :: LixConverter -> Int -> [CoverageEntry] -> SimpleCoverage +toSimpleCoverage convert lineCount = convert . toLix lineCount + +getExprSource :: [String] -> MixEntry -> [String] +getExprSource source (hpcPos, _) = subSubSeq startCol endCol subLines + where subLines = subSeq startLine endLine source + startLine = startLine' - 1 + startCol = startCol' - 1 + (startLine', startCol', endLine, endCol) = fromHpcPos hpcPos + +groupMixEntryTixs :: [(MixEntry, Integer, [String])] -> [CoverageEntry] +groupMixEntryTixs = map mergeOnLst3 . groupBy ((==) `on` fst . fst3) + where mergeOnLst3 xxs@(x : _) = (map fst3 xxs, map snd3 xxs, trd3 x) + mergeOnLst3 [] = error "mergeOnLst3 appliedTo empty list" + +coverageToJson :: LixConverter -> FilePath -> ModuleCoverageData -> Value +coverageToJson converter filePath (source, mix, tixs) = object [ + "name" .= filePath, + "source_digest" .= (show . md5 . LBS.pack) source, + "coverage" .= coverage] + where coverage = toSimpleCoverage converter lineCount mixEntriesTixs + lineCount = length $ lines source + mixEntriesTixs = groupMixEntryTixs mixEntryTixs + mixEntryTixs = zip3 mixEntries tixs (map getExprSource' mixEntries) + Mix _ _ _ _ mixEntries = mix + getExprSource' = getExprSource $ lines source + +toCoverallsJson :: Config -> LixConverter -> TestSuiteCoverageData -> Value +toCoverallsJson conf converter testSuiteCoverageData = + object $ if serviceName conf == "travis-ci" then withRepoToken else withGitInfo + where base = [ + "service_job_id" .= jobId conf, + "service_name" .= serviceName conf, + "source_files" .= toJsonCoverageList testSuiteCoverageData] + toJsonCoverageList = map (uncurry $ coverageToJson converter) . M.toList + withRepoToken = mcons (("repo_token" .=) <$> repoToken conf) base + withGitInfo = ("git" .= gitInfo conf) : withRepoToken + +mergeCoverageData :: [TestSuiteCoverageData] -> TestSuiteCoverageData +mergeCoverageData = foldr1 (M.unionWith mergeModule) + where mergeModule (source, mix, tixs1) (_, _, tixs2) = + (source, mix, zipWith (+) tixs1 tixs2) + +readMix' :: Config -> TixModule -> IO Mix +readMix' conf tix = readMix [SHC.Types.mixDir conf] (Right tix) + +-- | Create a list of coverage data from the tix input +readCoverageData :: Config -> String -> IO TestSuiteCoverageData +readCoverageData conf suite = do + let tixPath = getTixPath (hpcDir conf) suite + mTix <- readTix tixPath + case mTix of + Nothing -> putStrLn ("Couldn't find the file " ++ tixPath) >> + dumpDirectoryTree (hpcDir conf) >> exitFailure + Just (Tix tixs) -> do + mixs <- mapM (readMix' conf) tixs + let files = map filePath mixs + sources <- mapM readFile files + let coverageDataList = zip4 files sources mixs (map tixModuleTixs tixs) + let filteredCoverageDataList = filter sourceDirFilter coverageDataList + return $ M.fromList $ map toFirstAndRest filteredCoverageDataList + where filePath (Mix fp _ _ _ _) = fp + sourceDirFilter = not . matchAny excludeDirPatterns . fst4 + excludeDirPatterns = [] -- XXX: for now + +-- | Generate Coveralls JSON formatted code coverage from HPC coverage data +generateCoverallsFromTix :: Config -> IO Value +generateCoverallsFromTix conf = do + testSuitesCoverages <- mapM (readCoverageData conf) [testSuiteName] -- XXX: fix suites + let coverageData = mergeCoverageData testSuitesCoverages + return $ toCoverallsJson conf converter coverageData + where testSuiteName = suiteName conf + converter = case conversion conf of + FullLines -> strictConverter + PartialLines -> looseConverter diff --git a/src/SHC/Lix.hs b/src/SHC/Lix.hs new file mode 100644 --- /dev/null +++ b/src/SHC/Lix.hs @@ -0,0 +1,58 @@ +-- | +-- Module: SHC.Lix +-- Copyright: (c) 2014-2015 Guillaume Nargeot +-- License: BSD3 +-- Maintainer: Michele Lacchia +-- Stability: experimental +-- Portability: portable +-- +-- Functions for converting HPC output to line-based code coverage data. + +module SHC.Lix + where + +import Data.Ord +import Data.List +import Prelude hiding (getLine) +import SHC.Types +import SHC.Utils +import Trace.Hpc.Mix +import Trace.Hpc.Util + +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 :: CoverageEntry -> (Int, Bool) +toLineHit (entries, counts, _source) = (getLine (head entries) - 1, all (> 0) counts) + +isOtherwiseEntry :: CoverageEntry -> Bool +isOtherwiseEntry (mixEntries, _, source) = + source == ["otherwise"] && boxLabels == otherwiseBoxLabels + where boxLabels = map snd mixEntries + otherwiseBoxLabels = [ + ExpBox False, + BinBox GuardBinBox True, + BinBox GuardBinBox False] + +adjust :: CoverageEntry -> CoverageEntry +adjust coverageEntry@(mixEntries, tixs, source) = + if isOtherwiseEntry coverageEntry && any (> 0) tixs + then (mixEntries, [1, 1, 1], source) + else coverageEntry + +-- | Convert hpc coverage entries into a line based coverage format +toLix :: Int -- ^ Source line count + -> [CoverageEntry] -- ^ 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 . adjust) entries diff --git a/src/SHC/Paths.hs b/src/SHC/Paths.hs new file mode 100644 --- /dev/null +++ b/src/SHC/Paths.hs @@ -0,0 +1,56 @@ +-- | +-- Module: Trace.Hpc.Coveralls.Paths +-- Copyright: (c) 2014-2015 Guillaume Nargeot +-- License: BSD3 +-- Maintainer: Guillaume Nargeot +-- Stability: experimental +-- +-- Paths constants and functions for hpc coverage report output. + +module SHC.Paths + where + +import Control.Monad +import Data.Maybe +import Data.List (isSuffixOf) +import Data.Traversable (traverse) +import System.Directory ( + doesDirectoryExist, getDirectoryContents + ) +import System.Directory.Tree ( + AnchoredDirTree(..), dirTree, readDirectoryWith + ) +import System.FilePath (()) +import Trace.Hpc.Tix + + +tixDir :: FilePath -> FilePath +tixDir = ( "tix") + +mixDir :: FilePath -> FilePath +mixDir = ( "mix") + +getTixPath :: FilePath -> String -> FilePath +getTixPath hpcDir testSuiteName = tixDir hpcDir testSuiteName getTixFileName testSuiteName + +firstExistingDirectory :: [FilePath] -> IO (Maybe FilePath) +firstExistingDirectory = fmap msum . mapM pathIfExist + where pathIfExist path = do + pathExists <- doesDirectoryExist path + return $ if pathExists then Just path else Nothing + +dumpDirectory :: FilePath -> IO () +dumpDirectory path = do + directoryExists <- doesDirectoryExist path + unless directoryExists $ putStrLn ("Couldn't find the directory " ++ path) + putStrLn $ "Dumping " ++ path ++ " directory content:" + contents <- getDirectoryContents path + traverse putStrLn contents + return () + +dumpDirectoryTree :: FilePath -> IO () +dumpDirectoryTree path = do + putStrLn $ "Dumping " ++ path ++ " directory tree:" + tree <- readDirectoryWith return path + traverse putStrLn $ dirTree tree + return () diff --git a/src/SHC/Types.hs b/src/SHC/Types.hs new file mode 100644 --- /dev/null +++ b/src/SHC/Types.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE OverloadedStrings #-} + +module SHC.Types + where + +import Data.Aeson +import Trace.Hpc.Mix + + +data ConversionType = FullLines + | PartialLines + deriving (Show, Eq) + +type CoverageEntry = ( [MixEntry] -- ^ Mix entries + , [Integer] -- ^ Tix values + , [String] -- ^ Entry source code + ) + +data Hit = Full + | Partial + | None + | Irrelevant + deriving (Eq, Show) + +type Lix = [Hit] + +data PostResult = PostSuccess String + | PostFailure String + deriving (Show) + +data Config = Config { + suiteName :: String + , serviceName :: String + , jobId :: String + , repoToken :: Maybe String + , gitInfo :: GitInfo + , hpcDir :: FilePath + , mixDir :: FilePath + , conversion :: ConversionType + } + +data GitInfo = GitInfo { + headRef :: Commit + , branch :: String + , remotes :: [Remote] + } + +data Commit = Commit { + hash :: String + , authorName :: String + , authorEmail :: String + , committerName :: String + , committerEmail :: String + , message :: String + } + +data Remote = Remote { + name :: String + , url :: String + } + +instance ToJSON GitInfo where + toJSON i = object [ "head" .= headRef i + , "branch" .= branch i + , "remotes" .= remotes i + ] + +instance ToJSON Commit where + toJSON c = object [ "id" .= hash c + , "author_name" .= authorName c + , "author_email" .= authorEmail c + , "committer_name" .= committerName c + , "committer_email" .= committerEmail c + , "message" .= message c + ] + +instance ToJSON Remote where + toJSON r = object [ "name" .= name r + , "url" .= url r + ] diff --git a/src/SHC/Utils.hs b/src/SHC/Utils.hs new file mode 100644 --- /dev/null +++ b/src/SHC/Utils.hs @@ -0,0 +1,95 @@ +module SHC.Utils + where + +import Data.List +import Data.Function (on) +import Control.Monad (guard) +import Control.Applicative ((<$>), (<*>)) +import System.Process (readProcess) +import System.FilePath (()) + +import SHC.Types + + +readP :: String -> [String] -> IO String +readP name args = init <$> readProcess name args [] -- strip trailing \n + +git :: [String] -> IO String +git = readP "git" + +stack :: [String] -> IO String +stack = readP "stack" + +-- | Get information about the Git repo in the current directory. +getGitInfo :: IO GitInfo +getGitInfo = GitInfo <$> headRef <*> branch <*> getRemotes + where headRef = Commit <$> git ["rev-parse", "HEAD"] + <*> git ["log", "-1", "--pretty=%aN"] + <*> git ["log", "-1", "--pretty=%aE"] + <*> git ["log", "-1", "--pretty=%cN"] + <*> git ["log", "-1", "--pretty=%cE"] + <*> git ["log", "-1", "--pretty=%s"] + branch = git ["rev-parse", "--abbrev-ref", "HEAD"] + +getRemotes :: IO [Remote] +getRemotes = nubBy ((==) `on` name) <$> parseRemotes <$> git ["remote", "-v"] + where parseRemotes :: String -> [Remote] + parseRemotes input = do + line <- lines input + let fields = words line + guard $ length fields >= 2 + return $ Remote (head fields) (fields !! 1) + +getHpcDir :: String -> IO FilePath +getHpcDir package = ( package) <$> stack ["path", "--local-hpc-root"] + +getMixDir :: IO FilePath +getMixDir = ( "hpc") <$> stack ["path", "--dist-dir"] + +fst3 :: (a, b, c) -> a +fst3 (x, _, _) = x + +snd3 :: (a, b, c) -> b +snd3 (_, x, _) = x + +trd3 :: (a, b, c) -> c +trd3 (_, _, x) = x + +fst4 :: (a, b, c, d) -> a +fst4 (x, _, _, _) = x + +toFirstAndRest :: (a, b, c, d) -> (a, (b, c, d)) +toFirstAndRest (a, b, c, d) = (a, (b, c, d)) + +listToMaybe :: [a] -> Maybe [a] +listToMaybe [] = Nothing +listToMaybe xs = Just xs + +mcons :: Maybe a -> [a] -> [a] +mcons Nothing xs = xs +mcons (Just x) xs = x : xs + +matchAny :: [String] -> String -> Bool +matchAny patterns fileName = any (`isPrefixOf` fileName) patterns + +mapFirst :: (a -> a) -> [a] -> [a] +mapFirst f (x : xs) = f x : xs +mapFirst _ [] = [] + +mapLast :: (a -> a) -> [a] -> [a] +mapLast f [x] = [f x] +mapLast f (x : xs) = x : mapLast f xs +mapLast _ [] = [] + +subSeq :: Int -> Int -> [a] -> [a] +subSeq start end = drop start . take end + +subSubSeq :: Int -> Int -> [[a]] -> [[a]] +subSubSeq start end = mapFirst (drop start) . mapLast (take end) + +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 diff --git a/stack-hpc-coveralls.cabal b/stack-hpc-coveralls.cabal new file mode 100644 --- /dev/null +++ b/stack-hpc-coveralls.cabal @@ -0,0 +1,77 @@ +name: stack-hpc-coveralls +version: 0.0.0.1 +synopsis: Initial project template from stack +description: Please see README.md +homepage: http://github.com/rubik/stack-hpc-coveralls +license: ISC +license-file: LICENSE +author: Michele Lacchia +maintainer: michelelacchia@gmail.com +copyright: Copyright (c) 2015 Michele Lacchia +category: Control +build-type: Simple +extra-source-files: + stack.yaml +cabal-version: >=1.18 + +library + hs-source-dirs: src + exposed-modules: SHC + other-modules: SHC.Coveralls + SHC.Types + SHC.Paths + SHC.Utils + SHC.Lix + SHC.Api + build-depends: base >=4.7 && <5 + , hpc >=0.6 + , filepath >=1.4 + , process >=1.2 + , pureMD5 >=2.1 + , containers >=0.5 + , aeson >=0.8 + , bytestring >=0.10 + , utf8-string >=1.0 + , text >=1.2 + , directory >=1.2 + , directory-tree >=0.12 + , wreq >=0.4 + , http-client >=0.4 + , lens >=4.12 + , lens-aeson >=1.0 + , safe >=0.3 + default-language: Haskell2010 + +executable stack-hpc-coveralls + hs-source-dirs: app + main-is: Main.hs + ghc-options: -Wall + build-depends: base >=4.7 && <5 + , aeson >=0.8 + , bytestring >=0.10 + , docopt >=0.7 + , stack-hpc-coveralls -any + default-language: Haskell2010 + +test-suite stack-hpc-coveralls-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base >=4.7 && <5 + , stack-hpc-coveralls -any + , hspec >=2.2 + 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 + location: https://github.com/rubik/stack-hpc-coveralls diff --git a/stack.yaml b/stack.yaml new file mode 100644 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,33 @@ +# 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: lts-3.11 + +# Local packages, usually specified by relative directory name +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] diff --git a/test/HLint.hs b/test/HLint.hs new file mode 100644 --- /dev/null +++ b/test/HLint.hs @@ -0,0 +1,16 @@ +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/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"