1 {-# LANGUAGE TemplateHaskell #-} 2 module Databrary.Model.Citation.SQL 3 ( selectVolumeCitation 4 , selectCitation 5 , insertVolumeCitation 6 , updateVolumeCitation 7 , deleteVolumeCitation 8 , selectVolumeLink 9 , insertVolumeLink 10 , deleteVolumeLink 11 ) where 12 13 import qualified Data.Text as T 14 import qualified Language.Haskell.TH as TH 15 16 import Databrary.Model.SQL.Select 17 import Databrary.Model.Audit.SQL 18 import Databrary.Model.Volume.Types 19 import Databrary.Model.Volume.SQL 20 import Databrary.Model.Citation.Types 21 22 citationRow :: Selector -- ^ @Maybe 'T.Text' -> 'Citation'@ 23 citationRow = selectColumns 'Citation "volume_citation" ["head", "url", "year"] 24 25 selectVolumeCitation :: Selector -- ^ @Maybe 'T.Text' -> 'Citation'@ 26 selectVolumeCitation = citationRow 27 28 makeVolumeCitation :: Volume -> Maybe (Maybe T.Text -> Citation) -> (Volume, Maybe Citation) 29 makeVolumeCitation v cf = (v, cf <*> Just (Just (volumeName $ volumeRow v))) 30 31 selectCitation :: TH.Name -- ^ @'Identity'@ 32 -> Selector -- ^ @('Volume', Maybe 'Citation')@ 33 selectCitation i = selectJoin 'makeVolumeCitation 34 [ selectVolume i 35 , maybeJoinOn "volume.id = volume_citation.volume" 36 selectVolumeCitation 37 ] 38 39 linkRow :: Selector -- ^ @'Citation'@ 40 linkRow = selectColumns 'Citation "volume_link" ["head", "url"] 41 42 selectVolumeLink :: Selector -- ^ @'Citation'@ 43 selectVolumeLink = selectMap ((`TH.AppE` TH.ConE 'Nothing) . (`TH.AppE` TH.ConE 'Nothing)) 44 linkRow 45 46 volumeKeys :: String -- ^ @'Volume'@ 47 -> [(String, String)] 48 volumeKeys v = 49 [ ("volume", "${volumeId $ volumeRow " ++ v ++ "}") ] 50 51 linkSets :: String -- ^ @'Citation'@ 52 -> [(String, String)] 53 linkSets c = 54 [ ("head", "${citationHead " ++ c ++ "}") 55 , ("url", "${citationURL " ++ c ++ "}") 56 ] 57 58 citationSets :: String -- ^ @'Citation'@ 59 -> [(String, String)] 60 citationSets c = linkSets c ++ 61 [ ("year", "${citationYear " ++ c ++ "}") 62 ] 63 64 insertVolumeCitation :: TH.Name -- ^ @'AuditIdentity'@ 65 -> TH.Name -- ^ @'Volume'@ 66 -> TH.Name -- ^ @'Citation'@ 67 -> TH.ExpQ -- ^ () 68 insertVolumeCitation ident v c = auditInsert ident "volume_citation" 69 (volumeKeys (nameRef v) ++ citationSets (nameRef c)) 70 Nothing 71 72 updateVolumeCitation :: TH.Name -- ^ @'AuditIdentity'@ 73 -> TH.Name -- ^ @'Volume'@ 74 -> TH.Name -- ^ @'Citation'@ 75 -> TH.ExpQ -- ^ () 76 updateVolumeCitation ident v c = auditUpdate ident "volume_citation" 77 (citationSets (nameRef c)) 78 (whereEq $ volumeKeys (nameRef v)) 79 Nothing 80 81 deleteVolumeCitation :: TH.Name -- ^ @'AuditIdentity'@ 82 -> TH.Name -- ^ @'Volume'@ 83 -> TH.ExpQ -- ^ () 84 deleteVolumeCitation ident v = auditDelete ident "volume_citation" 85 (whereEq $ volumeKeys (nameRef v)) 86 Nothing 87 88 insertVolumeLink :: TH.Name -- ^ @'AuditIdentity'@ 89 -> TH.Name -- ^ @'Volume'@ 90 -> TH.Name -- ^ @'Citation'@ 91 -> TH.ExpQ -- ^ () 92 insertVolumeLink ident v c = auditInsert ident "volume_link" 93 (volumeKeys (nameRef v) ++ linkSets (nameRef c)) 94 Nothing 95 96 deleteVolumeLink :: TH.Name -- ^ @'AuditIdentity'@ 97 -> TH.Name -- ^ @'Volume'@ 98 -> TH.ExpQ -- ^ () 99 deleteVolumeLink ident v = auditDelete ident "volume_link" 100 (whereEq $ volumeKeys (nameRef v)) 101 Nothing