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