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.Database.Types.Node (Node,Hyperdata)
  32 import Gargantext.Database.Utils (fromField')
  33 import Gargantext.Prelude
  34 import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
  35 import Test.QuickCheck (elements)
  36 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  37
  38 ------------------------------------------------------------------------
  39
  40 type NodeContact  = Node HyperdataContact
  41
  42 data HyperdataContact =
  43      HyperdataContact { _hc_bdd    :: Maybe Text           -- ID of Database source
  44                       , _hc_who    :: Maybe ContactWho
  45                       , _hc_where  :: [ContactWhere]
  46                       , _hc_title  :: Maybe Text -- TODO remove (only demo)
  47                       , _hc_source :: Maybe Text -- TODO remove (only demo)
  48                       , _hc_lastValidation  :: Maybe Text
  49                       , _hc_uniqIdBdd       :: Maybe Text
  50                       , _hc_uniqId          :: Maybe Text
  51
  52   } deriving (Eq, Show, Generic)
  53
  54 -- TOD0 contact metadata (Type is too flat)
  55 data ContactMetaData =
  56      ContactMetaData { _cm_bdd :: Maybe Text
  57                      , _cm_lastValidation  :: Maybe Text
  58   } deriving (Eq, Show, Generic)
  59
  60
  61 arbitraryHyperdataContact :: HyperdataContact
  62 arbitraryHyperdataContact = HyperdataContact Nothing Nothing []
  63                                              Nothing Nothing Nothing
  64                                              Nothing Nothing
  65
  66 data ContactWho =
  67      ContactWho { _cw_id          :: Maybe Text
  68                 , _cw_firstName   :: Maybe Text
  69                 , _cw_lastName    :: Maybe Text
  70                 , _cw_keywords :: [Text]
  71                 , _cw_freetags :: [Text]
  72   } deriving (Eq, Show, Generic)
  73
  74 data ContactWhere =
  75      ContactWhere { _cw_organization :: [Text]
  76                   , _cw_labTeamDepts :: [Text]
  77
  78                   , _cw_role         :: Maybe Text
  79
  80                   , _cw_office       :: Maybe Text
  81                   , _cw_country      :: Maybe Text
  82                   , _cw_city         :: Maybe Text
  83
  84                   , _cw_touch        :: Maybe ContactTouch
  85
  86                   , _cw_entry        :: Maybe UTCTime
  87                   , _cw_exit         :: Maybe UTCTime
  88   } deriving (Eq, Show, Generic)
  89
  90 data ContactTouch =
  91      ContactTouch { _ct_mail      :: Maybe Text
  92                   , _ct_phone     :: Maybe Text
  93                   , _ct_url       :: Maybe Text
  94   } deriving (Eq, Show, Generic)
  95
  96
  97
  98 -- | ToSchema instances
  99 instance ToSchema HyperdataContact where
 100   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hc_")
 101 instance ToSchema ContactWho where
 102   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
 103 instance ToSchema ContactWhere where
 104   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
 105 instance ToSchema ContactTouch where
 106   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ct_")
 107 instance ToSchema ContactMetaData where
 108   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cm_")
 109
 110 -- | Arbitrary instances
 111 instance Arbitrary HyperdataContact where
 112   arbitrary = elements [HyperdataContact Nothing Nothing [] Nothing Nothing Nothing Nothing Nothing]
 113
 114 -- | Specific Gargantext instance
 115 instance Hyperdata HyperdataContact
 116
 117 -- | Database (Posgresql-simple instance)
 118 instance FromField HyperdataContact where
 119   fromField = fromField'
 120
 121 -- | Database (Opaleye instance)
 122 instance QueryRunnerColumnDefault PGJsonb HyperdataContact   where
 123   queryRunnerColumnDefault = fieldQueryRunnerColumn
 124
 125 -- | All lenses
 126 makeLenses ''ContactWho
 127 makeLenses ''ContactWhere
 128 makeLenses ''ContactTouch
 129 makeLenses ''ContactMetaData
 130 makeLenses ''HyperdataContact
 131
 132 -- | All Json instances
 133 $(deriveJSON (unPrefix "_cw_") ''ContactWho)
 134 $(deriveJSON (unPrefix "_cw_") ''ContactWhere)
 135 $(deriveJSON (unPrefix "_ct_") ''ContactTouch)
 136 $(deriveJSON (unPrefix "_cm_") ''ContactMetaData)
 137 $(deriveJSON (unPrefix "_hc_") ''HyperdataContact)