src/Gargantext/Core/Ext/IMTUser.hs

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