-
Notifications
You must be signed in to change notification settings - Fork 10
/
hpodder.hs
87 lines (74 loc) · 2.98 KB
/
hpodder.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
{- hpodder component
Copyright (C) 2006-2008 John Goerzen <jgoerzen@complete.org>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
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 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
-}
{- |
Module : Main
Copyright : Copyright (C) 2006-2008 John Goerzen
License : GNU GPL, version 2 or above
Maintainer : John Goerzen <jgoerzen@complete.org>
Stability : provisional
Portability: portable
Written by John Goerzen, jgoerzen\@complete.org
-}
import Config
import DB
import System.Log.Logger
import System.Log.Handler.Simple
import System.IO(stdout)
import System.Console.GetOpt.Utils
import System.Console.GetOpt
import System.Environment
import Data.List
import System.Exit
import Commands
import Types
import Control.Monad
import Utils
import Database.HDBC
main =
do updateGlobalLogger "" (setLevel INFO)
argv <- getArgs
let (optargs, commandargs) = span (isPrefixOf "-") argv
case getOpt RequireOrder options optargs of
(o, n, []) -> worker o n commandargs
(_, _, errors) -> usageerror (concat errors) -- ++ usageInfo header options)
options = [Option "d" ["debug"] (NoArg ("d", "")) "Enable debugging",
Option "" ["help"] (NoArg ("help", "")) "Display this help"]
worker args n commandargs =
do when (lookup "help" args == Just "") $ usageerror ""
when (lookup "d" args == Just "")
(updateGlobalLogger "" (setLevel DEBUG))
handler <- streamHandler stdout DEBUG
updateGlobalLogger "" (setHandlers [handler])
initDirs
let commandname = head cmdargs
case lookup commandname allCommands of
Just command ->
do cp <- loadCP
dbh <- connect
handleSqlError $ execcmd command (tail cmdargs)
(GlobalInfo {gcp = cp, gdbh = dbh})
disconnect dbh
Nothing -> usageerror ("Invalid command name " ++ commandname)
where cmdargs = case commandargs of
[] -> ["fetch"]
x -> x
usageerror errormsg =
do putStrLn errormsg
putStrLn (usageInfo header options)
putStrLn "Run \"hpodder lscommands\" for a list of available commands.\n\
\Run \"hpodder command --help\" for help on a particular command.\n"
exitFailure
header = "Usage: hpodder [global-options] command [command-options]\n\n\
\Available global-options are:\n"