nevras.hs

{-# LANGUAGE ScopedTypeVariables #-}

import           Control.Conditional(unlessM)
import           Control.Exception(Handler(..), catches, throwIO)
import           Control.Monad.Except(runExceptT)
import           Data.Conduit((.|), runConduit)
import qualified Data.Conduit.List as CL
import qualified Data.Text as T
import           System.Console.GetOpt
import           System.Directory(doesFileExist)
import           System.Environment(getArgs)
import           System.Exit(exitFailure)
import           Text.Regex.PCRE((=~))

import BDCS.DB(checkAndRunSqlite)
import BDCS.Groups(groupsC, groupIdToNevra)
import BDCS.Utils.Either(whenLeft)
import BDCS.Version

import Utils.Exceptions(InspectErrors(..))
import Utils.GetOpt(OptClass, commandLineArgs, compilerOpts)
import Utils.IO(liftedPutStrLn)

-- These warnings are coming from options records that only have one field.
-- As options are added, these warnings will go away.  Until then, ignore
-- them.
{-# ANN module "HLint: ignore Use newtype instead of data" #-}

data NevrasOptions = NevrasOptions { nevraMatches :: String }

instance OptClass NevrasOptions

defaultNevrasOptions :: NevrasOptions
defaultNevrasOptions = NevrasOptions { nevraMatches = ".*" }

runCommand :: T.Text -> FilePath -> [String] -> IO (Either String ())
runCommand db _ args = do
    (opts, _) <- compilerOpts options defaultNevrasOptions args "nevras"
    runExceptT $ checkAndRunSqlite db $ runConduit $
        groupsC .| CL.map fst
                .| CL.mapMaybeM groupIdToNevra
                .| CL.filter (\g -> T.unpack g =~ nevraMatches opts)
                .| CL.mapM_ liftedPutStrLn
 where
    options :: [OptDescr (NevrasOptions -> NevrasOptions)]
    options = [
        Option ['m'] ["matches"]
               (ReqArg (\d opts -> opts { nevraMatches = d }) "REGEX")
               "return only results that match REGEX"
     ]

usage :: IO ()
usage = do
    printVersion "inspect-nevras"
    putStrLn "Usage: inspect-nevras output.db repo [args ...]"
    putStrLn "  List NEVRAs of RPM packages in the content store"
    putStrLn "- output.db is the path to a metadata database"
    putStrLn "- repo is the path to a content store repo"
    exitFailure

runMain :: IO ()
runMain = do
    argv <- getArgs
    case commandLineArgs argv of
        Nothing               -> usage
        Just (db, repo, args) -> do
            unlessM (doesFileExist db) $
                throwIO MissingDBError

            result <- runCommand (T.pack db) repo args
            whenLeft result (\e -> print $ "error: " ++ e)

main :: IO ()
main =
    -- Add handlers for other exception types (IOException, whatever) here.
    runMain `catches` [Handler (\(e :: InspectErrors) -> handleInspectErrors e)]
 where
    -- And then add handlers for the various kinds of InspectErrors here.
    handleInspectErrors :: InspectErrors -> IO ()
    handleInspectErrors MissingDBError = putStrLn "Metadata database does not exist\n" >> usage

    handleInspectErrors _              = usage