]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Node/Contact.hs
Merge branch 'dev' into dev-phylo
[gargantext.git] / 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.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 -- | ToSchema instances
109 instance ToSchema HyperdataContact where
110 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hc_")
111 instance ToSchema ContactWho where
112 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
113 instance ToSchema ContactWhere where
114 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
115 instance ToSchema ContactTouch where
116 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ct_")
117 instance ToSchema ContactMetaData where
118 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cm_")
119
120 -- | Arbitrary instances
121 instance Arbitrary HyperdataContact where
122 arbitrary = elements [HyperdataContact Nothing Nothing [] Nothing Nothing Nothing Nothing Nothing]
123
124 -- | Specific Gargantext instance
125 instance Hyperdata HyperdataContact
126
127 -- | Database (Posgresql-simple instance)
128 instance FromField HyperdataContact where
129 fromField = fromField'
130
131 -- | Database (Opaleye instance)
132 instance QueryRunnerColumnDefault PGJsonb HyperdataContact where
133 queryRunnerColumnDefault = fieldQueryRunnerColumn
134
135 -- | All lenses
136 makeLenses ''ContactWho
137 makeLenses ''ContactWhere
138 makeLenses ''ContactTouch
139 makeLenses ''ContactMetaData
140 makeLenses ''HyperdataContact
141
142 -- | All Json instances
143 $(deriveJSON (unPrefix "_cw_") ''ContactWho)
144 $(deriveJSON (unPrefix "_cw_") ''ContactWhere)
145 $(deriveJSON (unPrefix "_ct_") ''ContactTouch)
146 $(deriveJSON (unPrefix "_cm_") ''ContactMetaData)
147 $(deriveJSON (unPrefix "_hc_") ''HyperdataContact)