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