1  {-|
  2  Module      : Gargantext.Core.Ext.IMTUser
  3  Description : Interface to get IMT users
  4  Copyright   : (c) CNRS, 2017-Present
  5  License     : AGPL + CECILL v3
  6  Maintainer  : team@gargantext.org
  7  Stability   : experimental
  8  Portability : POSIX
  9  
 10  We can not import the IMT Client API code since it is copyrighted.
 11  Here is writtent a common interface.
 12  
 13  -}
 14  
 15  
 16  module Gargantext.Core.Ext.IMTUser -- (deserialiseImtUsersFromFile)
 17    where
 18  
 19  import Codec.Serialise ( Serialise, deserialise )
 20  import Data.ByteString.Lazy qualified as BL
 21  import Data.Csv ( (.:), header, decodeByNameWith, FromNamedRecord(..), Header )
 22  import Data.Text qualified as T
 23  import Data.Vector (Vector)
 24  import Data.Vector qualified as Vector
 25  import Gargantext.Core.Text.Corpus.Parsers.CSV ( csvDecodeOptions, Delimiter(Tab) )
 26  import Gargantext.Database.Admin.Types.Hyperdata.Contact
 27  import Gargantext.Prelude
 28  import System.FilePath.Posix (takeExtension)
 29  
 30  ------------------------------------------------------------------------
 31  readFile_Annuaire :: FilePath -> IO [HyperdataContact]
 32  readFile_Annuaire fp = case takeExtension fp of
 33      ".csv"     -> readCSVFile_Annuaire fp
 34      ".data"    -> deserialiseImtUsersFromFile fp
 35      unknownExt -> panicTrace $ "[G.C.E.I.readFile_Annuaire] extension unknown: " <> T.pack unknownExt
 36  
 37  ------------------------------------------------------------------------
 38  data IMTUser = IMTUser
 39    { id         :: Maybe Text
 40    , entite     :: Maybe Text
 41    , mail       :: Maybe Text
 42    , nom        :: Maybe Text
 43    , prenom     :: Maybe Text
 44    , fonction   :: Maybe Text
 45    , fonction2  :: Maybe Text
 46    , tel        :: Maybe Text
 47    , fax        :: Maybe Text
 48    , service    :: Maybe Text
 49    , groupe     :: Maybe Text
 50    , entite2    :: Maybe Text
 51    , service2   :: Maybe Text
 52    , groupe2    :: Maybe Text
 53    , bureau     :: Maybe Text
 54    , url        :: Maybe Text
 55    , pservice   :: Maybe Text
 56    , pfonction  :: Maybe Text
 57    , afonction  :: Maybe Text
 58    , afonction2 :: Maybe Text
 59    , grprech      :: Maybe Text
 60    , appellation  :: Maybe Text
 61    , lieu         :: Maybe Text
 62    , aprecision   :: Maybe Text
 63    , atel         :: Maybe Text
 64    , sexe         :: Maybe Text
 65    , statut       :: Maybe Text
 66    , idutilentite :: Maybe Text
 67    , actif             :: Maybe Text
 68    , idutilsiecoles    :: Maybe Text
 69    , date_modification :: Maybe Text
 70    } deriving (Eq, Show, Generic)
 71  
 72  -- | CSV instance
 73  instance FromNamedRecord IMTUser where
 74    parseNamedRecord r = do
 75      id <- r .: "id"
 76      entite <- r .: "entite"
 77      mail <- r .: "mail"
 78      nom <- r .: "nom"
 79      prenom <- r .: "prenom"
 80      fonction <- r .: "fonction"
 81      fonction2 <- r .: "fonction2"
 82      tel <- r .: "tel"
 83      fax <- r .: "fax"
 84      service <- r .: "service"
 85      groupe <- r .: "groupe"
 86      entite2 <- r .: "entite2"
 87      service2 <- r .: "service2"
 88      groupe2 <- r .: "groupe2"
 89      bureau <- r .: "bureau"
 90      url <- r .: "url"
 91      pservice <- r .: "pservice"
 92      pfonction <- r .: "pfonction"
 93      afonction <- r .: "afonction"
 94      afonction2 <- r .: "afonction2"
 95      grprech <- r .: "grprech"
 96      appellation <- r .: "appellation"
 97      lieu <- r .: "lieu"
 98      aprecision <- r .: "aprecision"
 99      atel <- r .: "atel"
