{----------------------------------------------------------------- (c) 2008-2009 Markus Dittrich This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License Version 3 as published by the Free Software Foundation. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 3 for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --------------------------------------------------------------------} -- | hark is a tool for querying installed packages on a Gentoo -- Linux system -- imports import qualified Data.ByteString.Char8 as BC(pack) import Prelude import System.Directory(doesFileExist, setCurrentDirectory) import System.Exit(exitWith, ExitCode(..)) -- local imports import Drivers.Depend(search_for_depends) import Drivers.Content(display_package_contents, display_binary_package_contents, display_etc_package_contents, display_doc_package_contents, display_include_package_contents, display_library_package_contents, display_share_package_contents) import Drivers.Owner(display_file_owner) import Drivers.SearchPackage(search_for_packages_detailed, search_for_packages_short) import Drivers.Use(search_for_use_all, search_for_use_used) import Helpers.Common(find_package_paths, get_categories, strip_category) import Helpers.FileIO(dataBaseDir) import Helpers.PrettyPrint(Color(..), putColorStr, putColorStrLn) import Parsers.CommandLine(ArgOrder(..), defaultOptions, getArgs, getOpt, Query(..), options, Options(..), show_usage, usageInfo) --import Debug.Trace -- | main driver routine main :: IO () main = -- parse command line getArgs >>= \args -> let ( actions, nonOpts, _) = getOpt RequireOrder options args in foldl (>>=) ( return defaultOptions ) actions >>= \opts -> -- assign command line options let Options { theQuery = request } = opts in -- retrieve all categories from database get_categories dataBaseDir >>= \categories -> setCurrentDirectory dataBaseDir -- check for supplied patterns and then call the -- appropriate handler if any patterns given, otherwise abort -- FIXME: For now we only call the handler for the first -- pattern supplied on the command line even if -- more are given. Should we instead loop over them -- all on at a time? >> if null nonOpts then (putColorStrLn Red $ "\nERROR: No pattern supplied.\n") >> show_usage opts >> return () else case request of None -> show_usage opts >> return () UseAll -> handle_use_all categories (head nonOpts) UseUsed -> handle_use_used categories (head nonOpts) _ -> handle_path_request request categories (head nonOpts) -- | main request handler dealing with request to show -- packages that have a certain USE flag handle_use_all :: [FilePath] -> String -> IO () handle_use_all categories useFlag = message "packages that have" ("IUSE = " ++ useFlag) >> search_for_use_all categories (BC.pack useFlag) -- | main request handler dealing with request to show -- packages that have and were emerged with a certain -- USE flag handle_use_used :: [FilePath] -> String -> IO () handle_use_used categories useFlag = message "packages that were emerge with" ("USE = " ++ useFlag) >> search_for_use_used categories (BC.pack useFlag) -- | main request handler dealing with requests involving -- some type of category/package name type request. -- Dispatches the proper routine depending on the user request handle_path_request :: Query -> [FilePath] -> String -> IO () handle_path_request request categories pattern = -- if the user supplied a full category/name -- entry we strip the category and search only -- the relevant subdirectory for efficiency let (strippedPattern, strippedPaths) = strip_category pattern categories in -- dispatch on user selection case request of -- quick search for package; no need to make sure that the -- requested package exists since we're searching SearchShort -> message "package(s) matching" pattern >> search_for_packages_short (BC.pack strippedPattern) strippedPaths -- detailed search for package; no need to make sure that the -- requested package exists since we're searching SearchDetailed -> message "package(s) matching" pattern >> search_for_packages_detailed (BC.pack strippedPattern) strippedPaths -- display package owning a particular file Owner -> message "package owning" pattern -- check if the user supplied path exists, if so, try -- to find a match >> doesFileExist pattern >>= \isFile -> case isFile of False -> putColorStrLn Cyan $ "ERROR: " ++ pattern ++ "is not a file" True -> display_file_owner pattern categories -- dispatch on options that require unique filename _ -> find_package_paths strippedPattern strippedPaths >>= \result -> case length result of 0 -> print_no_match 1 -> dispatch_unique_request categories request pattern (head result) _ -> print_multiple_pkg_error result -- | dispatch on options that require a unique file path dispatch_unique_request :: [FilePath] -> Query -> String -> FilePath -> IO () dispatch_unique_request paths request pattern targetPath = case request of -- search for dependent packages (for all use flags) DependUsed -> message "(USEd) dependencies of" pattern >> search_for_depends targetPath paths True -- search for dependent packages (for "used" use flags) DependAll -> message "(USEd) dependencies of" pattern >> search_for_depends targetPath paths False -- display full content belonging to a package Contents -> message "files installed by" pattern >> display_package_contents targetPath -- display binaries belonging to a package BinContents -> message "binary files installed by" pattern >> display_binary_package_contents targetPath -- display docs belonging to a package DocContents -> message "doc files installed by" pattern >> display_doc_package_contents targetPath -- display etc content belonging to a package EtcContents -> message "etc files installed by" pattern >> display_etc_package_contents targetPath -- display all include files belonging to a package IncludeContents -> message "include files installed by" pattern >> display_include_package_contents targetPath -- display all libraries belonging to a package LibContents -> message "library files installed by" pattern >> display_library_package_contents targetPath -- display all content in share belonging to a package ShareContents -> message "library files installed by" pattern >> display_share_package_contents targetPath -- default action _ -> putStrLn $ usageInfo "Usage: hark [options]\n" options -- | helper functions for printing status messages message :: String -> String -> IO () message string pattern = (putColorStr Magenta $ "\n*** Searching for " ++ string ++ " ") >> (putColorStr Yellow $ pattern) >> (putColorStr Magenta $ " ***\n") -- | helper function for printing no matches print_no_match :: IO () print_no_match = (putColorStrLn Red $ "\nERROR: No match found.\n") >> (exitWith $ ExitFailure 1) -- | helper function for printing multiple matches print_multiple_pkg_error :: [FilePath] -> IO () print_multiple_pkg_error paths = (putColorStr Red "WARNING: ") >> (putStrLn "Search pattern matches multiple packages.") >> (putStr "\t Please unambiguate via a category, version ") >> (putStrLn "or slot.\n") >> (mapM_ (putStrLn . (++) "\t " ) paths) >> (exitWith $ ExitFailure 1)