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
Expand all 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
This diff is collapsed.
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