right track
This commit is contained in:
parent
6b1f6d0fdb
commit
4e3888ae12
4 changed files with 37 additions and 36 deletions
|
@ -48,12 +48,11 @@ import qualified Aggreact.Users as User
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
import Data.Time.Format ()
|
||||
import Database.SQLite.Simple (Only (..), query, query_)
|
||||
import Database.SQLite.Simple (Connection,query_)
|
||||
|
||||
|
||||
import Database.Beam (references_, (&&.), (==?.))
|
||||
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 (..))
|
||||
|
@ -109,10 +108,16 @@ getLatestComments' SQLiteState{..} = liftIO . query_ conn . conv $
|
|||
"SELECT * FROM " <> stTablename <> " ORDER BY created DESC LIMIT 20"
|
||||
|
||||
-- commentsView' :: _ -> AggreactDB f -> Slug -> IO [_res]
|
||||
commentsView' conn db sl = do
|
||||
commentsView' :: Beam.Database BeamSqlite.Sqlite db
|
||||
=> Connection
|
||||
-> AggreactDB (Beam.DatabaseEntity BeamSqlite.Sqlite db)
|
||||
-> Slug
|
||||
-> IO [CommentView]
|
||||
commentsView' conn db (Slug sl) = do
|
||||
res <- BeamSqlite.runBeamSqliteDebug putStrLn conn $
|
||||
Beam.runSelectReturningList $ Beam.select $ do
|
||||
comment <- Beam.all_ (_aggreactComments db)
|
||||
Beam.guard_ ((_slug comment) Beam.==. Beam.val_ sl)
|
||||
muser <- Beam.leftJoin_
|
||||
(Beam.all_ (_aggreactUsers db))
|
||||
(\u -> (Beam.maybe_
|
||||
|
@ -120,18 +125,10 @@ commentsView' conn db sl = do
|
|||
(`references_` u)
|
||||
(_userid comment)))
|
||||
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
|
||||
traverse (\(c,mu) -> pure $
|
||||
CommentView
|
||||
(bCommentToCommentNoUser c)
|
||||
(fmap User.bUserToUser mu)) res
|
||||
|
||||
-- | A comment handler, handle all impure operations needed to Comments
|
||||
data CommentHandler = CommentHandler
|
||||
|
@ -150,6 +147,7 @@ data CommentHandler = CommentHandler
|
|||
|
||||
-- | Init a new comment handler
|
||||
-- newCommentHandler :: AggreactDB e -> User.DBStore -> CommentDBConf -> IO CommentHandler
|
||||
newCommentHandler :: Beam.Database BeamSqlite.Sqlite db => AggreactDB (Beam.DatabaseEntity BeamSqlite.Sqlite db) -> p -> CommentDBConf -> IO CommentHandler
|
||||
newCommentHandler db userStore conf = do
|
||||
dbstore <- initDBComments conf
|
||||
pure CommentHandler { createComment = createComment' dbstore
|
||||
|
|
|
@ -139,11 +139,11 @@ data NewComment =
|
|||
bCommentToCommentNoUser :: BComment -> Comment
|
||||
bCommentToCommentNoUser bc =
|
||||
Entity
|
||||
(_id bc)
|
||||
(Id (toS (_id bc)))
|
||||
(NewComment
|
||||
{ parent = _parent bc
|
||||
, slug = _slug bc
|
||||
, content = _content bc
|
||||
{ parent = ParentId (fmap toS (_parent bc))
|
||||
, slug = Slug (_slug bc)
|
||||
, content = Content (_content bc)
|
||||
, userid = MUserId Nothing
|
||||
})
|
||||
(DefaultMetas
|
||||
|
@ -152,12 +152,12 @@ bCommentToCommentNoUser bc =
|
|||
|
||||
data BCommentT f =
|
||||
BComment
|
||||
{ _parent :: Beam.Columnar f ParentId -- ^ UUID
|
||||
, _slug :: Beam.Columnar f Slug -- ^ Text (URL)
|
||||
, _content :: Beam.Columnar f Content -- ^ Text
|
||||
{ _parent :: Beam.Columnar (Beam.Nullable f) Text -- ^ UUID
|
||||
, _slug :: Beam.Columnar f Text -- ^ Text (URL)
|
||||
, _content :: Beam.Columnar f Text -- ^ Text
|
||||
, _created :: Beam.Columnar f UTCTime
|
||||
, _updated :: Beam.Columnar f (Maybe UTCTime)
|
||||
, _id :: Beam.Columnar f Id
|
||||
, _id :: Beam.Columnar f Text
|
||||
, _userid :: Beam.PrimaryKey BUserT (Beam.Nullable f) -- ^ UUID
|
||||
} deriving (Generic)
|
||||
type BComment = BCommentT Identity
|
||||
|
@ -167,7 +167,7 @@ deriving instance Eq BComment
|
|||
instance Beam.Beamable BCommentT
|
||||
instance Beam.Table BCommentT where
|
||||
data PrimaryKey BCommentT f =
|
||||
BCommentId (Beam.Columnar f Id) deriving (Generic, Beam.Beamable)
|
||||
BCommentId (Beam.Columnar f Text) deriving (Generic, Beam.Beamable)
|
||||
primaryKey = BCommentId . _id
|
||||
|
||||
-- Web
|
||||
|
|
|
@ -84,12 +84,14 @@ instance Form.FromForm NewUser where
|
|||
bUserToUser :: BUser -> User
|
||||
bUserToUser bc =
|
||||
Entity
|
||||
(_id bc)
|
||||
(Id (toS (_id bc)))
|
||||
NewUser
|
||||
{ nick = _nick bc
|
||||
, email = _email bc
|
||||
, password = _password bc
|
||||
, role = _role bc
|
||||
{ nick = Nick (_nick bc)
|
||||
, email = Email (_email bc)
|
||||
, password = HashedPassword (_password bc)
|
||||
, role = (case _role bc of
|
||||
"Admin" -> Admin
|
||||
_ -> User)
|
||||
, trust = _trust bc
|
||||
}
|
||||
DefaultMetas
|
||||
|
@ -98,14 +100,14 @@ bUserToUser bc =
|
|||
|
||||
data BUserT f =
|
||||
BUser
|
||||
{ _nick :: Beam.Columnar f Nick
|
||||
, _email :: Beam.Columnar f Email
|
||||
, _password :: Beam.Columnar f HashedPassword
|
||||
, _role :: Beam.Columnar f Role
|
||||
{ _nick :: Beam.Columnar f Text
|
||||
, _email :: Beam.Columnar f Text
|
||||
, _password :: Beam.Columnar f Text
|
||||
, _role :: Beam.Columnar f Text
|
||||
, _trust :: Beam.Columnar f Int
|
||||
, _created :: Beam.Columnar f UTCTime
|
||||
, _updated :: Beam.Columnar (Beam.Nullable f) UTCTime
|
||||
, _id :: Beam.Columnar f Id
|
||||
, _id :: Beam.Columnar f Text
|
||||
} deriving (Generic)
|
||||
type BUser = BUserT Identity
|
||||
type BUserId = Beam.PrimaryKey BUserT Identity
|
||||
|
@ -119,7 +121,7 @@ deriving instance Eq BMUserId
|
|||
instance Beam.Beamable BUserT
|
||||
instance Beam.Table BUserT where
|
||||
data PrimaryKey BUserT f =
|
||||
BUserId (Beam.Columnar f Id) deriving (Generic, Beam.Beamable)
|
||||
BUserId (Beam.Columnar f Text) deriving (Generic, Beam.Beamable)
|
||||
primaryKey = BUserId . _id
|
||||
|
||||
newtype Nick = Nick Text
|
||||
|
|
|
@ -74,6 +74,7 @@ instance StringConv UUID [Char] where strConv l = strConv l . UUID.toString
|
|||
instance StringConv UUID Text where strConv l = strConv l . UUID.toText
|
||||
instance StringConv UUID UUID where strConv _ x = x
|
||||
instance StringConv UUID Id where strConv l uuid = Id (strConv l uuid)
|
||||
instance StringConv Text UUID where strConv l = fromString . strConv l
|
||||
|
||||
instance IsString UUID where
|
||||
fromString = fromMaybe UUID.nil . UUID.fromString
|
||||
|
|
Loading…
Reference in a new issue