Skip to content

H
haskell-gargantext
Commit 942f8bef authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

Merge branch 'dev' into dev-doc-annotation-issue

parents c55bb752 92e50de6
Hide whitespace changes
Inline Side-by-side
Showing with 436 additions and 168 deletions
gargantext.ini_toModify
View file @ 942f8bef
[gargantext]
# Needed to instantiate the first users and first data
MASTER_USER = gargantua
# SECURITY WARNING: keep the secret key used in production secret!
SECRET_KEY = PASSWORD_TO_CHANGE
# Frames
# Data path to local files
DATA_FILEPATH = FILEPATH_TO_CHANGE
# [external]
# FRAMES
FRAME_WRITE_URL = URL_TO_CHANGE
FRAME_CALC_URL = URL_TO_CHANGE
FRAME_SEARX_URL = URL_TO_CHANGE
FRAME_ISTEX_URL = URL_TO_CHANGE
[server]
# Server config (TODO connect in ReaderMonad)
ALLOWED_ORIGIN = http://localhost
ALLOWED_ORIGIN_PORT = 8008
ALLOWED_HOST = localhost
ALLOWED_HOST_PORT = 3000
JWT_SETTINGS = TODO
[network]
# Emails From address (sent by smtp)
MAIL = username@gargantext.org
......@@ -26,5 +46,5 @@ DB_PASS = PASSWORD_TO_CHANGE
[logs]
LOG_FILE = /var/log/gargantext/backend.log
LOG_LEVEL = DEBUG
LOG_LEVEL = LevelDebug
LOG_FORMATTER = verbose
package.yaml
View file @ 942f8bef
name: gargantext
version: '0.0.1.7.1'
version: '0.0.1.7.3'
synopsis: Search, map, share
description: Please see README.md
category: Data
......
src/Gargantext/API/Admin/Settings.hs
View file @ 942f8bef
......@@ -75,7 +75,6 @@ data Settings = Settings
, _cookieSettings :: CookieSettings
, _sendLoginEmails :: SendEmailType
, _scrapydUrl :: BaseUrl
, _fileFolder :: FilePath
, _config :: GargConfig
}
......@@ -97,7 +96,6 @@ devSettings jwkFile = do
-- , _dbServer = "localhost"
, _sendLoginEmails = LogEmailToConsole
, _scrapydUrl = fromMaybe (panic "Invalid scrapy URL") $ parseBaseUrl "http://localhost:6800"
, _fileFolder = "data"
, _cookieSettings = defaultCookieSettings { cookieXsrfSetting = Just xsrfCookieSetting } -- TODO-SECURITY tune
, _jwtSettings = defaultJWTSettings jwk -- TODO-SECURITY tune
, _config = defaultConfig
......
src/Gargantext/API/HashedResponse.hs
View file @ 942f8bef
{-|
Module : Gargantext.API.HashedResponse
Description :
Copyright : (c) CNRS, 2020-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
module Gargantext.API.HashedResponse where
import Data.Aeson
......
src/Gargantext/API/Ngrams.hs
View file @ 942f8bef
......@@ -510,13 +510,13 @@ instance ToSchema a => ToSchema (Replace a) where
-- TODO Keep constructor is not supported here.
aSchema <- declareSchemaRef (Proxy :: Proxy a)
return $ NamedSchema (Just "Replace") $ mempty
& type_ ?~ SwaggerObject
& properties .~
InsOrdHashMap.fromList
[ ("old", aSchema)
, ("new", aSchema)
]
& required .~ [ "old", "new" ]
& type_ ?~ SwaggerObject
& properties .~
InsOrdHashMap.fromList
[ ("old", aSchema)
, ("new", aSchema)
]
& required .~ [ "old", "new" ]
data NgramsPatch =
NgramsPatch { _patch_children :: PatchMSet NgramsTerm
......
src/Gargantext/API/Node.hs
View file @ 942f8bef
......@@ -31,6 +31,7 @@ module Gargantext.API.Node
where
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.TH (deriveJSON)
import Data.Maybe
import Data.Swagger
import Data.Text (Text())
......@@ -40,14 +41,14 @@ import Gargantext.API.Metrics
import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus)
import Gargantext.API.Node.New
import Gargantext.API.Prelude
import Gargantext.API.Search (SearchDocsAPI, searchDocs, SearchPairsAPI, searchPairs)
import Gargantext.API.Table
import Gargantext.Core.Types (NodeTableResult)
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Core.Types.Main (Tree, NodeTree)
import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Database.Action.Flow.Pairing (pairing)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude -- (Cmd, CmdM)
import Gargantext.Database.Query.Facet (FacetDoc, OrderBy(..))
import Gargantext.Database.Query.Table.Node
......@@ -64,6 +65,7 @@ import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import qualified Gargantext.API.Node.Share as Share
import qualified Gargantext.API.Node.Update as Update
import qualified Gargantext.API.Search as Search
import qualified Gargantext.Database.Action.Delete as Action (deleteNode)
import qualified Gargantext.Database.Query.Table.Node.Update as U (update, Update(..))
......@@ -127,14 +129,13 @@ type NodeAPI a = Get '[JSON] (Node a)
:<|> "ngrams" :> TableNgramsApi
:<|> "category" :> CatApi
:<|> "search" :> SearchDocsAPI
:<|> "search" :> (Search.API Search.SearchResult)
:<|> "share" :> Share.API
-- Pairing utilities
:<|> "pairwith" :> PairWith
:<|> "pairs" :> Pairs
:<|> "pairing" :> PairingApi
:<|> "searchPair" :> SearchPairsAPI
-- VIZ
:<|> "metrics" :> ScatterAPI
......@@ -204,13 +205,12 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
:<|> apiNgramsTableCorpus id'
:<|> catApi id'
:<|> searchDocs id'
:<|> Search.api id'
:<|> Share.api id'
-- Pairing Tools
:<|> pairWith id'
:<|> pairs id'
:<|> getPair id'
:<|> searchPairs id'
:<|> scatterApi id'
:<|> chartApi id'
......@@ -227,12 +227,6 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
data RenameNode = RenameNode { r_name :: Text }
deriving (Generic)
-- TODO unPrefix "r_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON RenameNode
instance ToJSON RenameNode
instance ToSchema RenameNode
instance Arbitrary RenameNode where
arbitrary = elements [RenameNode "test"]
------------------------------------------------------------------------
------------------------------------------------------------------------
type CatApi = Summary " To Categorize NodeNodes: 0 for delete, 1/null neutral, 2 favorite"
......@@ -276,7 +270,7 @@ pairs cId = do
type PairWith = Summary "Pair a Corpus with an Annuaire"
:> "annuaire" :> Capture "annuaire_id" AnnuaireId
:> "list" :> Capture "list_id" ListId
:> QueryParam "list_id" ListId
:> Post '[JSON] Int
pairWith :: CorpusId -> GargServer PairWith
......@@ -285,7 +279,6 @@ pairWith cId aId lId = do
_ <- insertNodeNode [ NodeNode cId aId Nothing Nothing]
pure r
------------------------------------------------------------------------
------------------------------------------------------------------------
type TreeAPI = QueryParams "type" NodeType :> Get '[JSON] (Tree NodeTree)
......@@ -315,4 +308,12 @@ moveNode :: User
-> Cmd err [Int]
moveNode _u n p = update (Move n p)
-------------------------------------------------------------
$(deriveJSON (unPrefix "r_" ) ''RenameNode )
instance ToSchema RenameNode
instance Arbitrary RenameNode where
arbitrary = elements [RenameNode "test"]
-------------------------------------------------------------
src/Gargantext/API/Node/Update.hs
View file @ 942f8bef
......@@ -17,18 +17,20 @@ module Gargantext.API.Node.Update
where
import Data.Aeson
import Data.Maybe (Maybe(..))
import Data.Swagger
import GHC.Generics (Generic)
import Data.Maybe (Maybe(..))
import Gargantext.API.Admin.Settings (HasSettings)
import Gargantext.Prelude
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
import Gargantext.API.Admin.Settings (HasSettings)
import Gargantext.API.Node.Corpus.New (AsyncJobs)
import Gargantext.API.Prelude (GargServer, simuLogs)
import Gargantext.Viz.Graph.Distances (GraphMetric(..), Distance(..))
import Gargantext.Viz.Graph.API (recomputeGraph)
import Gargantext.Database.Action.Flow.Pairing (pairing)
import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Prelude (Ord, Eq, (<$>), ($), liftBase, (.), printDebug, pure)
import Gargantext.Viz.Graph.API (recomputeGraph)
import Gargantext.Viz.Graph.Distances (GraphMetric(..), Distance(..))
import Prelude (Enum, Bounded, minBound, maxBound)
import Servant
import Servant.Job.Async (JobFunction(..), serveJobsAPI)
......@@ -45,6 +47,7 @@ data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method }
| UpdateNodeParamsGraph { methodGraph :: !GraphMetric }
| UpdateNodeParamsTexts { methodTexts :: !Granularity }
| UpdateNodeParamsBoard { methodBoard :: !Charts }
| LinkNodeReq { nodeType :: !NodeType, id :: !NodeId }
deriving (Generic)
----------------------------------------------------------------------
......@@ -63,11 +66,11 @@ data Charts = Sources | Authors | Institutes | Ngrams | All
api :: UserId -> NodeId -> GargServer API
api uId nId =
serveJobsAPI $
JobFunction (\p log ->
JobFunction (\p log'' ->
let
log' x = do
printDebug "updateNode" x
liftBase $ log x
liftBase $ log'' x
in updateNode uId nId p (liftBase . log')
)
......@@ -95,6 +98,24 @@ updateNode uId nId (UpdateNodeParamsGraph metric) logStatus = do
, _scst_events = Just []
}
updateNode _uId nid1 (LinkNodeReq nt nid2) logStatus = do
logStatus JobLog { _scst_succeeded = Just 1
, _scst_failed = Just 0
, _scst_remaining = Just 1
, _scst_events = Just []
}
_ <- case nt of
NodeAnnuaire -> pairing nid2 nid1 Nothing -- defaultList
NodeCorpus -> pairing nid1 nid2 Nothing -- defaultList
_ -> panic $ "[G.API.N.Update.updateNode] NodeType not implemented"
<> cs (show nt)
pure JobLog { _scst_succeeded = Just 2
, _scst_failed = Just 0
, _scst_remaining = Just 0
, _scst_events = Just []
}
updateNode _uId _nId _p logStatus = do
simuLogs logStatus 10
......
src/Gargantext/API/Routes.hs
View file @ 942f8bef
......@@ -33,7 +33,7 @@ import Gargantext.API.Count (CountAPI, count, Query)
import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableDoc)
import Gargantext.API.Node
import Gargantext.API.Prelude
import Gargantext.API.Search (SearchPairsAPI, searchPairs)
-- import qualified Gargantext.API.Search as Search
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node
......@@ -129,8 +129,8 @@ type GargPrivateAPI' =
:> CountAPI
-- Corpus endpoint --> TODO rename s/search/filter/g
:<|> "search" :> Capture "corpus" NodeId
:> SearchPairsAPI
-- :<|> "search" :> Capture "corpus" NodeId
-- :> (Search.API Search.SearchResult)
-- TODO move to NodeAPI?
:<|> "graph" :> Summary "Graph endpoint"
......@@ -212,8 +212,8 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
:<|> count -- TODO: undefined
:<|> withAccess (Proxy :: Proxy SearchPairsAPI) Proxy uid
<$> PathNode <*> searchPairs -- TODO: move elsewhere
-- :<|> withAccess (Proxy :: Proxy (Search.API Search.SearchResult)) Proxy uid
-- <$> PathNode <*> Search.api -- TODO: move elsewhere
:<|> withAccess (Proxy :: Proxy GraphAPI) Proxy uid
<$> PathNode <*> graphAPI uid -- TODO: mock
......
src/Gargantext/API/Search.hs
View file @ 942f8bef
......@@ -19,16 +19,18 @@ Count API part of Gargantext.
module Gargantext.API.Search
where
import Data.Aeson.TH (deriveJSON)
import Data.Swagger
import Data.Aeson
import Data.Maybe (fromMaybe)
import Data.Swagger hiding (fieldLabelModifier, Contact)
import Data.Text (Text)
import Data.Time (UTCTime)
import GHC.Generics (Generic)
import Gargantext.API.Prelude (GargServer)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Core.Utils.Prefix (unPrefixSwagger, unCapitalize, dropPrefix)
import Gargantext.Database.Query.Facet
import Gargantext.Database.Action.Search
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact)
import Gargantext.Database.Action.Flow.Pairing (isPairedWith)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact(..), HyperdataDocument(..), ContactWho(..))
import Gargantext.Database.Admin.Types.Node
import Gargantext.Prelude
import Servant
......@@ -36,65 +38,248 @@ import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
-----------------------------------------------------------------------
data SearchQuery = SearchQuery
{ sq_query :: [Text]
} deriving (Generic)
-- TODO-ACCESS: CanSearch? or is it part of CanGetNode
-- TODO-EVENTS: No event, this is a read-only query.
type API results = Summary "Search endpoint"
:> ReqBody '[JSON] SearchQuery
:> QueryParam "offset" Int
:> QueryParam "limit" Int
:> QueryParam "order" OrderBy
:> Post '[JSON] results
-----------------------------------------------------------------------
api :: NodeId -> GargServer (API SearchResult)
api nId (SearchQuery q SearchDoc) o l order =
SearchResult <$> SearchResultDoc <$> map toRow <$> 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
api _ _ _ _ _ = undefined
$(deriveJSON (unPrefix "sq_") ''SearchQuery)
-----------------------------------------------------------------------
-----------------------------------------------------------------------
-- | Main Types
-----------------------------------------------------------------------
data SearchType = SearchDoc | SearchContact
deriving (Generic)
instance ToSchema SearchQuery where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "sq_")
instance FromJSON SearchType
where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance Arbitrary SearchQuery where
arbitrary = elements [SearchQuery ["electrodes"]]
instance ToJSON SearchType
where
toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToSchema SearchType
instance Arbitrary SearchType where
arbitrary = elements [SearchDoc, SearchContact]
-----------------------------------------------------------------------
data SearchDocResults = SearchDocResults { sdr_results :: [FacetDoc]}
data SearchQuery =
SearchQuery { query :: ![Text]
, expected :: !SearchType
}
| SearchQueryErr !Text
deriving (Generic)
instance FromJSON SearchQuery
where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToJSON SearchQuery
where
toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToSchema SearchQuery
{-
where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
-}
instance Arbitrary SearchQuery where
arbitrary = elements [SearchQuery ["electrodes"] SearchDoc]
-- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
-----------------------------------------------------------------------
data SearchResult =
SearchResult { result :: !SearchResultTypes
}
| SearchResultErr !Text
deriving (Generic)
instance FromJSON SearchResult
where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToJSON SearchResult
where
toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToSchema SearchResult
{-
where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
-}
instance Arbitrary SearchResult where
arbitrary = SearchResult <$> arbitrary
data SearchResultTypes = SearchResultDoc { docs :: ![Row]}
| SearchResultContact { contacts :: ![Row] }
| SearchNoResult { message :: !Text }
deriving (Generic)
$(deriveJSON (unPrefix "sdr_") ''SearchDocResults)
instance Arbitrary SearchDocResults where
arbitrary = SearchDocResults <$> arbitrary
instance FromJSON SearchResultTypes
where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToJSON SearchResultTypes
where
toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance Arbitrary SearchResultTypes where
arbitrary = do
srd <- SearchResultDoc <$> arbitrary
src <- SearchResultContact <$> arbitrary
srn <- pure $ SearchNoResult "No result because.."
elements [srd, src, srn]
instance ToSchema SearchResultTypes where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
instance ToSchema SearchDocResults where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "sdr_")
--------------------------------------------------------------------
data SearchPairedResults =
SearchPairedResults { spr_results :: [FacetPaired Int UTCTime HyperdataContact Int] }
data Row =
Document { id :: !NodeId
, created :: !UTCTime
, title :: !Text
, hyperdata :: !HyperdataRow
, category :: !Int
, score :: !Int
}
| Contact { c_id :: !Int
, c_created :: !UTCTime
, c_hyperdata :: !HyperdataRow
, c_score :: !Int
}
deriving (Generic)
$(deriveJSON (unPrefix "spr_") ''SearchPairedResults)
instance Arbitrary SearchPairedResults where
arbitrary = SearchPairedResults <$> arbitrary
instance FromJSON Row
where
parseJSON = genericParseJSON
( defaultOptions { sumEncoding = ObjectWithSingleField
}
)
instance ToSchema SearchPairedResults where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "spr_")
instance ToJSON Row
where
toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance Arbitrary Row where
arbitrary = arbitrary
-----------------------------------------------------------------------
-- TODO-ACCESS: CanSearch? or is it part of CanGetNode
-- TODO-EVENTS: No event, this is a read-only query.
type SearchAPI results = Summary "Search endpoint"
:> ReqBody '[JSON] SearchQuery
:> QueryParam "offset" Int
:> QueryParam "limit" Int
:> QueryParam "order" OrderBy
:> Post '[JSON] results
type SearchDocsAPI = SearchAPI SearchDocResults
searchDocs :: NodeId -> GargServer SearchDocsAPI
searchDocs nId (SearchQuery q) o l order =
SearchDocResults <$> searchInCorpus nId False q o l order
--SearchResults <$> searchInCorpusWithContacts nId q o l order
instance ToSchema Row where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
-----------------------------------------------------------------------
type SearchPairsAPI = Summary ""
:> "list"
:> Capture "annuaire" AnnuaireId
:> SearchAPI SearchPairedResults
searchPairs :: NodeId -> GargServer SearchPairsAPI
class ToRow a where
toRow :: a -> Row
searchPairs pId aId (SearchQuery q) o l order =
SearchPairedResults <$> searchInCorpusWithContacts pId aId q o l order
instance ToRow FacetDoc where
toRow (FacetDoc nId utc t h mc md) = Document nId utc t (toHyperdataRow h) (fromMaybe 0 mc) (round $ fromMaybe 0 md)
-----------------------------------------------------------------------
-- | 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
--------------------------------------------------------------------
data HyperdataRow =
HyperdataRowDocument { _hr_bdd :: !Text
, _hr_doi :: !Text
, _hr_url :: !Text
, _hr_uniqId :: !Text
, _hr_uniqIdBdd :: !Text
, _hr_page :: !Int
, _hr_title :: !Text
, _hr_authors :: !Text
, _hr_institutes :: !Text
, _hr_source :: !Text
, _hr_abstract :: !Text
, _hr_publication_date :: !Text
, _hr_publication_year :: !Int
, _hr_publication_month :: !Int
, _hr_publication_day :: !Int
, _hr_publication_hour :: !Int
, _hr_publication_minute :: !Int
, _hr_publication_second :: !Int
, _hr_language_iso2 :: !Text
}
| HyperdataRowContact { _hr_firstname :: !Text
, _hr_lastname :: !Text
, _hr_labs :: !Text
}
deriving (Generic)
instance FromJSON HyperdataRow
where
parseJSON = genericParseJSON
( defaultOptions
{ sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
, omitNothingFields = False
}
)
instance ToJSON HyperdataRow
where
toJSON = genericToJSON
( defaultOptions
{ sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
, omitNothingFields = False
}
)
instance Arbitrary HyperdataRow where
arbitrary = arbitrary
instance ToSchema HyperdataRow where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hr_")
class ToHyperdataRow a where
toHyperdataRow :: a -> HyperdataRow
instance ToHyperdataRow HyperdataDocument where
toHyperdataRow (HyperdataDocument b d u ui ub p t a i s abs pd py pm pda ph pmin psec l) =
HyperdataRowDocument
(fromMaybe "" b)
(fromMaybe "" d)
(fromMaybe "" u)
(fromMaybe "" ui)
(fromMaybe "" ub)
(fromMaybe 0 p)
(fromMaybe "Title" t)
(fromMaybe "" a)
(fromMaybe "" i)
(fromMaybe "" s)
(fromMaybe "" abs)
(fromMaybe "" pd)
(fromMaybe 2020 py)
(fromMaybe 1 pm)
(fromMaybe 1 pda)
(fromMaybe 1 ph)
(fromMaybe 1 pmin)
(fromMaybe 1 psec)
(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"
src/Gargantext/Config.hs
View file @ 942f8bef
......@@ -22,16 +22,20 @@ import GHC.Generics (Generic)
import Control.Lens (makeLenses)
data GargConfig = GargConfig { _gc_masteruser :: Text
, _gc_secretkey :: Text
, _gc_frame_write_url :: Text
, _gc_frame_calc_url :: Text
data GargConfig = GargConfig { _gc_masteruser :: !Text
, _gc_secretkey :: !Text
, _gc_datafilepath :: !FilePath
, _gc_frame_write_url :: !Text
, _gc_frame_calc_url :: !Text
, _gc_frame_searx_url :: !Text
, _gc_frame_istex_url :: !Text
}
deriving (Generic)
deriving (Generic, Show)
makeLenses ''GargConfig
readConfig :: FilePath -> IO GargConfig
readConfig fp = do
ini <- readIniFile fp
......@@ -45,8 +49,17 @@ readConfig fp = do
pure $ GargConfig (val "MASTER_USER")
(val "SECRET_KEY")
(cs $ val "DATA_FILEPATH")
(val "FRAME_WRITE_URL")
(val "FRAME_CALC_URL")
(val "FRAME_SEARX_URL")
(val "FRAME_ISTEX_URL")
defaultConfig :: GargConfig
defaultConfig = GargConfig "gargantua" "secret" "https://frame_write.url" "https://frame_calc.url"
defaultConfig = GargConfig "gargantua"
"secret"
"data/"
"https://frame_write.url"
"https://frame_calc.url"
"https://frame_searx.url"
"https://frame_istex.url"
src/Gargantext/Core/Flow/Types.hs
View file @ 942f8bef
......@@ -17,7 +17,7 @@ module Gargantext.Core.Flow.Types where
import Control.Lens (Lens')
import Data.Map (Map)
import Data.Maybe (Maybe)
-- import Control.Applicative
import Gargantext.Text (HasText(..))
import Gargantext.Core.Types.Main (HashId)
import Gargantext.Database.Admin.Types.Hyperdata
......
src/Gargantext/Database/Action/Flow/Pairing.hs
View file @ 942f8bef
......@@ -35,6 +35,8 @@ import Gargantext.Database.Prelude (Cmd, runOpaQuery)
import Gargantext.Database.Query.Prelude (leftJoin2, returnA, queryNodeNodeTable)
import Gargantext.Database.Query.Table.Node.Children (getAllContacts)
import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername)
import Gargantext.Database.Query.Table.Node (defaultList)
import Gargantext.Database.Query.Table.NodeNode (insertNodeNode)
import Gargantext.Database.Schema.Ngrams -- (NgramsType(..))
import Gargantext.Database.Schema.Node
import Gargantext.Prelude hiding (sum)
......@@ -49,8 +51,8 @@ import qualified Data.Text as DT
-- | isPairedWith
-- All NodeAnnuaire paired with a Corpus of NodeId nId:
-- isPairedWith NodeAnnuaire corpusId
isPairedWith :: NodeType -> NodeId -> Cmd err [NodeId]
isPairedWith nt nId = runOpaQuery (selectQuery nt nId)
isPairedWith :: NodeId -> NodeType -> Cmd err [NodeId]
isPairedWith nId nt = runOpaQuery (selectQuery nt nId)
where
selectQuery :: NodeType -> NodeId -> Query (Column PGInt4)
selectQuery nt' nId' = proc () -> do
......@@ -64,14 +66,16 @@ isPairedWith nt nId = runOpaQuery (selectQuery nt nId)
where
cond (node, node_node) = node^.node_id .== node_node^. nn_node2_id
-----------------------------------------------------------------------
pairing :: AnnuaireId -> CorpusId -> ListId -> GargNoServer Int
pairing a c l = do
pairing :: AnnuaireId -> CorpusId -> Maybe ListId -> GargNoServer Int
pairing a c l' = do
l <- case l' of
Nothing -> defaultList c
Just l'' -> pure l''
dataPaired <- dataPairing a (c,l,Authors) takeName takeName
insertDB $ prepareInsert dataPaired
r <- insertDB $ prepareInsert dataPaired
_ <- insertNodeNode [ NodeNode c a Nothing Nothing]
pure r
dataPairing :: AnnuaireId
......
src/Gargantext/Database/Action/Metrics/NgramsByNode.hs
View file @ 942f8bef
......@@ -19,14 +19,12 @@ module Gargantext.Database.Action.Metrics.NgramsByNode
import Data.Map.Strict (Map, fromListWith, elems, toList, fromList)
import Data.Map.Strict.Patch (PatchMap, Replace, diff)
import Data.Set (Set)
import qualified Data.Ord as DO (Down(..))
import Data.Text (Text)
import Data.Tuple.Extra (second, swap)
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Debug.Trace (trace)
import Gargantext.Core (Lang(..))
import Gargantext.Core.Types (Ordering(..))
import Gargantext.Database.Admin.Config (nodeTypeId)
import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
import Gargantext.Database.Prelude (Cmd, runPGSQuery)
......@@ -58,12 +56,6 @@ ngramsGroup l _m _n = Text.intercalate " "
. Text.replace "-" " "
sortTficf :: Ordering
-> (Map Text (Double, Set Text))
-> [ (Text,(Double, Set Text))]
sortTficf Down = List.sortOn (DO.Down . fst . snd) . toList
sortTficf Up = List.sortOn (fst . snd) . toList
getTficf :: UserCorpusId
-> MasterCorpusId
......
src/Gargantext/Database/Action/Search.hs
View file @ 942f8bef
......@@ -115,30 +115,11 @@ searchInCorpusWithContacts cId aId q o l _order =
runOpaQuery $ limit' l
$ offset' o
$ orderBy ( desc _fp_score)
$ group cId aId
$ selectGroup cId aId
$ intercalate " | "
$ map stemIt q
-- TODO group by
selectContactViaDoc
:: CorpusId
-> AnnuaireId
-> Text
-> Select FacetPairedReadNull
selectContactViaDoc cId aId q = proc () -> do
(doc, (corpus_doc, (_contact_doc, (annuaire_contact, contact)))) <- queryContactViaDoc -< ()
restrict -< (doc^.ns_search) @@ (pgTSQuery $ unpack q )
restrict -< (doc^.ns_typename) .== (pgInt4 $ nodeTypeId NodeDocument)
restrict -< (corpus_doc^.nn_node1_id) .== (toNullable $ pgNodeId cId)
restrict -< (annuaire_contact^.nn_node1_id) .== (toNullable $ pgNodeId aId)
restrict -< (contact^.node_typename) .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
returnA -< FacetPaired (contact^.node_id)
(contact^.node_date)
(contact^.node_hyperdata)
(toNullable $ pgInt4 1)
selectContactViaDoc'
:: CorpusId
-> AnnuaireId
-> Text
......@@ -148,7 +129,7 @@ selectContactViaDoc'
, Column (Nullable PGJsonb)
, Column (Nullable PGInt4)
)
selectContactViaDoc' cId aId q = proc () -> do
selectContactViaDoc cId aId q = proc () -> do
(doc, (corpus_doc, (_contact_doc, (annuaire_contact, contact)))) <- queryContactViaDoc -< ()
restrict -< (doc^.ns_search) @@ (pgTSQuery $ unpack q )
restrict -< (doc^.ns_typename) .== (pgInt4 $ nodeTypeId NodeDocument)
......@@ -161,13 +142,13 @@ selectContactViaDoc' cId aId q = proc () -> do
, toNullable $ pgInt4 1
)
group :: NodeId
selectGroup :: NodeId
-> NodeId
-> Text
-> Select FacetPairedReadNull
group cId aId q = proc () -> do
selectGroup cId aId q = proc () -> do
(a, b, c, d) <- aggregate (p4 (groupBy, groupBy, groupBy, O.sum))
(selectContactViaDoc' cId aId q) -< ()
(selectContactViaDoc cId aId q) -< ()
returnA -< FacetPaired a b c d
......
src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs
View file @ 942f8bef
......@@ -29,8 +29,6 @@ import Gargantext.Prelude
import Gargantext.Database.Admin.Types.Hyperdata.Prelude
--------------------------------------------------------------------------------
data HyperdataContact =
HyperdataContact { _hc_bdd :: Maybe Text -- ID of Database source
, _hc_who :: Maybe ContactWho
......
src/Gargantext/Database/Admin/Types/Hyperdata/Default.hs
View file @ 942f8bef
......@@ -109,6 +109,3 @@ defaultHyperdata NodeDashboard = DefaultDashboard defaultHyperdataDashboard
defaultHyperdata NodeFrameWrite = DefaultFrameWrite defaultHyperdataFrame
defaultHyperdata NodeFrameCalc = DefaultFrameCalc defaultHyperdataFrame
src/Gargantext/Database/Admin/Types/Hyperdata/Document.hs
View file @ 942f8bef
......@@ -21,6 +21,7 @@ Portability : POSIX
module Gargantext.Database.Admin.Types.Hyperdata.Document where
import Gargantext.Prelude
import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
import Gargantext.Database.Admin.Types.Hyperdata.Prelude
......@@ -44,7 +45,8 @@ data HyperdataDocument = HyperdataDocument { _hd_bdd :: !(Maybe T
, _hd_publication_minute :: !(Maybe Int)
, _hd_publication_second :: !(Maybe Int)
, _hd_language_iso2 :: !(Maybe Text)
} deriving (Show, Generic)
}
deriving (Show, Generic)
defaultHyperdataDocument :: HyperdataDocument
......@@ -67,6 +69,7 @@ data StatusV3 = StatusV3 { statusV3_error :: !(Maybe Text)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "statusV3_") ''StatusV3)
------------------------------------------------------------------------
data HyperdataDocumentV3 = HyperdataDocumentV3 { _hdv3_publication_day :: !(Maybe Int)
, _hdv3_language_iso2 :: !(Maybe Text)
......@@ -132,9 +135,32 @@ instance Hyperdata HyperdataDocument
instance Hyperdata HyperdataDocumentV3
------------------------------------------------------------------------
$(makeLenses ''HyperdataDocument)
makePrisms ''HyperdataDocument
$(makeLenses ''HyperdataDocumentV3)
$(deriveJSON (unPrefix "_hd_") ''HyperdataDocument)
-- $(deriveJSON (unPrefix "_hd_") ''HyperdataDocument)
instance FromJSON HyperdataDocument
where
parseJSON = genericParseJSON
( defaultOptions { sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_hd_"
, omitNothingFields = True
}
)
instance ToJSON HyperdataDocument
where
toJSON = genericToJSON
( defaultOptions { sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_hd_"
, omitNothingFields = True
}
)
$(deriveJSON (unPrefix "_hdv3_") ''HyperdataDocumentV3)
instance ToSchema HyperdataDocument where
......
src/Gargantext/Database/Admin/Types/Node.hs
View file @ 942f8bef
......@@ -57,7 +57,7 @@ type MasterUserId = UserId
type Node json = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
-- | NodeSearch (queries)
type NodeSearch json = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
-- type NodeSearch json = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
------------------------------------------------------------------------
......
src/Gargantext/Database/Query/Facet.hs
View file @ 942f8bef
......@@ -75,23 +75,23 @@ import Gargantext.Database.Schema.Node
--instance FromJSON Facet
--instance ToJSON Facet
type Favorite = Int
type Category = Int
type Title = Text
-- TODO remove Title
type FacetDoc = Facet NodeId UTCTime Title HyperdataDocument (Maybe Favorite) (Maybe Double)
type FacetDoc = Facet NodeId UTCTime Title HyperdataDocument (Maybe Category) (Maybe Double)
-- type FacetSources = FacetDoc
-- type FacetAuthors = FacetDoc
-- type FacetTerms = FacetDoc
data Facet id created title hyperdata favorite ngramCount =
data Facet id created title hyperdata category ngramCount =
FacetDoc { facetDoc_id :: id
, facetDoc_created :: created
, facetDoc_title :: title
, facetDoc_hyperdata :: hyperdata
, facetDoc_favorite :: favorite
, facetDoc_ngramCount :: ngramCount
, facetDoc_category :: category
, facetDoc_score :: ngramCount
} deriving (Show, Generic)
{- | TODO after demo
data Facet id date hyperdata score =
......@@ -318,8 +318,8 @@ orderWith (Just DateDesc) = desc facetDoc_created
orderWith (Just TitleAsc) = asc facetDoc_title
orderWith (Just TitleDesc) = desc facetDoc_title
orderWith (Just ScoreAsc) = asc facetDoc_favorite
orderWith (Just ScoreDesc) = desc facetDoc_favorite
orderWith (Just ScoreAsc) = asc facetDoc_category
orderWith (Just ScoreDesc) = desc facetDoc_category
orderWith (Just SourceAsc) = asc facetDoc_source
orderWith (Just SourceDesc) = desc facetDoc_source
......
src/Gargantext/Database/Schema/Node.hs
View file @ 942f8bef
......@@ -156,16 +156,17 @@ $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
$(makeLenses ''NodePolySearch)
nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id = optional "id"
, _ns_typename = required "typename"
, _ns_userId = required "user_id"
, _ns_parentId = required "parent_id"
, _ns_name = required "name"
, _ns_date = optional "date"
, _ns_hyperdata = required "hyperdata"
, _ns_search = optional "search"
}
)
nodeTableSearch = Table "nodes" ( pNodeSearch
NodeSearch { _ns_id = optional "id"
, _ns_typename = required "typename"
, _ns_userId = required "user_id"
, _ns_parentId = required "parent_id"
, _ns_name = required "name"
, _ns_date = optional "date"
, _ns_hyperdata = required "hyperdata"
, _ns_search = optional "search"
}
)
------------------------------------------------------------------------
src/Gargantext/Prelude/Utils.hs
View file @ 942f8bef
......@@ -20,6 +20,7 @@ import Control.Monad.Reader (MonadReader)
import Control.Monad.Reader (ask)
import Data.Text (Text)
import GHC.IO (FilePath)
import Gargantext.Config
import Gargantext.API.Admin.Settings
import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
import Gargantext.Prelude
......@@ -41,6 +42,14 @@ data NodeToHash = NodeToHash { nodeType :: NodeType
type FolderPath = FilePath
type FileName = FilePath
-- | toPath example of use:
-- toPath 2 "gargantexthello"
-- ("ga/rg","antexthello")
--
-- toPath 3 "gargantexthello"
-- ("gar/gan","texthello")
toPath :: Int -> Text -> (FolderPath,FileName)
toPath n x = (Text.unpack $ Text.intercalate "/" [x1,x2], Text.unpack xs)
where
......@@ -57,7 +66,7 @@ class ReadFile a where
writeFile :: (MonadReader env m, MonadBase IO m, HasSettings env, SaveFile a)
=> a -> m FilePath
writeFile a = do
dataPath <- view (settings . fileFolder) <$> ask
dataPath <- view (settings . config . gc_datafilepath) <$> ask
(fp,fn) <- liftBase $ (toPath 3) . hash . show <$> newStdGen
let foldPath = dataPath <> "/" <> fp
......@@ -72,5 +81,5 @@ writeFile a = do
readFile :: (MonadReader env m, MonadBase IO m, HasSettings env, ReadFile a)
=> FilePath -> m a
readFile fp = do
dataPath <- view (settings . fileFolder) <$> ask
dataPath <- view (settings . config . gc_datafilepath) <$> ask
liftBase $ readFile' $ dataPath <> "/" <> fp
src/Gargantext/Text/List.hs
View file @ 942f8bef
......@@ -21,7 +21,8 @@ import Gargantext.API.Ngrams (NgramsElement, mkNgramsElement, RootParent(..), mS
-- import Gargantext.API.Ngrams.Tools (getCoocByNgrams', Diagonal(..))
import Gargantext.Core (Lang(..))
import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId, Ordering(..))
import Gargantext.Database.Action.Metrics.NgramsByNode (getTficf, sortTficf, ngramsGroup, getNodesByNgramsUser, groupNodesByNgramsWith)
import Gargantext.Database.Action.Metrics.NgramsByNode (getTficf, ngramsGroup, getNodesByNgramsUser, groupNodesByNgramsWith)
import Gargantext.Text.Metrics.TFICF (sortTficf)
import Gargantext.Database.Prelude (Cmd)
import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.Prelude
......@@ -199,7 +200,6 @@ toGargList stop l n = case stop n of
False -> (l, n)
isStopTerm :: StopSize -> Text -> Bool
isStopTerm (StopSize n) x = Text.length x < n || any isStopChar (Text.unpack x)
where
......
src/Gargantext/Text/Metrics/TFICF.hs
View file @ 942f8bef
......@@ -19,14 +19,20 @@ module Gargantext.Text.Metrics.TFICF ( TFICF
, Total(..)
, Count(..)
, tficf
, sortTficf
)
where
import Data.Text (Text)
import Gargantext.Prelude
import Data.Set (Set)
import Gargantext.Core.Types (Ordering(..))
import Data.Map.Strict (Map, toList)
import qualified Data.Ord as DO (Down(..))
import qualified Data.List as List
path :: Text
path = "Gargantext.Text.Metrics.TFICF"
path = "[G.T.Metrics.TFICF]"
type TFICF = Double
......@@ -42,8 +48,14 @@ tficf :: TficfContext Count Total
-> TFICF
tficf (TficfInfra (Count ic) (Total it) )
(TficfSupra (Count sc) (Total st) )
| it >= ic && st >= sc = (ic/it) / log (sc/st)
| it >= ic && st >= sc && it <= st = (ic/it) / log (sc/st)
| otherwise = panic $ "[ERR]" <> path <>" Frequency impossible"
tficf _ _ = panic $ "[ERR]" <> path <> "Undefined for these contexts"
sortTficf :: Ordering
-> (Map Text (Double, Set Text))
-> [ (Text,(Double, Set Text))]
sortTficf Down = List.sortOn (DO.Down . fst . snd) . toList
sortTficf Up = List.sortOn (fst . snd) . toList
src/Gargantext/Viz/Graph.hs
View file @ 942f8bef
......@@ -16,7 +16,6 @@ Portability : POSIX
module Gargantext.Viz.Graph
where
import Control.Lens (makeLenses)
import Data.ByteString.Lazy as DBL (readFile, writeFile)
import Data.Text (Text, pack)
......
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