1 {-# LANGUAGE RecordWildCards, OverloadedStrings, DataKinds #-}
    2 module Model.Funding
    3   ( module 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 JSON
   23 import Service.DB
   24 import Model.SQL
   25 import Model.Id.Types
   26 import Model.Volume.Types
   27 import Model.Funding.Types
   28 -- import Model.Funding.SQL
   29 
   30 lookupFunder :: MonadDB c m => Id Funder -> m (Maybe Funder)
   31 lookupFunder fi = do
   32   let _tenv_a13FG = unknownPGTypeEnv
   33   rows <- dbQuery1 -- (selectQuery selectFunder "WHERE funder.fundref_id = ${fi}")
   34     (mapQuery
   35       ((\ _p_a13FH ->
   36                        Data.ByteString.concat
   37                           [Data.String.fromString
   38                              "SELECT funder.fundref_id,funder.name FROM funder WHERE funder.fundref_id = ",
   39                            pgEscapeParameter
   40                              _tenv_a13FG (PGTypeProxy :: PGTypeName "bigint") _p_a13FH])
   41          fi)
   42                (\ [_cfundref_id_a13FI, _cname_a13FJ]
   43                   -> (pgDecodeColumnNotNull
   44                         _tenv_a13FG
   45                         (PGTypeProxy :: PGTypeName "bigint")
   46                         _cfundref_id_a13FI,
   47                       pgDecodeColumnNotNull
   48                         _tenv_a13FG (PGTypeProxy :: PGTypeName "text") _cname_a13FJ)))
   49   pure
   50     (fmap
   51       (\ (vid_a13Ft, vname_a13Fu) -> Funder vid_a13Ft vname_a13Fu)
   52       rows)
   53 
   54 findFunders :: MonadDB c m => T.Text -> m [Funder]
   55 findFunders q = do
   56   let _tenv_a1vMY = unknownPGTypeEnv
   57   rows <- dbQuery -- (selectQuery selectFunder "WHERE funder.name ILIKE '%' || ${q} || '%'")
   58     (mapQuery
   59       ((\ _p_a1vMZ ->
   60                        Data.ByteString.concat
   61                           [Data.String.fromString
   62                              "SELECT funder.fundref_id,funder.name FROM funder WHERE funder.name ILIKE '%' || ",
   63                            pgEscapeParameter
   64                              _tenv_a1vMY (PGTypeProxy :: PGTypeName "text") _p_a1vMZ,
   65                            Data.String.fromString " || '%'"])
   66          q)
   67                (\ [_cfundref_id_a1vN0, _cname_a1vN1]
   68                   -> (pgDecodeColumnNotNull
   69                         _tenv_a1vMY
   70                         (PGTypeProxy :: PGTypeName "bigint")
   71                         _cfundref_id_a1vN0,
   72                       pgDecodeColumnNotNull
   73                         _tenv_a1vMY (PGTypeProxy :: PGTypeName "text") _cname_a1vN1)))
   74   pure
   75       (fmap
   76           (\(vid_a1vMW, vname_a1vMX) -> Funder vid_a1vMW vname_a1vMX)
   77           rows)
   78 
   79 addFunder :: MonadDB c m => Funder -> m ()
   80 addFunder f =
   81   dbExecute1' --[pgSQL|INSERT INTO funder (fundref_id, name) VALUES (${funderId f}, ${funderName f})|]
   82     (mapQuery
   83            (Data.ByteString.concat
   84               [Data.String.fromString
   85                  "INSERT INTO funder (fundref_id, name) VALUES (",
   86                Database.PostgreSQL.Typed.Types.pgEscapeParameter
   87                  unknownPGTypeEnv
   88                  (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
   89                     Database.PostgreSQL.Typed.Types.PGTypeName "bigint")
   90                  (funderId f),
   91                Data.String.fromString ", ",
   92                Database.PostgreSQL.Typed.Types.pgEscapeParameter
   93                  unknownPGTypeEnv
   94                  (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
   95                     Database.PostgreSQL.Typed.Types.PGTypeName "text")
   96                  (funderName f),
   97                Data.String.fromString ")"])
   98            (\[] -> ()))
   99 
  100 lookupVolumeFunding :: (MonadDB c m) => Volume -> m [Funding]
  101 lookupVolumeFunding vol = do
  102   let _tenv_a13pg = unknownPGTypeEnv
  103   rows <- dbQuery -- (selectQuery selectVolumeFunding "WHERE volume_funding.volume = ${volumeId $ volumeRow vol}")
  104    (mapQuery
  105       ((\ _p_a13ph ->
  106                        Data.ByteString.concat
  107                           [Data.String.fromString
  108                              "SELECT volume_funding.awards,funder.fundref_id,funder.name FROM volume_funding JOIN funder ON volume_funding.funder = funder.fundref_id WHERE volume_funding.volume = ",
  109                            pgEscapeParameter
  110                              _tenv_a13pg (PGTypeProxy :: PGTypeName "integer") _p_a13ph])
  111          (volumeId $ volumeRow vol))
  112                (\ [_cawards_a13pi, _cfundref_id_a13pj, _cname_a13pk]
  113                   -> (pgDecodeColumnNotNull
  114                         _tenv_a13pg (PGTypeProxy :: PGTypeName "text[]") _cawards_a13pi,
  115                       pgDecodeColumnNotNull
  116                         _tenv_a13pg
  117                         (PGTypeProxy :: PGTypeName "bigint")
  118                         _cfundref_id_a13pj,
  119                       pgDecodeColumnNotNull
  120                         _tenv_a13pg (PGTypeProxy :: PGTypeName "text") _cname_a13pk)))
  121   pure
  122     (fmap
  123       (\ (vawards_a13n8, vid_a13n9, vname_a13na)
  124          -> ($)
  125               (makeFunding vawards_a13n8)
  126               (Funder vid_a13n9 vname_a13na))
  127       rows)
  128 
  129 changeVolumeFunding :: MonadDB c m => Volume -> Funding -> m Bool
  130 changeVolumeFunding v Funding{..} =
  131   (0 <) . fst <$> updateOrInsert
  132     -- [pgSQL|UPDATE volume_funding SET awards = ${a} WHERE volume = ${volumeId $ volumeRow v} AND funder = ${funderId fundingFunder}|]
  133     (mapQuery
  134       (Data.ByteString.concat
  135         [Data.String.fromString "UPDATE volume_funding SET awards = ",
  136          Database.PostgreSQL.Typed.Types.pgEscapeParameter
  137            unknownPGTypeEnv
  138            (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  139               Database.PostgreSQL.Typed.Types.PGTypeName "text[]")
  140            a,
  141          Data.String.fromString " WHERE volume = ",
  142          Database.PostgreSQL.Typed.Types.pgEscapeParameter
  143            unknownPGTypeEnv
  144            (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  145               Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  146            (volumeId $ volumeRow v),
  147          Data.String.fromString " AND funder = ",
  148          Database.PostgreSQL.Typed.Types.pgEscapeParameter
  149            unknownPGTypeEnv
  150            (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  151               Database.PostgreSQL.Typed.Types.PGTypeName "bigint")
  152            (funderId fundingFunder)])
  153       (\[] -> ()))
  154     -- [pgSQL|INSERT INTO volume_funding (volume, funder, awards) VALUES (${volumeId $ volumeRow v}, ${funderId fundingFunder}, ${a})|]
  155     (mapQuery
  156              (Data.ByteString.concat
  157                 [Data.String.fromString
  158                    "INSERT INTO volume_funding (volume, funder, awards) VALUES (",
  159                  Database.PostgreSQL.Typed.Types.pgEscapeParameter
  160                    unknownPGTypeEnv
  161                    (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  162                       Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  163                    (volumeId $ volumeRow v),
  164                  Data.String.fromString ", ",
  165                  Database.PostgreSQL.Typed.Types.pgEscapeParameter
  166                    unknownPGTypeEnv
  167                    (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  168                       Database.PostgreSQL.Typed.Types.PGTypeName "bigint")
  169                    (funderId fundingFunder),
  170                  Data.String.fromString ", ",
  171                  Database.PostgreSQL.Typed.Types.pgEscapeParameter
  172                    unknownPGTypeEnv
  173                    (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  174                       Database.PostgreSQL.Typed.Types.PGTypeName "text[]")
  175                    a,
  176                  Data.String.fromString ")"])
  177              (\[] -> ()))
  178       -- (volumeId $ volumeRow v) (funderId fundingFunder) a
  179   where a = map Just fundingAwards
  180 
  181 mapQuery :: ByteString -> ([PGValue] -> a) -> PGSimpleQuery a
  182 mapQuery qry mkResult =
  183   fmap mkResult (rawPGSimpleQuery qry)
  184 
  185 removeVolumeFunder :: MonadDB c m => Volume -> Id Funder -> m Bool
  186 removeVolumeFunder v f =
  187   dbExecute1 -- [pgSQL|DELETE FROM volume_funding WHERE volume = ${volumeId $ volumeRow v} AND funder = ${f}|]
  188     (mapQuery
  189         (Data.ByteString.concat
  190            [Data.String.fromString
  191               "DELETE FROM volume_funding WHERE volume = ",
  192             Database.PostgreSQL.Typed.Types.pgEscapeParameter
  193               unknownPGTypeEnv
  194               (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  195                  Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  196               (volumeId $ volumeRow v),
  197             Data.String.fromString " AND funder = ",
  198             Database.PostgreSQL.Typed.Types.pgEscapeParameter
  199               unknownPGTypeEnv
  200               (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  201                  Database.PostgreSQL.Typed.Types.PGTypeName "bigint")
  202               f])
  203         (\[] -> ()))
  204       -- (volumeId $ volumeRow v) f
  205 
  206 funderJSON :: JSON.ToObject o => Funder -> o
  207 funderJSON Funder{..} =
  208      "id" JSON..= funderId
  209   <> "name" JSON..= funderName
  210 
  211 fundingJSON :: JSON.ToNestedObject o u => Funding -> o
  212 fundingJSON Funding{..} =
  213      "funder" JSON..=. funderJSON fundingFunder
  214   <> "awards" JSON..= fundingAwards