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

[FIX] temp fix on the textflow (needs refactoring)

parent 8d8471b1
......@@ -47,7 +47,7 @@ tficf :: TficfContext Count Total
-> TFICF
tficf (TficfInfra (Count ic) (Total it) )
(TficfSupra (Count sc) (Total st) )
| it >= ic && st >= sc {-&& it <= st-} = (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"
......
......@@ -206,8 +206,8 @@ flowCorpusUser l user corpusName ctype ids = do
-- TODO: check if present already, ignore
_ <- Doc.add userCorpusId ids
-- tId <- insertDefaultNode NodeTexts userCorpusId userId
-- printDebug "Node Text Id" tId
tId <- insertDefaultNode NodeTexts userCorpusId userId
printDebug "Node Text Ids:" tId
-- User List Flow
(masterUserId, _masterRootId, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left "") ctype
......@@ -238,6 +238,7 @@ insertDocs hs uId cId = do
printDebug "docs" (length docs)
ids <- insertDb uId cId docs
printDebug "ids" (length ids)
-- printDebug "inserted" (map reUniqId ids)
let
ids' = map reId ids
documentsWithId = mergeData (toInserted ids) (Map.fromList $ map viewUniqId' docs)
......@@ -256,7 +257,7 @@ insertMasterDocs :: ( FlowCmdM env err m
insertMasterDocs c lang hs = do
(masterUserId, _, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left corpusMasterName) c
(ids', documentsWithId) <- insertDocs hs masterUserId masterCorpusId
_ <- Doc.add masterCorpusId ids'
-- TODO
-- create a corpus with database name (CSV or PubMed)
-- add documents to the corpus (create node_node link)
......@@ -303,7 +304,7 @@ viewUniqId' d = maybe err (\h -> (h,d)) (view uniqId d)
toInserted :: [ReturnId]
-> Map HashId ReturnId
toInserted =
Map.fromList . map (\r -> (reUniqId r, r) )
Map.fromList . map (\r -> (reUniqId r, r) )
. filter (\r -> reInserted r == True)
mergeData :: Map HashId ReturnId
......
......@@ -78,10 +78,6 @@ flowList_Tficf' u m nt f = do
-}
-- | TODO check optimization
mapNodeIdNgrams :: [DocumentIdWithNgrams a]
-> Map Ngrams (Map NgramsType (Map NodeId Int))
......
......@@ -57,12 +57,14 @@ module Gargantext.Database.Query.Table.Node.Document.Insert
import Control.Lens (set, view)
import Control.Lens.Cons
import Control.Lens.Prism
import Data.Aeson (toJSON)
import Data.Aeson (toJSON{-, ToJSON-})
import Data.Maybe (maybe)
import Data.Text (Text)
-- import Data.ByteString (ByteString)
import Data.Time.Segment (jour)
import Database.PostgreSQL.Simple (FromRow, Query, Only(..))
import Database.PostgreSQL.Simple.FromRow (fromRow, field)
-- import Database.PostgreSQL.Simple.ToRow (toRow, ToRow)
import Database.PostgreSQL.Simple.SqlQQ
import Database.PostgreSQL.Simple.ToField (toField, Action)
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
......@@ -70,7 +72,7 @@ import GHC.Generics (Generic)
import Gargantext.Database.Admin.Config (nodeTypeId)
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd, runPGSQuery)
import Gargantext.Database.Prelude (Cmd, runPGSQuery{-, formatPGSQuery-})
import Gargantext.Prelude
import Gargantext.Prelude.Crypto.Hash (hash)
import qualified Data.Text as DT (pack, concat, take)
......@@ -126,7 +128,7 @@ instance InsertDb HyperdataContact
, toField u
, toField p
, toField $ maybe "Contact" (DT.take 255) (Just "Name") -- (_hc_name h)
, toField $ jour 2010 1 1 -- TODO put default date
, toField $ jour 0 1 1 -- TODO put default date
, (toField . toJSON) h
]
......@@ -134,14 +136,14 @@ instance InsertDb HyperdataContact
--
-- to print rendered query (Debug purpose) use @formatQuery@ function.
{-
insertDocuments_Debug :: (Hyperdata a, ToJSON a, ToRow a) => UserId -> ParentId -> [a] -> Cmd ByteString
insertDocuments_Debug :: (Hyperdata a, ToJSON a, ToRow a, InsertDb [a])
=> UserId -> ParentId -> [a] -> Cmd err ByteString
insertDocuments_Debug uId pId hs = formatPGSQuery queryInsert (Only $ Values fields inputData)
where
fields = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
inputData = prepare uId pId hs
inputData = insertDb' uId pId hs
-}
-- | Input Tables: types of the tables
inputSqlTypes :: [Text]
inputSqlTypes = map DT.pack ["int4","int4","int4","text","date","jsonb"]
......@@ -153,27 +155,25 @@ queryInsert = [sql|
, ins AS (
INSERT INTO nodes (typename,user_id,parent_id,name,date,hyperdata)
SELECT * FROM input_rows
ON CONFLICT ((hyperdata ->> 'uniqIdBdd')) DO UPDATE SET user_id=EXCLUDED.user_id -- on unique index
-- ON CONFLICT ((hyperdata ->> 'uniqIdBdd')) DO NOTHING -- on unique index -- this does not return the ids
-- ON CONFLICT (typename, parent_id, (hyperdata ->> 'uniqId')) DO NOTHING -- on unique index
ON CONFLICT ((hyperdata ->> 'uniqIdBdd')) DO UPDATE SET user_id=EXCLUDED.user_id -- on unique index
RETURNING id,hyperdata
)
SELECT true AS source -- true for 'newly inserted'
, id
, hyperdata ->> 'uniqId' as doi
, hyperdata ->> 'uniqIdBdd' as doi
FROM ins
UNION ALL
SELECT false AS source -- false for 'not inserted'
, c.id
, hyperdata ->> 'uniqId' as doi
, hyperdata ->> 'uniqIdBdd' as doi
FROM input_rows
JOIN nodes c USING (hyperdata); -- columns of unique index
|]
------------------------------------------------------------------------
-- * Main Types used
-- ** Return Types
-- | When documents are inserted
......@@ -229,12 +229,10 @@ addUniqIdsContact hc = set (hc_uniqIdBdd) (Just shaBdd)
-- | TODO add more shaparameters
shaParametersContact :: [(HyperdataContact -> Text)]
shaParametersContact = [ \d -> maybeText $ view (hc_who . _Just . cw_firstName) d
, \d -> maybeText $ view (hc_who . _Just . cw_lastName ) d
, \d -> maybeText $ view (hc_where . _head . cw_touch . _Just . ct_mail) d
]
shaParametersContact = [ \d -> maybeText $ view (hc_who . _Just . cw_firstName ) d
, \d -> maybeText $ view (hc_who . _Just . cw_lastName ) d
, \d -> maybeText $ view (hc_where . _head . cw_touch . _Just . ct_mail) d
]
maybeText :: Maybe Text -> Text
maybeText = maybe (DT.pack "") identity
......
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