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,author,comment)]
  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 data Markup = Text String
  27         | Bold String
  28         | Paragraph [Markup]
  29
  30 type Document = [Markup]
  31
  32 newtype PGB = PGB DBService
  33
  34 createPGB :: String -> String -> String -> String -> IO PGB
  35 createPGB host database user password = let db = createDBService host database "" user password Nothing in return (PGB db)
  36
  37
  38 testDB = createPGB "wave" "wiki" "wiki" "12wiki34db"
  39
  40 instance Backend PGB where
  41
  42         getCurrent (PGB db) key = do
  43                 result <- selectReturnTuples db $ "SELECT fulltext,timestamp FROM curtexts WHERE keyword="++tov key
  44                 case result of
  45                         [text,date]:_ -> return (Just (text,date))
  46                         _ -> return Nothing
  47
  48         getList (PGB db) key = do
  49                 list <- selectReturnTuples db $ "SELECT id, timestamp, author, comment from fulltexts WHERE keyword = "++tov key
  50                 return $ map (\[id,date,author,comment] -> (id,date,author,comment)) list
  51
  52         get (PGB db) key id = return ""
  53
  54         setCurrent (PGB db) key id = do
  55                 full <- selectReturnTuples db $ "SELECT keyword FROM fulltexts WHERE keyword="++tov key++" AND id='"++id++"'"
  56                 cur <- selectReturnTuples db $ "SELECT keyword FROM curtexts WHERE keyword='"++tov key++"'"
  57                 case full of
  58                         [[]] -> do
  59                                 print "No text found with this id and key"
  60                                 return False
  61                         _  -> do
  62                                 rows <- case cur of
  63                                         [] -> do
  64                                                 print "No link found in current, inserting"
  65                                                 execute db $ "INSERT INTO current (keyword, id) VALUES ("++tov id++","++tov key++")"
  66                                         _  -> do
  67                                                 print "Link found in current, updating"
  68                                                 execute db $ "UPDATE current SET id = "++tov id++" WHERE keyword = "++tov key
  69                                 print rows
  70                                 if rows == 1 then return True
  71                                         else return False
  72
  73         update (PGB db) key text author comment = do
  74                 rows <- execute db $ "INSERT INTO fulltexts (keyword,fulltext, author, comment) VALUES ("++tov key++","++tov text++","++tov author++","++tov comment++")"
  75                 if rows == 0 then return ""
  76                         else do
  77                                 [[id]] <- selectReturnTuples db $ "SELECT currval('fulltexts_id_seq')"
  78                                 setCurrent (PGB db) key id
  79                                 return id
  80
  81
  82 tov :: String -> String
  83 tov s = '\'':escapeQuery s++"'"
  84
  85