Wiki.hs

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