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 ( Node)
  28 import Gargantext.Database.Admin.Types.Hyperdata (Hyperdata)
  29 import Gargantext.Database.Prelude (fromField')
  30 import Gargantext.Prelude
  31 import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
  32 import Test.QuickCheck (elements)
  33 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  34
  35 ------------------------------------------------------------------------
  36
  37 type NodeContact  = Node HyperdataContact
  38
  39 data HyperdataContact =
  40      HyperdataContact { _hc_bdd    :: Maybe Text           -- ID of Database source
  41                       , _hc_who    :: Maybe ContactWho
  42                       , _hc_where  :: [ContactWhere]
  43                       , _hc_title  :: Maybe Text -- TODO remove (only demo)
  44                       , _hc_source :: Maybe Text -- TODO remove (only demo)
  45                       , _hc_lastValidation  :: Maybe Text -- TODO UTCTime
  46                       , _hc_uniqIdBdd       :: Maybe Text
  47                       , _hc_uniqId          :: Maybe Text
  48
  49   } deriving (Eq, Show, Generic)
  50
  51
  52 fake_HyperdataContact :: HyperdataContact
  53 fake_HyperdataContact = HyperdataContact (Just "bdd")
  54                                          (Just fake_ContactWho)
  55                                          [fake_ContactWhere]
  56                                          (Just "Title")
  57                                          (Just "Source")
  58                                          (Just "TODO lastValidation date")
  59                                          (Just "DO NOT expose this")
  60                                          (Just "DO NOT expose this")
  61
  62
  63 -- TOD0 contact metadata (Type is too flat)
  64 data ContactMetaData =
  65      ContactMetaData { _cm_bdd :: Maybe Text
  66                      , _cm_lastValidation  :: Maybe Text -- TODO UTCTIME
  67   } deriving (Eq, Show, Generic)
  68
  69 fake_ContactMetaData :: ContactMetaData
  70 fake_ContactMetaData = ContactMetaData (Just "bdd") (Just "TODO UTCTime")
  71
  72 arbitraryHyperdataContact :: HyperdataContact
  73 arbitraryHyperdataContact = HyperdataContact Nothing Nothing []
  74                                              Nothing Nothing Nothing
  75                                              Nothing Nothing
  76
  77
  78 data ContactWho =
  79      ContactWho { _cw_id          :: Maybe Text
  80                 , _cw_firstName   :: Maybe Text
  81                 , _cw_lastName    :: Maybe Text
  82                 , _cw_keywords :: [Text]
  83                 , _cw_freetags :: [Text]
  84   } deriving (Eq, Show, Generic)
  85
  86 fake_ContactWho :: ContactWho
  87 fake_ContactWho = ContactWho (Just "123123")
  88                              (Just "First Name")
  89                              (Just "Last Name")
  90                              ["keyword A"]
  91                              ["freetag A"]
  92
  93 data ContactWhere =
  94      ContactWhere { _cw_organization :: [Text]
  95                   , _cw_labTeamDepts :: [Text]
  96
  97                   , _cw_role         :: Maybe Text
  98
  99                   , _cw_office       :: Maybe Text
 100                   , _cw_country      :: Maybe Text
 101                   , _cw_city         :: Maybe Text
 102
 103                   , _cw_touch        :: Maybe ContactTouch
 104
 105                   , _cw_entry        :: Maybe UTCTime
 106                   , _cw_exit         :: Maybe UTCTime
 107   } deriving (Eq, Show, Generic)
 108
 109 fake_ContactWhere :: ContactWhere
 110 fake_ContactWhere = ContactWhere ["Organization A"]
 111                                  ["Organization B"]
 112                                  (Just "Role")
 113                                  (Just "Office")
 114                                  (Just "Country")
 115                                  (Just "City")
 116                                  (Just fake_ContactTouch)
 117                                  (Just $ jour 01 01 2020)
 118                                  (Just $ jour 01 01 2029)
 119
 120 data ContactTouch =
 121      ContactTouch { _ct_mail      :: Maybe Text
 122                   , _ct_phone     :: Maybe Text
 123                   , _ct_url       :: Maybe Text
 124   } deriving (Eq, Show, Generic)
 125
 126 fake_ContactTouch :: ContactTouch
 127 fake_ContactTouch = ContactTouch (Just "email@data.com")
 128                                  (Just "+336 328 283 288")
 129                                  (Just "https://url.com")
 130
 131 -- | ToSchema instances
 132 instance ToSchema HyperdataContact where
 133   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hc_")
 134 instance ToSchema ContactWho where
 135   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
 136 instance ToSchema ContactWhere where
 137   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
 138 instance ToSchema ContactTouch where
 139   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ct_")
 140 instance ToSchema ContactMetaData where
 141   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cm_")
 142
 143 -- | Arbitrary instances
 144 instance Arbitrary HyperdataContact where
 145   arbitrary = elements [HyperdataContact Nothing Nothing [] Nothing Nothing Nothing Nothing Nothing]
 146
 147 -- | Specific Gargantext instance
 148 instance Hyperdata HyperdataContact
 149
 150 -- | Database (Posgresql-simple instance)
 151 instance FromField HyperdataContact where
 152   fromField = fromField'
 153
 154 -- | Database (Opaleye instance)
 155 instance QueryRunnerColumnDefault PGJsonb HyperdataContact   where
 156   queryRunnerColumnDefault = fieldQueryRunnerColumn
 157
 158 -- | All lenses
 159 makeLenses ''ContactWho
 160 makeLenses ''ContactWhere
 161 makeLenses ''ContactTouch
 162 makeLenses ''ContactMetaData
 163 makeLenses ''HyperdataContact
 164
 165 -- | All Json instances
 166 $(deriveJSON (unPrefix "_cw_") ''ContactWho)
 167 $(deriveJSON (unPrefix "_cw_") ''ContactWhere)
 168 $(deriveJSON (unPrefix "_ct_") ''ContactTouch)
 169 $(deriveJSON (unPrefix "_cm_") ''ContactMetaData)
 170 $(deriveJSON (unPrefix "_hc_") ''HyperdataContact)