{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Arrows #-} module Model.Avatar where import qualified Data.Text as T import qualified Data.ByteString as BS import Data.Int (Int64) import Data.Profunctor.Product (p4) import qualified Database.PostgreSQL.Simple as PGS import Control.Arrow import Control.Monad.IO.Class (liftIO) import Opaleye as O -- internal imports import Types import Classes (FromDatabase(fromDatabase)) initAvatar :: PGS.Query initAvatar = mconcat [ "CREATE TABLE IF NOT EXISTS \"avatar\" (" , "avatar_id SERIAL PRIMARY KEY," , "avatar_name TEXT NOT NULL," , "avatar_hash BYTEA NOT NULL," , "avatar_data BYTEA NOT NULL" , ")" ] avatarTable :: Table ( Maybe (Field SqlInt4) , Field SqlText , Field SqlBytea , Field SqlBytea ) ( Field SqlInt4 , Field SqlText , Field SqlBytea , Field SqlBytea ) avatarTable = table "avatar" ( p4 ( tableField "avatar_id" , tableField "avatar_name" , tableField "avatar_hash" , tableField "avatar_data" ) ) avatarSelect :: PGS.Connection -> IO [Avatar] avatarSelect conn = liftIO $ do avatars <- runSelect conn ( proc () -> do ret <- orderBy (desc (\(_, name, _, _) -> name)) (selectTable avatarTable) -< () returnA -< ret ) :: IO [ ( Int , T.Text , BS.ByteString , BS.ByteString ) ] mapM (return . fromDatabase) avatars avatarSelectById :: Int -> PGS.Connection -> IO [Avatar] avatarSelectById aid conn = do avatars <- runSelect conn (proc () -> do stuff@(aaid, _, _, _) <- selectTable avatarTable -< () restrict -< aaid .== toFields aid returnA -< stuff ) :: IO [ ( Int , T.Text , BS.ByteString , BS.ByteString ) ] mapM (return . fromDatabase) avatars insertAvatar :: AvatarData -> BS.ByteString -> PGS.Connection -> MateHandler Int insertAvatar (AvatarData name dat) hash conn = fmap head $ liftIO $ do runInsert_ conn $ Insert { iTable = avatarTable , iRows = [ ( toFields (Nothing :: Maybe Int) , toFields name , toFields hash , toFields (BS.pack dat) ) ] , iReturning = rReturning (\(aid, _, _, _) -> aid) , iOnConflict = Nothing } updateAvatar :: Int -> AvatarData -> BS.ByteString -> PGS.Connection -> MateHandler Int64 updateAvatar aid (AvatarData name dat) hash conn = liftIO $ do runUpdate_ conn $ Update { uTable = avatarTable , uUpdateWith = updateEasy (\(did, _, _, _) -> ( did , toFields name , toFields hash , toFields (BS.pack dat) ) ) , uWhere = \(did, _, _, _) -> did .== toFields aid , uReturning = rCount }