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