{-# Language TypeApplications #-}
{-# Language TypeOperators #-}
{-# Language DataKinds #-}
{-# Language DuplicateRecordFields #-}
module Database.Tag
  ( def
  , booksTags
  , upsertTag
  , Tag(..) ) where

import ClassyPrelude
import Database.Schema
import Database
import Database.Selda

upsertTag :: (MonadMask m, MonadIO m, MonadSelda m) => Username -> Text -> m Tag
upsertTag username tag = transaction $ do
  -- I want this to error out if some data is invariant is wrong and roll back
  -- the transaction
  [userId] <- query userQ
  void $ upsert (gen tags) (predicate userId) id [toRel (Tag def tag userId)]
  [t] <- fromRels <$> query (tagQ userId)
  return t
  where
    predicate userId (_ :*: tag' :*: owner) = tag' .== literal tag .&& owner .== literal userId
    tagQ userId = do
      t@(_ :*: tag' :*: owner) <- select (gen tags)
      restrict (tag' .== literal tag .&& owner .== literal userId)
      return t
    userQ = do
      userId :*: _ :*: username' :*: _ <- select (gen users)
      restrict (username' .== literal username)
      return userId

booksTags :: (MonadMask m, MonadIO m, MonadSelda m) => BookID -> m [Tag]
booksTags bookId = fromRels <$> query q
  where
    q = do
      tagId :*: bookId' <- select (gen bookTags)
      tag@(tagId' :*: _) <- select (gen tags)
      restrict (tagId .== tagId')
      restrict (bookId' .== literal bookId)
      return tag