Commit 0de7e051 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Annuaire] types to import users.

parent e50ae8f8
Pipeline #30 failed with stage
...@@ -147,6 +147,7 @@ library: ...@@ -147,6 +147,7 @@ library:
- servant-swagger - servant-swagger
- servant-swagger-ui - servant-swagger-ui
- servant-static-th - servant-static-th
- serialise
- split - split
- stemmer - stemmer
- string-conversions - string-conversions
......
...@@ -72,7 +72,7 @@ flowInsert nt hyperdataDocuments cName = do ...@@ -72,7 +72,7 @@ flowInsert nt hyperdataDocuments cName = do
pure (ids, masterUserId, userId, userCorpusId) pure (ids, masterUserId, userId, userCorpusId)
--{- --{-
flowInsertAnnuaire children name = do flowInsertAnnuaire name children = do
(masterUserId, _, masterCorpusId) <- subFlowCorpus userMaster corpusMasterName (masterUserId, _, masterCorpusId) <- subFlowCorpus userMaster corpusMasterName
ids <- runCmd' $ insertDocuments masterUserId masterCorpusId children ids <- runCmd' $ insertDocuments masterUserId masterCorpusId children
...@@ -80,6 +80,8 @@ flowInsertAnnuaire children name = do ...@@ -80,6 +80,8 @@ flowInsertAnnuaire children name = do
(userId, _, userCorpusId) <- subFlowCorpus userArbitrary name (userId, _, userCorpusId) <- subFlowCorpus userArbitrary name
_ <- runCmd' $ add userCorpusId (map reId ids) _ <- runCmd' $ add userCorpusId (map reId ids)
printDebug "AnnuaireID" userCorpusId
pure (ids, masterUserId, userId, userCorpusId) pure (ids, masterUserId, userId, userCorpusId)
...@@ -122,6 +124,7 @@ flowCorpus NodeCorpus hyperdataDocuments (ids,masterUserId,userId,userCorpusId) ...@@ -122,6 +124,7 @@ flowCorpus NodeCorpus hyperdataDocuments (ids,masterUserId,userId,userCorpusId)
flowCorpus NodeAnnuaire _hyperdataDocuments (_ids,_masterUserId,_userId,_userCorpusId) = undefined flowCorpus NodeAnnuaire _hyperdataDocuments (_ids,_masterUserId,_userId,_userCorpusId) = undefined
flowCorpus _ _ _ = undefined flowCorpus _ _ _ = undefined
type CorpusName = Text type CorpusName = Text
subFlowCorpus :: Username -> CorpusName -> IO (UserId, RootId, CorpusId) subFlowCorpus :: Username -> CorpusName -> IO (UserId, RootId, CorpusId)
......
...@@ -56,7 +56,7 @@ arbitraryHyperdataContact :: HyperdataContact ...@@ -56,7 +56,7 @@ arbitraryHyperdataContact :: HyperdataContact
arbitraryHyperdataContact = HyperdataContact Nothing Nothing Nothing arbitraryHyperdataContact = HyperdataContact Nothing Nothing Nothing
data ContactWho = data ContactWho =
ContactWho { _cw_id :: Maybe Int ContactWho { _cw_id :: Maybe Text
, _cw_firstName :: Maybe Text , _cw_firstName :: Maybe Text
, _cw_lastName :: Maybe Text , _cw_lastName :: Maybe Text
, _cw_keywords :: Maybe [Text] , _cw_keywords :: Maybe [Text]
......
...@@ -111,3 +111,4 @@ publisBySchool hal_data' = Gargantext.Prelude.map (\(i,n) -> (M.lookup i mapIdSc ...@@ -111,3 +111,4 @@ publisBySchool hal_data' = Gargantext.Prelude.map (\(i,n) -> (M.lookup i mapIdSc
$ DV.map (\n -> splitOn (pack ", ") (csvHal_instStructId_i n) ) $ DV.map (\n -> splitOn (pack ", ") (csvHal_instStructId_i n) )
$ DV.filter (\n -> csvHal_publication_year n == 2017) hal_data' $ DV.filter (\n -> csvHal_publication_year n == 2017) hal_data'
{-|
Module : Gargantext.Ext.IMTUser
Description : Interface to get IMT users
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
We can not import the IMT Client API code since it is copyrighted.
Here is writtent a common interface.
-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile)
where
import System.IO (FilePath)
import Codec.Serialise
import Data.Maybe (Maybe, catMaybes)
import Data.Text (Text)
import GHC.Generics (Generic)
import Gargantext.Prelude
import Gargantext.Database.Node.Contact -- (HyperdataContact, ContactWho, ContactWhere, ContactTouch, ContactMetaData)
import qualified Data.ByteString.Lazy as BSL
instance Serialise IMTUser
deserialiseImtUsersFromFile :: FilePath -> IO [HyperdataContact]
deserialiseImtUsersFromFile filepath = map imtUser2gargContact <$> deserialiseFromFile' filepath
deserialiseFromFile' :: FilePath -> IO [IMTUser]
deserialiseFromFile' filepath = deserialise <$> BSL.readFile filepath
serialiseToFile :: FilePath -> [IMTUser] -> IO ()
serialiseToFile f d = BSL.writeFile f (serialise d)
data IMTUser = IMTUser
{ id :: Text
, entite :: Maybe Text
, mail :: Maybe Text
, nom :: Maybe Text
, prenom :: Maybe Text
, fonction :: Maybe Text
, tel :: Maybe Text
, fax :: Maybe Text
, service :: Maybe Text
, groupe :: Maybe Text
, bureau :: Maybe Text
, url :: Maybe Text
, pservice :: Maybe Text
, pfonction :: Maybe Text
, afonction :: Maybe Text
, grprech :: Maybe Text
, lieu :: Maybe Text
, aprecision :: Maybe Text
, atel :: Maybe Text
, sexe :: Maybe Text
, statut :: Maybe Text
, idutilentite :: Maybe Text
, entite2 :: Maybe Text
, service2 :: Maybe Text
, groupe2 :: Maybe Text
, actif :: Maybe Text
, idutilsiecoles :: Maybe Text
, date_modification :: Maybe Text
} deriving (Eq, Show, Generic)
imtUser2gargContact :: IMTUser -> HyperdataContact
imtUser2gargContact (IMTUser id' entite' mail' nom' prenom' fonction' tel' _fax'
service' _groupe' bureau' url' _pservice' _pfonction' _afonction'
_grprech' lieu' _aprecision' _atel' _sexe' _statut' _idutilentite'
_entite2' _service2' _group2' _actif' _idutilsiecoles' date_modification')
= HyperdataContact (Just qui) (Just [ou]) (Just meta)
where
qui = ContactWho (Just id') prenom' nom' (Just $ catMaybes [service']) Nothing
ou = ContactWhere (toList entite') (toList service') fonction' bureau' (Just "France") lieu' contact Nothing Nothing
contact = Just $ ContactTouch mail' tel' url'
meta = ContactMetaData (Just "IMT annuaire") date_modification' Nothing Nothing
toList Nothing = Nothing
toList (Just x) = Just [x]
...@@ -8,8 +8,6 @@ packages: ...@@ -8,8 +8,6 @@ packages:
- 'deps/patches-map' - 'deps/patches-map'
- 'deps/patches-class' - 'deps/patches-class'
#- 'deps/imt-api-client'
allow-newer: true allow-newer: true
extra-deps: extra-deps:
- git: https://github.com/delanoe/data-time-segment.git - git: https://github.com/delanoe/data-time-segment.git
...@@ -30,6 +28,6 @@ extra-deps: ...@@ -30,6 +28,6 @@ extra-deps:
- servant-multipart-0.11.2 - servant-multipart-0.11.2
- stemmer-0.5.2 - stemmer-0.5.2
- servant-flatten-0.2 - servant-flatten-0.2
- serialise-0.2.0.0 # imt-api-client - serialise-0.2.0.0
- KMP-0.1.0.2 - KMP-0.1.0.2
- validity-0.8.0.0 # patches-{map,class} - validity-0.8.0.0 # patches-{map,class}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment