hmmm... typing magics...
This commit is contained in:
parent
73bc5b3e49
commit
6b1f6d0fdb
2 changed files with 32 additions and 19 deletions
|
@ -44,21 +44,22 @@ import Protolude
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
import Aggreact.Comments.Types
|
import Aggreact.Comments.Types
|
||||||
import Aggreact.DB
|
import Aggreact.DB
|
||||||
import qualified Aggreact.Users as User
|
import qualified Aggreact.Users as User
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
import Data.Time.Format ()
|
import Data.Time.Format ()
|
||||||
import Database.SQLite.Simple (Only (..), query, query_)
|
import Database.SQLite.Simple (Only (..), query, query_)
|
||||||
|
|
||||||
|
|
||||||
import Database.Beam ((&&.),references_,(==?.))
|
import Database.Beam (references_, (&&.), (==?.))
|
||||||
import qualified Database.Beam as Beam
|
import qualified Database.Beam as Beam
|
||||||
import qualified Database.Beam.Sqlite as BeamSqlite
|
import qualified Database.Beam.Query as BeamQ
|
||||||
import Database.Store (DefaultMetas (..), Id (..),
|
import qualified Database.Beam.Sqlite as BeamSqlite
|
||||||
Store (..))
|
import Database.Store (DefaultMetas (..), Id (..),
|
||||||
import Database.Store.Backend.SQLite as SQL
|
Store (..))
|
||||||
import qualified Database.Store.CRUD as CRUD
|
import Database.Store.Backend.SQLite as SQL
|
||||||
import qualified Database.Store.Search as Search
|
import qualified Database.Store.CRUD as CRUD
|
||||||
|
import qualified Database.Store.Search as Search
|
||||||
|
|
||||||
type CommentSQLiteStore = SQLiteStore IO DefaultMetas NewComment
|
type CommentSQLiteStore = SQLiteStore IO DefaultMetas NewComment
|
||||||
type DBStore = StartedStore CommentSQLiteStore
|
type DBStore = StartedStore CommentSQLiteStore
|
||||||
|
@ -107,18 +108,30 @@ getLatestComments' :: DBStore -> IO [Comment]
|
||||||
getLatestComments' SQLiteState{..} = liftIO . query_ conn . conv $
|
getLatestComments' SQLiteState{..} = liftIO . query_ conn . conv $
|
||||||
"SELECT * FROM " <> stTablename <> " ORDER BY created DESC LIMIT 20"
|
"SELECT * FROM " <> stTablename <> " ORDER BY created DESC LIMIT 20"
|
||||||
|
|
||||||
-- commentsView' :: AggreactDB -> Slug -> IO [CommentView]
|
-- commentsView' :: _ -> AggreactDB f -> Slug -> IO [_res]
|
||||||
commentsView' conn db sl =
|
commentsView' conn db sl = do
|
||||||
BeamSqlite.runBeamSqliteDebug putStrLn conn $
|
res <- BeamSqlite.runBeamSqliteDebug putStrLn conn $
|
||||||
Beam.runSelectReturningList $ Beam.select $ do
|
Beam.runSelectReturningList $ Beam.select $ do
|
||||||
comment <- Beam.all_ (_aggreactComments db)
|
comment <- Beam.all_ (_aggreactComments db)
|
||||||
user <- Beam.leftJoin_
|
muser <- Beam.leftJoin_
|
||||||
(Beam.all_ (_aggreactUsers db))
|
(Beam.all_ (_aggreactUsers db))
|
||||||
(\u -> (Beam.maybe_
|
(\u -> (Beam.maybe_
|
||||||
(pure False)
|
(Beam.val_ False)
|
||||||
(\uc -> uc `references_` u)
|
(`references_` u)
|
||||||
(_userid comment)))
|
(_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
|
-- | A comment handler, handle all impure operations needed to Comments
|
||||||
data CommentHandler = CommentHandler
|
data CommentHandler = CommentHandler
|
||||||
|
|
|
@ -52,7 +52,7 @@ where
|
||||||
|
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
import Aggreact.Users (User, UserId (..), BUserT, BUserId)
|
import Aggreact.Users (User, UserId (..), BUserT)
|
||||||
|
|
||||||
import qualified Control.Exception as Ex
|
import qualified Control.Exception as Ex
|
||||||
import Data.Aeson (FromJSON (..), ToJSON (..),
|
import Data.Aeson (FromJSON (..), ToJSON (..),
|
||||||
|
|
Loading…
Reference in a new issue