module Porte.Tool(toolMain) where
import System.Environment
import System.Exit
import Control.Monad
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Porte.Ports as P
import qualified Porte.Statistics as S
import qualified System.IO as I
version = "0.0.2.1"
printFormat = [P.path, P.comment, P.website]
toField :: String -> P.PortField
toField f =
case (P.toField f) of
Nothing -> error $ "Unknown field: " ++ f
Just f -> f
doStatistics :: [String] -> IO ()
doStatistics (a:m:_) =
case a of
"frequency" -> case m of
"categories" -> doOutput $ S.fieldsFrequency P.categories
"buildDepends" -> doOutput $ S.fieldsFrequency P.buildDepends
"extractDepends" -> doOutput $ S.fieldsFrequency P.extractDepends
_ -> doOutput $ S.fieldFrequency (toField m)
_ -> error $ "Unknown statistics mode"
where
doOutput f = P.index Nothing >>= flip forM_ S.printFrequency . f
doStatistics _ = toolUsage >> die
doIndex :: IO ()
doIndex =
P.index Nothing >>= P.putPorts printFormat
parseSearch :: [String] -> P.PortQuery
parseSearch q =
build [] q
where
build p (f:q:qs) = build ((toField f, q) : p) qs
build p (_:[]) = error "Parse error"
build p _ = p
genericSearch :: (P.PortQuery -> [P.Port] -> [P.Port]) -> [String] -> IO ()
genericSearch f [] = exit
genericSearch f q = do
ports <- P.index Nothing
P.putPorts printFormat $ (f . parseSearch) q ports
doSearch q = genericSearch P.search q
doFind q = genericSearch P.find q
die = exitWith (ExitFailure 1)
exit = exitWith (ExitSuccess)
hToolUsage :: I.Handle -> IO ()
hToolUsage h = I.hPutStrLn h "Usage: porte [-hvlsfS]"
toolUsage = hToolUsage I.stderr
printVersion :: IO ()
printVersion = I.putStrLn $ "Porte.Tool " ++ version
toolMain = do
argv <- getArgs
case (null argv) of
True -> toolUsage >> die
_ -> case (head argv) of
"-h" -> hToolUsage I.stdout
"-v" -> printVersion
"-l" -> doIndex
"-s" -> doSearch $ tail argv
"-f" -> doFind $ tail argv
"-S" -> doStatistics $ tail argv
_ -> toolUsage >> die