wip

package.yaml

@@ -54,6 +54,7 @@ library:
   - http-types
   - human-readable-duration
   - ixset-typed
+  - lens
   - generics-sop
   - safecopy
   - scrypt

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' :: AggreactDB -> Slug -> IO [CommentView]
-commentsView' userStore commentStore sl = do
+commentsView' conn db sl =
-  let queryTxt = "SELECT * FROM "
+  BeamSqlite.runBeamSqliteDebug putStrLn conn $
-                 <> stTablename commentStore <> " c"
+    Beam.runSelectReturningList $ Beam.select $ do
-                 <> " INNER JOIN "
+        user    <- Beam.all_ (db ^. aggreactUsers)
-                 <> stTablename userStore <> " u"
+        comment <- Beam.leftJoin_ (all_ (db ^. aggreactComments))
-                 <> " ON c.userid = u.id"
+                    (\comment -> _commentUserId comment `references_` user)
-                 <> " WHERE "
+        pure (comment, user)
-                 <> " slug = ? "
+  -- let queryTxt = "SELECT * FROM "
-                 <> " ORDER BY created"
+  --                <> stTablename commentStore <> " c"
-                 <> " DESC LIMIT 1000"
+  --                <> " INNER JOIN "
-  liftIO $ query (conn commentStore) (conv queryTxt) (Only sl)
+  --                <> 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 :: AggreactDB e -> User.DBStore -> CommentDBConf -> IO CommentHandler
-newCommentHandler userStore conf = do
+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
                       }

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.Comments.Types
-import           Aggreact.Users
+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