100      sexe <- r .: "sexe"
101      statut <- r .: "statut"
102      idutilentite <- r .: "idutilentite"
103      actif <- r .: "actif"
104      idutilsiecoles <- r .: "idutilsiecoles"
105      date_modification <- r .: "date_modification"
106      pure $ IMTUser {..}
107  
108  headerCSVannuaire :: Header
109  headerCSVannuaire =
110    header ["id","entite","mail","nom","prenom","fonction","fonction2","tel","fax","service","groupe","entite2","service2","groupe2","bureau","url","pservice","pfonction","afonction","afonction2","grprech","appellation","lieu","aprecision","atel","sexe","statut","idutilentite","actif","idutilsiecoles","date_modification"]
111  
112  
113  readCSVFile_Annuaire :: FilePath -> IO [HyperdataContact]
114  readCSVFile_Annuaire fp = do
115    users <- snd <$> readCSVFile_Annuaire' fp
116    pure $ map imtUser2gargContact $ Vector.toList users
117  
118  readCSVFile_Annuaire' :: FilePath -> IO (Header, Vector IMTUser)
119  readCSVFile_Annuaire' = fmap readCsvHalLazyBS' . BL.readFile
120    where
121      readCsvHalLazyBS' :: BL.ByteString -> (Header, Vector IMTUser)
122      readCsvHalLazyBS' bs = case decodeByNameWith (csvDecodeOptions Tab) bs of
123            Left  e    -> panicTrace (cs e)
124            Right rows -> rows
125  
126  ------------------------------------------------------------------------
127  -- | Serialization for optimization
128  instance Serialise IMTUser
129  deserialiseImtUsersFromFile :: FilePath -> IO [HyperdataContact]
130  deserialiseImtUsersFromFile filepath = map imtUser2gargContact <$> deserialiseFromFile' filepath
131  
132  deserialiseFromFile' :: FilePath -> IO [IMTUser]
133  deserialiseFromFile' filepath = deserialise <$> BL.readFile filepath
134  
135  ------------------------------------------------------------------------
136  imtUser2gargContact :: IMTUser -> HyperdataContact
137  --imtUser2gargContact (IMTUser id' entite' mail' nom' prenom' fonction' _fonction2' tel' _fax'
138  --                     service' _groupe' _entite2 _service2 _group2 bureau' url' _pservice' _pfonction' _afonction' _afonction2'
139  --                     _grprech' _appellation' lieu' _aprecision' _atel' _sexe' _statut' _idutilentite'
140  --                     _actif' _idutilsiecoles' date_modification')
141  --                  = HyperdataContact (Just "IMT Annuaire") (Just qui) [ou] ((<>) <$> (fmap (\p -> p <> " ") prenom') <*> nom') entite' date_modification' Nothing Nothing
142  imtUser2gargContact (IMTUser { id
143                               , entite
144                               , mail
145                               , nom
146                               , prenom
147                               , fonction
148                               , tel
149                               , service
150                               , bureau
151                               , url
152                               , lieu
153                               , date_modification }) =
154                          HyperdataContact { _hc_bdd = Just "IMT Annuaire"
155                                           , _hc_who = Just qui
156                                           , _hc_where = [ou]
157                                           , _hc_title = title
158                                           , _hc_source = entite
159                                           , _hc_lastValidation = date_modification }
160    where
161      title = (<>) <$> fmap (\p -> p <> " ") prenom <*> nom
162      qui = ContactWho { _cw_id = id
163                       , _cw_firstName = prenom
164                       , _cw_lastName = nom
165                       , _cw_keywords = catMaybes [service]
166                       , _cw_freetags = []
167                       , _cw_description = Nothing }
168      ou  = ContactWhere { _cw_organization = toList' entite
169                         , _cw_labTeamDepts = toList' service
170                         , _cw_role = fonction
171                         , _cw_office = bureau
172                         , _cw_country = Just "France"
173                         , _cw_city = lieu
174                         , _cw_touch = contact
175                         , _cw_entry = Nothing
176                         , _cw_exit = Nothing }
177      contact = Just $ ContactTouch { _ct_mail = mail
178                                    , _ct_phone = tel
179                                    , _ct_url = url }
180      -- meta    = ContactMetaData (Just "IMT annuaire") date_modification'
181      toList' Nothing  = []
182      toList' (Just x) = [x]
183  
184  
185  
186