wip
This commit is contained in:
parent
194adb8913
commit
5b1dd9a9d9
3 changed files with 33 additions and 17 deletions
|
@ -54,6 +54,7 @@ library:
|
|||
- http-types
|
||||
- human-readable-duration
|
||||
- ixset-typed
|
||||
- lens
|
||||
- generics-sop
|
||||
- safecopy
|
||||
- scrypt
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue