🚧 WIP 🚧

aggreact.cabal

@@ -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

src/Aggreact/Comments/StoreService.hs

@@ -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 "

src/Aggreact/Comments/Types.hs

@@ -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

src/Aggreact/Users/Types.hs

@@ -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 =