1 {-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DataKinds #-}
    2 module Databrary.Model.Citation
    3   ( module Databrary.Model.Citation.Types
    4   , lookupVolumeCitation
    5   , lookupVolumesCitations
    6   , changeVolumeCitation
    7   , lookupVolumeLinks
    8   , changeVolumeLinks
    9   ) where
   10 
   11 import Databrary.Has (peek, view)
   12 import Databrary.Service.DB
   13 import Databrary.Model.SQL
   14 import Databrary.Model.Audit
   15 import Databrary.Model.Id.Types
   16 import Databrary.Model.Identity.Types
   17 import Databrary.Model.Party.Types
   18 import Databrary.Model.Volume.Types
   19 import Databrary.Model.Citation.Types
   20 import Databrary.Model.Citation.SQL
   21 
   22 lookupVolumeCitation :: (MonadDB c m) => Volume -> m (Maybe Citation)
   23 lookupVolumeCitation vol =
   24   dbQuery1 $ fmap ($ Just (volumeName $ volumeRow vol)) $(selectQuery selectVolumeCitation "$WHERE volume_citation.volume = ${volumeId $ volumeRow vol}")
   25 
   26 lookupVolumesCitations :: (MonadDB c m, MonadHasIdentity c m) => m [(Volume, Maybe Citation)]
   27 lookupVolumesCitations = do
   28   ident :: Identity <- peek
   29   dbQuery $(selectQuery (selectCitation 'ident) "WHERE volume.id > 0")
   30 
   31 lookupVolumeLinks :: (MonadDB c m) => Volume -> m [Citation]
   32 lookupVolumeLinks vol =
   33   dbQuery $(selectQuery selectVolumeLink "$WHERE volume_link.volume = ${volumeId $ volumeRow vol}")
   34 
   35 changeVolumeCitation :: (MonadAudit c m) => Volume -> Maybe Citation -> m Bool
   36 changeVolumeCitation vol citem = do
   37   ident <- getAuditIdentity
   38   (0 <) <$> maybe
   39     (dbExecute $(deleteVolumeCitation 'ident 'vol))
   40     (\cite -> fst <$> updateOrInsert
   41       $(updateVolumeCitation 'ident 'vol 'cite)
   42       $(insertVolumeCitation 'ident 'vol 'cite))
   43     citem
   44 
   45 changeVolumeLinks :: (MonadAudit c m) => Volume -> [Citation] -> m ()
   46 changeVolumeLinks vol links = do
   47   ident <- getAuditIdentity
   48   dbTransaction $ do
   49     _ <- dbExecute $(deleteVolumeLink 'ident 'vol)
   50     mapM_ (\link -> dbExecute $(insertVolumeLink 'ident 'vol 'link)) links