hmmm... typing magics...

This commit is contained in:
Yann Esposito (Yogsototh) 2019-06-13 22:10:58 +02:00
parent 73bc5b3e49
commit 6b1f6d0fdb
Signed by untrusted user who does not match committer: yogsototh
GPG key ID: 7B19A4C650D59646
2 changed files with 32 additions and 19 deletions

View file

@ -44,21 +44,22 @@ import Protolude
--------------------------------------------------------------------------------
import Aggreact.Comments.Types
import Aggreact.DB
import qualified Aggreact.Users as User
import qualified Aggreact.Users as User
--------------------------------------------------------------------------------
import Data.Time.Format ()
import Database.SQLite.Simple (Only (..), query, query_)
import Data.Time.Format ()
import Database.SQLite.Simple (Only (..), query, query_)
import Database.Beam ((&&.),references_,(==?.))
import qualified Database.Beam as Beam
import qualified Database.Beam.Sqlite as BeamSqlite
import Database.Store (DefaultMetas (..), Id (..),
Store (..))
import Database.Store.Backend.SQLite as SQL
import qualified Database.Store.CRUD as CRUD
import qualified Database.Store.Search as Search
import Database.Beam (references_, (&&.), (==?.))
import qualified Database.Beam as Beam
import qualified Database.Beam.Query as BeamQ
import qualified Database.Beam.Sqlite as BeamSqlite
import Database.Store (DefaultMetas (..), Id (..),
Store (..))
import Database.Store.Backend.SQLite as SQL
import qualified Database.Store.CRUD as CRUD
import qualified Database.Store.Search as Search
type CommentSQLiteStore = SQLiteStore IO DefaultMetas NewComment
type DBStore = StartedStore CommentSQLiteStore
@ -107,18 +108,30 @@ getLatestComments' :: DBStore -> IO [Comment]
getLatestComments' SQLiteState{..} = liftIO . query_ conn . conv $
"SELECT * FROM " <> stTablename <> " ORDER BY created DESC LIMIT 20"
-- commentsView' :: AggreactDB -> Slug -> IO [CommentView]
commentsView' conn db sl =
BeamSqlite.runBeamSqliteDebug putStrLn conn $
-- commentsView' :: _ -> AggreactDB f -> Slug -> IO [_res]
commentsView' conn db sl = do
res <- BeamSqlite.runBeamSqliteDebug putStrLn conn $
Beam.runSelectReturningList $ Beam.select $ do
comment <- Beam.all_ (_aggreactComments db)
user <- Beam.leftJoin_
muser <- Beam.leftJoin_
(Beam.all_ (_aggreactUsers db))
(\u -> (Beam.maybe_
(pure False)
(\uc -> uc `references_` u)
(Beam.val_ False)
(`references_` u)
(_userid comment)))
pure $ CommentView (bCommentToCommentNoUser comment) (bUserToUser user)
pure (comment,muser)
pure res
-- traverse (\(c,mu) -> pure $
-- CommentView
-- (bCommentToCommentNoUser c)
-- (fmap User.bUserToUser mu)) res
instance Beam.HasSqlEqualityCheck BeamSqlite.Sqlite Id
instance Beam.FromBackendRow BeamSqlite.Sqlite ParentId
instance Beam.FromBackendRow BeamSqlite.Sqlite Slug
instance Beam.FromBackendRow BeamSqlite.Sqlite Content
instance Beam.FromBackendRow BeamSqlite.Sqlite Id
-- | A comment handler, handle all impure operations needed to Comments
data CommentHandler = CommentHandler

View file

@ -52,7 +52,7 @@ where
import Protolude
import Aggreact.Users (User, UserId (..), BUserT, BUserId)
import Aggreact.Users (User, UserId (..), BUserT)
import qualified Control.Exception as Ex
import Data.Aeson (FromJSON (..), ToJSON (..),