4 Copyright 2013 Louis-Guillaume Gagnon <louis.guillaume.gagnon@gmail.com>
6 This program is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with this program. If not, see <http://www.gnu.org/licenses/>.
28 import Database
.HDBC
.Sqlite3
29 import System
.Directory
32 data Flag
= Path
String
42 isFlag
:: String -> Bool
43 isFlag f
= f `
elem`
["-f","-p","-t","-j","-y","-v","-a","-k"]
45 isPathFlag
:: Flag
-> Bool
46 isPathFlag f
= case f
of
50 areEqual f1 f2
= f1
' == f2
'
51 where (f1
',_
) = break (==' ') $ show f1
52 (f2
',_
) = break (==' ') $ show f2
54 add
:: [String] -> IO ()
55 add
[] = error $ "add: no arguments specified ('" ++ progName
++ " add help' for help)"
56 add argv
= if isHelp
$ head argv
57 then do putStrLn usageAdd
59 case parseFlags argv
of
60 Left msg
-> error $ "add: " ++ msg
61 Right flags
-> do checkDuplicates flags
63 putStrLn (flagsToString flags
)
64 runSQL
(buildSQL flags
)
66 buildSQL
:: [Flag
] -> String
67 buildSQL flags
= buildSQL
' ("INSERT INTO " ++ tableName
++ " (") "VALUES(" flags
68 where buildSQL
' t1 t2
[] = ((init t1
) ++ ") ") ++ (init(t2
) ++ ");")
69 buildSQL
' t1 t2
(f
:fs
) = buildSQL
' (t1
++key
++",") (t2
++"'"++value++"',") fs
70 where (key
,val
) = break (==' ') $ show f
71 value = filter (/= '\"') (tail val
)
73 checkDuplicates
:: [Flag
] -> IO ()
74 checkDuplicates
(f
:[]) = return ()
75 checkDuplicates
(f
:fs
) = if or $ map (areEqual f
) fs
76 then do let f
' = fst $ break (==' ') $ show f
77 error "add: duplicate arguments"
78 else do checkDuplicates fs
81 checkFile
:: [Flag
] -> IO ()
82 checkFile fs
= case filter isPathFlag fs
of
84 ((Path p
):_
) -> do exists
<- doesFileExist p
87 else do error $ "File does not exists: " ++ p
89 isYear
:: String -> Bool
90 isYear str
= and [and (map isDigit str
), (length str
== 4)]
92 isPages
:: String -> Bool
93 isPages str
= and (map isDigit (pf
++ pt
))
94 where (pf
,pt
') = break (=='-') str
95 pt
= if null pt
' then "0" else tail pt
'
97 flagsToString
:: [Flag
] -> String
98 flagsToString xs
= foldl' step
[] xs
99 where step ys x
= show x
++ "\n" ++ ys
101 parseFlags
:: [String] -> Either String [Flag
]
102 parseFlags argv
= parseFlags
' [] argv
103 where parseFlags
' _
(x
:[]) = if isFlag x
104 then Left
"too few arguments"
105 else Left
$ "Invalid argument: " ++ x
106 parseFlags
' fs
[] = Right fs
108 let flag
= getFlag xs
111 Right f
-> parseFlags
' (f
:fs
) (dropWhile (not . isFlag
) (tail xs
))
113 getFlag
:: [String] -> Either String Flag
114 getFlag x
@(x0
:x1
:_
) =
116 then Left
"too few argument"
118 "-f" -> Right
$ Path x1
119 "-t" -> Right
$ Title x1
120 "-j" -> Right
$ Journal x1
121 "-v" -> Right
$ Volume x1
124 else Left
$ "Invalid date: " ++ x1
++ " ('" ++ progName
++ "\
125 \ add help' for help)"
126 "-p" -> if isPages x1
127 then Right
$ Pages x1
128 else Left
$ "Invalid pages: " ++ x1
++ " ('" ++ progName
++ "\
129 \ add help' for help)"
130 "-k" -> Right
$ Keywords
$ getValues
$ tail x
131 "-a" -> Right
$ Authors
$ getValues
$ tail x
132 _
-> Left
$ "Invalid argument: " ++ x0
134 getValues
:: [String] -> String
135 getValues argv
= intercalate
"/" $ takeWhile (not . isFlag
) argv
138 runSQL
:: String -> IO ()
147 usageAdd
= "usage: " ++ progName
++ " add <filters>\n\
151 \ -a <author1 [author2] ...>\n\
152 \ -k <keyword1 [keyword2] ...>\n\
154 \ -y <year> : <yyyy>\n\
155 \ -p <page-from>-<page-to>"