[FACET DOC QUERY] needs Full Text filter and Sum ngrams count but type is ok for API integration.

src/Gargantext/Database/Instances.hs

@@ -5,13 +5,13 @@
 module Gargantext.Database.Instances where
 
 import Gargantext.Prelude
-
+import Data.Text (Text)
 import Data.Time (UTCTime)
 import Opaleye (PGInt4, PGTimestamptz, PGFloat8
                , QueryRunnerColumnDefault
                , queryRunnerColumnDefault
                , fieldQueryRunnerColumn
-               )
+               , Nullable, PGText)
 
 instance QueryRunnerColumnDefault PGInt4 Integer where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
@@ -25,4 +25,10 @@ instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
 instance QueryRunnerColumnDefault PGTimestamptz (Maybe UTCTime) where
   queryRunnerColumnDefault = fieldQueryRunnerColumn
 
+instance QueryRunnerColumnDefault (Nullable PGInt4) Int where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance QueryRunnerColumnDefault (Nullable PGText) Text    where
+  queryRunnerColumnDefault = fieldQueryRunnerColumn
+
 

src/Gargantext/Database/Node.hs

@@ -25,17 +25,19 @@ import Database.PostgreSQL.Simple.FromField ( Conversion
                                             , fromField
                                             , returnError
                                             )
-import Prelude hiding (null, id, map)
+import Prelude hiding (null, id, map, sum)
 
+import Gargantext.Types
 import Gargantext.Types.Main (NodeType)
---import Gargantext.Database.NodeNode
+import Gargantext.Database.NodeNode
+-- import Gargantext.Database.NodeNgram
+import Gargantext.Prelude hiding (sum)
+
 
 import Database.PostgreSQL.Simple.Internal  (Field)
 import Control.Arrow (returnA)
 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
 import Data.Aeson
-import Gargantext.Types
-import Gargantext.Prelude
 import Data.Maybe (Maybe, fromMaybe)
 import Data.Text (Text)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
@@ -57,6 +59,11 @@ type NodeRead = NodePoly  (Column PGInt4)   (Column PGInt4)
                           (Column (PGText)) (Column PGTimestamptz)
                           (Column PGJsonb) -- (Column PGTSVector)
 
+-- Facets / Views for the Front End
+type FacetDocRead  = Facet (Column PGInt4) (Column PGJsonb) (Column PGBool) (Column PGFloat8)
+-- type FacetDocWrite = Facet (Column PGInt4) (Column PGJsonb) (Column PGBool) (Column PGFloat8)
+
+
 instance FromField HyperdataCorpus where
     fromField = fromField'
 
@@ -70,16 +77,6 @@ instance FromField HyperdataUser where
     fromField = fromField'
 
 
-fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DBI.ByteString -> Conversion b
-fromField' field mb = do
-    v <- fromField field mb
-    valueToHyperdata v
-      where
-          valueToHyperdata v = case fromJSON v of
-             Success a  -> pure a
-             Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
-
-
 instance QueryRunnerColumnDefault PGJsonb HyperdataDocument where
   queryRunnerColumnDefault = fieldQueryRunnerColumn
 
@@ -92,20 +89,26 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataProject  where
 instance QueryRunnerColumnDefault PGJsonb HyperdataUser     where
   queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault (Nullable PGInt4) Int     where
-  queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault (Nullable PGText) Text    where
-  queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGInt4 Integer            where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
+fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DBI.ByteString -> Conversion b
+fromField' field mb = do
+    v <- fromField field mb
+    valueToHyperdata v
+      where
+          valueToHyperdata v = case fromJSON v of
+             Success a  -> pure a
+             Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
 
 
 
 $(makeAdaptorAndInstance "pNode" ''NodePoly)
 $(makeLensesWith abbreviatedFields   ''NodePoly)
 
