src/Gargantext/Database/Query/Table/Node/Contact.hs

   1 {-|
   2 Module      : Gargantext.Database.Query.Table.Node.Contact
   3 Description : Update Node in Database (Postgres)
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 {-# LANGUAGE FunctionalDependencies #-}
  13 {-# LANGUAGE TemplateHaskell        #-}
  14
  15 module Gargantext.Database.Query.Table.Node.Contact
  16   where
  17
  18 import Control.Lens (makeLenses)
  19 import Data.Time.Segment (jour)
  20 import Data.Aeson.TH (deriveJSON)
  21 import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
  22 import Data.Text (Text)
  23 import Data.Time (UTCTime)
  24 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
  25 import GHC.Generics (Generic)
  26 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
  27 import Gargantext.Database.Admin.Types.Node (Hyperdata, Node)
  28 import Gargantext.Database.Prelude (fromField')
  29 import Gargantext.Prelude
  30 import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
  31 import Test.QuickCheck (elements)
  32 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  33
  34 ------------------------------------------------------------------------
  35
  36 type NodeContact  = Node HyperdataContact
  37
  38 data HyperdataContact =
  39      HyperdataContact { _hc_bdd    :: Maybe Text           -- ID of Database source
  40                       , _hc_who    :: Maybe ContactWho
  41                       , _hc_where  :: [ContactWhere]
  42                       , _hc_title  :: Maybe Text -- TODO remove (only demo)
  43                       , _hc_source :: Maybe Text -- TODO remove (only demo)
  44                       , _hc_lastValidation  :: Maybe Text -- TODO UTCTime
  45                       , _hc_uniqIdBdd       :: Maybe Text
  46                       , _hc_uniqId          :: Maybe Text
  47
  48   } deriving (Eq, Show, Generic)
  49
  50
  51 fake_HyperdataContact :: HyperdataContact
  52 fake_HyperdataContact = HyperdataContact (Just "bdd")
  53                                          (Just fake_ContactWho)
  54                                          [fake_ContactWhere]
  55                                          (Just "Title")
  56                                          (Just "Source")
  57                                          (Just "TODO lastValidation date")
  58                                          (Just "DO NOT expose this")
  59                                          (Just "DO NOT expose this")
  60
  61
  62 -- TOD0 contact metadata (Type is too flat)
  63 data ContactMetaData =
  64      ContactMetaData { _cm_bdd :: Maybe Text
  65                      , _cm_lastValidation  :: Maybe Text -- TODO UTCTIME
  66   } deriving (Eq, Show, Generic)
  67
  68 fake_ContactMetaData :: ContactMetaData
  69 fake_ContactMetaData = ContactMetaData (Just "bdd") (Just "TODO UTCTime")
  70
  71 arbitraryHyperdataContact :: HyperdataContact
  72 arbitraryHyperdataContact = HyperdataContact Nothing Nothing []
  73                                              Nothing Nothing Nothing
  74                                              Nothing Nothing
  75
  76
  77 data ContactWho =
  78      ContactWho { _cw_id          :: Maybe Text
  79                 , _cw_firstName   :: Maybe Text
  80                 , _cw_lastName    :: Maybe Text
  81                 , _cw_keywords :: [Text]
  82                 , _cw_freetags :: [Text]
  83   } deriving (Eq, Show, Generic)
  84
  85 fake_ContactWho :: ContactWho
  86 fake_ContactWho = ContactWho (Just "123123")
  87                              (Just "First Name")
  88                              (Just "Last Name")
  89                              ["keyword A"]
  90                              ["freetag A"]
  91
  92 data ContactWhere =
  93      ContactWhere { _cw_organization :: [Text]
  94                   , _cw_labTeamDepts :: [Text]
  95
  96                   , _cw_role         :: Maybe Text
  97
  98                   , _cw_office       :: Maybe Text
  99                   , _cw_country      :: Maybe Text
 100                   , _cw_city         :: Maybe Text
 101
 102                   , _cw_touch        :: Maybe ContactTouch
 103
 104                   , _cw_entry        :: Maybe UTCTime
 105                   , _cw_exit         :: Maybe UTCTime
 106   } deriving (Eq, Show, Generic)
 107
 108 fake_ContactWhere :: ContactWhere
 109 fake_ContactWhere = ContactWhere ["Organization A"]
 110                                  ["Organization B"]
 111                                  (Just "Role")
 112                                  (Just "Office")
 113                                  (Just "Country")
 114                                  (Just "City")
 115                                  (Just fake_ContactTouch)
 116                                  (Just $ jour 01 01 2020)
 117                                  (Just $ jour 01 01 2029)
 118
 119 data ContactTouch =
 120      ContactTouch { _ct_mail      :: Maybe Text
 121                   , _ct_phone     :: Maybe Text
 122                   , _ct_url       :: Maybe Text
 123   } deriving (Eq, Show, Generic)
 124
 125 fake_ContactTouch :: ContactTouch
 126 fake_ContactTouch = ContactTouch (Just "email@data.com")
 127                                  (Just "+336 328 283 288")
 128                                  (Just "https://url.com")
 129
 130 -- | ToSchema instances
 131 instance ToSchema HyperdataContact where
 132   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hc_")
 133 instance ToSchema ContactWho where
 134   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
 135 instance ToSchema ContactWhere where
 136   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
 137 instance ToSchema ContactTouch where
 138   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ct_")
 139 instance ToSchema ContactMetaData where
 140   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cm_")
 141
 142 -- | Arbitrary instances
 143 instance Arbitrary HyperdataContact where
 144   arbitrary = elements [HyperdataContact Nothing Nothing [] Nothing Nothing Nothing Nothing Nothing]
 145
 146 -- | Specific Gargantext instance
 147 instance Hyperdata HyperdataContact
 148
 149 -- | Database (Posgresql-simple instance)
 150 instance FromField HyperdataContact where
 151   fromField = fromField'
 152
 153 -- | Database (Opaleye instance)
 154 instance QueryRunnerColumnDefault PGJsonb HyperdataContact   where
 155   queryRunnerColumnDefault = fieldQueryRunnerColumn
 156
 157 -- | All lenses
 158 makeLenses ''ContactWho
 159 makeLenses ''ContactWhere
 160 makeLenses ''ContactTouch
 161 makeLenses ''ContactMetaData
 162 makeLenses ''HyperdataContact
 163
 164 -- | All Json instances
 165 $(deriveJSON (unPrefix "_cw_") ''ContactWho)
 166 $(deriveJSON (unPrefix "_cw_") ''ContactWhere)
 167 $(deriveJSON (unPrefix "_ct_") ''ContactTouch)
 168 $(deriveJSON (unPrefix "_cm_") ''ContactMetaData)
 169 $(deriveJSON (unPrefix "_hc_") ''HyperdataContact)