right track

src/Aggreact/Comments/StoreService.hs

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

src/Aggreact/Comments/Types.hs

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

src/Aggreact/Users/Types.hs

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

src/Database/Store.hs

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