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