src/Add.hs

   1 {-
   2     Add.hs
   3
   4     Copyright 2013 Louis-Guillaume Gagnon <louis.guillaume.gagnon@gmail.com>
   5
   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.
  10
  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.
  15
  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/>.
  18 -}
  19
  20 module Add (
  21     add,
  22     usageAdd
  23 ) where
  24
  25 import Data.Char
  26 import Data.List
  27 import Database.HDBC
  28 import Database.HDBC.Sqlite3
  29 import System.Directory
  30 import Util
  31
  32 data Flag = Path String
  33           | Title String
  34           | Authors String
  35           | Keywords String
  36           | Journal String
  37           | Volume String
  38           | Year String
  39           | Pages String
  40           | Bookmarked String
  41           deriving (Eq,Show)
  42
  43 isFlag :: String -> Bool
  44 isFlag f = f `elem` ["-f","-b","-p","-t","-j","-y","-v","-a","-k"]
  45
  46 isKindFlag :: String -> Bool
  47 isKindFlag ('-':_) = True
  48 isKindFlag _       = False
  49
  50 isPathFlag :: Flag -> Bool
  51 isPathFlag f = case f of
  52     Path _ -> True
  53     _     -> False
  54
  55 areFlagsEqual :: Flag -> Flag -> Bool
  56 areFlagsEqual f1 f2 = f1' == f2'
  57     where (f1',_) = break (==' ') $ show f1
  58           (f2',_) = break (==' ') $ show f2
  59
  60 add :: [String] -> IO ()
  61 add [] = error $ "add: no arguments specified ('" ++ progName ++ " add help' for help)"
  62 add argv = if isHelp $ head argv
  63     then do putStrLn usageAdd
  64     else do
  65         case parseFlags argv of
  66             Left  msg   -> error $ "add: " ++ msg
  67             Right flags -> do checkDuplicates flags
  68                               checkFile flags
  69                               putStrLn (flagsToString flags)
  70                               runSQL (buildSQL flags)
  71
  72 buildSQL :: [Flag] -> String
  73 buildSQL flags = buildSQL' ("INSERT INTO " ++ tableName ++ " (") "VALUES(" flags
  74     where buildSQL' t1 t2 [] = ((init t1) ++ ") ") ++ (init(t2) ++ ");")
  75           buildSQL' t1 t2 (f:fs) = buildSQL' (t1++key++",") (t2++"'"++value++"',") fs
  76               where (key,val) = break (==' ') $ show f
  77                     value     = filter (/= '\"') (tail val)
  78
  79 checkDuplicates :: [Flag] -> IO ()
  80 checkDuplicates (f:[]) = return ()
  81 checkDuplicates (f:fs) = if or $ map (areFlagsEqual f) fs
  82                              then do let f' = fst $ break (==' ') $ show f
  83                                      error "add: duplicate arguments"
  84                              else do checkDuplicates fs
  85
  86
  87 checkFile :: [Flag] -> IO ()
  88 checkFile fs = case filter isPathFlag fs of
  89     []     -> return ()
  90     ((Path p):_)  -> do exists <- doesFileExist p
  91                         if exists
  92                             then do return ()
  93                             else do error $ "File does not exists: " ++ p
  94
  95 isYear :: String -> Bool
  96 isYear str = and [and (map isDigit str), (length str == 4)]
  97
  98 isPages :: String -> Bool
  99 isPages str = and (map isDigit (pf ++ pt))
 100     where (pf,pt') = break (=='-') str
 101           pt       = if null pt' then "0" else tail pt'
 102
 103 flagsToString :: [Flag] -> String
 104 flagsToString xs = foldl' step [] xs
 105     where step ys x = show x ++ "\n" ++ ys
 106
 107 parseFlags :: [String] -> Either String [Flag]
 108 parseFlags argv = parseFlags' [] argv
 109     where parseFlags' _  (x:[]) = if isFlag x
 110                                     then Left "too few arguments"
 111                                     else Left $ "Invalid argument: " ++ x
 112           parseFlags' fs []     = Right fs
 113           parseFlags' fs xs     =
 114               let flag = getFlag xs
 115               in case flag of
 116                   Left  msg  -> Left msg
 117                   Right f    -> parseFlags' (f:fs) (dropWhile (not . isFlag) (tail xs))
 118
 119 getFlag :: [String] -> Either String Flag
 120 getFlag x@(x0:x1:_) =
 121     if isFlag x1
 122         then if x0 == "-b"
 123             then Right $ Bookmarked "true"
 124             else Left "too few argument"
 125         else case x0 of
 126                  "-f" -> Right $ Path    $ getValues " " $ tail x
 127                  "-t" -> Right $ Title   $ getValues " " $ tail x
 128                  "-j" -> Right $ Journal $ getValues " " $ tail x
 129                  "-v" -> if and $ map isDigit x1
 130                              then Right $ Volume  x1
 131                              else Left $ "Invalid volume: " ++ x1
 132                  "-y" -> if isYear x1
 133                              then Right $ Year x1
 134                              else Left $ "Invalid date: " ++ x1 ++ " ('" ++ progName ++ "\
 135                                          \ add help' for help)"
 136                  "-p" -> if isPages x1
 137                              then Right $ Pages x1
 138                              else Left $ "Invalid pages: " ++ x1 ++ " ('" ++ progName ++ "\
 139                                          \ add help' for help)"
 140                  "-k" -> Right $ Keywords $ getValues "/" $ tail  x
 141                  "-a" -> Right $ Authors  $ getValues "/" $ tail  x
 142                  "-b" -> Right $ Bookmarked "true"
 143                  _    -> Left $ "Invalid argument: " ++ x0
 144
 145 getValues :: String -> [String] -> String
 146 getValues sep argv = getValues' "" argv
 147     where getValues' str [] = tail str
 148           getValues' str (f:fs) | isFlag f     = tail str
 149                                 | isKindFlag f = error $ "add: Invalid argument: " ++ f
 150                                 | otherwise    = getValues' (str ++ sep ++ f) fs
 151
 152
 153
 154 runSQL :: String -> IO ()
 155 runSQL sql = do
 156     db <- opendb
 157     run db sql []
 158     commit db
 159     disconnect db
 160     return ()
 161
 162 usageAdd :: String
 163 usageAdd = "usage: " ++ progName ++ " add <filters>\n\
 164             \filters:\n\
 165             \    -f <file>\n\
 166             \    -t <title>\n\
 167             \    -a <author1 [author2] ...>\n\
 168             \    -k <keyword1 [keyword2] ...>\n\
 169             \    -j <journal>\n\
 170             \    -y <year> : <yyyy>\n\
 171             \    -p <page-from>-<page-to>"