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