Skip to content

haskell-gargantext
haskell-gargantext
Commit adf9405c authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

Merge branch 'dev' into dev-node-board-add-text-cells

parents e61be930 b05ab4f9
Pipeline #1393 failed with stage
    Hide whitespace changes
    Inline Side-by-side
    Showing with 172 additions and 75 deletions
    src/Gargantext/API/Node/Contact.hs
    View file @ adf9405c
    ......@@ -55,8 +55,8 @@ type API = "contact" :> Summary "Contact endpoint"
    api :: UserId -> CorpusId -> GargServer API
    api uid cid = (api_async (RootId (NodeId uid)) cid)
    :<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) uid cid)
    api uid cid = (api_async (RootId (NodeId uid)) cid)
    :<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) uid cid)
    type API_Async = AsyncJobs JobLog '[JSON] AddContactParams JobLog
    ------------------------------------------------------------------------
    ......
    src/Gargantext/API/Routes.hs
    View file @ adf9405c
    ......@@ -95,10 +95,12 @@ type GargPrivateAPI' =
    :> Capture "node_id" NodeId
    :> NodeAPI HyperdataAny
    --{-
    -- Corpus endpoints
    :<|> "corpus" :> Summary "Corpus endpoint"
    :> Capture "corpus_id" CorpusId
    :> NodeAPI HyperdataCorpus
    --}
    :<|> "corpus" :> Summary "Corpus endpoint"
    :> Capture "node1_id" NodeId
    ......@@ -110,6 +112,12 @@ type GargPrivateAPI' =
    :> Export.API
    -- Annuaire endpoint
    {-
    :<|> "contact" :> Summary "Contact endpoint"
    :> Capture "contact_id" ContactId
    :> NodeAPI HyperdataContact
    --}
    :<|> "annuaire" :> Summary "Annuaire endpoint"
    :> Capture "annuaire_id" AnnuaireId
    :> NodeAPI HyperdataAnnuaire
    ......@@ -117,7 +125,6 @@ type GargPrivateAPI' =
    :<|> "annuaire" :> Summary "Contact endpoint"
    :> Capture "annuaire_id" NodeId
    :> Contact.API
    -- Document endpoint
    :<|> "document" :> Summary "Document endpoint"
    :> Capture "doc_id" DocId
    ......@@ -158,11 +165,11 @@ type GargPrivateAPI' =
    :<|> "lists" :> Summary "List export API"
    :> Capture "listId" ListId
    :> List.API
    {-
    :<|> "wait" :> Summary "Wait test"
    :> Capture "x" Int
    :> WaitAPI -- Get '[JSON] Int
    -}
    -- /mv/<id>/<id>
    -- /merge/<id>/<id>
    -- /rename/<id>
    ......@@ -207,6 +214,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
    :<|> nodeAPI (Proxy :: Proxy HyperdataCorpus) uid
    :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny) uid
    :<|> Export.getCorpus -- uid
    -- :<|> nodeAPI (Proxy :: Proxy HyperdataContact) uid
    :<|> nodeAPI (Proxy :: Proxy HyperdataAnnuaire) uid
    :<|> Contact.api uid
    ......@@ -232,7 +240,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
    -- :<|> New.api uid -- TODO-SECURITY
    -- :<|> New.info uid -- TODO-SECURITY
    :<|> List.api
    :<|> waitAPI
    -- :<|> waitAPI
    ----------------------------------------------------------------------
    ......
    src/Gargantext/API/Search.hs
    View file @ adf9405c
    ......@@ -10,8 +10,6 @@ Portability : POSIX
    Count API part of Gargantext.
    -}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE TypeOperators #-}
    {-# LANGUAGE DeriveAnyClass #-}
    ......@@ -27,15 +25,17 @@ import Data.Time (UTCTime)
    import GHC.Generics (Generic)
    import Gargantext.API.Prelude (GargServer)
    import Gargantext.Core.Utils.Prefix (unPrefixSwagger, unCapitalize, dropPrefix)
    import Gargantext.Database.Query.Facet
    import Gargantext.Database.Action.Search
    import Gargantext.Database.Action.Flow.Pairing (isPairedWith)
    import Gargantext.Database.Action.Search
    import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact(..), HyperdataDocument(..), ContactWho(..))
    import Gargantext.Database.Admin.Types.Hyperdata.Contact (_cw_organization)
    import Gargantext.Database.Admin.Types.Node
    import Gargantext.Database.Query.Facet
    import Gargantext.Prelude
    import Servant
    import Test.QuickCheck (elements)
    import Test.QuickCheck.Arbitrary
    import qualified Data.Text as Text
    -----------------------------------------------------------------------
    -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
    ......@@ -47,16 +47,25 @@ type API results = Summary "Search endpoint"
    :> QueryParam "order" OrderBy
    :> Post '[JSON] results
    -----------------------------------------------------------------------
    -- | Api search function
    api :: NodeId -> GargServer (API SearchResult)
    api nId (SearchQuery q SearchDoc) o l order =
    SearchResult <$> SearchResultDoc <$> map toRow <$> searchInCorpus nId False q o l order
    SearchResult <$> SearchResultDoc
    <$> map (toRow nId)
    <$> searchInCorpus nId False q o l order
    api nId (SearchQuery q SearchContact) o l order = do
    printDebug "isPairedWith" nId
    aIds <- isPairedWith nId NodeAnnuaire
    -- TODO if paired with several corpus
    case head aIds of
    Nothing -> pure $ SearchResult $ SearchNoResult "[G.A.Search] pair corpus with an Annuaire"
    Just aId -> SearchResult <$> SearchResultContact <$> map toRow <$> searchInCorpusWithContacts nId aId q o l order
    Nothing -> pure $ SearchResult
    $ SearchNoResult "[G.A.Search] pair corpus with an Annuaire"
    Just aId -> SearchResult
    <$> SearchResultContact
    <$> map (toRow aId)
    <$> searchInCorpusWithContacts nId aId q o l order
    api _ _ _ _ _ = undefined
    -----------------------------------------------------------------------
    ......@@ -105,8 +114,7 @@ instance Arbitrary SearchQuery where
    -- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
    -----------------------------------------------------------------------
    data SearchResult =
    SearchResult { result :: !SearchResultTypes
    }
    SearchResult { result :: !SearchResultTypes}
    | SearchResultErr !Text
    deriving (Generic)
    ......@@ -167,6 +175,7 @@ data Row =
    , c_created :: !UTCTime
    , c_hyperdata :: !HyperdataRow
    , c_score :: !Int
    , c_annuaireId :: !NodeId
    }
    deriving (Generic)
    ......@@ -188,16 +197,17 @@ instance ToSchema Row where
    declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
    class ToRow a where
    toRow :: a -> Row
    toRow :: NodeId -> a -> Row
    instance ToRow FacetDoc where
    toRow (FacetDoc nId utc t h mc _md sc) = Document nId utc t (toHyperdataRow h) (fromMaybe 0 mc) (round $ fromMaybe 0 sc)
    toRow _ (FacetDoc nId utc t h mc _md sc) =
    Document nId utc t (toHyperdataRow h) (fromMaybe 0 mc) (round $ fromMaybe 0 sc)
    -- | TODO rename FacetPaired
    type FacetContact = FacetPaired Int UTCTime HyperdataContact Int
    instance ToRow FacetContact where
    toRow (FacetPaired nId utc h s) = Contact nId utc (toHyperdataRow h) s
    toRow annuaireId (FacetPaired nId utc h s) = Contact nId utc (toHyperdataRow h) s annuaireId
    --------------------------------------------------------------------
    ......@@ -281,5 +291,9 @@ instance ToHyperdataRow HyperdataDocument where
    (fromMaybe "EN" l)
    instance ToHyperdataRow HyperdataContact where
    toHyperdataRow (HyperdataContact _ (Just (ContactWho _ fn ln _ _)) _ _ _ _ _ _ ) = HyperdataRowContact (fromMaybe "FN" fn) (fromMaybe "LN" ln) "Labs"
    toHyperdataRow (HyperdataContact _ _ _ _ _ _ _ _ ) = HyperdataRowContact "FirstName" "LastName" "Labs"
    toHyperdataRow (HyperdataContact _ (Just (ContactWho _ fn ln _ _)) ou _ _ _ _ _ ) =
    HyperdataRowContact (fromMaybe "FirstName" fn) (fromMaybe "LastName" ln) ou'
    where
    ou' = maybe "CNRS" (Text.intercalate " " . _cw_organization) (head ou)
    toHyperdataRow (HyperdataContact _ _ _ _ _ _ _ _ ) =
    HyperdataRowContact "FirstName" "LastName" "Labs"
    src/Gargantext/Core/Ext/IMTUser.hs
    View file @ adf9405c
    ......@@ -13,72 +13,138 @@ Here is writtent a common interface.
    -}
    module Gargantext.Core.Ext.IMTUser (deserialiseImtUsersFromFile)
    module Gargantext.Core.Ext.IMTUser -- (deserialiseImtUsersFromFile)
    where
    import Codec.Serialise
    import Data.Csv
    import Data.Either
    import Data.Maybe (catMaybes)
    import Data.Text (Text)
    import Data.Vector (Vector)
    import GHC.Generics (Generic)
    import Gargantext.Core.Text.Corpus.Parsers.CSV
    import Gargantext.Database.Admin.Types.Hyperdata.Contact
    import Gargantext.Prelude
    import System.FilePath.Posix (takeExtension)
    import System.IO (FilePath)
    import qualified Data.ByteString.Lazy as BSL
    import qualified Data.ByteString.Lazy as BL
    import qualified Data.Vector as Vector
    ------------------------------------------------------------------------
    readFile_Annuaire :: FilePath -> IO [HyperdataContact]
    readFile_Annuaire fp = case takeExtension fp of
    ".csv" -> readCSVFile_Annuaire fp
    ".data" -> deserialiseImtUsersFromFile fp
    _ -> panic "[G.C.E.I.readFile_Annuaire] extension unknown"
    instance Serialise IMTUser
    deserialiseImtUsersFromFile :: FilePath -> IO [HyperdataContact]
    deserialiseImtUsersFromFile filepath = map imtUser2gargContact <$> deserialiseFromFile' filepath
    deserialiseFromFile' :: FilePath -> IO [IMTUser]
    deserialiseFromFile' filepath = deserialise <$> BSL.readFile filepath
    ------------------------------------------------------------------------
    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
    { id :: Maybe Text
    , entite :: Maybe Text
    , mail :: Maybe Text
    , nom :: Maybe Text
    , prenom :: Maybe Text
    , fonction :: Maybe Text
    , fonction2 :: Maybe Text
    , tel :: Maybe Text
    , fax :: Maybe Text
    , service :: Maybe Text
    , groupe :: Maybe Text
    , entite2 :: Maybe Text
    , service2 :: Maybe Text
    , groupe2 :: Maybe Text
    , bureau :: Maybe Text
    , url :: Maybe Text
    , pservice :: Maybe Text
    , pfonction :: Maybe Text
    , afonction :: Maybe Text
    , afonction2 :: Maybe Text
    , grprech :: Maybe Text
    , appellation :: 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
    , actif :: Maybe Text
    , idutilsiecoles :: Maybe Text
    , date_modification :: Maybe Text
    } deriving (Eq, Show, Generic)
    -- | CSV instance
    instance FromNamedRecord IMTUser where
    parseNamedRecord r = IMTUser <$> r .: "id"
    <*> r .: "entite"
    <*> r .: "mail"
    <*> r .: "nom"
    <*> r .: "prenom"
    <*> r .: "fonction"
    <*> r .: "fonction2"
    <*> r .: "tel"
    <*> r .: "fax"
    <*> r .: "service"
    <*> r .: "groupe"
    <*> r .: "entite2"
    <*> r .: "service2"
    <*> r .: "groupe2"
    <*> r .: "bureau"
    <*> r .: "url"
    <*> r .: "pservice"
    <*> r .: "pfonction"
    <*> r .: "afonction"
    <*> r .: "afonction2"
    <*> r .: "grprech"
    <*> r .: "appellation"
    <*> r .: "lieu"
    <*> r .: "aprecision"
    <*> r .: "atel"
    <*> r .: "sexe"
    <*> r .: "statut"
    <*> r .: "idutilentite"
    <*> r .: "actif"
    <*> r .: "idutilsiecoles"
    <*> r .: "date_modification"
    headerCSVannuaire :: Header
    headerCSVannuaire =
    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"]
    readCSVFile_Annuaire :: FilePath -> IO [HyperdataContact]
    readCSVFile_Annuaire fp = do
    users <- snd <$> readCSVFile_Annuaire' fp
    pure $ map imtUser2gargContact $ Vector.toList users
    readCSVFile_Annuaire' :: FilePath -> IO (Header, Vector IMTUser)
    readCSVFile_Annuaire' = fmap readCsvHalLazyBS' . BL.readFile
    where
    readCsvHalLazyBS' :: BL.ByteString -> (Header, Vector IMTUser)
    readCsvHalLazyBS' bs = case decodeByNameWith csvDecodeOptions bs of
    Left e -> panic (cs e)
    Right rows -> rows
    ------------------------------------------------------------------------
    -- | Serialization for optimization
    instance Serialise IMTUser
    deserialiseImtUsersFromFile :: FilePath -> IO [HyperdataContact]
    deserialiseImtUsersFromFile filepath = map imtUser2gargContact <$> deserialiseFromFile' filepath
    deserialiseFromFile' :: FilePath -> IO [IMTUser]
    deserialiseFromFile' filepath = deserialise <$> BL.readFile filepath
    ------------------------------------------------------------------------
    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')
    imtUser2gargContact (IMTUser id' entite' mail' nom' prenom' fonction' _fonction2' tel' _fax'
    service' _groupe' _entite2 _service2 _group2 bureau' url' _pservice' _pfonction' _afonction' _afonction2'
    _grprech' _appellation' lieu' _aprecision' _atel' _sexe' _statut' _idutilentite'
    _actif' _idutilsiecoles' date_modification')
    = HyperdataContact (Just "IMT Annuaire") (Just qui) [ou] ((<>) <$> (fmap (\p -> p <> " ") prenom') <*> nom') entite' date_modification' Nothing Nothing
    where
    qui = ContactWho (Just id') prenom' nom' (catMaybes [service']) []
    qui = ContactWho id' prenom' nom' (catMaybes [service']) []
    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'
    toList Nothing = []
    toList (Just x) = [x]
    src/Gargantext/Core/Text/Corpus/Parsers/CSV.hs
    View file @ adf9405c
    ......@@ -34,7 +34,8 @@ import Gargantext.Core.Text.Context
    ---------------------------------------------------------------
    headerCsvGargV3 :: Header
    headerCsvGargV3 = header [ "title"
    headerCsvGargV3 =
    header [ "title"
    , "source"
    , "publication_year"
    , "publication_month"
    ......@@ -44,9 +45,9 @@ headerCsvGargV3 = header [ "title"
    ]
    ---------------------------------------------------------------
    data CsvGargV3 = CsvGargV3
    { d_docId :: !Int
    , d_title :: !Text
    , d_source :: !Text
    { d_docId :: !Int
    , d_title :: !Text
    , d_source :: !Text
    , d_publication_year :: !Int
    , d_publication_month :: !Int
    , d_publication_day :: !Int
    ......@@ -115,14 +116,14 @@ splitDoc m splt doc = let docSize = (length $ csv_abstract doc) in
    where
    firstDoc = CsvDoc t s py pm pd firstAbstract auth
    firstAbstract = head' "splitDoc'1" abstracts
    nextDocs = map (\txt -> CsvDoc
    (head' "splitDoc'2" $ sentences txt)
    s py pm pd
    (unsentences $ tail' "splitDoc'1" $ sentences txt)
    auth
    ) (tail' "splitDoc'2" abstracts)
    abstracts = (splitBy $ contextSize) abst
    ---------------------------------------------------------------
    ......@@ -226,7 +227,6 @@ readCsvLazyBS bs = case decodeByNameWith csvDecodeOptions bs of
    Right csvDocs -> csvDocs
    ------------------------------------------------------------------------
    -- | TODO use readFileLazy
    readCsvHal :: FilePath -> IO (Header, Vector CsvHal)
    readCsvHal = fmap readCsvHalLazyBS . BL.readFile
    ......@@ -307,11 +307,11 @@ instance ToNamedRecord CsvHal where
    toNamedRecord (CsvHal t s py pm pd abst aut url isbn iss j lang doi auth inst dept lab team doct) =
    namedRecord [ "title" .= t
    , "source" .= s
    , "publication_year" .= py
    , "publication_month" .= pm
    , "publication_day" .= pd
    , "abstract" .= abst
    , "authors" .= aut
    ......@@ -320,13 +320,13 @@ instance ToNamedRecord CsvHal where
    , "issue_s" .= iss
    , "journalPublisher_s" .= j
    , "language_s" .= lang
    , "doiId_s" .= doi
    , "authId_i" .= auth
    , "instStructId_i" .= inst
    , "deptStructId_i" .= dept
    , "labStructId_i" .= lab
    , "rteamStructId_i" .= team
    , "docType_s" .= doct
    ]
    ......@@ -389,7 +389,6 @@ parseHal' :: BL.ByteString -> [HyperdataDocument]
    parseHal' = V.toList . V.map csvHal2doc . snd . readCsvHalLazyBS
    ------------------------------------------------------------------------
    parseCsv :: FilePath -> IO [HyperdataDocument]
    parseCsv fp = V.toList <$> V.map csv2doc <$> snd <$> readFile fp
    ......
    src/Gargantext/Database/Action/Flow.hs
    View file @ adf9405c
    ......@@ -66,7 +66,7 @@ import qualified Data.Map as Map
    import Gargantext.Core (Lang(..), PosTagAlgo(..))
    import Gargantext.Core.Ext.IMT (toSchoolName)
    import Gargantext.Core.Ext.IMTUser (deserialiseImtUsersFromFile)
    import Gargantext.Core.Ext.IMTUser (readFile_Annuaire)
    import Gargantext.Core.Flow.Types
    import Gargantext.Core.Text
    import Gargantext.Core.Text.List.Group.WithStem ({-StopSize(..),-} GroupParams(..))
    ......@@ -166,7 +166,7 @@ flowAnnuaire :: (FlowCmdM env err m)
    -> FilePath
    -> m AnnuaireId
    flowAnnuaire u n l filePath = do
    docs <- liftBase $ (( splitEvery 500 <$> deserialiseImtUsersFromFile filePath) :: IO [[HyperdataContact]])
    docs <- liftBase $ (( splitEvery 500 <$> readFile_Annuaire filePath) :: IO [[HyperdataContact]])
    flow (Nothing :: Maybe HyperdataAnnuaire) u n l docs
    ------------------------------------------------------------------------
    ......
    src/Gargantext/Database/Query/Facet.hs
    View file @ adf9405c
    ......@@ -232,13 +232,23 @@ instance Arbitrary OrderBy
    -- TODO-SECURITY check
    --{-
    runViewAuthorsDoc :: HasDBid NodeType => ContactId -> IsTrash -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [FacetDoc]
    runViewAuthorsDoc :: HasDBid NodeType
    => ContactId
    -> IsTrash
    -> Maybe Offset
    -> Maybe Limit
    -> Maybe OrderBy
    -> Cmd err [FacetDoc]
    runViewAuthorsDoc cId t o l order = runOpaQuery $ filterWith o l order $ viewAuthorsDoc cId t ntId
    where
    ntId = NodeDocument
    -- TODO add delete ?
    viewAuthorsDoc :: HasDBid NodeType => ContactId -> IsTrash -> NodeType -> Query FacetDocRead
    viewAuthorsDoc :: HasDBid NodeType
    => ContactId
    -> IsTrash
    -> NodeType
    -> Query FacetDocRead
    viewAuthorsDoc cId _ nt = proc () -> do
    (doc,(_,(_,(_,contact')))) <- queryAuthorsDoc -< ()
    ......
    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