cabalQuery-0.1.0.0: tools/Main.hs

module Main where

import System.Environment
import System.IO

import Data.Either
import Data.List (isInfixOf, intercalate)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.String.Utils
import Distribution.Query
import Distribution.PackageDescription (GenericPackageDescription)

main :: IO ()
main = do
  args <- getArgs
  eCfg <- parseArgs args
  case eCfg of
    Nothing -> printHelp
    Just cfg | ["--help"] `isInfixOf` (options cfg) -> printHelp
             | otherwise -> do
      let cmds = map cmdFn $ commands cfg
      mapM_ (query cmds) (files cfg)

printHelp :: IO ()
printHelp = do
  putStrLn "Usage: cabalQuery [command] [cabalfile] [options]"
  putStrLn ""
  putStrLn "Commands, files and options can be interspersed."
  putStrLn ""
  putStrLn "Options:"
  putStrLn "  --help             Prints this help output."
  putStrLn "  --version          Nothing, yet."
  putStrLn "  --numeric-version  Nothing, yet."
  putStrLn ""
  putStrLn "Commands:"
  mapM_ (\cmd -> putStrLn ("  " ++ (cmdName cmd) ++ "\t\t" ++ (cmdDesc cmd))) commandList

commandMap :: Map String Command
commandMap = Map.fromList $ map (\cmd -> (cmdName cmd, cmd)) commandList

commandList :: [Command]
commandList =
  [ Command "numeric-version"
      "Returns the numeric version in a machine-readable fashion." numericVersion
  , Command "version" "An alias for numeric-version" numericVersion
  , Command "name"  "The package name." name
  , Command "license" "The package license." license
  , Command "copyright" "The package copyright." copyright
  , Command "homepage" "The package homepage." homepage
  , Command "pkgUrl" "The package url." pkgUrl
  , Command "bugReports" "The bug reporting url." bugReports
  , Command "synopsis" "The package synopsis." synopsis
  , Command "description" "The package description." description
  , Command "buildType" "The buildType." buildType
  , Command "dataDir" "The dataDir." dataDir
  ]

data Command = Command { cmdName :: String
                         -- ^ The name of the command, as written on the command line.
                       , cmdDesc :: String
                         -- ^ A description of the command, for help output.
                       , cmdFn :: GenericPackageDescription -> String
                         -- ^ The function over a package description
                         -- to get the string value of the thing we're requesting.
                       }

data Config = Config { files :: [FilePath]
                     -- ^ The cabal file(s) to examine. Defaults to ./*.cabal
                     , commands :: [Command]
                     -- ^ The things to show, from the cabal file.
                     -- e.g., 'numeric-version'
                     , options :: [String]
                     -- ^ Any options to pass to cabalQuery, starting with "--"
                     }

toCommand :: String -> Either String Command
toCommand str = case Map.lookup str commandMap of
                  Nothing  -> Left str
                  Just cmd -> Right cmd

parseArgs :: [String] -> IO (Maybe Config)
parseArgs args = do
  let eCmds = map toCommand $ filter isCommand args
  case (lefts eCmds, rights eCmds) of
    ([] , cmds) ->
      return (Just (Config { files = filter isCabalFile args
                  , options = filter isOption args
                  , commands = cmds
                  }))
    (errs, _) -> do
      hPutStrLn stderr "Invalid commands specified:"
      mapM_ (hPrint stderr) errs
      return Nothing

isCabalFile :: FilePath -> Bool
isCabalFile file = endswith ".cabal" file

isOption :: String -> Bool
isOption str = startswith "--" str

isCommand :: String -> Bool
isCommand str = not (isOption str || isCabalFile str)


query :: [GenericPackageDescription -> String] -> FilePath -> IO ()
query cmds file = do
  eGpb <- loadDescr file
  case eGpb of
    Left  err -> hPrint stderr err
    Right gpb -> putStrLn $ intercalate ", " (map ($ gpb) cmds)