Add.hs

   1 module Add (
   2     add,
   3     usageAdd
   4 ) where
   5
   6 import Data.Char
   7 import Data.List
   8 import Database.HDBC
   9 import Database.HDBC.Sqlite3
  10 import System.Directory
  11 import Util
  12
  13 data Flag = Path String
  14           | Title String
  15           | Authors String
  16           | Keywords String
  17           | Journal String
  18           | Volume String
  19           | Issue String
  20           | Date String
  21           | Pages String
  22           deriving (Eq,Show)
  23
  24 isFlag :: String -> Bool
  25 isFlag f = f `elem` ["-f","-p","-t","-j","-i","-d","-v","-a","-k"]
  26
  27 isPathFlag :: Flag -> Bool
  28 isPathFlag f = case f of
  29     Path _ -> True
  30     _     -> False
  31
  32 add :: [String] -> IO ()
  33 add [] = error $ "add: no arguments specified ('" ++ progName ++ " add help' for help)"
  34 add argv = if isHelp $ head argv
  35     then do putStrLn usageAdd
  36     else do
  37         case parseFlags argv of
  38             Left  msg   -> error $ "add: " ++ msg
  39             Right flags -> do checkFile flags
  40                               putStrLn (flagsToString flags)
  41                               runSQL (buildSQL flags)
  42
  43 buildSQL :: [Flag] -> String
  44 buildSQL flags = buildSQL' ("INSERT INTO " ++ tableName ++ " (") "VALUES(" flags
  45     where buildSQL' t1 t2 [] = ((init t1) ++ ") ") ++ (init(t2) ++ ");")
  46           buildSQL' t1 t2 (f:fs) = buildSQL' (t1++key++",") (t2++"'"++value++"',") fs
  47               where (key,val) = break (==' ') $ show f
  48                     value     = filter (/= '\"') (tail val)
  49
  50 checkFile :: [Flag] -> IO ()
  51 checkFile fs = case filter isPathFlag fs of
  52     []     -> return ()
  53     ((Path p):_)  -> do exists <- doesFileExist p
  54                         if exists
  55                             then do return ()
  56                             else do error $ "File does not exists: " ++ p
  57
  58 isDate :: String -> Bool
  59 isDate str = and [and (map isDigit str), (size == 4) || (size == 6) || (size == 8)]
  60     where size = length str
  61
  62 isPages :: String -> Bool
  63 isPages str = and (map isDigit (pf ++ pt))
  64     where (pf,pt') = break (=='-') str
  65           pt       = if null pt' then "0" else tail pt'
  66
  67 flagsToString :: [Flag] -> String
  68 flagsToString xs = foldl' step [] xs
  69     where step ys x = show x ++ "\n" ++ ys
  70
  71 parseFlags :: [String] -> Either String [Flag]
  72 parseFlags argv = parseFlags' [] argv
  73     where parseFlags' _  (x:[]) = Left "too few arguments"
  74           parseFlags' fs []     = Right fs
  75           parseFlags' fs xs     =
  76               let flag = getFlag xs
  77               in case flag of
  78                   Left  msg  -> Left msg
  79                   Right f    -> parseFlags' (f:fs) (dropWhile (not . isFlag) (tail xs))
  80
  81 getFlag :: [String] -> Either String Flag
  82 getFlag x@(x0:x1:_) =
  83     if isFlag x1
  84         then Left "too few argument"
  85         else case x0 of
  86                  "-f" -> Right $ Path    x1
  87                  "-t" -> Right $ Title   x1
  88                  "-j" -> Right $ Journal x1
  89                  "-v" -> Right $ Volume  x1
  90                  "-i" -> Right $ Issue   x1
  91                  "-d" -> if isDate x1
  92                              then Right $ Date x1
  93                              else Left $ "Invalid date: " ++ x1 ++ " ('" ++ progName ++ "\
  94                                          \ add help' for help)"
  95                  "-p" -> if isPages x1
  96                              then Right $ Pages x1
  97                              else Left $ "Invalid pages: " ++ x1 ++ " ('" ++ progName ++ "\
  98                                          \ add help' for help)"
  99                  "-k" -> Right $ Keywords $ getValues $ tail  x
 100                  "-a" -> Right $ Authors  $ getValues $ tail  x
 101
 102 getValues :: [String] -> String
 103 getValues argv = intercalate "/" $ takeWhile (not . isFlag) argv
 104
 105 opendb :: IO Connection
 106 opendb = do
 107     conn <- connectSqlite3 dbName
 108     tables <- getTables conn
 109     if not (tableName `elem` tables)
 110         then do
 111              run conn  ("CREATE TABLE " ++ tableName ++ "(id       INTEGER PRIMARY KEY,\
 112                                                         \ Path     VARCHAR(1000),\
 113                                                         \ Title    VARCHAR(1000),\
 114                                                         \ Authors  VARCHAR(1000),\
 115                                                         \ Keywords VARCHAR(1000),\
 116                                                         \ Journal  VARCHAR(1000),\
 117                                                         \ Volume   VARCHAR(1000),\
 118                                                         \ Issue    VARCHAR(1000),\
 119                                                         \ Date     VARCHAR(1000),\
 120                                                         \ Pages    VARCHAR(1000));") []
 121              commit conn
 122              return conn
 123         else do
 124              commit conn
 125              return conn
 126
 127 runSQL :: String -> IO ()
 128 runSQL sql = do
 129     db <- opendb
 130     run db sql []
 131     commit db
 132     disconnect db
 133     return ()
 134
 135 usageAdd :: String
 136 usageAdd = "usage: " ++ progName ++ " add <filters>\n\
 137             \filters:\n\
 138             \    -f <file>\n\
 139             \    -t <title>\n\
 140             \    -a <author1 [author2] ...>\n\
 141             \    -k <keyword1 [keyword2] ...>\n\
 142             \    -j <journal>\n\
 143             \    -i <issue>\n\
 144             \    -d <date> : <yyyy> OR <mmyyyy> OR <ddmmyyyy>\n\
 145             \    -p <page-from>-<page-to>"