Commit 3dec90f2 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Annuaire][Demo] Types adapted for Demo emergency.

parent 325970ef
...@@ -80,7 +80,7 @@ import Gargantext.API.Node ( Roots , roots ...@@ -80,7 +80,7 @@ import Gargantext.API.Node ( Roots , roots
, HyperdataCorpus , HyperdataCorpus
, HyperdataAnnuaire , HyperdataAnnuaire
) )
import Gargantext.Database.Node.Contact (HyperdataContact) --import Gargantext.Database.Node.Contact (HyperdataContact)
import Gargantext.Database.Types.Node () import Gargantext.Database.Types.Node ()
import Gargantext.API.Count ( CountAPI, count, Query) import Gargantext.API.Count ( CountAPI, count, Query)
import Gargantext.API.Search ( SearchAPI, search, SearchQuery) import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
...@@ -284,7 +284,7 @@ serverGargAPI env = do ...@@ -284,7 +284,7 @@ serverGargAPI env = do
:<|> roots conn :<|> roots conn
:<|> nodeAPI conn (Proxy :: Proxy HyperdataAny) :<|> nodeAPI conn (Proxy :: Proxy HyperdataAny)
:<|> nodeAPI conn (Proxy :: Proxy HyperdataCorpus) :<|> nodeAPI conn (Proxy :: Proxy HyperdataCorpus)
:<|> nodeAPI conn (Proxy :: Proxy HyperdataContact) :<|> nodeAPI conn (Proxy :: Proxy HyperdataAnnuaire)
:<|> nodesAPI conn :<|> nodesAPI conn
:<|> count -- TODO: undefined :<|> count -- TODO: undefined
:<|> search conn :<|> search conn
......
...@@ -35,7 +35,7 @@ import Gargantext.Database.Node.Document.Insert (insertDocuments, ReturnId(..), ...@@ -35,7 +35,7 @@ import Gargantext.Database.Node.Document.Insert (insertDocuments, ReturnId(..),
import Gargantext.Database.NodeNgram (NodeNgramPoly(..), insertNodeNgrams) import Gargantext.Database.NodeNgram (NodeNgramPoly(..), insertNodeNgrams)
import Gargantext.Database.NodeNgramsNgrams (NodeNgramsNgramsPoly(..), insertNodeNgramsNgramsNew) import Gargantext.Database.NodeNgramsNgrams (NodeNgramsNgramsPoly(..), insertNodeNgramsNgramsNew)
import Gargantext.Database.Types.Node (HyperdataDocument(..)) import Gargantext.Database.Types.Node (HyperdataDocument(..))
import Gargantext.Database.Node.Contact (HyperdataContact(..)) --import Gargantext.Database.Node.Contact (HyperdataContact(..))
import Gargantext.Database.User (getUser, UserLight(..), Username) import Gargantext.Database.User (getUser, UserLight(..), Username)
import Gargantext.Ext.IMT (toSchoolName) import Gargantext.Ext.IMT (toSchoolName)
import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile) import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile)
...@@ -59,10 +59,8 @@ flowDatabase ff fp cName = do ...@@ -59,10 +59,8 @@ flowDatabase ff fp cName = do
flowInsert :: NodeType -> [HyperdataDocument] -> CorpusName flowInsert :: NodeType -> [HyperdataDocument] -> CorpusName
-> IO ([ReturnId], MasterUserId, MasterCorpusId, UserId, CorpusId) -> IO ([ReturnId], MasterUserId, MasterCorpusId, UserId, CorpusId)
flowInsert nt hyperdataDocuments cName = do flowInsert _nt hyperdataDocuments cName = do
let hyperdataDocuments' = case nt of let hyperdataDocuments' = map (\h -> ToDbDocument h) hyperdataDocuments
NodeCorpus -> map (\h -> ToDbDocument h) hyperdataDocuments
-- NodeAnnuaire -> map (\h -> ToDbContact h) hyperdataDocuments
(masterUserId, _, masterCorpusId) <- subFlowCorpus userMaster corpusMasterName (masterUserId, _, masterCorpusId) <- subFlowCorpus userMaster corpusMasterName
ids <- runCmd' $ insertDocuments masterUserId masterCorpusId hyperdataDocuments' ids <- runCmd' $ insertDocuments masterUserId masterCorpusId hyperdataDocuments'
...@@ -72,12 +70,18 @@ flowInsert nt hyperdataDocuments cName = do ...@@ -72,12 +70,18 @@ flowInsert nt hyperdataDocuments cName = do
pure (ids, masterUserId, masterCorpusId, userId, userCorpusId) pure (ids, masterUserId, masterCorpusId, userId, userCorpusId)
flowAnnuaire :: FilePath -> IO ()
flowAnnuaire filePath = do flowAnnuaire filePath = do
contacts <- deserialiseImtUsersFromFile filePath contacts <- deserialiseImtUsersFromFile filePath
ps <- flowInsertAnnuaire "Annuaire" $ take 10 $ map (\h-> ToDbContact h) $ map addUniqIdsContact contacts ps <- flowInsertAnnuaire "Annuaire" $ take 10 $ map (\h-> ToDbContact h) $ map addUniqIdsContact contacts
printDebug "length annuaire" (ps) printDebug "length annuaire" (ps)
--{- --{-
flowInsertAnnuaire :: CorpusName
-> [ToDbData]
-> IO ([ReturnId], UserId, CorpusId, UserId, CorpusId)
flowInsertAnnuaire name children = do flowInsertAnnuaire name children = do
(masterUserId, _, masterCorpusId) <- subFlowCorpus userMaster corpusMasterName (masterUserId, _, masterCorpusId) <- subFlowCorpus userMaster corpusMasterName
...@@ -94,7 +98,10 @@ flowInsertAnnuaire name children = do ...@@ -94,7 +98,10 @@ flowInsertAnnuaire name children = do
--} --}
--{- --{-
-- flowCorpus :: NodeType -> [HyperdataDocument] -> ([ReturnId],MasterUserId,UserId,CorpusId) -> IO CorpusId flowCorpus :: NodeType
-> [HyperdataDocument]
-> ([ReturnId], UserId, CorpusId, UserId, CorpusId)
-> IO CorpusId
flowCorpus NodeCorpus hyperdataDocuments (ids,masterUserId,masterCorpusId, userId,userCorpusId) = do flowCorpus NodeCorpus hyperdataDocuments (ids,masterUserId,masterCorpusId, userId,userCorpusId) = do
--} --}
-------------------------------------------------- --------------------------------------------------
...@@ -160,7 +167,7 @@ subFlowCorpus username cName = do ...@@ -160,7 +167,7 @@ subFlowCorpus username cName = do
subFlowAnnuaire :: Username -> CorpusName -> IO (UserId, RootId, CorpusId) subFlowAnnuaire :: Username -> CorpusName -> IO (UserId, RootId, CorpusId)
subFlowAnnuaire username cName = do subFlowAnnuaire username _cName = do
maybeUserId <- runCmd' (getUser username) maybeUserId <- runCmd' (getUser username)
let userId = case maybeUserId of let userId = case maybeUserId of
......
...@@ -52,6 +52,7 @@ data HyperdataContact = ...@@ -52,6 +52,7 @@ data HyperdataContact =
} deriving (Eq, Show, Generic) } deriving (Eq, Show, Generic)
-- TOD contact metadata (Type is too flat)
data ContactMetaData = data ContactMetaData =
ContactMetaData { _cm_bdd :: Maybe Text ContactMetaData { _cm_bdd :: Maybe Text
, _cm_lastValidation :: Maybe Text , _cm_lastValidation :: Maybe Text
......
...@@ -235,7 +235,7 @@ addUniqIdsContact hc = set (hc_uniqIdBdd) (Just hashBdd) ...@@ -235,7 +235,7 @@ addUniqIdsContact hc = set (hc_uniqIdBdd) (Just hashBdd)
$ set (hc_uniqId) (Just hash) hc $ set (hc_uniqId) (Just hash) hc
where where
hash = uniqId $ DT.concat $ map ($ hc) hashParametersContact hash = uniqId $ DT.concat $ map ($ hc) hashParametersContact
hashBdd = uniqId $ DT.concat $ map ($ hc) ([\d -> maybe' (view (hc_metaData . _Just . cm_bdd) d)] <> hashParametersContact) hashBdd = uniqId $ DT.concat $ map ($ hc) ([\d -> maybe' (view hc_bdd d)] <> hashParametersContact)
uniqId :: Text -> Text uniqId :: Text -> Text
uniqId = DT.pack . SHA.showDigest . SHA.sha256 . DC.pack . DT.unpack uniqId = DT.pack . SHA.showDigest . SHA.sha256 . DC.pack . DT.unpack
......
...@@ -38,9 +38,6 @@ deserialiseImtUsersFromFile filepath = map imtUser2gargContact <$> deserialiseFr ...@@ -38,9 +38,6 @@ deserialiseImtUsersFromFile filepath = map imtUser2gargContact <$> deserialiseFr
deserialiseFromFile' :: FilePath -> IO [IMTUser] deserialiseFromFile' :: FilePath -> IO [IMTUser]
deserialiseFromFile' filepath = deserialise <$> BSL.readFile filepath deserialiseFromFile' filepath = deserialise <$> BSL.readFile filepath
serialiseToFile :: FilePath -> [IMTUser] -> IO ()
serialiseToFile f d = BSL.writeFile f (serialise d)
data IMTUser = IMTUser data IMTUser = IMTUser
{ id :: Text { id :: Text
, entite :: Maybe Text , entite :: Maybe Text
...@@ -77,12 +74,12 @@ imtUser2gargContact (IMTUser id' entite' mail' nom' prenom' fonction' tel' _fax' ...@@ -77,12 +74,12 @@ imtUser2gargContact (IMTUser id' entite' mail' nom' prenom' fonction' tel' _fax'
service' _groupe' bureau' url' _pservice' _pfonction' _afonction' service' _groupe' bureau' url' _pservice' _pfonction' _afonction'
_grprech' lieu' _aprecision' _atel' _sexe' _statut' _idutilentite' _grprech' lieu' _aprecision' _atel' _sexe' _statut' _idutilentite'
_entite2' _service2' _group2' _actif' _idutilsiecoles' date_modification') _entite2' _service2' _group2' _actif' _idutilsiecoles' date_modification')
= HyperdataContact (Just qui) (Just [ou]) (Just meta) ((<>) <$> prenom' <*> nom') entite' Nothing Nothing = HyperdataContact (Just "IMT Annuaire") (Just qui) (Just [ou]) ((<>) <$> (fmap (\p -> p <> " ") prenom') <*> nom') entite' date_modification' Nothing Nothing
where where
qui = ContactWho (Just id') prenom' nom' (Just $ catMaybes [service']) Nothing qui = ContactWho (Just id') prenom' nom' (Just $ catMaybes [service']) Nothing
ou = ContactWhere (toList entite') (toList service') fonction' bureau' (Just "France") lieu' contact Nothing Nothing ou = ContactWhere (toList entite') (toList service') fonction' bureau' (Just "France") lieu' contact Nothing Nothing
contact = Just $ ContactTouch mail' tel' url' contact = Just $ ContactTouch mail' tel' url'
meta = ContactMetaData (Just "IMT annuaire") date_modification' -- meta = ContactMetaData (Just "IMT annuaire") date_modification'
toList Nothing = Nothing toList Nothing = Nothing
toList (Just x) = Just [x] toList (Just x) = Just [x]
......
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