Channels API

src/Database/Channel.hs

@@ -0,0 +1,34 @@
+{-# Language TypeApplications #-}
+{-# Language DataKinds #-}
+module Database.Channel
+  ( userChannels
+  , insertChannel
+  , Channel(..) )
+  where
+
+import ClassyPrelude
+import Database.Schema
+import Database
+import Database.Selda
+
+userChannels :: (MonadMask m, MonadIO m) => Username -> SeldaT m [Channel]
+userChannels username = fromRels <$> query q
+  where
+    q = do
+      userId :*: _ :*: username' :*: _ <- select (gen users)
+      channel@(_ :*: _ :*: owner) <- select (gen channels)
+      restrict (owner .== userId)
+      restrict (username' .== literal username)
+      return channel
+
+insertChannel :: (MonadMask m, MonadIO m) => Username -> Text -> SeldaT m ()
+insertChannel username channel = do
+  mUserId <- listToMaybe <$> getUser
+  void $ forM mUserId $ \userId ->
+    insertUnless (gen channels) (doesNotExist userId) [ def :*: channel :*: userId ]
+  where
+    doesNotExist userId (_ :*: channel' :*: userId') = channel' .== literal channel .&& userId' .== literal userId
+    getUser = query $ do
+      userId :*: _ :*: user :*: _ <- select (gen users)
+      restrict (user .== literal username)
+      return userId

src/Database/Schema.hs

@@ -112,8 +112,8 @@ tags = genTable "tags" [ (identifier :: Tag -> RowID) :- autoPrimaryGen
     i :*: _ = selectors (gen users)
 
 channels :: GenTable Channel
-channels = genTable "tags" [ (identifier :: Channel -> RowID) :- autoPrimaryGen
-                           , (owner :: Channel -> RowID) :- fkGen (gen users) i ]
+channels = genTable "channels" [ (identifier :: Channel -> RowID) :- autoPrimaryGen
+                               , (owner :: Channel -> RowID) :- fkGen (gen users) i ]
   where
     i :*: _ = selectors (gen users)