cabal-progdeps-1.0: progdeps.hs

module Main where

import System.Directory (getCurrentDirectory)
import System.FilePath ( (</>) )
import System.Exit (exitSuccess, exitWith, ExitCode(..))
import System.Environment (getArgs, getProgName)
import Data.List (intercalate)
import Data.Char (toUpper)
import Control.Applicative ( (<$>) )
import Control.Monad (when)
import Distribution.Simple.LocalBuildInfo
import Distribution.InstalledPackageInfo (showInstalledPackageInfoField
                                         -- ,showInstalledPackageInfo
                                         )
import Distribution.Simple.PackageIndex (topologicalOrder)

exitUsage :: IO ()
exitUsage = do  putStr "Usage: "
                putStr =<< getProgName
                putStrLn " [progdir]"
                putStrLn ""
                putStrLn "  Shows the current package dependency versions for the"
                putStrLn "  cabal-built program in progdir (default=current directory)."
                exitWith $ ExitFailure 2

mktable :: [[String]] -> [String]
mktable cols = zipLists "" (mkcol widths) cols
    where zipLists e f ls = if all null ls then []
                            else f (map (headOr e) ls) : zipLists e f (map (tailOr []) ls)
          headOr d = head . \l -> l ++ [d]
          tailOr d = tail . \l -> l ++ d
          widths = [ maximum (map length c) | c <- cols ]
          mkcol _ [] = ""
          mkcol s (a:bs) = let (sz:szs) = s
                               fillsz = if length a < sz then sz - length a else 0
                               fill = replicate fillsz ' '
                           in a ++ fill ++ "| " ++ mkcol szs bs

main :: IO ()
main = do args <- getArgs
          when ("-h" `elem` args) exitUsage
          when ("--help" `elem` args) exitUsage
          when (length args > 1) exitUsage
          curdir <- return . head . (++) args . flip (:) [] =<< getCurrentDirectory
          let progcfgName = curdir </> "dist" </> "setup-config"
          progcfg <- lines <$> readFile progcfgName
          -- always 2 lines: a version declaration followed by the LocalBuildInfo `show'
          let cdata = (read . head . tail $ progcfg) :: LocalBuildInfo
              showfld f = blnkOrVal f . showInstalledPackageInfoField $ f
              blnkOrVal f = maybe (const " ") (\g -> drop (2 + length f) . g)
              pkglist = topologicalOrder . installedPkgs $ cdata
              fldcol n = (:) (map toUpper n) . map (showfld n)
          putStrLn $ head progcfg
          -- putStrLn . show . withPrograms $ cdata
          putStrLn . intercalate "\n" $ mktable [ fldcol "name" pkglist
                                                , fldcol "version" pkglist
                                                , fldcol "stability" pkglist
                                                , fldcol "category" pkglist
                                                ]
          -- putStrLn . intercalate "\n\n" . map showInstalledPackageInfo $ pkglist
          exitSuccess