src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs

   1 {-|
   2 Module      : Gargantext.Database.Admin.Types.Hyperdata.Contact
   3 Description :
   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 DeriveAnyClass             #-}
  13 {-# LANGUAGE DeriveGeneric              #-}
  14 {-# LANGUAGE FlexibleContexts           #-}
  15 {-# LANGUAGE FunctionalDependencies     #-}
  16 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  17 {-# LANGUAGE MultiParamTypeClasses      #-}
  18 {-# LANGUAGE NoImplicitPrelude          #-}
  19 {-# LANGUAGE OverloadedStrings          #-}
  20 {-# LANGUAGE RankNTypes                 #-}
  21 {-# LANGUAGE TemplateHaskell            #-}
  22
  23
  24 module Gargantext.Database.Admin.Types.Hyperdata.Contact
  25   where
  26
  27 import Data.Morpheus.Types (GQLType(..), typeDirective)
  28 import Data.Time.Segment (jour)
  29 import qualified Gargantext.API.GraphQL.Utils as GAGU
  30 import Gargantext.Core.Text (HasText(..))
  31 import Gargantext.Database.Admin.Types.Hyperdata.Prelude
  32 import Gargantext.Prelude
  33 import Gargantext.Utils.UTCTime
  34
  35 --------------------------------------------------------------------------------
  36 data HyperdataContact =
  37   HyperdataContact { _hc_bdd    :: Maybe Text           -- ID of Database source
  38                    , _hc_who    :: Maybe ContactWho
  39                    , _hc_where  :: [ContactWhere]
  40                    , _hc_title  :: Maybe Text -- TODO remove (only demo)
  41                    , _hc_source :: Maybe Text -- TODO remove (only demo)
  42                    , _hc_lastValidation  :: Maybe Text -- TODO UTCTime
  43                    , _hc_uniqIdBdd       :: Maybe Text
  44                    , _hc_uniqId          :: Maybe Text
  45   } deriving (Eq, Show, Generic)
  46
  47 instance GQLType HyperdataContact where
  48   directives _ = typeDirective (GAGU.RemovePrefix "_hc_")
  49
  50 instance HasText HyperdataContact
  51   where
  52     hasText = undefined
  53
  54 defaultHyperdataContact :: HyperdataContact
  55 defaultHyperdataContact =
  56   HyperdataContact
  57     { _hc_bdd = Just "bdd"
  58     , _hc_who = Just defaultContactWho
  59     , _hc_where = [defaultContactWhere]
  60     , _hc_title =Just "Title"
  61     , _hc_source = Just "Source"
  62     , _hc_lastValidation = Just "TODO lastValidation date"
  63     , _hc_uniqIdBdd = Just "DO NOT expose this"
  64     , _hc_uniqId = Just "DO NOT expose this" }
  65
  66 hyperdataContact :: FirstName -> LastName -> HyperdataContact
  67 hyperdataContact fn ln =
  68   HyperdataContact
  69     { _hc_bdd = Nothing
  70     , _hc_who = Just (contactWho fn ln)
  71     , _hc_where = []
  72     , _hc_title = Nothing
  73     , _hc_source = Nothing
  74     , _hc_lastValidation = Nothing
  75     , _hc_uniqIdBdd = Nothing
  76     , _hc_uniqId = Nothing }
  77
  78 -- TOD0 contact metadata (Type is too flat)
  79 data ContactMetaData =
  80   ContactMetaData { _cm_bdd :: Maybe Text
  81                   , _cm_lastValidation  :: Maybe Text -- TODO UTCTIME
  82   } deriving (Eq, Show, Generic)
  83
  84 defaultContactMetaData :: ContactMetaData
  85 defaultContactMetaData = ContactMetaData (Just "bdd") (Just "TODO UTCTime")
  86
  87 arbitraryHyperdataContact :: HyperdataContact
  88 arbitraryHyperdataContact =
  89   HyperdataContact
  90     { _hc_bdd = Nothing
  91     , _hc_who = Nothing
  92     , _hc_where = []
  93     , _hc_title = Nothing
  94     , _hc_source = Nothing
  95     , _hc_lastValidation = Nothing
  96     , _hc_uniqIdBdd = Nothing
  97     , _hc_uniqId = Nothing }
  98
  99
 100 data ContactWho =
 101   ContactWho { _cw_id          :: Maybe Text
 102              , _cw_firstName   :: Maybe Text
 103              , _cw_lastName    :: Maybe Text
 104              , _cw_keywords :: [Text]
 105              , _cw_freetags :: [Text]
 106              , _cw_description :: Maybe Text
 107   } deriving (Eq, Show, Generic)
 108
 109 instance GQLType ContactWho where
 110   directives _ = typeDirective (GAGU.RemovePrefix "_cw_")
 111
 112 type FirstName = Text
 113 type LastName  = Text
 114
 115 defaultContactWho :: ContactWho
 116 defaultContactWho = contactWho "Pierre" "Dupont"
 117
 118 contactWho :: FirstName -> LastName -> ContactWho
 119 contactWho fn ln =
 120   ContactWho { _cw_id = Nothing
 121              , _cw_firstName = Just fn
 122              , _cw_lastName = Just ln
 123              , _cw_keywords = []
 124              , _cw_freetags = []
 125              , _cw_description = Nothing }
 126
 127 data ContactWhere =
 128   ContactWhere { _cw_organization :: [Text]
 129                , _cw_labTeamDepts :: [Text]
 130
 131                , _cw_role         :: Maybe Text
 132
 133                , _cw_office       :: Maybe Text
 134                , _cw_country      :: Maybe Text
 135                , _cw_city         :: Maybe Text
 136
 137                , _cw_touch        :: Maybe ContactTouch
 138
 139                , _cw_entry        :: Maybe NUTCTime
 140                , _cw_exit         :: Maybe NUTCTime
 141   } deriving (Eq, Show, Generic)
 142
 143 instance GQLType ContactWhere where
 144   directives _ = typeDirective (GAGU.RemovePrefix "_cw_")
 145
 146 defaultContactWhere :: ContactWhere
 147 defaultContactWhere =
 148   ContactWhere
 149     { _cw_organization = ["Organization X"]
 150     , _cw_labTeamDepts = ["Lab Z"]
 151     , _cw_role = Just "Role"
 152     , _cw_office = Just "Office"
 153     , _cw_country = Just "Country"
 154     , _cw_city = Just "City"
 155     , _cw_touch = Just defaultContactTouch
 156     , _cw_entry = Just $ NUTCTime $ jour 01 01 2020
 157     , _cw_exit = Just $ NUTCTime $ jour 01 01 2029 }
 158
 159 data ContactTouch =
 160      ContactTouch { _ct_mail      :: Maybe Text
 161                   , _ct_phone     :: Maybe Text
 162                   , _ct_url       :: Maybe Text
 163   } deriving (Eq, Show, Generic)
 164
 165 instance GQLType ContactTouch where
 166   directives _ = typeDirective (GAGU.RemovePrefix "_ct_")
 167
 168 defaultContactTouch :: ContactTouch
 169 defaultContactTouch =
 170   ContactTouch
 171     { _ct_mail = Just "email@data.com"
 172     , _ct_phone = Just "+336 328 283 288"
 173     , _ct_url = Just "https://url.com" }
 174
 175 -- | ToSchema instances
 176 instance ToSchema HyperdataContact where
 177   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hc_")
 178 instance ToSchema ContactWho where
 179   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
 180 instance ToSchema ContactWhere where
 181   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
 182 instance ToSchema ContactTouch where
 183   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ct_")
 184 instance ToSchema ContactMetaData where
 185   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cm_")
 186
 187 -- | Arbitrary instances
 188 instance Arbitrary HyperdataContact where
 189   arbitrary = elements [HyperdataContact Nothing Nothing [] Nothing Nothing Nothing Nothing Nothing]
 190
 191 -- | Specific Gargantext instance
 192 instance Hyperdata HyperdataContact
 193
 194 -- | Database (Posgresql-simple instance)
 195 instance FromField HyperdataContact where
 196   fromField = fromField'
 197
 198 -- | Database (Opaleye instance)
 199 instance DefaultFromField SqlJsonb HyperdataContact   where
 200   defaultFromField = fromPGSFromField
 201
 202
 203 instance DefaultFromField (Nullable SqlJsonb) HyperdataContact where
 204   defaultFromField = fromPGSFromField
 205
 206
 207
 208 -- | All lenses
 209 makeLenses ''ContactWho
 210 makeLenses ''ContactWhere
 211 makeLenses ''ContactTouch
 212 makeLenses ''ContactMetaData
 213 makeLenses ''HyperdataContact
 214
 215 -- | All Json instances
 216 $(deriveJSON (unPrefix "_cw_") ''ContactWho)
 217 $(deriveJSON (unPrefix "_cw_") ''ContactWhere)
 218 $(deriveJSON (unPrefix "_ct_") ''ContactTouch)
 219 $(deriveJSON (unPrefix "_cm_") ''ContactMetaData)
 220 $(deriveJSON (unPrefix "_hc_") ''HyperdataContact)