Wiki.hs

   1 module Wiki (
   2         Backend
   3         ,PGB
   4
   5 ) where
   6
   7 import Dbconnect
   8 import Data.Char
   9
  10 class Backend a where
  11         --Keyword -> (Full text,date)
  12         getCurrent :: a -> String -> IO (Maybe (String,String))
  13
  14         --Keyword -> [(id,date)]
  15         getList :: a -> String -> IO [(String, String, String, String)]
  16
  17         --Keyword -> id -> Full text
  18         get :: a -> String -> String -> IO String
  19
  20         --Keyword -> id -> ()
  21         setCurrent :: a -> String -> String -> IO Bool
  22
  23         --Keyword -> Full text -> id
  24         update :: a -> String -> String -> String -> String -> IO String
  25
  26 newtype PGB = PGB DBService
  27
  28 createPGB :: String -> String -> String -> String -> IO PGB
  29 createPGB host database user password = let db = createDBService host database "" user password Nothing in return (PGB db)
  30
  31
  32 testDB = createPGB "wave" "wiki" "wiki" "12wiki34db"
  33
  34 instance Backend PGB where
  35
  36         getCurrent (PGB db) key = do
  37                 result <- selectReturnTuples db $ "SELECT fulltext,timestamp FROM curtexts WHERE keyword="++tov key
  38                 case result of
  39                         [text,date]:_ -> return (Just (text,date))
  40                         _ -> return Nothing
  41
  42         getList (PGB db) key = do
  43                 list <- selectReturnTuples db $ "SELECT id, timestamp, author, comment from fulltexts WHERE keyword = "++tov key
  44                 return $ map (\[id,date,author,comment] -> (id,date,author,comment)) list
  45
  46         get (PGB db) key id = return ""
  47
  48         setCurrent (PGB db) key id = do
  49                 full <- selectReturnTuples db $ "SELECT keyword FROM fulltexts WHERE keyword="++tov key++" AND id='"++id++"'"
  50                 cur <- selectReturnTuples db $ "SELECT keyword FROM curtexts WHERE keyword='"++tov key++"'"
  51                 case full of
  52                         [[]] -> do
  53                                 print "No text found with this id and key"
  54                                 return False
  55                         _  -> do
  56                                 rows <- case cur of
  57                                         [] -> do
  58                                                 print "No link found in current, inserting"
  59                                                 execute db $ "INSERT INTO current (keyword, id) VALUES ("++tov id++","++tov key++")"
  60                                         _  -> do
  61                                                 print "Link found in current, updating"
  62                                                 execute db $ "UPDATE current SET id = "++tov id++" WHERE keyword = "++tov key
  63                                 print rows
  64                                 if rows == 1 then return True
  65                                         else return False
  66
  67         update (PGB db) key text author comment = do
  68                 rows <- execute db $ "INSERT INTO fulltexts (keyword,fulltext, author, comment) VALUES ("++tov key++","++tov text++","++tov author++","++tov comment++")"
  69                 if rows == 0 then return ""
  70                         else do
  71                                 [[id]] <- selectReturnTuples db $ "SELECT currval('fulltexts_id_seq')"
  72                                 setCurrent (PGB db) key id
  73                                 return id
  74
  75
  76 tov :: String -> String
  77 tov s = '\'':escapeQuery s++"'"
  78
  79