{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE NoImplicitPrelude #-} -- CLI frontend for running and submitting analyses to the Dragons.dev web -- service. -- -- : out dragons-analyze module Biz.Dragons.Analysis ( Analysis (..), Commit (..), run, main, test, git, ) where import Alpha import qualified Biz.Cli as Cli import Biz.Test ((@=?)) import qualified Biz.Test as Test import qualified Control.Concurrent.Async as Async import qualified Data.Aeson as Aeson import Data.Data (Data) import qualified Data.List as List import qualified Data.Map as Map import qualified Data.String as String import qualified Data.Text as Text import qualified Data.Time.Clock as Time import qualified Data.Time.Format as Time import qualified System.Directory as Directory import qualified System.Process as Process main :: IO () main = Cli.main <| Cli.Plan help move test tidy move :: Cli.Arguments -> IO () move args = gitDir +> run authors /> Aeson.encode +> putStrLn where gitDir = Cli.argument "git-dir" |> Cli.getArgWithDefault args ".git" |> Directory.makeAbsolute authors = -- i think this is not working? do i need optparse-applicative? -- see: https://github.com/docopt/docopt.hs/issues/25 Cli.shortOption 'a' |> Cli.getAllArgs args |> map Text.pack tidy :: cfg -> IO () tidy _ = pure () test :: Test.Tree test = Test.group "Biz.Dragons.Analysis" [test_calculateScore] help :: Cli.Docopt help = [Cli.docopt| dragons-analyze Usage: dragons-analyze test dragons-analyze [--author=]... Options: -a, --author List of active authors' emails. |] newtype Commit = Sha Text deriving (Eq, Data, Typeable, Ord, Generic, Show) instance Aeson.ToJSON Commit -- | The result of analyzing a git repo. data Analysis = Analysis { -- | Where the repo is stored on the local disk. gitDir :: FilePath, -- | A path with no active contributors blackholes :: [Text], -- | A path with < 3 active contributors liabilities :: [Text], -- | Map of path to number of commits, for detecting paths that continually -- get rewritten. hotspotMap :: Map FilePath Integer, -- | Files that have not been touched in 6 months stale :: Map FilePath Integer, -- | Total score for the repo score :: Integer, -- | Total number of files totalFiles :: Integer, -- | The total number of commits totalCommits :: Integer, -- | List of all the active users we care about activeAuthors :: [Text], -- | Which commit this analysis was run against. commit :: Commit } deriving (Eq, Ord, Generic, Show, Data, Typeable) instance Aeson.ToJSON Analysis run :: [Text] -> FilePath -> IO Analysis run activeAuthors bareRepo = do commit <- git bareRepo ["rev-parse", "HEAD"] /> Text.pack /> chomp /> Sha tree <- git bareRepo [ "ls-tree", "--full-tree", "--name-only", "-r", -- recurse into subtrees "HEAD" ] /> String.lines authors <- traverse (authorsFor bareRepo) tree :: IO [[(Text, Text, Text)]] let authorMap = zip tree authors :: [(FilePath, [(Text, Text, Text)])] stalenessMap <- traverse (lastTouched bareRepo) tree let blackholes = [ Text.pack path | (path, authors_) <- authorMap, null (map third authors_ `List.intersect` activeAuthors) ] let liabilities = [ Text.pack path | (path, authors_) <- authorMap, length (map third authors_ `List.intersect` activeAuthors) < 3 ] let numBlackholes = realToFrac <| length blackholes let numLiabilities = realToFrac <| length liabilities let numTotal = realToFrac <| length tree hotspotMap <- Map.fromList filter (/= '\n') /> readMaybe /> fromMaybe 0 pure <| Analysis { gitDir = bareRepo, stale = Map.fromList <| [ (path, days) | (path, Just days) <- stalenessMap, days > 180 ], score = calculateScore numTotal numBlackholes numLiabilities, totalFiles = toInteger <| length tree, .. } where third :: (a, b, c) -> c third (_, _, a) = a getChangeCount :: FilePath -> IO (FilePath, Integer) getChangeCount path = git bareRepo ["rev-list", "--count", "HEAD", "--", path] /> filter (/= '\n') /> readMaybe /> fromMaybe 0 /> (path,) -- | Given a git dir and a path inside the git repo, get information about the -- authors. authorsFor :: FilePath -> FilePath -> -- | returns (number of commits, author name, author email) IO [(Text, Text, Text)] authorsFor gitDir path = Process.readProcess "git" [ "--git-dir", gitDir, "shortlog", "--numbered", "--summary", "--email", "HEAD", "--", path ] "" /> Text.pack /> Text.lines /> map (Text.break (== '\t')) /> map parseAuthor where parseAuthor (commits, author) = ( Text.strip commits, Text.strip <| Text.takeWhile (/= '<') author, Text.strip <| Text.dropAround (`elem` ['<', '>']) <| Text.dropWhile (/= '<') author ) -- | Run a git command on a repo git :: -- | path to the git dir (bare repo) String -> -- | args to `git` [String] -> IO String git bareRepo args = Process.readProcess "git" (["--git-dir", bareRepo] ++ args) "" lastTouched :: FilePath -> FilePath -> IO (FilePath, Maybe Integer) lastTouched bareRepo path = do now <- Time.getCurrentTime timestamp <- Process.readProcess "git" [ "--git-dir", bareRepo, "log", "-n1", "--pretty=%aI", "--", path ] "" /> filter (/= '\n') /> Time.parseTimeM True Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%z" pure (path, calculateAge now Double -> Double -> Integer calculateScore 0 _ _ = 0 calculateScore a 0 0 | a > 0 = 100 calculateScore a b c | a < 0 || b < 0 || c < 0 = 0 calculateScore numTotal numBlackholes numLiabilities = max 0 <. round <| maxScore * (weightedBlackholes + weightedLiabilities + numGood) / numTotal where weightedBlackholes = numBlackholes * (5 / 10) weightedLiabilities = numLiabilities * (7 / 10) numGood = numTotal - numBlackholes - numLiabilities maxScore = 100.0 test_calculateScore :: Test.Tree test_calculateScore = Test.group "calculateScore" [ Test.unit "perfect score" <| 100 @=? calculateScore 100 0 0, Test.unit "all blackholes" <| 50 @=? calculateScore 100 100 0, Test.unit "all liabilities" <| 70 @=? calculateScore 100 0 100, Test.prop "never > 100" <| \t b l -> calculateScore t b l <= 100, Test.prop "never < 0" <| \t b l -> calculateScore t b l >= 0 ]