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