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