+$(makeAdaptorAndInstance "pFacetDoc" ''Facet)
+$(makeLensesWith abbreviatedFields   ''Facet)
+
+
 
 nodeTable :: Table NodeWrite NodeRead
 nodeTable = Table "nodes" (pNode Node { node_id                = optional "id"
@@ -146,11 +149,11 @@ selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
         limit' maybeLimit $ offset' maybeOffset $ orderBy (asc node_id) $ selectNodesWith' parentId maybeNodeType
 
 
-limit' ::  Maybe Limit -> Query NodeRead -> Query NodeRead
+limit' ::  Maybe Limit -> Query a -> Query a
 limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit
 
 
-offset' :: Maybe Offset -> Query NodeRead  -> Query NodeRead
+offset' :: Maybe Offset -> Query a  -> Query a
 offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset
 
 
@@ -170,6 +173,48 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
 
 
 
+getDocFacet :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [FacetDoc Value]
+getDocFacet conn parentId nodeType maybeOffset maybeLimit = 
+    runQuery conn $ selectDocFacet parentId nodeType maybeOffset maybeLimit
+
+selectDocFacet :: ParentId -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Query FacetDocRead
+selectDocFacet parentId maybeNodeType maybeOffset maybeLimit = 
+        -- limit' maybeLimit $ offset' maybeOffset $ orderBy (asc docFacet_id) $ selectDocFacet' parentId maybeNodeType
+        limit' maybeLimit $ offset' maybeOffset $ selectDocFacet' parentId maybeNodeType
+--
+
+selectDocFacet' :: ParentId -> Maybe NodeType -> Query FacetDocRead
+selectDocFacet' parentId maybeNodeType = proc () -> do
+    node <- (proc () -> do
+            -- Selecting the documents
+            (Node n_id typeId _ parentId' _ _ hyperdata)      <- queryNodeTable -< ()
+            restrict -< parentId' .== (toNullable $ pgInt4 parentId)
+
+            let typeId' = maybe 0 nodeTypeId maybeNodeType
+            restrict -< if typeId' > 0
+                           then typeId   .== (pgInt4 (typeId' :: Int))
+                           else (pgBool True)
+            
+            -- Ngram count by document
+            -- nodeNgramNgram@(NodeNgram _ n_id_nn _ weight) <- queryNodeNgramTable -< ()
+            -- restrict -< n_id_nn .== n_id
+            let ngramCount = (pgDouble 10) -- groupBy n_id
+
+            -- Favorite Column
+            (Node n_id_fav typeId_fav _ parentId_fav  _ _ _) <- queryNodeTable -< ()
+            (NodeNode n1_id n2_id count)                     <- queryNodeNodeTable  -< ()
+            
+            restrict -< typeId_fav .== 15 .&& parentId_fav .== (toNullable $ pgInt4 parentId)
+            restrict -< n1_id .== n_id_fav .&& n_id .== n2_id
+            
+            let isFav = ifThenElse (isNull count) (pgBool False) (pgBool True)
+            
+            returnA  -< (FacetDoc n_id hyperdata isFav ngramCount)) -< ()
+    returnA -< node
+
+
+
+
 deleteNode :: Connection -> Int -> IO Int
 deleteNode conn n = fromIntegral 
                  <$> runDelete conn nodeTable 
@@ -203,7 +248,6 @@ selectNodesWithParentID n = proc () -> do
 
 
 
-
 selectNodesWithType :: Column PGInt4 -> Query NodeRead
 selectNodesWithType type_id = proc () -> do
     row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()

src/Gargantext/Database/NodeNgram.hs

@@ -9,14 +9,11 @@
 module Gargantext.Database.NodeNgram where
 
 import Prelude
-import Data.Maybe (Maybe)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
-import qualified Database.PostgreSQL.Simple as PGS
 
 import Opaleye
 
-
 data NodeNgramPoly id node_id ngram_id weight
                    = NodeNgram { nodeNgram_NodeNgramId      :: id
                                , nodeNgram_NodeNgramNodeId  :: node_id
@@ -24,21 +21,21 @@ data NodeNgramPoly id node_id ngram_id weight
                                , nodeNgram_NodeNgramWeight  :: weight
                                } deriving (Show)
 
-type NodeNgramWrite = NodeNgramPoly (Maybe (Column PGInt4)) (Column PGInt4) (Column PGInt4) (Maybe (Column PGFloat8))
-type NodeNgramRead  = NodeNgramPoly        (Column PGInt4)  (Column PGInt4) (Column PGInt4) ((Column PGFloat8))
+type NodeNgramWrite = NodeNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) (Column PGFloat8)
+type NodeNgramRead  = NodeNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) (Column PGFloat8)
 
 
-type NodeNgram = NodeNgramPoly (Maybe Int) Int Int (Maybe Double)
+type NodeNgram = NodeNgramPoly Int Int Int Double
 
 $(makeAdaptorAndInstance "pNodeNgram" ''NodeNgramPoly)
 $(makeLensesWith abbreviatedFields    ''NodeNgramPoly)
 
 
 nodeNgramTable :: Table NodeNgramWrite NodeNgramRead
-nodeNgramTable  = Table "nodes_ngrams" (pNodeNgram NodeNgram { nodeNgram_NodeNgramId       = optional "id"
+nodeNgramTable  = Table "nodes_ngrams" (pNodeNgram NodeNgram { nodeNgram_NodeNgramId       = required "id"
                                                              , nodeNgram_NodeNgramNodeId   = required "node_id"
                                                              , nodeNgram_NodeNgramNgramId  = required "ngram_id"
-                                                             , nodeNgram_NodeNgramWeight   = optional "weight"
+                                                             , nodeNgram_NodeNgramWeight   = required "weight"
                                                              }
                                        )
 
@@ -47,13 +44,3 @@ queryNodeNgramTable :: Query NodeNgramRead
 queryNodeNgramTable = queryTable nodeNgramTable
 
 
-instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
-instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
-
--- | not optimized (get all ngrams without filters)
-nodeNgrams :: PGS.Connection -> IO [NodeNgram]
-nodeNgrams conn = runQuery conn queryNodeNgramTable

src/Gargantext/Database/NodeNode.hs

@@ -22,8 +22,8 @@ data NodeNodePoly node1_id node2_id score
                               , nodeNode_score :: score
                               } deriving (Show)
 
-type NodeNodeWrite = NodeNodePoly (Column PGInt4) (Column PGInt4) (Maybe (Column PGFloat8))
-type NodeNodeRead  = NodeNodePoly (Column PGInt4) (Column PGInt4) (Column PGFloat8)
+type NodeNodeWrite = NodeNodePoly (Column PGInt4) (Column PGInt4) (Column (Nullable PGFloat8))
+type NodeNodeRead  = NodeNodePoly (Column PGInt4) (Column PGInt4) (Column (Nullable PGFloat8))
 
 
 type NodeNode = NodeNodePoly Int Int (Maybe Double)
@@ -35,7 +35,7 @@ $(makeLensesWith abbreviatedFields   ''NodeNodePoly)
 nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
 nodeNodeTable  = Table "nodes_nodes" (pNodeNode NodeNode { nodeNode_node1_id = required "node1_id"
                                                            , nodeNode_node2_id = required "node2_id"
-                                                           , nodeNode_score    = optional "score"
+                                                           , nodeNode_score    = required "score"
                                                            }
                                        )
 
@@ -48,5 +48,10 @@ queryNodeNodeTable = queryTable nodeNodeTable
 nodeNodes :: PGS.Connection -> IO [NodeNode]
 nodeNodes conn = runQuery conn queryNodeNodeTable
 
+instance QueryRunnerColumnDefault (Nullable PGInt4) Int where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+
 instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+

src/Gargantext/Types/Main.hs

@@ -37,6 +37,7 @@ import Gargantext.Types.Node ( NodePoly, HyperdataUser
                                , HyperdataGraph
                                , HyperdataPhylo
                                , HyperdataNotebook
+                               , Facet
                                )
 
 
@@ -110,6 +111,8 @@ data Metrics  = Occurrences | Cooccurrences | Specclusion | Genclusion | Cvalue
 
 -- | NodePoly indicates that Node has a Polymorphism Type
 type Node json   = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json -- NodeVector
+type FacetDoc json = Facet NodeId HyperdataDocument Bool Double
+
 -- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
 type NodeTypeId   = Int
 type NodeId       = Int
@@ -200,10 +203,10 @@ nodeTypeId tn = fromMaybe (error $ "Typename " <> show tn <> " does not exist")
 
 
 
+
+
 -- Temporary types to be removed
 type Ngrams = (Text, Text, Text)
 type ErrorMessage = Text
 
 
-
-

src/Gargantext/Types/Node.hs

@@ -13,6 +13,16 @@ import Data.Time (UTCTime)
 import Gargantext.Utils.Prefix (unPrefix)
 import Data.Aeson.TH (deriveJSON)
 
+
+-- DocFacet
+data Facet id hyperdata favorite ngramCount = FacetDoc { facetDoc_id :: id
+                                                       , facetDoc_hyperdata :: hyperdata
+                                                       , facetDoc_favorite  :: favorite
+                                                       , facetDoc_ngramCount :: ngramCount
+                                                       }
+$(deriveJSON (unPrefix "facetDoc_") ''Facet)
+
+
 -- node_Id... ?
 data NodePoly id typename userId parentId name date hyperdata = Node { node_id        :: id
                                                                      , node_typename  :: typename
@@ -130,3 +140,7 @@ $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_Preferences   :: Maybe Text
                                    } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
+
+
+
+