Freq.hs

{-# LANGUAGE OverloadedStrings #-}
module Git.Freq where

import           Control.Arrow      ((***))
import           Data.ByteString    (ByteString)
import           Data.List          (sortBy)
import           Data.Map.Strict    (Map)
import qualified Data.Map.Strict    as Map
import           Data.Text          (Text)
import qualified Data.Text          as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO       as T
import           Text.Read          (readMaybe)

import           System.IO.Streams  (InputStream)
import qualified System.IO.Streams  as Streams

type FileName = Text
type NumStat = (Int, Int)
type Change = (FileName, NumStat)
type Result = Map FileName NumStat

freq :: [FilePath] -> IO ()
freq paths = do
    r <- getNumStatStream paths >>= freq'
    mapM_ render (sortResult $ Map.toList r)

getNumStatStream :: [FilePath] -> IO (InputStream ByteString)
getNumStatStream paths = do
  let args = ["log"
             , "--numstat"
             , "--pretty=\"%0\""
             ] ++ paths

  (_,is,_,_) <- Streams.runInteractiveProcess "git" args Nothing Nothing
  return is

freq' :: InputStream ByteString -> IO Result
freq' is = Streams.lines is >>=
           Streams.map (parseLine . T.decodeUtf8) >>=
           Streams.mapMaybe id >>=
           Streams.fold incrementChange Map.empty

sumChanges :: [Change] -> Result
sumChanges = foldl incrementChange Map.empty

incrementChange :: Result -> Change -> Result
incrementChange result (fileName,numstat@(a,d)) = Map.alter f fileName result
  where
    f numstat' = Just $ maybe numstat ((a+) *** (d+)) numstat'

sortResult :: [Change] -> [Change]
sortResult = let f (_,(xa,xd)) (_,(ya,yd)) = (ya+yd) `compare` (xa+xd) in sortBy f

parseLine :: Text -> Maybe Change
parseLine = go . T.splitOn (T.pack "\t")
    where go :: [Text] -> Maybe Change
          go (_:_:"":_) = Nothing
          go (added:deleted:filename:_) =
            case (readIntMaybe added, readIntMaybe deleted) of
                (Just a, Just d) -> Just (filename, (a, d))
                _                -> Nothing
          go _ = Nothing
          readIntMaybe x = readMaybe (T.unpack x) :: Maybe Int

render :: Change -> IO ()
render (fileName,(added,deleted)) =
    T.putStrLn . T.pack . mconcat $ [T.unpack fileName, ",",  show added, ",", show deleted]