Contact.hs

{-|
Module      : Gargantext.Database.Node.Contact
Description : Update Node in Database (Postgres)
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

{-# LANGUAGE DeriveGeneric          #-}
{-# LANGUAGE NoImplicitPrelude      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings      #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE TemplateHaskell        #-}

module Gargantext.Database.Node.Contact
  where

import Control.Lens (makeLenses)
import Data.Aeson.TH (deriveJSON)
import Data.Swagger (ToSchema)
import Data.Text (Text)
import Data.Time (UTCTime)
import Database.PostgreSQL.Simple.FromField (FromField, fromField)
import GHC.Generics (Generic)
import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Database.Schema.Node (NodeWrite, Name, node)
import Gargantext.Database.Types.Node (Node,Hyperdata,NodeType(..), UserId, AnnuaireId)
import Gargantext.Database.Utils (fromField')
import Gargantext.Prelude
import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)

------------------------------------------------------------------------

type NodeContact  = Node HyperdataContact

data HyperdataContact =
     HyperdataContact { _hc_bdd    :: Maybe Text           -- ID of Database source
                      , _hc_who    :: Maybe ContactWho
                      , _hc_where  :: [ContactWhere]
                      , _hc_title  :: Maybe Text -- TODO remove (only demo)
                      , _hc_source :: Maybe Text -- TODO remove (only demo)
                      , _hc_lastValidation  :: Maybe Text
                      , _hc_uniqIdBdd       :: Maybe Text
                      , _hc_uniqId          :: Maybe Text

  } deriving (Eq, Show, Generic)

-- TOD0 contact metadata (Type is too flat)
data ContactMetaData =
     ContactMetaData { _cm_bdd :: Maybe Text
                     , _cm_lastValidation  :: Maybe Text
  } deriving (Eq, Show, Generic)


arbitraryHyperdataContact :: HyperdataContact
arbitraryHyperdataContact = HyperdataContact Nothing Nothing []
                                             Nothing Nothing Nothing
                                             Nothing Nothing

data ContactWho = 
     ContactWho { _cw_id          :: Maybe Text
                , _cw_firstName   :: Maybe Text
                , _cw_lastName    :: Maybe Text
                , _cw_keywords :: [Text]
                , _cw_freetags :: [Text]
  } deriving (Eq, Show, Generic)

data ContactWhere =
     ContactWhere { _cw_organization :: [Text]
                  , _cw_labTeamDepts :: [Text]
                  
                  , _cw_role         :: Maybe Text
                  
                  , _cw_office       :: Maybe Text
                  , _cw_country      :: Maybe Text
                  , _cw_city         :: Maybe Text
                  
                  , _cw_touch        :: Maybe ContactTouch
                  
                  , _cw_entry        :: Maybe UTCTime
                  , _cw_exit         :: Maybe UTCTime
  } deriving (Eq, Show, Generic)

data ContactTouch =
     ContactTouch { _ct_mail      :: Maybe Text
                  , _ct_phone     :: Maybe Text
                  , _ct_url       :: Maybe Text
  } deriving (Eq, Show, Generic)


nodeContactW :: Maybe Name -> Maybe HyperdataContact
             -> AnnuaireId -> UserId -> NodeWrite
nodeContactW maybeName maybeContact aId = 
  node NodeContact name contact (Just aId)
    where
      name    = maybe "Contact" identity maybeName
      contact = maybe arbitraryHyperdataContact identity maybeContact


-- | Main instances of Contact
instance ToSchema HyperdataContact
instance ToSchema ContactWho
instance ToSchema ContactWhere
instance ToSchema ContactTouch

instance Arbitrary HyperdataContact where
  arbitrary = elements [HyperdataContact Nothing Nothing [] Nothing Nothing Nothing Nothing Nothing]


-- | Specific Gargantext instance
instance Hyperdata HyperdataContact

-- | Database (Posgresql-simple instance)
instance FromField HyperdataContact where
  fromField = fromField'

-- | Database (Opaleye instance)
instance QueryRunnerColumnDefault PGJsonb HyperdataContact   where
  queryRunnerColumnDefault = fieldQueryRunnerColumn

-- | All lenses
makeLenses ''ContactWho
makeLenses ''ContactWhere
makeLenses ''ContactTouch
makeLenses ''ContactMetaData
makeLenses ''HyperdataContact

-- | All Json instances
$(deriveJSON (unPrefix "_cw_") ''ContactWho)
$(deriveJSON (unPrefix "_cw_") ''ContactWhere)
$(deriveJSON (unPrefix "_ct_") ''ContactTouch)
$(deriveJSON (unPrefix "_cm_") ''ContactMetaData)
$(deriveJSON (unPrefix "_hc_") ''HyperdataContact)