🚧 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
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: 7697e107fa7eeea373c454c40543eeaf710a518e5b990e99e90983d8d665f561
|
-- hash: c6ba67633d506787943c9e979e0f721a602447dfad110f1302bbd2c64035d461
|
||||||
|
|
||||||
name: aggreact
|
name: aggreact
|
||||||
version: 0.1.0.0
|
version: 0.1.0.0
|
||||||
|
@ -87,6 +87,7 @@ library
|
||||||
, http-types
|
, http-types
|
||||||
, human-readable-duration
|
, human-readable-duration
|
||||||
, ixset-typed
|
, ixset-typed
|
||||||
|
, lens
|
||||||
, protolude
|
, protolude
|
||||||
, safecopy
|
, safecopy
|
||||||
, scrypt
|
, scrypt
|
||||||
|
|
|
@ -111,10 +111,11 @@ getLatestComments' SQLiteState{..} = liftIO . query_ conn . conv $
|
||||||
commentsView' conn db sl =
|
commentsView' conn db sl =
|
||||||
BeamSqlite.runBeamSqliteDebug putStrLn conn $
|
BeamSqlite.runBeamSqliteDebug putStrLn conn $
|
||||||
Beam.runSelectReturningList $ Beam.select $ do
|
Beam.runSelectReturningList $ Beam.select $ do
|
||||||
user <- Beam.all_ (db ^. aggreactUsers)
|
comment <- Beam.all_ (_aggreactComments db)
|
||||||
comment <- Beam.leftJoin_ (all_ (db ^. aggreactComments))
|
user <- Beam.leftJoin_
|
||||||
(\comment -> _commentUserId comment `references_` user)
|
(Beam.all_ (_aggreactUsers db))
|
||||||
pure (comment, user)
|
(\u ->_userid comment `Beam.references_` u)
|
||||||
|
pure $ CommentView (bCommentToComment comment) (bUserToUser user)
|
||||||
-- let queryTxt = "SELECT * FROM "
|
-- let queryTxt = "SELECT * FROM "
|
||||||
-- <> stTablename commentStore <> " c"
|
-- <> stTablename commentStore <> " c"
|
||||||
-- <> " INNER JOIN "
|
-- <> " INNER JOIN "
|
||||||
|
|
|
@ -52,7 +52,7 @@ where
|
||||||
|
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
import Aggreact.Users (User, UserId (..))
|
import Aggreact.Users (User, UserId (..), BUserId)
|
||||||
|
|
||||||
import qualified Control.Exception as Ex
|
import qualified Control.Exception as Ex
|
||||||
import Data.Aeson (FromJSON (..), ToJSON (..),
|
import Data.Aeson (FromJSON (..), ToJSON (..),
|
||||||
|
@ -136,12 +136,26 @@ data NewComment =
|
||||||
} deriving (Generic,Typeable,Data,Eq,Ord,Show)
|
} deriving (Generic,Typeable,Data,Eq,Ord,Show)
|
||||||
|
|
||||||
-- ** Beam
|
-- ** 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 =
|
data BCommentT f =
|
||||||
BComment
|
BComment
|
||||||
{ _parent :: Beam.Columnar f ParentId -- ^ UUID
|
{ _parent :: Beam.Columnar f ParentId -- ^ UUID
|
||||||
, _slug :: Beam.Columnar f Slug -- ^ Text (URL)
|
, _slug :: Beam.Columnar f Slug -- ^ Text (URL)
|
||||||
, _content :: Beam.Columnar f Content -- ^ Text
|
, _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
|
, _created :: Beam.Columnar f UTCTime
|
||||||
, _updated :: Beam.Columnar f (Maybe UTCTime)
|
, _updated :: Beam.Columnar f (Maybe UTCTime)
|
||||||
, _id :: Beam.Columnar f Id
|
, _id :: Beam.Columnar f Id
|
||||||
|
|
|
@ -87,13 +87,15 @@ data BUserT f =
|
||||||
, _role :: Beam.Columnar f Role
|
, _role :: Beam.Columnar f Role
|
||||||
, _trust :: Beam.Columnar f Int
|
, _trust :: Beam.Columnar f Int
|
||||||
, _created :: Beam.Columnar f UTCTime
|
, _created :: Beam.Columnar f UTCTime
|
||||||
, _updated :: Beam.Columnar f (Maybe UTCTime)
|
, _updated :: Beam.Columnar (Beam.Nullable f) UTCTime
|
||||||
, _id :: Beam.Columnar f Id
|
, _id :: Beam.Columnar f Id
|
||||||
} deriving (Generic)
|
} deriving (Generic)
|
||||||
type BUser = BUserT Identity
|
type BUser = BUserT Identity
|
||||||
type BUserId = Beam.PrimaryKey BUserT Identity
|
type BUserId = Beam.PrimaryKey BUserT Identity
|
||||||
deriving instance Show BUser
|
deriving instance Show BUser
|
||||||
deriving instance Eq BUser
|
deriving instance Eq BUser
|
||||||
|
deriving instance Show BUserId
|
||||||
|
deriving instance Eq BUserId
|
||||||
instance Beam.Beamable BUserT
|
instance Beam.Beamable BUserT
|
||||||
instance Beam.Table BUserT where
|
instance Beam.Table BUserT where
|
||||||
data PrimaryKey BUserT f =
|
data PrimaryKey BUserT f =
|
||||||
|
|
Loading…
Reference in a new issue