]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Node/Contact.hs
fix the weightedlogjaccard
[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)
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)