Skip to content

haskell-gargantext
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
Pipeline #1008 failed with stage
    Expand all Show 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/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,7 +156,8 @@ $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
    $(makeLenses ''NodePolySearch)
    nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
    nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id = optional "id"
    nodeTableSearch = Table "nodes" ( pNodeSearch
    NodeSearch { _ns_id = optional "id"
    , _ns_typename = required "typename"
    , _ns_userId = required "user_id"
    ......
    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