src/Gargantext/Database/Node/Contact.hs

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