Commit 8474b56f authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Ngrams Table] Front and Back implemented (but need next step for optimization...

[Ngrams Table] Front and Back implemented (but need next step for optimization and behavior of group controls (multichild issue)).
parent 0ee4f4f5
......@@ -308,7 +308,7 @@ ngrams2list = zip (repeat GraphList) . map (\(NgramsT ngt ng) -> (ngt, ng)) . DM
-- | TODO: weight of the list could be a probability
insertLists :: HasNodeError err => ListId -> [(ListType, (NgramsType, NgramsIndexed))] -> Cmd err Int
insertLists lId lngs = insertNodeNgrams [ NodeNgram lId (_ngramsId ng) (fromIntegral $ ngramsTypeId ngt) (fromIntegral $ listTypeId l) 1
insertLists lId lngs = insertNodeNgrams [ NodeNgram lId (_ngramsId ng) (ngramsTypeId ngt) (fromIntegral $ listTypeId l) 1
| (l,(ngt, ng)) <- lngs
]
------------------------------------------------------------------------
......@@ -114,10 +114,12 @@ instance FromField NgramsTypeId where
if (n :: Int) > 0 then return $ NgramsTypeId n
else mzero
pgNgramsType :: NgramsType -> Column PGInt4
pgNgramsType = pgNgramsTypeId . ngramsTypeId
pgNgramsTypeId :: NgramsTypeId -> Column PGInt4
pgNgramsTypeId (NgramsTypeId n) = pgInt4 n
ngramsTypeId :: NgramsType -> NgramsTypeId
ngramsTypeId Authors = 1
ngramsTypeId Institutes = 2
......
......@@ -127,7 +127,7 @@ updateNodeNgrams' :: [(ListId, NgramsTypeId, NgramsText, ListTypeId)] -> Cmd err
updateNodeNgrams' [] = pure ()
updateNodeNgrams' input = void $ execPGSQuery updateQuery (PGS.Only $ Values fields input)
where
fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","text","int4"]
fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","text","int4"]
updateNodeNgrams'' :: [(ListId, NgramsTypeId, NgramsText, ListTypeId)] -> Cmd err ByteString
updateNodeNgrams'' input = formatPGSQuery updateQuery (PGS.Only $ Values fields input)
......
......@@ -104,7 +104,7 @@ queryInCorpusWithContacts cId q _ _ _ = proc () -> do
restrict -< (_ns_search docs) @@ (pgTSQuery $ unpack q )
restrict -< (_ns_typename docs) .== (pgInt4 $ nodeTypeId NodeDocument)
restrict -< (nodeNode_node1_id corpusDoc) .== (toNullable $ pgNodeId cId)
restrict -< (_nn_listType docNgrams) .== (toNullable $ pgInt4 $ ngramsTypeId Authors)
restrict -< (_nn_listType docNgrams) .== (toNullable $ pgNgramsType Authors)
restrict -< (_node_typename contacts) .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
-- let contact_id = ifThenElse (isNull $ _node_id contacts) (toNullable $ pgInt4 0) (_node_id contacts)
returnA -< FacetPaired (_ns_id docs) (_ns_date docs) (_ns_hyperdata docs) (pgInt4 0) (Pair (_node_id contacts) (ngrams_terms ngrams'))
......
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