highlight-versions-0.1.4: src/Highlight.hs

module Main where

import           Data.Char                    (isSpace)
import qualified Data.Map                     as M
import           Distribution.Hackage.DB      (HackageDB, hackageTarball,
                                               readTarball)
import           Distribution.Pretty          (prettyShow)
import           Distribution.Text            (simpleParse)
import           Distribution.Types.PackageId (pkgName, pkgVersion)
import           Distribution.Types.Version   (Version)
import           Prelude
import qualified Prelude                      as P (map)
import           System.Console.ANSI

main = do
  tarball <- hackageTarball
  db      <- readTarball Nothing tarball
  input   <- getContents
  let ls = lines input
  mapM_ (highlightOutdated db) ls

-- | Take an individual line of output and see if the first word on
-- the line looks like a package identifier (/i.e./ @foo-0.3.2@).  If
-- so, compare it to the latest version on Hackage, and highlight it
-- if the version differs (in red if the version is older than the
-- latest on Hackage, or cyan if newer), also printing the version of
-- the latest Hackage release in blue.
highlightOutdated :: HackageDB -> String -> IO ()
highlightOutdated db s = do
  let (sp,l)   = span isSpace s
      (p,rest) = break isSpace l
  -- try to parse the beginning of the line as a package identifier (like foo-1.3.2)

  putStr sp
  case simpleParse p of
    Nothing    -> putStrLn l
    Just pkgId ->
      -- look up this package name in the Hackage DB
      case M.lookup (pkgName pkgId) db of
        Nothing -> putStrLn l
        Just versions -> do
          -- get the latest version and compare it to the stated version
          let latest    = maximum . P.map fst . M.assocs $ versions
          case compare (pkgVersion pkgId) latest of
            EQ -> putStrColor Green p >> putStrLn rest
            LT -> doHighlight p latest Red  rest  -- show outdated versions in red
            GT -> doHighlight p latest Cyan rest  -- show newer versions in cyan

-- | Output a package name highlighted in a given color, along with
--   another version in blue.
doHighlight :: String -> Version -> Color -> String -> IO ()
doHighlight s latest color rest = do
  putStrColor color s
  putStr " ("
  putStrColor Blue (prettyShow latest)
  putStr ")"
  putStrLn rest

-- | Output a string highlighted in a given color.
putStrColor :: Color -> String -> IO ()
putStrColor color s = do
  setSGR [SetColor Foreground Vivid color]
  putStr s
  setSGR []