Commit 20d568ee authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] masterListId bug, make it simple finally.

parent c2bfe19e
...@@ -44,7 +44,7 @@ import qualified Data.Set as Set ...@@ -44,7 +44,7 @@ import qualified Data.Set as Set
--import Data.Maybe (catMaybes) --import Data.Maybe (catMaybes)
--import qualified Data.Map.Strict as DM --import qualified Data.Map.Strict as DM
--import qualified Data.Set as Set --import qualified Data.Set as Set
import Control.Lens (view, (.~)) import Control.Lens ((.~))
import Data.Aeson import Data.Aeson
import Data.Aeson.TH (deriveJSON) import Data.Aeson.TH (deriveJSON)
import Data.Either(Either(Left)) import Data.Either(Either(Left))
...@@ -54,14 +54,12 @@ import Data.Swagger ...@@ -54,14 +54,12 @@ import Data.Swagger
import Data.Text (Text) import Data.Text (Text)
import Database.PostgreSQL.Simple (Connection) import Database.PostgreSQL.Simple (Connection)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.Core.Types (node_id)
--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.Node (getListsWithParentId)
import qualified Gargantext.Database.Ngrams as Ngrams import qualified Gargantext.Database.Ngrams as Ngrams
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core.Types (ListType(..), ListId) import Gargantext.Core.Types (ListType(..), ListId, CorpusId)
import Prelude (Enum, Bounded, minBound, maxBound) import Prelude (Enum, Bounded, minBound, maxBound)
import Servant hiding (Patch) import Servant hiding (Patch)
import Test.QuickCheck (elements) import Test.QuickCheck (elements)
...@@ -236,7 +234,6 @@ ngramsIdPatch = fromList $ catMaybes $ reverse [ replace (1::NgramsId) (Just $ n ...@@ -236,7 +234,6 @@ ngramsIdPatch = fromList $ catMaybes $ reverse [ replace (1::NgramsId) (Just $ n
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
type CorpusId = Int
type TableNgramsApiGet = Summary " Table Ngrams API Get" type TableNgramsApiGet = Summary " Table Ngrams API Get"
:> QueryParam "ngramsType" TabType :> QueryParam "ngramsType" TabType
...@@ -252,13 +249,6 @@ type NgramsIdPatchsFeed = NgramsIdPatchs ...@@ -252,13 +249,6 @@ type NgramsIdPatchsFeed = NgramsIdPatchs
type NgramsIdPatchsBack = NgramsIdPatchs type NgramsIdPatchsBack = NgramsIdPatchs
defaultList :: Connection -> CorpusId -> IO ListId
defaultList c cId = view node_id <$> maybe (panic noListFound) identity
<$> head
<$> getListsWithParentId c cId
where
noListFound = "Gargantext.API.Ngrams.defaultList: no list found"
{- {-
toLists :: ListId -> NgramsIdPatchs -> [(ListId, NgramsId, ListTypeId)] toLists :: ListId -> NgramsIdPatchs -> [(ListId, NgramsId, ListTypeId)]
-- toLists = undefined -- toLists = undefined
...@@ -305,7 +295,7 @@ getTableNgrams c cId maybeTabType maybeListId = do ...@@ -305,7 +295,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 -> defaultList c cId Nothing -> Ngrams.defaultList c cId
Just lId -> pure lId Just lId -> pure lId
(ngramsTableDatas, mapToParent, mapToChildren) <- (ngramsTableDatas, mapToParent, mapToChildren) <-
......
...@@ -53,7 +53,7 @@ import Gargantext.Prelude ...@@ -53,7 +53,7 @@ import Gargantext.Prelude
import Gargantext.Database.Types.Node import Gargantext.Database.Types.Node
import Gargantext.Database.Node ( runCmd import Gargantext.Database.Node ( runCmd
, getNodesWithParentId , getNodesWithParentId
, getNode, getNodesWith, CorpusId , getNode, getNodesWith
, deleteNode, deleteNodes, mk, JSONB) , deleteNode, deleteNodes, mk, JSONB)
import qualified Gargantext.Database.Node.Update as U (update, Update(..)) import qualified Gargantext.Database.Node.Update as U (update, Update(..))
import Gargantext.Database.Facet (FacetDoc , runViewDocuments', OrderBy(..) import Gargantext.Database.Facet (FacetDoc , runViewDocuments', OrderBy(..)
...@@ -65,7 +65,7 @@ import Gargantext.Database.NodeNode (nodesToFavorite, nodesToTrash) ...@@ -65,7 +65,7 @@ import Gargantext.Database.NodeNode (nodesToFavorite, nodesToTrash)
import Gargantext.Viz.Graph (Graph,readGraphFromJson,defaultGraph) import Gargantext.Viz.Graph (Graph,readGraphFromJson,defaultGraph)
-- import Gargantext.Core (Lang(..)) -- import Gargantext.Core (Lang(..))
import Gargantext.Core.Types (Offset, Limit) import Gargantext.Core.Types (Offset, Limit)
import Gargantext.Core.Types.Main (Tree, NodeTree, ListId) import Gargantext.Core.Types.Main (Tree, NodeTree, ListId, CorpusId)
-- import Gargantext.Text.Terms (TermType(..)) -- import Gargantext.Text.Terms (TermType(..))
import Test.QuickCheck (elements) import Test.QuickCheck (elements)
......
...@@ -81,6 +81,8 @@ corpusTree nId t = TreeN (NodeTree ("Corpus " <> t) NodeCorpus nId) ( [ leafT ...@@ -81,6 +81,8 @@ corpusTree nId t = TreeN (NodeTree ("Corpus " <> t) NodeCorpus nId) ( [ leafT
--data Classification = Favorites | MyClassifcation --data Classification = Favorites | MyClassifcation
type CorpusId = Int
type ListId = Int type ListId = Int
-- TODO multiple ListType declaration, remove it -- TODO multiple ListType declaration, remove it
......
...@@ -23,28 +23,27 @@ Ngrams connection to the Database. ...@@ -23,28 +23,27 @@ Ngrams connection to the Database.
module Gargantext.Database.Ngrams where module Gargantext.Database.Ngrams where
import Prelude (Enum, Bounded, minBound, maxBound)
import Control.Lens (makeLenses, view) import Control.Lens (makeLenses, view)
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.Set (Set) import Data.Set (Set)
import Data.Tuple.Extra (both)
import qualified Data.Set as DS
import Data.Text (Text, splitOn) import Data.Text (Text, splitOn)
import Database.PostgreSQL.Simple.FromRow (fromRow, field) import Database.PostgreSQL.Simple.FromRow (fromRow, field)
import Database.PostgreSQL.Simple.SqlQQ (sql) import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.ToField (toField) import Database.PostgreSQL.Simple.ToField (toField)
import Database.PostgreSQL.Simple.ToRow (toRow) import Database.PostgreSQL.Simple.ToRow (toRow)
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Debug.Trace (trace)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.Core.Types -- (fromListTypeId, ListType, NodePoly(Node)) import Gargantext.Core.Types -- (fromListTypeId, ListType, NodePoly(Node))
import Gargantext.Database.Config (nodeTypeId,userMaster) import Gargantext.Database.Config (nodeTypeId,userMaster)
import Gargantext.Database.Types.Node (NodeType) import Gargantext.Database.Node (mkCmd, Cmd(..),getListsWithParentId, getCorporaWithParentId)
import Gargantext.Database.Node (mkCmd, Cmd(..))
import Gargantext.Database.Root (getRoot) import Gargantext.Database.Root (getRoot)
import Gargantext.Database.Tree (dbTree, toNodeTree) import Gargantext.Core.Types (CorpusId)
import Gargantext.Core.Types.Main (NodeTree(..)) import Gargantext.Database.Types.Node (NodeType)
import Gargantext.Prelude import Gargantext.Prelude
import Prelude (Enum, Bounded, minBound, maxBound)
import qualified Data.Set as DS
import qualified Database.PostgreSQL.Simple as DPS import qualified Database.PostgreSQL.Simple as DPS
--data NgramPoly id terms n = NgramDb { ngram_id :: id --data NgramPoly id terms n = NgramDb { ngram_id :: id
...@@ -181,7 +180,12 @@ queryInsertNgrams = [sql| ...@@ -181,7 +180,12 @@ 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
...@@ -192,15 +196,19 @@ getNgramsTableDb :: DPS.Connection ...@@ -192,15 +196,19 @@ getNgramsTableDb :: DPS.Connection
-> NgramsTableParamUser -> NgramsTableParamUser
-> IO ([NgramsTableData], MapToParent, MapToChildren) -> IO ([NgramsTableData], MapToParent, MapToChildren)
getNgramsTableDb c nt ngrt ntp@(NgramsTableParam listIdUser _) = do getNgramsTableDb c nt ngrt ntp@(NgramsTableParam listIdUser _) = do
let lieu = "Garg.Db.Ngrams.getTableNgrams: "
maybeRoot <- head <$> getRoot userMaster c maybeRoot <- head <$> getRoot userMaster c
let masterRootId = maybe (panic $ lieu <> "no userMaster Tree") (view node_id) maybeRoot let path = "Garg.Db.Ngrams.getTableNgrams: "
tree <- map toNodeTree <$> dbTree c masterRootId let masterRootId = maybe (panic $ path <> "no userMaster Tree") (view node_id) maybeRoot
let maybeCorpus = head $ filter (\n -> _nt_type n == NodeCorpus) tree -- let errMess = panic "Error"
let maybeList = head $ filter (\n -> _nt_type n == NodeList) tree
let maybeIds = fmap (both _nt_id) $ (,) <$> maybeCorpus <*> maybeList corpusMasterId <- maybe (panic "error corpus master") (view node_id) <$> head <$> getCorporaWithParentId c masterRootId
let (corpusMasterId, listMasterId) = maybe (panic $ lieu <> "no CorpusId or ListId") identity maybeIds
listMasterId <- maybe (panic "error liste master") (view node_id) <$> head <$> getListsWithParentId c corpusMasterId
ngramsTableData <- getNgramsTableData c nt ngrt ntp (NgramsTableParam listMasterId corpusMasterId) ngramsTableData <- getNgramsTableData c nt ngrt ntp (NgramsTableParam listMasterId corpusMasterId)
(mapToParent,mapToChildren) <- getNgramsGroup c listIdUser listMasterId (mapToParent,mapToChildren) <- getNgramsGroup c listIdUser listMasterId
pure (ngramsTableData, mapToParent,mapToChildren) pure (ngramsTableData, mapToParent,mapToChildren)
...@@ -224,11 +232,14 @@ getNgramsTableData :: DPS.Connection ...@@ -224,11 +232,14 @@ getNgramsTableData :: DPS.Connection
-> NgramsTableParamUser -> NgramsTableParamMaster -> NgramsTableParamUser -> NgramsTableParamMaster
-> IO [NgramsTableData] -> IO [NgramsTableData]
getNgramsTableData conn nodeT ngrmT (NgramsTableParam ul uc) (NgramsTableParam ml mc) = getNgramsTableData conn nodeT ngrmT (NgramsTableParam ul uc) (NgramsTableParam ml mc) =
map (\(t,n,nt,w) -> NgramsTableData t n (fromListTypeId nt) w) trace ("Ngrams table params" <> show params) <$>
<$> DPS.query conn querySelectTableNgrams (ul,uc,nodeTId,ngrmTId,ml,mc,nodeTId,ngrmTId,uc) map (\(t,n,nt,w) -> NgramsTableData t n (fromListTypeId nt) w) <$>
where DPS.query conn querySelectTableNgrams params
nodeTId = nodeTypeId nodeT where
ngrmTId = ngramsTypeId ngrmT nodeTId = nodeTypeId nodeT
ngrmTId = ngramsTypeId ngrmT
params = (ul,uc,nodeTId,ngrmTId,ml,mc,nodeTId,ngrmTId,uc)
querySelectTableNgrams :: DPS.Query querySelectTableNgrams :: DPS.Query
......
...@@ -18,7 +18,7 @@ Portability : POSIX ...@@ -18,7 +18,7 @@ Portability : POSIX
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
...@@ -84,7 +84,6 @@ mkCmd :: (Connection -> IO a) -> Cmd a ...@@ -84,7 +84,6 @@ mkCmd :: (Connection -> IO a) -> Cmd a
mkCmd = Cmd . ReaderT mkCmd = Cmd . ReaderT
------------------------------------------------------------------------ ------------------------------------------------------------------------
type CorpusId = Int
type AnnuaireId = Int type AnnuaireId = Int
type DocId = Int type DocId = Int
...@@ -276,6 +275,9 @@ getDocumentsWithParentId conn n = runQuery conn $ selectNodesWith' n (Just NodeD ...@@ -276,6 +275,9 @@ getDocumentsWithParentId conn n = runQuery conn $ selectNodesWith' n (Just NodeD
getListsWithParentId :: Connection -> Int -> IO [Node HyperdataList] getListsWithParentId :: Connection -> Int -> IO [Node HyperdataList]
getListsWithParentId conn n = runQuery conn $ selectNodesWith' n (Just NodeList) getListsWithParentId conn n = runQuery conn $ selectNodesWith' n (Just NodeList)
getCorporaWithParentId :: Connection -> Int -> IO [Node HyperdataCorpus]
getCorporaWithParentId conn n = runQuery conn $ selectNodesWith' n (Just NodeCorpus)
------------------------------------------------------------------------ ------------------------------------------------------------------------
selectNodesWithParentID :: Int -> Query NodeRead selectNodesWithParentID :: Int -> Query NodeRead
selectNodesWithParentID n = proc () -> do selectNodesWithParentID n = proc () -> do
......
...@@ -30,7 +30,8 @@ import Database.PostgreSQL.Simple.SqlQQ (sql) ...@@ -30,7 +30,8 @@ import Database.PostgreSQL.Simple.SqlQQ (sql)
import Control.Lens.TH (makeLensesWith, abbreviatedFields) import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import Data.Maybe (Maybe) import Data.Maybe (Maybe)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Gargantext.Database.Node (Cmd(..), mkCmd, CorpusId, DocId) import Gargantext.Database.Node (Cmd(..), mkCmd, DocId)
import Gargantext.Core.Types (CorpusId)
import Gargantext.Prelude import Gargantext.Prelude
import Opaleye import Opaleye
......
...@@ -42,6 +42,7 @@ import Gargantext.Text.Metrics.Count (cooc) ...@@ -42,6 +42,7 @@ import Gargantext.Text.Metrics.Count (cooc)
import Gargantext.Text.Metrics (filterCooc, FilterConfig(..), Clusters(..), SampleBins(..), DefaultValue(..), MapListSize(..), InclusionSize(..)) import Gargantext.Text.Metrics (filterCooc, FilterConfig(..), Clusters(..), SampleBins(..), DefaultValue(..), MapListSize(..), InclusionSize(..))
import Gargantext.Text.Terms (TermType, extractTerms) import Gargantext.Text.Terms (TermType, extractTerms)
import Gargantext.Text.Context (splitBy, SplitContext(Sentences)) import Gargantext.Text.Context (splitBy, SplitContext(Sentences))
import Gargantext.Core.Types (CorpusId)
import Gargantext.Text.Parsers.CSV import Gargantext.Text.Parsers.CSV
......
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