1 {-# LANGUAGE TemplateHaskell, QuasiQuotes, RecordWildCards, OverloadedStrings, DataKinds #-} 2 module Databrary.Model.Funding 3 ( module Databrary.Model.Funding.Types 4 , lookupFunder 5 , findFunders 6 , addFunder 7 , lookupVolumeFunding 8 , changeVolumeFunding 9 , removeVolumeFunder 10 , funderJSON 11 , fundingJSON 12 ) where 13 14 import Data.Monoid ((<>)) 15 import qualified Data.Text as T 16 import Database.PostgreSQL.Typed.Query 17 import Database.PostgreSQL.Typed.Types 18 import qualified Data.ByteString 19 import Data.ByteString (ByteString) 20 import qualified Data.String 21 22 import qualified Databrary.JSON as JSON 23 import Databrary.Service.DB 24 import Databrary.Model.SQL 25 import Databrary.Model.Id.Types 26 import Databrary.Model.Volume.Types 27 import Databrary.Model.Funding.Types 28 import Databrary.Model.Funding.SQL 29 30 lookupFunder :: MonadDB c m => Id Funder -> m (Maybe Funder) 31 lookupFunder fi = 32 dbQuery1 $(selectQuery selectFunder "$WHERE funder.fundref_id = ${fi}") 33 34 findFunders :: MonadDB c m => T.Text -> m [Funder] 35 findFunders q = 36 dbQuery $(selectQuery selectFunder "$WHERE funder.name ILIKE '%' || ${q} || '%'") 37 38 addFunder :: MonadDB c m => Funder -> m () 39 addFunder f = 40 dbExecute1' --[pgSQL|INSERT INTO funder (fundref_id, name) VALUES (${funderId f}, ${funderName f})|] 41 (mapQuery 42 (Data.ByteString.concat 43 [Data.String.fromString 44 "INSERT INTO funder (fundref_id, name) VALUES (", 45 Database.PostgreSQL.Typed.Types.pgEscapeParameter 46 unknownPGTypeEnv 47 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 48 Database.PostgreSQL.Typed.Types.PGTypeName "bigint") 49 (funderId f), 50 Data.String.fromString ", ", 51 Database.PostgreSQL.Typed.Types.pgEscapeParameter 52 unknownPGTypeEnv 53 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 54 Database.PostgreSQL.Typed.Types.PGTypeName "text") 55 (funderName f), 56 Data.String.fromString ")"]) 57 (\[] -> ())) 58 59 lookupVolumeFunding :: (MonadDB c m) => Volume -> m [Funding] 60 lookupVolumeFunding vol = 61 dbQuery $(selectQuery selectVolumeFunding "$WHERE volume_funding.volume = ${volumeId $ volumeRow vol}") 62 63 changeVolumeFunding :: MonadDB c m => Volume -> Funding -> m Bool 64 changeVolumeFunding v Funding{..} = 65 (0 <) . fst <$> updateOrInsert 66 -- [pgSQL|UPDATE volume_funding SET awards = ${a} WHERE volume = ${volumeId $ volumeRow v} AND funder = ${funderId fundingFunder}|] 67 (mapQuery 68 (Data.ByteString.concat 69 [Data.String.fromString "UPDATE volume_funding SET awards = ", 70 Database.PostgreSQL.Typed.Types.pgEscapeParameter 71 unknownPGTypeEnv 72 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 73 Database.PostgreSQL.Typed.Types.PGTypeName "text[]") 74 a, 75 Data.String.fromString " WHERE volume = ", 76 Database.PostgreSQL.Typed.Types.pgEscapeParameter 77 unknownPGTypeEnv 78 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 79 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 80 (volumeId $ volumeRow v), 81 Data.String.fromString " AND funder = ", 82 Database.PostgreSQL.Typed.Types.pgEscapeParameter 83 unknownPGTypeEnv 84 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 85 Database.PostgreSQL.Typed.Types.PGTypeName "bigint") 86 (funderId fundingFunder)]) 87 (\[] -> ())) 88 -- [pgSQL|INSERT INTO volume_funding (volume, funder, awards) VALUES (${volumeId $ volumeRow v}, ${funderId fundingFunder}, ${a})|] 89 (mapQuery 90 (Data.ByteString.concat 91 [Data.String.fromString 92 "INSERT INTO volume_funding (volume, funder, awards) VALUES (", 93 Database.PostgreSQL.Typed.Types.pgEscapeParameter 94 unknownPGTypeEnv 95 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 96 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 97 (volumeId $ volumeRow v), 98 Data.String.fromString ", ", 99 Database.PostgreSQL.Typed.Types.pgEscapeParameter 100 unknownPGTypeEnv 101 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 102 Database.PostgreSQL.Typed.Types.PGTypeName "bigint") 103 (funderId fundingFunder), 104 Data.String.fromString ", ", 105 Database.PostgreSQL.Typed.Types.pgEscapeParameter 106 unknownPGTypeEnv 107 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 108 Database.PostgreSQL.Typed.Types.PGTypeName "text[]") 109 a, 110 Data.String.fromString ")"]) 111 (\[] -> ())) 112 -- (volumeId $ volumeRow v) (funderId fundingFunder) a 113 where a = map Just fundingAwards 114 115 mapQuery :: ByteString -> ([PGValue] -> a) -> PGSimpleQuery a 116 mapQuery qry mkResult = 117 fmap mkResult (rawPGSimpleQuery qry) 118 119 removeVolumeFunder :: MonadDB c m => Volume -> Id Funder -> m Bool 120 removeVolumeFunder v f = 121 dbExecute1 -- [pgSQL|DELETE FROM volume_funding WHERE volume = ${volumeId $ volumeRow v} AND funder = ${f}|] 122 (mapQuery 123 (Data.ByteString.concat 124 [Data.String.fromString 125 "DELETE FROM volume_funding WHERE volume = ", 126 Database.PostgreSQL.Typed.Types.pgEscapeParameter 127 unknownPGTypeEnv 128 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 129 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 130 (volumeId $ volumeRow v), 131 Data.String.fromString " AND funder = ", 132 Database.PostgreSQL.Typed.Types.pgEscapeParameter 133 unknownPGTypeEnv 134 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 135 Database.PostgreSQL.Typed.Types.PGTypeName "bigint") 136 f]) 137 (\[] -> ())) 138 -- (volumeId $ volumeRow v) f 139 140 funderJSON :: JSON.ToObject o => Funder -> o 141 funderJSON Funder{..} = 142 "id" JSON..= funderId 143 <> "name" JSON..= funderName 144 145 fundingJSON :: JSON.ToNestedObject o u => Funding -> o 146 fundingJSON Funding{..} = 147 "funder" JSON..=. funderJSON fundingFunder 148 <> "awards" JSON..= fundingAwards