From 5b1dd9a9d912fdeb9f1a12b7202f35efca8d17cd Mon Sep 17 00:00:00 2001 From: "Yann Esposito (Yogsototh)" Date: Mon, 29 Apr 2019 09:29:10 +0200 Subject: [PATCH] wip --- package.yaml | 1 + src/Aggreact/Comments/StoreService.hs | 39 ++++++++++++++++----------- src/Aggreact/DB.hs | 10 +++++-- 3 files changed, 33 insertions(+), 17 deletions(-) diff --git a/package.yaml b/package.yaml index e041777..62d307c 100644 --- a/package.yaml +++ b/package.yaml @@ -54,6 +54,7 @@ library: - http-types - human-readable-duration - ixset-typed + - lens - generics-sop - safecopy - scrypt diff --git a/src/Aggreact/Comments/StoreService.hs b/src/Aggreact/Comments/StoreService.hs index ed59f1a..8cb8c4d 100644 --- a/src/Aggreact/Comments/StoreService.hs +++ b/src/Aggreact/Comments/StoreService.hs @@ -43,6 +43,7 @@ import Protolude -------------------------------------------------------------------------------- import Aggreact.Comments.Types +import Aggreact.DB import qualified Aggreact.Users as User -------------------------------------------------------------------------------- @@ -53,6 +54,8 @@ import Database.Store (DefaultMetas (..), Id (..), Store (..)) +import qualified Database.Beam as Beam +import qualified Database.Beam.Sqlite as BeamSqlite import Database.Store.Backend.SQLite as SQL import qualified Database.Store.CRUD as CRUD import qualified Database.Store.Search as Search @@ -104,18 +107,24 @@ getLatestComments' :: DBStore -> IO [Comment] getLatestComments' SQLiteState{..} = liftIO . query_ conn . conv $ "SELECT * FROM " <> stTablename <> " ORDER BY created DESC LIMIT 20" -commentsView' :: User.DBStore -> DBStore -> Slug -> IO [CommentView] -commentsView' userStore commentStore sl = do - let queryTxt = "SELECT * FROM " - <> stTablename commentStore <> " c" - <> " INNER JOIN " - <> stTablename userStore <> " u" - <> " ON c.userid = u.id" - <> " WHERE " - <> " slug = ? " - <> " ORDER BY created" - <> " DESC LIMIT 1000" - liftIO $ query (conn commentStore) (conv queryTxt) (Only sl) +-- commentsView' :: AggreactDB -> Slug -> IO [CommentView] +commentsView' conn db sl = + BeamSqlite.runBeamSqliteDebug putStrLn conn $ + Beam.runSelectReturningList $ Beam.select $ do + user <- Beam.all_ (db ^. aggreactUsers) + comment <- Beam.leftJoin_ (all_ (db ^. aggreactComments)) + (\comment -> _commentUserId comment `references_` user) + pure (comment, user) + -- let queryTxt = "SELECT * FROM " + -- <> stTablename commentStore <> " c" + -- <> " INNER JOIN " + -- <> stTablename userStore <> " u" + -- <> " ON c.userid = u.id" + -- <> " WHERE " + -- <> " slug = ? " + -- <> " ORDER BY created" + -- <> " DESC LIMIT 1000" + -- liftIO $ query (conn commentStore) (conv queryTxt) (Only sl) -- | A comment handler, handle all impure operations needed to Comments data CommentHandler = CommentHandler @@ -133,8 +142,8 @@ data CommentHandler = CommentHandler } -- | Init a new comment handler -newCommentHandler :: User.DBStore -> CommentDBConf -> IO CommentHandler -newCommentHandler userStore conf = do +-- newCommentHandler :: AggreactDB e -> User.DBStore -> CommentDBConf -> IO CommentHandler +newCommentHandler db userStore conf = do dbstore <- initDBComments conf pure CommentHandler { createComment = createComment' dbstore , readComment = readComment' dbstore @@ -146,5 +155,5 @@ newCommentHandler userStore conf = do , getTopSlugs = getTopSlugs' dbstore , getLatestSlugs = getLatestSlugs' dbstore , getLatestComments = getLatestComments' dbstore - , commentsView = commentsView' userStore dbstore + , commentsView = commentsView' (conn dbstore) db } diff --git a/src/Aggreact/DB.hs b/src/Aggreact/DB.hs index 6b27f91..d11ae59 100644 --- a/src/Aggreact/DB.hs +++ b/src/Aggreact/DB.hs @@ -8,6 +8,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE ImpredicativeTypes #-} {-# LANGUAGE BlockArguments #-} {-# LANGUAGE DeriveGeneric #-} @@ -43,8 +44,8 @@ where import Protolude -import Aggreact.Comments -import Aggreact.Users +import Aggreact.Comments.Types +import Aggreact.Users.Types import qualified Database.Beam as Beam @@ -55,3 +56,8 @@ data AggreactDB f = AggreactDB aggreactDB :: Beam.DatabaseSettings be AggreactDB aggreactDB = Beam.defaultDbSettings + +-- Create lenses +AggreactDB + (Beam.TableLens aggreactUsers) + (Beam.TableLens aggreactComments) = Beam.dbLenses