Commit 7408a02c authored by Alexandre Delanoë's avatar Alexandre Delanoë

[NGRAMS][LIST] getOrMk List.

parent cadd8650
Pipeline #52 failed with stage
...@@ -57,6 +57,7 @@ import GHC.Generics (Generic) ...@@ -57,6 +57,7 @@ import GHC.Generics (Generic)
--import Gargantext.Core.Types.Main (Tree(..)) --import Gargantext.Core.Types.Main (Tree(..))
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Database.Types.Node (NodeType(..)) import Gargantext.Database.Types.Node (NodeType(..))
import Gargantext.Database.Schema.Node (defaultList)
import qualified Gargantext.Database.Schema.Ngrams as Ngrams import qualified Gargantext.Database.Schema.Ngrams as Ngrams
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core.Types (ListType(..), ListId, CorpusId) import Gargantext.Core.Types (ListType(..), ListId, CorpusId)
...@@ -295,7 +296,7 @@ getTableNgrams c cId maybeTabType maybeListId = do ...@@ -295,7 +296,7 @@ getTableNgrams c cId maybeTabType maybeListId = do
_ -> panic $ lieu <> "No Ngrams for this tab" _ -> panic $ lieu <> "No Ngrams for this tab"
listId <- case maybeListId of listId <- case maybeListId of
Nothing -> Ngrams.defaultList c cId Nothing -> defaultList c cId
Just lId -> pure lId Just lId -> pure lId
(ngramsTableDatas, mapToParent, mapToChildren) <- (ngramsTableDatas, mapToParent, mapToChildren) <-
......
...@@ -16,37 +16,37 @@ Portability : POSIX ...@@ -16,37 +16,37 @@ Portability : POSIX
module Gargantext.Database.Flow -- (flowDatabase, ngrams2list) module Gargantext.Database.Flow -- (flowDatabase, ngrams2list)
where where
import GHC.Show (Show)
--import Control.Lens (view) --import Control.Lens (view)
import System.FilePath (FilePath) --import Gargantext.Core.Types
--import Gargantext.Database.Node.Contact (HyperdataContact(..))
import Data.Map (Map, lookup)
import Data.Maybe (Maybe(..), catMaybes) import Data.Maybe (Maybe(..), catMaybes)
import Data.Text (Text, splitOn) import Data.Text (Text, splitOn)
import Data.Map (Map, lookup)
import Data.Tuple.Extra (both, second) import Data.Tuple.Extra (both, second)
import qualified Data.Map as DM import GHC.Show (Show)
import Gargantext.Core.Types (NodePoly(..), ListType(..), listTypeId) import Gargantext.Core.Types (NodePoly(..), ListType(..), listTypeId)
import Gargantext.Core.Types.Individu (Username)
import Gargantext.Core.Types.Main
import Gargantext.Database.Bashql (runCmd') -- , del) import Gargantext.Database.Bashql (runCmd') -- , del)
import Gargantext.Database.Config (userMaster, userArbitrary, corpusMasterName) import Gargantext.Database.Config (userMaster, userArbitrary, corpusMasterName)
import Gargantext.Database.Schema.Ngrams (insertNgrams, Ngrams(..), NgramsT(..), NgramsIndexed(..), indexNgramsT, NgramsType(..), text2ngrams) import Gargantext.Database.Flow.Utils (insertToNodeNgrams)
import Gargantext.Database.Schema.Node (mkRoot, mkCorpus, mkList, mkGraph, mkDashboard, mkAnnuaire, getCorporaWithParentId')
import Gargantext.Database.Root (getRootCmd)
import Gargantext.Database.Types.Node (NodeType(..), NodeId)
import Gargantext.Database.Node.Document.Add (add) import Gargantext.Database.Node.Document.Add (add)
import Gargantext.Database.Node.Document.Insert (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..)) import Gargantext.Database.Node.Document.Insert (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
import Gargantext.Database.Root (getRootCmd)
import Gargantext.Database.Schema.Ngrams (insertNgrams, Ngrams(..), NgramsT(..), NgramsIndexed(..), indexNgramsT, NgramsType(..), text2ngrams)
import Gargantext.Database.Schema.Node (mkRoot, mkCorpus, getOrMkList, mkGraph, mkDashboard, mkAnnuaire, getCorporaWithParentId')
import Gargantext.Database.Schema.NodeNgram (NodeNgramPoly(..), insertNodeNgrams) import Gargantext.Database.Schema.NodeNgram (NodeNgramPoly(..), insertNodeNgrams)
import Gargantext.Database.Schema.NodeNgramsNgrams (NodeNgramsNgramsPoly(..), insertNodeNgramsNgramsNew) import Gargantext.Database.Schema.NodeNgramsNgrams (NodeNgramsNgramsPoly(..), insertNodeNgramsNgramsNew)
import Gargantext.Database.Schema.User (getUser, UserLight(..))
import Gargantext.Database.Types.Node (HyperdataDocument(..)) import Gargantext.Database.Types.Node (HyperdataDocument(..))
import Gargantext.Database.Types.Node (NodeType(..), NodeId)
import Gargantext.Database.Utils (Cmd(..)) import Gargantext.Database.Utils (Cmd(..))
--import Gargantext.Database.Node.Contact (HyperdataContact(..))
import Gargantext.Database.Schema.User (getUser, UserLight(..))
import Gargantext.Core.Types.Individu (Username)
import Gargantext.Ext.IMT (toSchoolName) import Gargantext.Ext.IMT (toSchoolName)
import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile) import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Text.Parsers (parseDocs, FileFormat) import Gargantext.Text.Parsers (parseDocs, FileFormat)
import Gargantext.Core.Types.Main import System.FilePath (FilePath)
--import Gargantext.Core.Types import qualified Data.Map as DM
import Gargantext.Database.Flow.Utils (insertToNodeNgrams)
flowCorpus :: FileFormat -> FilePath -> CorpusName -> IO CorpusId flowCorpus :: FileFormat -> FilePath -> CorpusName -> IO CorpusId
flowCorpus ff fp cName = do flowCorpus ff fp cName = do
...@@ -264,7 +264,7 @@ indexNgrams ng2nId = do ...@@ -264,7 +264,7 @@ indexNgrams ng2nId = do
flowList :: UserId -> CorpusId -> Map (NgramsT NgramsIndexed) (Map NodeId Int) -> Cmd ListId flowList :: UserId -> CorpusId -> Map (NgramsT NgramsIndexed) (Map NodeId Int) -> Cmd ListId
flowList uId cId ngs = do flowList uId cId ngs = do
-- printDebug "ngs:" ngs -- printDebug "ngs:" ngs
lId <- maybe (panic "mkList error") identity <$> head <$> mkList cId uId lId <- getOrMkList cId uId
--printDebug "ngs" (DM.keys ngs) --printDebug "ngs" (DM.keys ngs)
-- TODO add stemming equivalence of 2 ngrams -- TODO add stemming equivalence of 2 ngrams
let groupEd = groupNgramsBy (\(NgramsT t1 n1) (NgramsT t2 n2) -> if (((==) t1 t2) && ((==) n1 n2)) then (Just (n1,n2)) else Nothing) ngs let groupEd = groupNgramsBy (\(NgramsT t1 n1) (NgramsT t2 n2) -> if (((==) t1 t2) && ((==) n1 n2)) then (Just (n1,n2)) else Nothing) ngs
...@@ -279,8 +279,8 @@ flowList uId cId ngs = do ...@@ -279,8 +279,8 @@ flowList uId cId ngs = do
pure lId pure lId
flowListUser :: UserId -> CorpusId -> Cmd [Int] flowListUser :: UserId -> CorpusId -> Cmd Int
flowListUser uId cId = mkList cId uId flowListUser uId cId = getOrMkList cId uId
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
...@@ -24,7 +24,7 @@ Ngrams connection to the Database. ...@@ -24,7 +24,7 @@ Ngrams connection to the Database.
module Gargantext.Database.Schema.Ngrams where module Gargantext.Database.Schema.Ngrams where
import Control.Lens (makeLenses, view) import Control.Lens (makeLenses, view, _Just, traverse)
import Data.ByteString.Internal (ByteString) import Data.ByteString.Internal (ByteString)
import Data.Map (Map, fromList, lookup, fromListWith) import Data.Map (Map, fromList, lookup, fromListWith)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
...@@ -193,12 +193,6 @@ queryInsertNgrams = [sql| ...@@ -193,12 +193,6 @@ queryInsertNgrams = [sql|
JOIN ngrams c USING (terms); -- columns of unique index JOIN ngrams c USING (terms); -- columns of unique index
|] |]
defaultList :: DPS.Connection -> CorpusId -> IO ListId
defaultList c cId = view node_id <$> maybe (panic errMessage) identity
<$> head
<$> getListsWithParentId c cId
where
errMessage = "Gargantext.API.Ngrams.defaultList: no list found"
-- | Ngrams Table -- | Ngrams Table
-- TODO: the way we are getting main Master Corpus and List ID is not clean -- TODO: the way we are getting main Master Corpus and List ID is not clean
......
...@@ -564,13 +564,11 @@ childWith uId pId (Node' NodeContact txt v []) = node2table uId (Just pId) (Nod ...@@ -564,13 +564,11 @@ childWith uId pId (Node' NodeContact txt v []) = node2table uId (Just pId) (Nod
childWith _ _ (Node' _ _ _ _) = panic "This NodeType can not be a child" childWith _ _ (Node' _ _ _ _) = panic "This NodeType can not be a child"
-- TODO: remove hardcoded userId (with Reader)
-- TODO: user Reader in the API and adapt this function
userId :: Int
userId = 1
mk :: Connection -> NodeType -> Maybe ParentId -> Text -> IO [Int] mk :: Connection -> NodeType -> Maybe ParentId -> Text -> IO [Int]
mk c nt pId name = mk' c nt userId pId name mk c nt pId name = mk' c nt userId pId name
where
userId = 1
mk' :: Connection -> NodeType -> UserId -> Maybe ParentId -> Text -> IO [Int] mk' :: Connection -> NodeType -> UserId -> Maybe ParentId -> Text -> IO [Int]
mk' c nt uId pId name = map fromIntegral <$> insertNodesWithParentR pId [node nt name hd pId uId] c mk' c nt uId pId name = map fromIntegral <$> insertNodesWithParentR pId [node nt name hd pId uId] c
...@@ -594,6 +592,34 @@ mkRoot uname uId = case uId > 0 of ...@@ -594,6 +592,34 @@ mkRoot uname uId = case uId > 0 of
mkCorpus :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> Cmd [Int] mkCorpus :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> Cmd [Int]
mkCorpus n h p u = insertNodesR' [nodeCorpusW n h p u] mkCorpus n h p u = insertNodesR' [nodeCorpusW n h p u]
--{-
getOrMkList :: ParentId -> UserId -> Cmd Int
getOrMkList pId uId = do
maybeList <- defaultListSafe' pId
case maybeList of
Nothing -> maybe (panic "no list") identity <$> headMay <$> mkList pId uId
Just x -> pure x
defaultListSafe' :: CorpusId -> Cmd (Maybe ListId)
defaultListSafe' cId = mkCmd $ \c -> do
maybeNode <- headMay <$> getListsWithParentId c cId
case maybeNode of
Nothing -> pure Nothing
(Just node) -> pure $ Just $ _node_id node
--}
defaultListSafe :: Connection -> CorpusId -> IO (Maybe ListId)
defaultListSafe c cId = do
maybeNode <- headMay <$> getListsWithParentId c cId
case maybeNode of
Nothing -> pure Nothing
(Just node) -> pure $ Just $ _node_id node
defaultList :: Connection -> CorpusId -> IO ListId
defaultList c cId = maybe (panic errMessage) identity <$> defaultListSafe c cId
where
errMessage = "Gargantext.API.Ngrams.defaultList: no list found"
mkList :: ParentId -> UserId -> Cmd [Int] mkList :: ParentId -> UserId -> Cmd [Int]
mkList p u = insertNodesR' [nodeListW Nothing Nothing p u] mkList p u = insertNodesR' [nodeListW Nothing Nothing p u]
......
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