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.Aeson.TH (deriveJSON)
  25 import Data.Text (Text)
  26 import Data.Time (UTCTime)
  27 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
  28 import GHC.Generics (Generic)
  29 import Gargantext.Core.Utils.Prefix (unPrefix)
  30 import Gargantext.Database.Node (NodeWrite', AnnuaireId, UserId, Name, node)
  31 import Gargantext.Database.Types.Node (Node,Hyperdata,NodeType(..))
  32 import Gargantext.Database.Utils (fromField')
  33 import Gargantext.Prelude
  34 import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
  35
  36 ------------------------------------------------------------------------
  37
  38 type NodeContact  = Node HyperdataContact
  39
  40 data HyperdataContact =
  41      HyperdataContact { _hc_bdd    :: Maybe Text           -- ID of Database source
  42                       , _hc_who    :: Maybe ContactWho
  43                       , _hc_where  :: Maybe [ContactWhere]
  44                       , _hc_lastValidation  :: Maybe Text
  45                       , _hc_uniqIdBdd       :: Maybe Text
  46                       , _hc_uniqId          :: Maybe Text
  47
  48   } deriving (Eq, Show, Generic)
  49
  50 arbitraryHyperdataContact :: HyperdataContact
  51 arbitraryHyperdataContact = HyperdataContact Nothing Nothing Nothing Nothing Nothing Nothing
  52
  53 data ContactWho =
  54      ContactWho { _cw_id          :: Maybe Int
  55                 , _cw_firstName   :: Maybe Text
  56                 , _cw_lastName    :: Maybe Text
  57                 , _cw_keywords :: Maybe [Text]
  58                 , _cw_freetags :: Maybe [Text]
  59   } deriving (Eq, Show, Generic)
  60
  61 data ContactWhere =
  62      ContactWhere { _cw_organization :: Maybe [Text]
  63                   , _cw_labTeamDepts :: Maybe [Text]
  64                   , _cw_role         :: Maybe Text
  65                   , _cw_office       :: Maybe Text
  66                   , _cw_country      :: Maybe Text
  67                   , _cw_city         :: Maybe Text
  68                   , _cw_touch        :: Maybe ContactTouch
  69                   , _cw_start        :: Maybe UTCTime
  70                   , _cw_end          :: Maybe UTCTime
  71   } deriving (Eq, Show, Generic)
  72
  73 data ContactTouch =
  74      ContactTouch { _ct_mail      :: Maybe Text
  75                   , _ct_phone     :: Maybe Text
  76                   , _ct_url       :: Maybe Text
  77   } deriving (Eq, Show, Generic)
  78
  79
  80 nodeContactW :: Maybe Name -> Maybe HyperdataContact
  81              -> AnnuaireId -> UserId -> NodeWrite'
  82 nodeContactW maybeName maybeContact aId =
  83   node NodeContact name contact (Just aId)
  84     where
  85       name    = maybe "Contact" identity maybeName
  86       contact = maybe arbitraryHyperdataContact identity maybeContact
  87
  88
  89
  90 instance Hyperdata HyperdataContact
  91 instance FromField HyperdataContact where
  92   fromField = fromField'
  93 instance QueryRunnerColumnDefault PGJsonb HyperdataContact   where
  94   queryRunnerColumnDefault = fieldQueryRunnerColumn
  95
  96 makeLenses ''ContactWho
  97 makeLenses ''ContactWhere
  98 makeLenses ''ContactTouch
  99 makeLenses ''HyperdataContact
 100
 101 $(deriveJSON (unPrefix "_cw_") ''ContactWho)
 102 $(deriveJSON (unPrefix "_cw_") ''ContactWhere)
 103 $(deriveJSON (unPrefix "_ct_") ''ContactTouch)
 104 $(deriveJSON (unPrefix "_hc_") ''HyperdataContact)
 105
 106