{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Persistence implementation for Chan types.
-- | This should perform an "upsert," but I'm holding off until
-- | Psql 9.5, which includes that feature. Now we just log failures. 
-- | Until then, take care to not insert duplicate rows.

module Persist (
  runDatabase, 
  runDatabaseConn, 
  insertPost,
  insertThread,
  insertBoard,
  postFetchAll, 
  postFetchByID, 
  postFetchByThread,
)
where 

import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromRow
import Database.PostgreSQL.Simple.ToRow

import Control.Monad.Reader.Class
import Control.Monad.Reader
import Control.Monad.Logger
import Control.Monad.IO.Class (liftIO, MonadIO)
import Control.Applicative
import Control.Exception

import qualified Data.ByteString as BS

import Post as P
import Types
 
data PostPersist = PostPersist { 
  post :: P.Post,
  threadId :: ThreadID 
} 
  deriving (Show)

newtype Database a = Database { unDatabase :: ReaderT Connection (LoggingT IO) a}
    deriving (Functor, Applicative, Monad, MonadIO, MonadReader Connection, MonadLogger)

-- | Runs a database action with a given Connection 
-- | The connection is will be closed isf there is no database error 
runDatabaseConn :: Connection -> Database a -> IO a 
runDatabaseConn conn d = do 
  result <- runStdoutLoggingT $ runReaderT (unDatabase d) conn
  close conn
  return result

runDatabase :: Database a -> IO (Either SqlError a)
runDatabase d = do 
 conn <- connectPostgreSQL "dbname='chan' user='ksmiley'"
 try $ runDatabaseConn conn d 

instance ToRow PostPersist where 
  toRow p = toRow (P.no $ post p, threadId p, P.now $ post p, P.name $ post p, P.com $ post p, P.time $ post p)

instance FromRow PostPersist where 
  fromRow = do 
    no <- field 
    threadId <- field
    now <- field
    name <- field
    com <- field
    time <- field
    return (PostPersist (Post no now name com time) threadId)

insertPost :: (MonadReader Connection m, MonadLogger m, MonadIO m) => ThreadID -> P.Post -> m () 
insertPost tid post = do 
  conn <- ask 
  liftIO $ execute conn "INSERT INTO post VALUES (?, ?, ?, ?, ?, ?);" $ PostPersist post tid
  return ()

insertThread :: (MonadReader Connection m, MonadLogger m, MonadIO m) => BoardID -> ThreadID -> Thread -> m () 
insertThread bid tid thread = do 
  conn <- ask 
  liftIO $ (execute conn "INSERT INTO thread VALUES (?, ?)" (tid, bid))
  mapM_ (insertPost tid) (posts thread)
  return ()

insertBoard :: (MonadReader Connection m, MonadLogger m, MonadIO m) => BoardID -> Board -> m ()
insertBoard bid board = mapM_ (\t -> insertThread bid (P.no (head (posts t))) t) board

postFetchByThread :: (MonadReader Connection m, MonadIO m) =>  ThreadID -> m [P.Post]
postFetchByThread tid = do 
  conn <- ask
  persistposts <- liftIO $ query conn "SELECT * FROM post WHERE thread_id = ?" (Only tid)
  return $ map post persistposts 

postFetchByID :: (MonadReader Connection m, MonadIO m) => P.PostID -> m [P.Post]
postFetchByID pid = do
  conn <- ask
  persistposts <- liftIO $ query conn "SELECT * FROM post WHERE id = ?" (Only pid)
  return $ map post persistposts

postFetchAll :: (MonadReader Connection m, MonadLogger m, MonadIO m) => m [P.Post]
postFetchAll = do 
  conn <- ask 
  persistposts <- liftIO $ query_ conn "SELECT * FROM post;"
  return $ map post persistposts
