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.Swagger (ToSchema(..), genericDeclareNamedSchema)
  26 import Data.Text (Text)
  27 import Data.Time (UTCTime)
  28 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
  29 import GHC.Generics (Generic)
  30 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
  31 import Gargantext.Core.Types (Name)
  32 import Gargantext.Database.Schema.Node (NodeWrite, node)
  33 import Gargantext.Database.Types.Node (Node,Hyperdata,NodeType(..), UserId, AnnuaireId)
  34 import Gargantext.Database.Utils (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
  51                       , _hc_uniqIdBdd       :: Maybe Text
  52                       , _hc_uniqId          :: Maybe Text
  53
  54   } deriving (Eq, Show, Generic)
  55
  56 -- TOD0 contact metadata (Type is too flat)
  57 data ContactMetaData =
  58      ContactMetaData { _cm_bdd :: Maybe Text
  59                      , _cm_lastValidation  :: Maybe Text
  60   } deriving (Eq, Show, Generic)
  61
  62
  63 arbitraryHyperdataContact :: HyperdataContact
  64 arbitraryHyperdataContact = HyperdataContact Nothing Nothing []
  65                                              Nothing Nothing Nothing
  66                                              Nothing Nothing
  67
  68 data ContactWho =
  69      ContactWho { _cw_id          :: Maybe Text
  70                 , _cw_firstName   :: Maybe Text
  71                 , _cw_lastName    :: Maybe Text
  72                 , _cw_keywords :: [Text]
  73                 , _cw_freetags :: [Text]
  74   } deriving (Eq, Show, Generic)
  75
  76 data ContactWhere =
  77      ContactWhere { _cw_organization :: [Text]
  78                   , _cw_labTeamDepts :: [Text]
  79
  80                   , _cw_role         :: Maybe Text
  81
  82                   , _cw_office       :: Maybe Text
  83                   , _cw_country      :: Maybe Text
  84                   , _cw_city         :: Maybe Text
  85
  86                   , _cw_touch        :: Maybe ContactTouch
  87
  88                   , _cw_entry        :: Maybe UTCTime
  89                   , _cw_exit         :: Maybe UTCTime
  90   } deriving (Eq, Show, Generic)
  91
  92 data ContactTouch =
  93      ContactTouch { _ct_mail      :: Maybe Text
  94                   , _ct_phone     :: Maybe Text
  95                   , _ct_url       :: Maybe Text
  96   } deriving (Eq, Show, Generic)
  97
  98
  99 nodeContactW :: Maybe Name -> Maybe HyperdataContact
 100              -> AnnuaireId -> UserId -> NodeWrite
 101 nodeContactW maybeName maybeContact aId =
 102   node NodeContact name contact (Just aId)
 103     where
 104       name    = maybe "Contact" identity maybeName
 105       contact = maybe arbitraryHyperdataContact identity maybeContact
 106
 107
 108 -- | ToSchema instances
 109 instance ToSchema HyperdataContact where
 110   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hc_")
 111 instance ToSchema ContactWho where
 112   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
 113 instance ToSchema ContactWhere where
 114   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
 115 instance ToSchema ContactTouch where
 116   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ct_")
 117 instance ToSchema ContactMetaData where
 118   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cm_")
 119
 120 -- | Arbitrary instances
 121 instance Arbitrary HyperdataContact where
 122   arbitrary = elements [HyperdataContact Nothing Nothing [] Nothing Nothing Nothing Nothing Nothing]
 123
 124 -- | Specific Gargantext instance
 125 instance Hyperdata HyperdataContact
 126
 127 -- | Database (Posgresql-simple instance)
 128 instance FromField HyperdataContact where
 129   fromField = fromField'
 130
 131 -- | Database (Opaleye instance)
 132 instance QueryRunnerColumnDefault PGJsonb HyperdataContact   where
 133   queryRunnerColumnDefault = fieldQueryRunnerColumn
 134
 135 -- | All lenses
 136 makeLenses ''ContactWho
 137 makeLenses ''ContactWhere
 138 makeLenses ''ContactTouch
 139 makeLenses ''ContactMetaData
 140 makeLenses ''HyperdataContact
 141
 142 -- | All Json instances
 143 $(deriveJSON (unPrefix "_cw_") ''ContactWho)
 144 $(deriveJSON (unPrefix "_cw_") ''ContactWhere)
 145 $(deriveJSON (unPrefix "_ct_") ''ContactTouch)
 146 $(deriveJSON (unPrefix "_cm_") ''ContactMetaData)
 147 $(deriveJSON (unPrefix "_hc_") ''HyperdataContact)