Portability : POSIX
-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Facet
( runViewAuthorsDoc
, runViewDocuments
+ , viewDocuments
+ , runCountDocuments
, filterWith
+ , Category
+ , Score
+ , Title
+
, Pair(..)
, Facet(..)
, FacetDoc
, FacetDocRead
, FacetPaired(..)
, FacetPairedRead
- , FacetPairedReadNull
- , FacetPairedReadNullAgg
, OrderBy(..)
)
where
import Control.Arrow (returnA)
import Control.Lens ((^.))
-import Data.Aeson (FromJSON, ToJSON)
-import Data.Aeson.TH (deriveJSON)
-import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
-import Data.Swagger
-import Data.Text (Text)
-import Data.Time (UTCTime)
-import Data.Time.Segment (jour)
-import Data.Typeable (Typeable)
-import GHC.Generics (Generic)
+import qualified Data.Text as T
import Opaleye
-import Prelude hiding (null, id, map, sum, not, read)
-import Servant.API
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary
+import qualified Opaleye.Aggregate as OAgg
+import Protolude hiding (null, map, sum, not)
import qualified Opaleye.Internal.Unpackspec()
+import Gargantext.Core
import Gargantext.Core.Types
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
-import Gargantext.Database.Admin.Config (nodeTypeId)
-import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Query.Filter
-import Gargantext.Database.Query.Join (leftJoin5)
+import Gargantext.Database.Query.Table.Context
+import Gargantext.Database.Query.Table.ContextNodeNgrams
import Gargantext.Database.Query.Table.Ngrams
-import Gargantext.Database.Query.Table.NodeNode
-import Gargantext.Database.Query.Table.NodeNodeNgrams
+import Gargantext.Database.Query.Table.Node (defaultList)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
+import Gargantext.Database.Query.Table.NodeContext (queryNodeContextTable)
+import Gargantext.Database.Query.Facet.Types
import Gargantext.Database.Prelude
+import Gargantext.Database.Schema.Context
import Gargantext.Database.Schema.Node
+import Gargantext.Database.Schema.NodeContext
------------------------------------------------------------------------
--- | DocFacet
-
--- data Facet = FacetDoc | FacetSources | FacetAuthors | FacetTerms
--- deriving (Show, Generic)
---instance FromJSON Facet
---instance ToJSON Facet
-
-type Category = Int
-type Title = Text
-
--- TODO remove Title
-type FacetDoc = Facet NodeId UTCTime Title HyperdataDocument (Maybe Category) (Maybe Double)
--- type FacetSources = FacetDoc
--- type FacetAuthors = FacetDoc
--- type FacetTerms = FacetDoc
-
-
-data Facet id created title hyperdata category ngramCount =
- FacetDoc { facetDoc_id :: id
- , facetDoc_created :: created
- , facetDoc_title :: title
- , facetDoc_hyperdata :: hyperdata
- , facetDoc_category :: category
- , facetDoc_score :: ngramCount
- } deriving (Show, Generic)
-{- | TODO after demo
-data Facet id date hyperdata score =
- FacetDoc { facetDoc_id :: id
- , facetDoc_date :: date
- , facetDoc_hyperdata :: hyperdata
- , facetDoc_score :: score
- } deriving (Show, Generic)
--}
-
-data Pair i l = Pair {_p_id :: i
- ,_p_label :: l
- } deriving (Show, Generic)
-$(deriveJSON (unPrefix "_p_") ''Pair)
-$(makeAdaptorAndInstance "pPair" ''Pair)
-
-instance (Typeable i, Typeable l, ToSchema i, ToSchema l) => ToSchema (Pair i l) where
- declareNamedSchema = wellNamedSchema "_p_"
-instance (Arbitrary i, Arbitrary l) => Arbitrary (Pair i l) where
- arbitrary = Pair <$> arbitrary <*> arbitrary
-
-data FacetPaired id date hyperdata score =
- FacetPaired {_fp_id :: id
- ,_fp_date :: date
- ,_fp_hyperdata :: hyperdata
- ,_fp_score :: score
- } deriving (Show, Generic)
-$(deriveJSON (unPrefix "_fp_") ''FacetPaired)
-$(makeAdaptorAndInstance "pFacetPaired" ''FacetPaired)
-
-
-
-instance ( ToSchema id
- , ToSchema date
- , ToSchema hyperdata
- , ToSchema score
- , Typeable id
- , Typeable date
- , Typeable hyperdata
- , Typeable score
- ) => ToSchema (FacetPaired id date hyperdata score) where
- declareNamedSchema = wellNamedSchema "_fp_"
-
-instance ( Arbitrary id
- , Arbitrary date
- , Arbitrary hyperdata
- , Arbitrary score
- ) => Arbitrary (FacetPaired id date hyperdata score) where
- arbitrary = FacetPaired <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
-
-type FacetPairedRead = FacetPaired (Column PGInt4 )
- (Column PGTimestamptz)
- (Column PGJsonb )
- (Column PGInt4 )
-
-type FacetPairedReadNull = FacetPaired (Column (Nullable PGInt4) )
- (Column (Nullable PGTimestamptz))
- (Column (Nullable PGJsonb) )
- (Column (Nullable PGInt4) )
-
-type FacetPairedReadNullAgg = FacetPaired (Aggregator (Column (Nullable PGInt4) )
- (Column (Nullable PGInt4) )
- )
- (Aggregator (Column (Nullable PGTimestamptz))
- (Column (Nullable PGTimestamptz))
-
- )
- (Aggregator (Column (Nullable PGJsonb) )
- (Column (Nullable PGJsonb) )
- )
- (Aggregator (Column (Nullable PGInt4) )
- (Column (Nullable PGInt4) )
- )
-
-
-
-
--- | JSON instance
-$(deriveJSON (unPrefix "facetDoc_") ''Facet)
-
--- | Documentation instance
-instance ToSchema FacetDoc where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "facetDoc_")
-
--- | Mock and Quickcheck instances
-instance Arbitrary FacetDoc where
- arbitrary = elements [ FacetDoc id' (jour year 01 01) t hp (Just cat) (Just ngramCount)
- | id' <- [1..10]
- , year <- [1990..2000]
- , t <- ["title", "another title"]
- , hp <- arbitraryHyperdataDocuments
- , cat <- [0..2]
- , ngramCount <- [3..100]
- ]
-
--- Facets / Views for the Front End
--- | Database instances
-$(makeAdaptorAndInstance "pFacetDoc" ''Facet)
--- $(makeLensesWith abbreviatedFields ''Facet)
-
-type FacetDocRead = Facet (Column PGInt4 )
- (Column PGTimestamptz)
- (Column PGText )
- (Column PGJsonb )
- (Column (Nullable PGInt4)) -- Category
- (Column (Nullable PGFloat8)) -- Score
-
------------------------------------------------------------------------
------------------------------------------------------------------------
-data OrderBy = DateAsc | DateDesc
- | TitleAsc | TitleDesc
- | ScoreDesc | ScoreAsc
- | SourceAsc | SourceDesc
- deriving (Generic, Enum, Bounded, Read, Show)
-
-instance FromHttpApiData OrderBy
- where
- parseUrlPiece "DateAsc" = pure DateAsc
- parseUrlPiece "DateDesc" = pure DateDesc
- parseUrlPiece "TitleAsc" = pure TitleAsc
- parseUrlPiece "TitleDesc" = pure TitleDesc
- parseUrlPiece "ScoreAsc" = pure ScoreAsc
- parseUrlPiece "ScoreDesc" = pure ScoreDesc
- parseUrlPiece "SourceAsc" = pure SourceAsc
- parseUrlPiece "SourceDesc" = pure SourceDesc
- parseUrlPiece _ = Left "Unexpected value of OrderBy"
-
-instance ToParamSchema OrderBy
-instance FromJSON OrderBy
-instance ToJSON OrderBy
-instance ToSchema OrderBy
-instance Arbitrary OrderBy
- where
- arbitrary = elements [minBound..maxBound]
-- TODO-SECURITY check
-
---{-
-runViewAuthorsDoc :: ContactId -> IsTrash -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [FacetDoc]
+runViewAuthorsDoc :: HasDBid NodeType
+ => ContactId
+ -> IsTrash
+ -> Maybe Offset
+ -> Maybe Limit
+ -> Maybe OrderBy
+ -> Cmd err [FacetDoc]
runViewAuthorsDoc cId t o l order = runOpaQuery $ filterWith o l order $ viewAuthorsDoc cId t ntId
where
ntId = NodeDocument
-- TODO add delete ?
-viewAuthorsDoc :: ContactId -> IsTrash -> NodeType -> Query FacetDocRead
+viewAuthorsDoc :: HasDBid NodeType
+ => ContactId
+ -> IsTrash
+ -> NodeType
+ -> Select FacetDocRead
viewAuthorsDoc cId _ nt = proc () -> do
- (doc,(_,(_,(_,contact)))) <- queryAuthorsDoc -< ()
-
- {-nn <- queryNodeNodeTable -< ()
- restrict -< nn_node1_id nn .== _node_id doc
- -- restrict -< nn_delete nn .== (pgBool t)
- -}
+ --(doc,(_,(_,(_,contact')))) <- queryAuthorsDoc -< ()
+ (doc, _, _, _, contact') <- queryAuthorsDoc -< ()
+
+ restrict -< fromMaybeFields (sqlInt4 $ -1) (_node_id <$> contact') .=== pgNodeId cId
+ restrict -< _node_typename doc .== sqlInt4 (toDBid nt)
+
+ returnA -< FacetDoc { facetDoc_id = _node_id doc
+ , facetDoc_created = _node_date doc
+ , facetDoc_title = _node_name doc
+ , facetDoc_hyperdata = _node_hyperdata doc
+ , facetDoc_category = toNullable $ sqlInt4 1
+ , facetDoc_ngramCount = toNullable $ sqlDouble 1.0
+ , facetDoc_score = toNullable $ sqlDouble 1 }
+
+queryAuthorsDoc :: Select ( NodeRead
+ , MaybeFields ContextNodeNgramsRead
+ , MaybeFields NgramsRead
+ , MaybeFields ContextNodeNgramsRead
+ , MaybeFields NodeRead)
+queryAuthorsDoc = proc () -> do
+ n <- queryNodeTable -< ()
+ cnn <- optionalRestrict queryContextNodeNgramsTable -<
+ \cnn' -> _node_id n .== _cnng_context_id cnn'
+ ng <- optionalRestrict queryNgramsTable -<
+ \ng' -> justFields (ng' ^. ngrams_id) .=== (_cnng_ngrams_id <$> cnn)
+ cnn2 <- optionalRestrict queryContextNodeNgramsTable -<
+ \cnn2' -> (_ngrams_id <$> ng) .=== justFields (_cnng_ngrams_id cnn2')
+ contact <- optionalRestrict queryNodeTable -<
+ \contact' -> justFields (_node_id contact') .=== (_cnng_context_id <$> cnn2)
+
+ returnA -< (n, cnn, ng, cnn2, contact)
- restrict -< _node_id contact .== (toNullable $ pgNodeId cId)
- restrict -< _node_typename doc .== (pgInt4 $ nodeTypeId nt)
- returnA -< FacetDoc (_node_id doc)
- (_node_date doc)
- (_node_name doc)
- (_node_hyperdata doc)
- (toNullable $ pgInt4 1)
- (toNullable $ pgDouble 1)
-
-queryAuthorsDoc :: Query (NodeRead, (NodeNodeNgramsReadNull, (NgramsReadNull, (NodeNodeNgramsReadNull, NodeReadNull))))
-queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNodeNgramsTable queryNgramsTable queryNodeNodeNgramsTable queryNodeTable cond12 cond23 cond34 cond45
- where
- cond12 :: (NodeNodeNgramsRead, NodeRead) -> Column PGBool
- cond12 (nodeNgram, doc) = _node_id doc
- .== _nnng_node1_id nodeNgram
-
- cond23 :: (NgramsRead, (NodeNodeNgramsRead, NodeReadNull)) -> Column PGBool
- cond23 (ngrams, (nodeNgram, _)) = ngrams^.ngrams_id
- .== _nnng_ngrams_id nodeNgram
-
- cond34 :: (NodeNodeNgramsRead, (NgramsRead, (NodeNodeNgramsReadNull, NodeReadNull))) -> Column PGBool
- cond34 (nodeNgram2, (ngrams, (_,_)))= ngrams^.ngrams_id .== _nnng_ngrams_id nodeNgram2
-
- cond45 :: (NodeRead, (NodeNodeNgramsRead, (NgramsReadNull, (NodeNodeNgramsReadNull, NodeReadNull)))) -> Column PGBool
- cond45 (contact, (nodeNgram2, (_, (_,_)))) = _node_id contact .== _nnng_node1_id nodeNgram2
-
---}
------------------------------------------------------------------------
-
-- TODO-SECURITY check
-runViewDocuments :: CorpusId -> IsTrash -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [FacetDoc]
-runViewDocuments cId t o l order =
- runOpaQuery $ filterWith o l order $ viewDocuments cId t ntId
+runViewDocuments :: (HasDBid NodeType, HasNodeError err)
+ => CorpusId
+ -> IsTrash
+ -> Maybe Offset
+ -> Maybe Limit
+ -> Maybe OrderBy
+ -> Maybe Text
+ -> Maybe Text
+ -> Cmd err [FacetDoc]
+runViewDocuments cId t o l order query year = do
+ listId <- defaultList cId
+
+ res <- runOpaQuery $ filterWith' o l order (sqlQuery listId) :: Cmd err [FacetDocAgg']
+ pure $ remapNgramsCount <$> res
+ where
+ sqlQuery lId = viewDocuments cId lId t (toDBid NodeDocument) query year
+
+ remapNgramsCount (FacetDoc { .. }) =
+ FacetDoc { facetDoc_ngramCount = Just $ fromIntegral facetDoc_ngramCount
+ , facetDoc_score = Just $ fromIntegral facetDoc_score
+ , .. }
+
+runCountDocuments :: (HasDBid NodeType, HasNodeError err)
+ => CorpusId -> IsTrash -> Maybe Text -> Maybe Text -> Cmd err Int
+runCountDocuments cId t mQuery mYear = do
+ listId <- defaultList cId
+ runCountOpaQuery (sqlQuery listId)
where
- ntId = nodeTypeId NodeDocument
-
-viewDocuments :: CorpusId -> IsTrash -> NodeTypeId -> Query FacetDocRead
-viewDocuments cId t ntId = proc () -> do
- n <- queryNodeTable -< ()
- nn <- queryNodeNodeTable -< ()
- restrict -< n^.node_id .== nn^.nn_node2_id
- restrict -< nn^.nn_node1_id .== (pgNodeId cId)
- restrict -< n^.node_typename .== (pgInt4 ntId)
- restrict -< if t then nn^.nn_category .== (pgInt4 0)
- else nn^.nn_category .>= (pgInt4 1)
- returnA -< FacetDoc (_node_id n)
- (_node_date n)
- (_node_name n)
- (_node_hyperdata n)
- (toNullable $ nn^.nn_category)
- (toNullable $ nn^.nn_score)
+ sqlQuery lId = viewDocuments cId lId t (toDBid NodeDocument) mQuery mYear
+
+viewDocuments :: CorpusId
+ -> ListId
+ -> IsTrash
+ -> NodeTypeId
+ -> Maybe Text
+ -> Maybe Text
+ -> Select FacetDocAgg
+viewDocuments cId lId t ntId mQuery mYear =
+ aggregate (pFacetDoc FacetDoc { facetDoc_id = OAgg.groupBy
+ , facetDoc_created = OAgg.groupBy
+ , facetDoc_title = OAgg.groupBy
+ , facetDoc_hyperdata = OAgg.groupBy
+ , facetDoc_category = OAgg.groupBy
+ , facetDoc_ngramCount = OAgg.sumInt4
+ , facetDoc_score = OAgg.sumInt4 })
+ (viewDocumentsAgg cId lId t ntId mQuery mYear)
+
+viewDocumentsAgg :: CorpusId
+ -> ListId
+ -> IsTrash
+ -> NodeTypeId
+ -> Maybe Text
+ -> Maybe Text
+ -> Select FacetDocAggPart
+viewDocumentsAgg cId lId t ntId mQuery mYear = proc () -> do
+ (c, nc) <- viewDocumentsQuery cId t ntId mQuery mYear -< ()
+ cnng <- optionalRestrict queryContextNodeNgramsTable -<
+ \cnng' -> (cnng' ^. cnng_node_id) .== pgNodeId lId .&& -- (nc ^. nc_node_id) .&&
+ (cnng' ^. cnng_context_id) .== (c ^. cs_id)
+ let ngramCount = fromMaybeFields 0 $ _cnng_doc_count <$> cnng
+ returnA -< FacetDoc { facetDoc_id = _cs_id c
+ , facetDoc_created = _cs_date c
+ , facetDoc_title = _cs_name c
+ , facetDoc_hyperdata = _cs_hyperdata c
+ , facetDoc_category = nc ^. nc_category
+ , facetDoc_ngramCount = ngramCount
+ -- NOTE This is a slight abuse of "score" but
+ -- currently it is all 0's in the DB and the
+ -- search functionality on the frontend orders
+ -- by Score.
+ , facetDoc_score = ngramCount
+ }
+
+-- TODO Join with context_node_ngrams at context_id/node_id and sum by
+-- doc_count.
+viewDocumentsQuery :: CorpusId
+ -> IsTrash
+ -> NodeTypeId
+ -> Maybe Text
+ -> Maybe Text
+ -> Select (ContextSearchRead, NodeContextRead)
+viewDocumentsQuery cId t ntId mQuery mYear = proc () -> do
+ c <- queryContextSearchTable -< ()
+ nc <- queryNodeContextTable -< ()
+ restrict -< (c^.cs_id) .== (nc^.nc_context_id)
+ restrict -< nc^.nc_node_id .== pgNodeId cId
+ restrict -< c^.cs_typename .== sqlInt4 ntId
+ restrict -< if t then nc^.nc_category .== sqlInt4 0
+ else nc^.nc_category .>= sqlInt4 1
+
+ let
+ query = (fromMaybe "" mQuery)
+ year = (fromMaybe "" mYear)
+ iLikeQuery = T.intercalate "" ["%", query, "%"]
+ abstractLHS h = fromNullable (sqlStrictText "")
+ $ toNullable h .->> sqlStrictText "abstract"
+ yearLHS h = fromNullable (sqlStrictText "")
+ $ toNullable h .->> sqlStrictText "publication_year"
+
+ restrict -<
+ if query == "" then sqlBool True
+ else ((c^.cs_name) `ilike` (sqlStrictText iLikeQuery))
+ .|| ((abstractLHS (c^.cs_hyperdata)) `ilike` (sqlStrictText iLikeQuery))
+ restrict -<
+ if year == "" then sqlBool True
+ else yearLHS (c ^. cs_hyperdata) .== sqlStrictText year
+
+ returnA -< (c, nc)
+ -- returnA -< (c, nc, cnng)
+
------------------------------------------------------------------------
-filterWith :: (PGOrd date, PGOrd title, PGOrd score, hyperdata ~ Column SqlJsonb) =>
- Maybe Gargantext.Core.Types.Offset
+filterWith :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ SqlJsonb) =>
+ Maybe Gargantext.Core.Types.Offset
-> Maybe Gargantext.Core.Types.Limit
-> Maybe OrderBy
- -> Select (Facet id (Column date) (Column title) hyperdata (Column score) ngramCount)
- -> Select (Facet id (Column date) (Column title) hyperdata (Column score) ngramCount)
+ -> Select (Facet id (Field date) (Field title) (Field hyperdata) (FieldNullable category) ngramCount (FieldNullable score))
+ -> Select (Facet id (Field date) (Field title) (Field hyperdata)(FieldNullable category) ngramCount (FieldNullable score))
filterWith o l order q = limit' l $ offset' o $ orderBy (orderWith order) q
-orderWith :: (PGOrd b1, PGOrd b2, PGOrd b3)
+orderWith :: (SqlOrd b1, SqlOrd b2, SqlOrd b3, SqlOrd b4)
=> Maybe OrderBy
- -> Order (Facet id (Column b1) (Column b2) (Column SqlJsonb) (Column b3) score)
+ -> Order (Facet id (Field b1) (Field b2) (Field SqlJsonb) (FieldNullable b3) ngramCount (FieldNullable b4))
orderWith (Just DateAsc) = asc facetDoc_created
orderWith (Just DateDesc) = desc facetDoc_created
orderWith (Just TitleAsc) = asc facetDoc_title
orderWith (Just TitleDesc) = desc facetDoc_title
-orderWith (Just ScoreAsc) = asc facetDoc_category
-orderWith (Just ScoreDesc) = desc facetDoc_category
+orderWith (Just ScoreAsc) = ascNullsLast facetDoc_score
+orderWith (Just ScoreDesc) = descNullsLast facetDoc_score
+
+orderWith (Just SourceAsc) = ascNullsLast facetDoc_source
+orderWith (Just SourceDesc) = descNullsLast facetDoc_source
-orderWith (Just SourceAsc) = asc facetDoc_source
-orderWith (Just SourceDesc) = desc facetDoc_source
+orderWith (Just TagAsc) = ascNullsLast facetDoc_category
+orderWith (Just TagDesc) = descNullsLast facetDoc_category
orderWith _ = asc facetDoc_created
-facetDoc_source :: PGIsJson a
- => Facet id created title (Column a) favorite ngramCount
- -> Column (Nullable PGText)
-facetDoc_source x = toNullable (facetDoc_hyperdata x) .->> pgString "source"
+
+
+filterWith' :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ SqlJsonb, SqlOrd ngramCount) =>
+ Maybe Gargantext.Core.Types.Offset
+ -> Maybe Gargantext.Core.Types.Limit
+ -> Maybe OrderBy
+ -> Select (Facet id (Field date) (Field title) (Field hyperdata) (Field category) (Field ngramCount) (Field score))
+ -> Select (Facet id (Field date) (Field title) (Field hyperdata) (Field category) (Field ngramCount) (Field score))
+filterWith' o l order q = limit' l $ offset' o $ orderBy (orderWith' order) q
+
+
+orderWith' :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd ngramCount, SqlOrd score)
+ => Maybe OrderBy
+ -> Order (Facet id (Field date) (Field title) (Field SqlJsonb) (Field category) (Field ngramCount) (Field score))
+orderWith' (Just DateAsc) = asc facetDoc_created
+orderWith' (Just DateDesc) = desc facetDoc_created
+
+orderWith' (Just TitleAsc) = asc facetDoc_title
+orderWith' (Just TitleDesc) = desc facetDoc_title
+
+orderWith' (Just NgramCountAsc) = asc facetDoc_ngramCount
+orderWith' (Just NgramCountDesc) = desc facetDoc_ngramCount
+
+orderWith' (Just ScoreAsc) = asc facetDoc_score
+orderWith' (Just ScoreDesc) = desc facetDoc_score
+
+orderWith' (Just SourceAsc) = ascNullsLast facetDoc_source
+orderWith' (Just SourceDesc) = descNullsLast facetDoc_source
+
+orderWith' (Just TagAsc) = asc facetDoc_category
+orderWith' (Just TagDesc) = desc facetDoc_category
+
+orderWith' _ = asc facetDoc_created
+
+facetDoc_source :: SqlIsJson a
+ => Facet id created title (Field a) favorite ngramCount score
+ -> FieldNullable SqlText
+facetDoc_source x = (toNullable $ facetDoc_hyperdata x) .->> sqlString "source"