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