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 data ContactWhere =
  67      ContactWhere { _cw_organization :: Maybe [Text]
  68                   , _cw_labTeamDepts :: Maybe [Text]
  69                   , _cw_role         :: Maybe Text
  70                   , _cw_office       :: Maybe Text
  71                   , _cw_country      :: Maybe Text
  72                   , _cw_city         :: Maybe Text
  73                   , _cw_touch        :: Maybe ContactTouch
  74   } deriving (Eq, Show, Generic)
  75
  76 data ContactTouch =
  77      ContactTouch { _ct_mail      :: Maybe Text
  78                   , _ct_phone     :: Maybe Text
  79                   , _ct_url       :: Maybe Text
  80   } deriving (Eq, Show, Generic)
  81
  82
  83 nodeContactW :: Maybe Name -> Maybe HyperdataContact
  84              -> AnnuaireId -> UserId -> NodeWrite'
  85 nodeContactW maybeName maybeContact aId =
  86   node NodeContact name contact (Just aId)
  87     where
  88       name    = maybe "Contact" identity maybeName
  89       contact = maybe arbitraryHyperdataContact identity maybeContact
  90
  91
  92
  93 instance Hyperdata HyperdataContact
  94 instance FromField HyperdataContact where
  95   fromField = fromField'
  96 instance QueryRunnerColumnDefault PGJsonb HyperdataContact   where
  97   queryRunnerColumnDefault = fieldQueryRunnerColumn
  98
  99 {-
 100 makeLenses ''ContactWho
 101 makeLenses ''ContactWhere
 102 makeLenses ''ContactTouch
 103 makeLenses ''HyperdataContact
 104 -}
 105
 106 $(deriveJSON (unPrefix "_cw_") ''ContactWho)
 107 $(deriveJSON (unPrefix "_cw_") ''ContactWhere)
 108 $(deriveJSON (unPrefix "_ct_") ''ContactTouch)
 109 $(deriveJSON (unPrefix "_hc_") ''HyperdataContact)
 110
 111