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 = IMTUser <$> r .: "id"
  79                                <*> r .: "entite"
  80                                <*> r .: "mail"
  81                                <*> r .: "nom"
  82                                <*> r .: "prenom"
  83                                <*> r .: "fonction"
  84                                <*> r .: "fonction2"
  85                                <*> r .: "tel"
  86                                <*> r .: "fax"
  87                                <*> r .: "service"
  88                                <*> r .: "groupe"
  89                                <*> r .: "entite2"
  90                                <*> r .: "service2"
  91                                <*> r .: "groupe2"
  92                                <*> r .: "bureau"
  93                                <*> r .: "url"
  94                                <*> r .: "pservice"
  95                                <*> r .: "pfonction"
  96                                <*> r .: "afonction"
  97                                <*> r .: "afonction2"
  98                                <*> r .: "grprech"
  99                                <*> r .: "appellation"
 100                                <*> r .: "lieu"
 101                                <*> r .: "aprecision"
 102                                <*> r .: "atel"
 103                                <*> r .: "sexe"
 104                                <*> r .: "statut"
 105                                <*> r .: "idutilentite"
 106                                <*> r .: "actif"
 107                                <*> r .: "idutilsiecoles"
 108                                <*> r .: "date_modification"
 109
 110 headerCSVannuaire :: Header
 111 headerCSVannuaire =
 112   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"]
 113
 114
 115 readCSVFile_Annuaire :: FilePath -> IO [HyperdataContact]
 116 readCSVFile_Annuaire fp = do
 117   users <- snd <$> readCSVFile_Annuaire' fp
 118   pure $ map imtUser2gargContact $ Vector.toList users
 119
 120 readCSVFile_Annuaire' :: FilePath -> IO (Header, Vector IMTUser)
 121 readCSVFile_Annuaire' = fmap readCsvHalLazyBS' . BL.readFile
 122   where
 123     readCsvHalLazyBS' :: BL.ByteString -> (Header, Vector IMTUser)
 124     readCsvHalLazyBS' bs = case decodeByNameWith csvDecodeOptions bs of
 125           Left  e    -> panic (cs e)
 126           Right rows -> rows
 127
 128 ------------------------------------------------------------------------
 129 -- | Serialization for optimization
 130 instance Serialise IMTUser
 131 deserialiseImtUsersFromFile :: FilePath -> IO [HyperdataContact]
 132 deserialiseImtUsersFromFile filepath = map imtUser2gargContact <$> deserialiseFromFile' filepath
 133
 134 deserialiseFromFile' :: FilePath -> IO [IMTUser]
 135 deserialiseFromFile' filepath = deserialise <$> BL.readFile filepath
 136
 137 ------------------------------------------------------------------------
 138 imtUser2gargContact :: IMTUser -> HyperdataContact
 139 imtUser2gargContact (IMTUser id' entite' mail' nom' prenom' fonction' _fonction2' tel' _fax'
 140                      service' _groupe' _entite2 _service2 _group2 bureau' url' _pservice' _pfonction' _afonction' _afonction2'
 141                      _grprech' _appellation' lieu' _aprecision' _atel' _sexe' _statut' _idutilentite'
 142                      _actif' _idutilsiecoles' date_modification')
 143                   = HyperdataContact (Just "IMT Annuaire") (Just qui) [ou] ((<>) <$> (fmap (\p -> p <> " ") prenom') <*> nom') entite' date_modification' Nothing Nothing
 144                     where
 145                       qui = ContactWho id' prenom' nom' (catMaybes [service']) []
 146                       ou  = ContactWhere (toList entite') (toList service') fonction' bureau' (Just "France") lieu' contact Nothing Nothing
 147                       contact = Just $ ContactTouch mail' tel' url'
 148                       -- meta    = ContactMetaData (Just "IMT annuaire") date_modification'
 149                       toList Nothing  = []
 150                       toList (Just x) = [x]