🚧 WIP 🚧
This commit is contained in:
parent
5b1dd9a9d9
commit
12d7fafb7d
4 changed files with 26 additions and 8 deletions
|
@ -4,7 +4,7 @@ cabal-version: 1.12
|
|||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 7697e107fa7eeea373c454c40543eeaf710a518e5b990e99e90983d8d665f561
|
||||
-- hash: c6ba67633d506787943c9e979e0f721a602447dfad110f1302bbd2c64035d461
|
||||
|
||||
name: aggreact
|
||||
version: 0.1.0.0
|
||||
|
@ -87,6 +87,7 @@ library
|
|||
, http-types
|
||||
, human-readable-duration
|
||||
, ixset-typed
|
||||
, lens
|
||||
, protolude
|
||||
, safecopy
|
||||
, scrypt
|
||||
|
|
|
@ -111,10 +111,11 @@ getLatestComments' SQLiteState{..} = liftIO . query_ conn . conv $
|
|||
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)
|
||||
comment <- Beam.all_ (_aggreactComments db)
|
||||
user <- Beam.leftJoin_
|
||||
(Beam.all_ (_aggreactUsers db))
|
||||
(\u ->_userid comment `Beam.references_` u)
|
||||
pure $ CommentView (bCommentToComment comment) (bUserToUser user)
|
||||
-- let queryTxt = "SELECT * FROM "
|
||||
-- <> stTablename commentStore <> " c"
|
||||
-- <> " INNER JOIN "
|
||||
|
|
|
@ -52,7 +52,7 @@ where
|
|||
|
||||
import Protolude
|
||||
|
||||
import Aggreact.Users (User, UserId (..))
|
||||
import Aggreact.Users (User, UserId (..), BUserId)
|
||||
|
||||
import qualified Control.Exception as Ex
|
||||
import Data.Aeson (FromJSON (..), ToJSON (..),
|
||||
|
@ -136,12 +136,26 @@ data NewComment =
|
|||
} deriving (Generic,Typeable,Data,Eq,Ord,Show)
|
||||
|
||||
-- ** Beam
|
||||
bCommentToComment :: BComment -> Comment
|
||||
bCommentToComment bc =
|
||||
Entity
|
||||
(_id bc)
|
||||
(NewComment
|
||||
{ parent = _parent bc
|
||||
, slug = _slug bc
|
||||
, content = _content bc
|
||||
, userid = MUserId (_userid bc)
|
||||
})
|
||||
(DefaultMetas
|
||||
{ updated = _updated bc
|
||||
, created = _created bc })
|
||||
|
||||
data BCommentT f =
|
||||
BComment
|
||||
{ _parent :: Beam.Columnar f ParentId -- ^ UUID
|
||||
, _slug :: Beam.Columnar f Slug -- ^ Text (URL)
|
||||
, _content :: Beam.Columnar f Content -- ^ Text
|
||||
, _userid :: Beam.Columnar f MUserId -- ^ UUID
|
||||
, _userid :: Beam.Columnar (Beam.Nullable f) BUserId -- ^ UUID
|
||||
, _created :: Beam.Columnar f UTCTime
|
||||
, _updated :: Beam.Columnar f (Maybe UTCTime)
|
||||
, _id :: Beam.Columnar f Id
|
||||
|
|
|
@ -87,13 +87,15 @@ data BUserT f =
|
|||
, _role :: Beam.Columnar f Role
|
||||
, _trust :: Beam.Columnar f Int
|
||||
, _created :: Beam.Columnar f UTCTime
|
||||
, _updated :: Beam.Columnar f (Maybe UTCTime)
|
||||
, _updated :: Beam.Columnar (Beam.Nullable f) UTCTime
|
||||
, _id :: Beam.Columnar f Id
|
||||
} deriving (Generic)
|
||||
type BUser = BUserT Identity
|
||||
type BUserId = Beam.PrimaryKey BUserT Identity
|
||||
deriving instance Show BUser
|
||||
deriving instance Eq BUser
|
||||
deriving instance Show BUserId
|
||||
deriving instance Eq BUserId
|
||||
instance Beam.Beamable BUserT
|
||||
instance Beam.Table BUserT where
|
||||
data PrimaryKey BUserT f =
|
||||
|
|
Loading…
Reference in a new issue