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.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 -- | Main instances of Contact
 109 instance ToSchema HyperdataContact
 110 instance ToSchema ContactWho
 111 instance ToSchema ContactWhere
 112 instance ToSchema ContactTouch
 113
 114 instance Arbitrary HyperdataContact where
 115   arbitrary = elements [HyperdataContact Nothing Nothing [] Nothing Nothing Nothing Nothing Nothing]
 116
 117
 118 -- | Specific Gargantext instance
 119 instance Hyperdata HyperdataContact
 120
 121 -- | Database (Posgresql-simple instance)
 122 instance FromField HyperdataContact where
 123   fromField = fromField'
 124
 125 -- | Database (Opaleye instance)
 126 instance QueryRunnerColumnDefault PGJsonb HyperdataContact   where
 127   queryRunnerColumnDefault = fieldQueryRunnerColumn
 128
 129 -- | All lenses
 130 makeLenses ''ContactWho
 131 makeLenses ''ContactWhere
 132 makeLenses ''ContactTouch
 133 makeLenses ''ContactMetaData
 134 makeLenses ''HyperdataContact
 135
 136 -- | All Json instances
 137 $(deriveJSON (unPrefix "_cw_") ''ContactWho)
 138 $(deriveJSON (unPrefix "_cw_") ''ContactWhere)
 139 $(deriveJSON (unPrefix "_ct_") ''ContactTouch)
 140 $(deriveJSON (unPrefix "_cm_") ''ContactMetaData)
 141 $(deriveJSON (unPrefix "_hc_") ''HyperdataContact)