The awakening!
[fquery.git] / Main.hs
blobd64ce554d27515148efe899ea1d9aef9b01fdec6
1 -- Main.hs
2 --
3 -- Adelie is a collection of scripts to querying portage packages.
5 module Main (main) where
7 import System (getArgs, getProgName)
9 import Adelie.Colour
10 import Adelie.Options
11 import Adelie.QChangelog
12 import Adelie.QCheck
13 import Adelie.QDepend
14 import Adelie.QHasUse
15 import Adelie.QList
16 import Adelie.QOwn
17 import Adelie.QSize
18 import Adelie.QUse
19 import Adelie.QWant
21 type CommandProc = [String] -> IO ()
23 data Command
24 = Short String String CommandProc
25 | Long String String String CommandProc
27 logCommands :: [Command]
28 logCommands = [
29 (Long "c" "changes"
30 "list changes since the installed version"
31 qChangelog),
32 (Short "cl"
33 "find the changelog of a package"
34 qLogFile)
37 listCommands :: [Command]
38 listCommands = [
39 (Long "f" "files"
40 "list the contents of a package"
41 (qList ListAll)),
42 (Short "fd"
43 "list the directories in a package"
44 (qList ListDirs)),
45 (Short "ff"
46 "list the files in a package"
47 (qList ListFiles)),
48 (Short "fl"
49 "list the links in a package"
50 (qList ListLinks))
53 ownCommands :: [Command]
54 ownCommands = [
55 (Long "b" "belongs"
56 "find the package(s) owning a file"
57 qOwn),
58 (Short "bp"
59 "find the package(s) owning a file with regexp"
60 qOwnRegex),
61 (Long "s" "size"
62 "find the size of files in a package"
63 qSize),
64 (Long "k" "check"
65 "check MD5sums and timestamps of a package"
66 qCheck)
69 dependCommands :: [Command]
70 dependCommands = [
71 (Long "d" "depends"
72 "list packages directly depending on this package"
73 qDepend),
74 (Short "dd"
75 "list direct dependencies of a package"
76 qWant)
79 useCommands :: [Command]
80 useCommands = [
81 (Long "u" "uses"
82 "describe a package's USE flags"
83 qUse),
84 (Long "h" "hasuse"
85 "list all packages with a USE flag"
86 qHasUse)
89 allCommands :: [Command]
90 allCommands = logCommands ++ listCommands ++ ownCommands ++ dependCommands ++ useCommands
92 ----------------------------------------------------------------
94 main :: IO ()
95 main = do
96 args0 <- getArgs
97 let (options, commands) = span isOption args0
98 mapM_ parseOptions options
99 case commands of
100 [] -> usage
101 (cmd:cargs) -> (runCommand cmd allCommands) cargs
104 isOption :: String -> Bool
105 isOption = ('-' ==) . head
107 ----------------------------------------------------------------
109 parseOptions :: String -> IO ()
110 parseOptions [] = return ()
112 parseOptions "-C" = setColourEnabled False
113 parseOptions "--nocolor" = setColourEnabled False
114 parseOptions "--nocolour" = setColourEnabled False
116 parseOptions _ = return ()
118 ----------------------------------------------------------------
120 runCommand :: String -> [Command] -> CommandProc
121 runCommand _ [] = (\ _ -> usage)
123 runCommand command ((Short cmd _ f):cs)
124 | command == cmd = f
125 | otherwise = runCommand command cs
127 runCommand command ((Long cmd0 cmd1 _ f):cs)
128 | command == cmd0 = f
129 | command == cmd1 = f
130 | otherwise = runCommand command cs
132 ----------------------------------------------------------------
134 usage :: IO ()
135 usage = do
136 prog <- getProgName
137 putStrLn "fquery 0.2\n"
138 putStrLn $ "Usage: " ++ prog ++ " [options] <command> <arguments>\n"
140 cyan >> putStr "Options:" >> off2
141 inYellow (putStr " -C --nocolour") >> tab >> putStrLn "turn off colours"
144 cyan >> putStr "Commands for Installed Packages:" >> off2
145 mapM_ putCommand logCommands; nl
146 mapM_ putCommand listCommands; nl
147 mapM_ putCommand ownCommands; nl
148 mapM_ putCommand dependCommands; nl
149 mapM_ putCommand useCommands; nl
151 putCommand :: Command -> IO ()
152 putCommand (Short cmd desc _) = f `withDesc` desc
153 where f = green >> putStr cmd >> off >> tab
155 putCommand (Long cmd0 cmd1 desc _) = f `withDesc` desc
156 where f = green >> putStr (cmd0 ++ " " ++ cmd1) >> off
158 withDesc :: IO () -> String -> IO ()
159 f `withDesc` desc = putStr " " >> f >> tab >> putStrLn desc
161 tab :: IO ()
162 tab = putChar '\t'
163 nl :: IO ()
164 nl = putChar '\n'