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           | Date String
  20           | Pages String
  21           deriving (Eq,Show)
  22
  23 isFlag :: String -> Bool
  24 isFlag f = f `elem` ["-f","-p","-t","-j","-d","-v","-a","-k"]
  25
  26 isPathFlag :: Flag -> Bool
  27 isPathFlag f = case f of
  28     Path _ -> True
  29     _     -> False
  30
  31 add :: [String] -> IO ()
  32 add [] = error $ "add: no arguments specified ('" ++ progName ++ " add help' for help)"
  33 add argv = if isHelp $ head argv
  34     then do putStrLn usageAdd
  35     else do
  36         case parseFlags argv of
  37             Left  msg   -> error $ "add: " ++ msg
  38             Right flags -> do checkFile flags
  39                               putStrLn (flagsToString flags)
  40                               runSQL (buildSQL flags)
  41
  42 buildSQL :: [Flag] -> String
  43 buildSQL flags = buildSQL' ("INSERT INTO " ++ tableName ++ " (") "VALUES(" flags
  44     where buildSQL' t1 t2 [] = ((init t1) ++ ") ") ++ (init(t2) ++ ");")
  45           buildSQL' t1 t2 (f:fs) = buildSQL' (t1++key++",") (t2++"'"++value++"',") fs
  46               where (key,val) = break (==' ') $ show f
  47                     value     = filter (/= '\"') (tail val)
  48
  49 checkFile :: [Flag] -> IO ()
  50 checkFile fs = case filter isPathFlag fs of
  51     []     -> return ()
  52     ((Path p):_)  -> do exists <- doesFileExist p
  53                         if exists
  54                             then do return ()
  55                             else do error $ "File does not exists: " ++ p
  56
  57 isDate :: String -> Bool
  58 isDate str = and [and (map isDigit str), (size == 4) || (size == 6) || (size == 8)]
  59     where size = length str
  60
  61 isPages :: String -> Bool
  62 isPages str = and (map isDigit (pf ++ pt))
  63     where (pf,pt') = break (=='-') str
  64           pt       = if null pt' then "0" else tail pt'
  65
  66 flagsToString :: [Flag] -> String
  67 flagsToString xs = foldl' step [] xs
  68     where step ys x = show x ++ "\n" ++ ys
  69
  70 parseFlags :: [String] -> Either String [Flag]
  71 parseFlags argv = parseFlags' [] argv
  72     where parseFlags' _  (x:[]) = if isFlag x
  73                                     then Left "too few arguments"
  74                                     else Left $ "Invalid argument: " ++ x
  75           parseFlags' fs []     = Right fs
  76           parseFlags' fs xs     =
  77               let flag = getFlag xs
  78               in case flag of
  79                   Left  msg  -> Left msg
  80                   Right f    -> parseFlags' (f:fs) (dropWhile (not . isFlag) (tail xs))
  81
  82 getFlag :: [String] -> Either String Flag
  83 getFlag x@(x0:x1:_) =
  84     if isFlag x1
  85         then Left "too few argument"
  86         else case x0 of
  87                  "-f" -> Right $ Path    x1
  88                  "-t" -> Right $ Title   x1
  89                  "-j" -> Right $ Journal x1
  90                  "-v" -> Right $ Volume  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                  _    -> Left $ "Invalid argument: " ++ x0
 102
 103 getValues :: [String] -> String
 104 getValues argv = intercalate "/" $ takeWhile (not . isFlag) argv
 105
 106
 107 runSQL :: String -> IO ()
 108 runSQL sql = do
 109     db <- opendb
 110     run db sql []
 111     commit db
 112     disconnect db
 113     return ()
 114
 115 usageAdd :: String
 116 usageAdd = "usage: " ++ progName ++ " add <filters>\n\
 117             \filters:\n\
 118             \    -f <file>\n\
 119             \    -t <title>\n\
 120             \    -a <author1 [author2] ...>\n\
 121             \    -k <keyword1 [keyword2] ...>\n\
 122             \    -j <journal>\n\
 123             \    -d <date> : <yyyy> OR <mmyyyy> OR <ddmmyyyy>\n\
 124             \    -p <page-from>-<page-to>"