Commit 966bc15d authored by Alexandre Delanoë's avatar Alexandre Delanoë

[DEP] haskell-opaleye dep upgrade

parent 8d1d7c9c
...@@ -188,9 +188,9 @@ instance FromField HyperdataGraph ...@@ -188,9 +188,9 @@ instance FromField HyperdataGraph
where where
fromField = fromField' fromField = fromField'
instance QueryRunnerColumnDefault PGJsonb HyperdataGraph instance DefaultFromField PGJsonb HyperdataGraph
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
----------------------------------------------------------- -----------------------------------------------------------
-- This type is used to return graph via API -- This type is used to return graph via API
......
...@@ -55,7 +55,7 @@ isPairedWith nId nt = runOpaQuery (selectQuery nt nId) ...@@ -55,7 +55,7 @@ isPairedWith nId nt = runOpaQuery (selectQuery nt nId)
selectQuery :: NodeType -> NodeId -> Query (Column PGInt4) selectQuery :: NodeType -> NodeId -> Query (Column PGInt4)
selectQuery nt' nId' = proc () -> do selectQuery nt' nId' = proc () -> do
(node, node_node) <- queryJoin -< () (node, node_node) <- queryJoin -< ()
restrict -< (node^.node_typename) .== (pgInt4 $ toDBid nt') restrict -< (node^.node_typename) .== (sqlInt4 $ toDBid nt')
restrict -< (node_node^.nn_node1_id) .== (toNullable $ pgNodeId nId') restrict -< (node_node^.nn_node1_id) .== (toNullable $ pgNodeId nId')
returnA -< node^.node_id returnA -< node^.node_id
......
...@@ -45,7 +45,7 @@ searchDocInDatabase _p t = runOpaQuery (queryDocInDatabase t) ...@@ -45,7 +45,7 @@ searchDocInDatabase _p t = runOpaQuery (queryDocInDatabase t)
queryDocInDatabase q = proc () -> do queryDocInDatabase q = proc () -> do
row <- queryNodeSearchTable -< () row <- queryNodeSearchTable -< ()
restrict -< (_ns_search row) @@ (pgTSQuery (unpack q)) restrict -< (_ns_search row) @@ (pgTSQuery (unpack q))
restrict -< (_ns_typename row) .== (pgInt4 $ toDBid NodeDocument) restrict -< (_ns_typename row) .== (sqlInt4 $ toDBid NodeDocument)
returnA -< (_ns_id row, _ns_hyperdata row) returnA -< (_ns_id row, _ns_hyperdata row)
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -83,10 +83,10 @@ queryInCorpus cId t q = proc () -> do ...@@ -83,10 +83,10 @@ queryInCorpus cId t q = proc () -> do
(n, nn) <- joinInCorpus -< () (n, nn) <- joinInCorpus -< ()
restrict -< (nn^.nn_node1_id) .== (toNullable $ pgNodeId cId) restrict -< (nn^.nn_node1_id) .== (toNullable $ pgNodeId cId)
restrict -< if t restrict -< if t
then (nn^.nn_category) .== (toNullable $ pgInt4 0) then (nn^.nn_category) .== (toNullable $ sqlInt4 0)
else (nn^.nn_category) .>= (toNullable $ pgInt4 1) else (nn^.nn_category) .>= (toNullable $ sqlInt4 1)
restrict -< (n ^. ns_search) @@ (pgTSQuery (unpack q)) restrict -< (n ^. ns_search) @@ (pgTSQuery (unpack q))
restrict -< (n ^. ns_typename ) .== (pgInt4 $ toDBid NodeDocument) restrict -< (n ^. ns_typename ) .== (sqlInt4 $ toDBid NodeDocument)
returnA -< FacetDoc (n^.ns_id ) returnA -< FacetDoc (n^.ns_id )
(n^.ns_date ) (n^.ns_date )
(n^.ns_name ) (n^.ns_name )
...@@ -133,14 +133,14 @@ selectContactViaDoc ...@@ -133,14 +133,14 @@ selectContactViaDoc
selectContactViaDoc cId aId q = proc () -> do selectContactViaDoc cId aId q = proc () -> do
(doc, (corpus_doc, (_contact_doc, (annuaire_contact, contact)))) <- queryContactViaDoc -< () (doc, (corpus_doc, (_contact_doc, (annuaire_contact, contact)))) <- queryContactViaDoc -< ()
restrict -< (doc^.ns_search) @@ (pgTSQuery $ unpack q ) restrict -< (doc^.ns_search) @@ (pgTSQuery $ unpack q )
restrict -< (doc^.ns_typename) .== (pgInt4 $ toDBid NodeDocument) restrict -< (doc^.ns_typename) .== (sqlInt4 $ toDBid NodeDocument)
restrict -< (corpus_doc^.nn_node1_id) .== (toNullable $ pgNodeId cId) restrict -< (corpus_doc^.nn_node1_id) .== (toNullable $ pgNodeId cId)
restrict -< (annuaire_contact^.nn_node1_id) .== (toNullable $ pgNodeId aId) restrict -< (annuaire_contact^.nn_node1_id) .== (toNullable $ pgNodeId aId)
restrict -< (contact^.node_typename) .== (toNullable $ pgInt4 $ toDBid NodeContact) restrict -< (contact^.node_typename) .== (toNullable $ sqlInt4 $ toDBid NodeContact)
returnA -< ( contact^.node_id returnA -< ( contact^.node_id
, contact^.node_date , contact^.node_date
, contact^.node_hyperdata , contact^.node_hyperdata
, toNullable $ pgInt4 1 , toNullable $ sqlInt4 1
) )
selectGroup :: HasDBid NodeType selectGroup :: HasDBid NodeType
......
...@@ -45,7 +45,7 @@ instance ToSchema HyperdataAny where ...@@ -45,7 +45,7 @@ instance ToSchema HyperdataAny where
instance FromField HyperdataAny where instance FromField HyperdataAny where
fromField = fromField' fromField = fromField'
instance QueryRunnerColumnDefault PGJsonb HyperdataAny instance DefaultFromField PGJsonb HyperdataAny
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
...@@ -166,12 +166,12 @@ instance FromField HyperdataContact where ...@@ -166,12 +166,12 @@ instance FromField HyperdataContact where
fromField = fromField' fromField = fromField'
-- | Database (Opaleye instance) -- | Database (Opaleye instance)
instance QueryRunnerColumnDefault PGJsonb HyperdataContact where instance DefaultFromField PGJsonb HyperdataContact where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault (Nullable PGJsonb) HyperdataContact where instance DefaultFromField (Nullable PGJsonb) HyperdataContact where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
......
...@@ -90,10 +90,10 @@ instance FromField HyperdataAnnuaire ...@@ -90,10 +90,10 @@ instance FromField HyperdataAnnuaire
where where
fromField = fromField' fromField = fromField'
------------------------------------------------------------------------ ------------------------------------------------------------------------
instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus instance DefaultFromField PGJsonb HyperdataCorpus
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGJsonb HyperdataAnnuaire instance DefaultFromField PGJsonb HyperdataAnnuaire
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
...@@ -71,7 +71,7 @@ instance ToSchema HyperdataDashboard where ...@@ -71,7 +71,7 @@ instance ToSchema HyperdataDashboard where
instance FromField HyperdataDashboard where instance FromField HyperdataDashboard where
fromField = fromField' fromField = fromField'
instance QueryRunnerColumnDefault PGJsonb HyperdataDashboard instance DefaultFromField PGJsonb HyperdataDashboard
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
...@@ -202,11 +202,11 @@ instance ToField HyperdataDocumentV3 where ...@@ -202,11 +202,11 @@ instance ToField HyperdataDocumentV3 where
toField = toJSONField toField = toJSONField
------------------------------------------------------------------------ ------------------------------------------------------------------------
instance QueryRunnerColumnDefault PGJsonb HyperdataDocument instance DefaultFromField PGJsonb HyperdataDocument
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGJsonb HyperdataDocumentV3 instance DefaultFromField PGJsonb HyperdataDocumentV3
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -54,9 +54,9 @@ instance FromField HyperdataFile ...@@ -54,9 +54,9 @@ instance FromField HyperdataFile
where where
fromField = fromField' fromField = fromField'
instance QueryRunnerColumnDefault PGJsonb HyperdataFile instance DefaultFromField PGJsonb HyperdataFile
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance ToSchema HyperdataFile where instance ToSchema HyperdataFile where
declareNamedSchema proxy = declareNamedSchema proxy =
......
...@@ -53,9 +53,9 @@ instance FromField HyperdataFrame ...@@ -53,9 +53,9 @@ instance FromField HyperdataFrame
where where
fromField = fromField' fromField = fromField'
instance QueryRunnerColumnDefault PGJsonb HyperdataFrame instance DefaultFromField PGJsonb HyperdataFrame
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance ToSchema HyperdataFrame where instance ToSchema HyperdataFrame where
declareNamedSchema proxy = declareNamedSchema proxy =
......
...@@ -98,12 +98,12 @@ instance FromField HyperdataListCooc ...@@ -98,12 +98,12 @@ instance FromField HyperdataListCooc
where where
fromField = fromField' fromField = fromField'
instance QueryRunnerColumnDefault PGJsonb HyperdataList instance DefaultFromField PGJsonb HyperdataList
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGJsonb HyperdataListCooc instance DefaultFromField PGJsonb HyperdataListCooc
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance ToSchema HyperdataList where instance ToSchema HyperdataList where
......
...@@ -48,9 +48,9 @@ instance FromField HyperdataModel ...@@ -48,9 +48,9 @@ instance FromField HyperdataModel
where where
fromField = fromField' fromField = fromField'
instance QueryRunnerColumnDefault PGJsonb HyperdataModel instance DefaultFromField PGJsonb HyperdataModel
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance ToSchema HyperdataModel where instance ToSchema HyperdataModel where
declareNamedSchema proxy = declareNamedSchema proxy =
......
...@@ -56,6 +56,6 @@ instance ToSchema HyperdataPhylo where ...@@ -56,6 +56,6 @@ instance ToSchema HyperdataPhylo where
instance FromField HyperdataPhylo where instance FromField HyperdataPhylo where
fromField = fromField' fromField = fromField'
instance QueryRunnerColumnDefault PGJsonb HyperdataPhylo instance DefaultFromField PGJsonb HyperdataPhylo
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
...@@ -48,7 +48,7 @@ import GHC.Generics (Generic) ...@@ -48,7 +48,7 @@ import GHC.Generics (Generic)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
import Gargantext.Database.Prelude (fromField') import Gargantext.Database.Prelude (fromField')
import Gargantext.Prelude import Gargantext.Prelude
import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn, Nullable) import Opaleye (DefaultFromField(..), PGJsonb, defaultFromField, fieldQueryRunnerColumn, Nullable)
import Test.QuickCheck (elements) import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary hiding (vector) import Test.QuickCheck.Arbitrary hiding (vector)
......
...@@ -54,7 +54,7 @@ instance ToSchema HyperdataTexts where ...@@ -54,7 +54,7 @@ instance ToSchema HyperdataTexts where
instance FromField HyperdataTexts where instance FromField HyperdataTexts where
fromField = fromField' fromField = fromField'
instance QueryRunnerColumnDefault PGJsonb HyperdataTexts instance DefaultFromField PGJsonb HyperdataTexts
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
...@@ -120,12 +120,12 @@ instance FromField HyperdataPublic where ...@@ -120,12 +120,12 @@ instance FromField HyperdataPublic where
fromField = fromField' fromField = fromField'
-- | Database (Opaleye instance) -- | Database (Opaleye instance)
instance QueryRunnerColumnDefault PGJsonb HyperdataUser where instance DefaultFromField PGJsonb HyperdataUser where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGJsonb HyperdataPrivate where instance DefaultFromField PGJsonb HyperdataPrivate where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGJsonb HyperdataPublic where instance DefaultFromField PGJsonb HyperdataPublic where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
...@@ -33,7 +33,7 @@ import Database.PostgreSQL.Simple.ToField (ToField, toField) ...@@ -33,7 +33,7 @@ import Database.PostgreSQL.Simple.ToField (ToField, toField)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Servant import Servant
import qualified Opaleye as O import qualified Opaleye as O
import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGInt4, PGText, PGTSVector, Nullable, fieldQueryRunnerColumn) import Opaleye (DefaultFromField, defaultFromField, PGInt4, PGText, PGTSVector, Nullable, fieldQueryRunnerColumn)
import Test.QuickCheck (elements) import Test.QuickCheck (elements)
import Gargantext.Prelude.Crypto.Hash (Hash) import Gargantext.Prelude.Crypto.Hash (Hash)
import Test.QuickCheck.Arbitrary import Test.QuickCheck.Arbitrary
...@@ -145,7 +145,7 @@ instance (Arbitrary hyperdata ...@@ -145,7 +145,7 @@ instance (Arbitrary hyperdata
------------------------------------------------------------------------ ------------------------------------------------------------------------
pgNodeId :: NodeId -> O.Column O.PGInt4 pgNodeId :: NodeId -> O.Column O.PGInt4
pgNodeId = O.pgInt4 . id2int pgNodeId = O.sqlInt4 . id2int
where where
id2int :: NodeId -> Int id2int :: NodeId -> Int
id2int (NodeId n) = n id2int (NodeId n) = n
...@@ -354,28 +354,28 @@ instance FromField (NodeId, Text) ...@@ -354,28 +354,28 @@ instance FromField (NodeId, Text)
fromField = fromField' fromField = fromField'
-} -}
------------------------------------------------------------------------ ------------------------------------------------------------------------
instance QueryRunnerColumnDefault PGTSVector (Maybe TSVector) instance DefaultFromField PGTSVector (Maybe TSVector)
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGInt4 (Maybe NodeId) instance DefaultFromField PGInt4 (Maybe NodeId)
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGInt4 NodeId instance DefaultFromField PGInt4 NodeId
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault (Nullable PGInt4) NodeId instance DefaultFromField (Nullable PGInt4) NodeId
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance (QueryRunnerColumnDefault (Nullable O.PGTimestamptz) UTCTime) instance (DefaultFromField (Nullable O.PGTimestamptz) UTCTime)
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGText (Maybe Hash) instance DefaultFromField PGText (Maybe Hash)
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
...@@ -31,7 +31,7 @@ import Database.PostgreSQL.Simple (Connection, connect) ...@@ -31,7 +31,7 @@ import Database.PostgreSQL.Simple (Connection, connect)
import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(ConversionFailed), fromField, returnError) import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(ConversionFailed), fromField, returnError)
import Database.PostgreSQL.Simple.Internal (Field) import Database.PostgreSQL.Simple.Internal (Field)
import Gargantext.Prelude import Gargantext.Prelude
import Opaleye (Query, Unpackspec, showSqlForPostgres, FromFields, Select, runQuery, PGJsonb, QueryRunnerColumnDefault) import Opaleye (Query, Unpackspec, showSql, FromFields, Select, runSelect, PGJsonb, DefaultFromField)
import Opaleye.Aggregate (countRows) import Opaleye.Aggregate (countRows)
import System.IO (FilePath) import System.IO (FilePath)
import System.IO (stderr) import System.IO (stderr)
...@@ -56,7 +56,7 @@ instance HasConfig GargConfig where ...@@ -56,7 +56,7 @@ instance HasConfig GargConfig where
hasConfig = identity hasConfig = identity
------------------------------------------------------- -------------------------------------------------------
type JSONB = QueryRunnerColumnDefault PGJsonb type JSONB = DefaultFromField PGJsonb
------------------------------------------------------- -------------------------------------------------------
type CmdM'' env err m = type CmdM'' env err m =
...@@ -111,11 +111,11 @@ runCmd env m = runExceptT $ runReaderT m env ...@@ -111,11 +111,11 @@ runCmd env m = runExceptT $ runReaderT m env
runOpaQuery :: Default FromFields fields haskells runOpaQuery :: Default FromFields fields haskells
=> Select fields => Select fields
-> Cmd err [haskells] -> Cmd err [haskells]
runOpaQuery q = mkCmd $ \c -> runQuery c q runOpaQuery q = mkCmd $ \c -> runSelect c q
runCountOpaQuery :: Select a -> Cmd err Int runCountOpaQuery :: Select a -> Cmd err Int
runCountOpaQuery q = do runCountOpaQuery q = do
counts <- mkCmd $ \c -> runQuery c $ countRows q counts <- mkCmd $ \c -> runSelect c $ countRows q
-- countRows is guaranteed to return a list with exactly one row so DL.head is safe here -- countRows is guaranteed to return a list with exactly one row so DL.head is safe here
pure $ fromInt64ToInt $ DL.head counts pure $ fromInt64ToInt $ DL.head counts
...@@ -189,5 +189,5 @@ fromField' field mb = do ...@@ -189,5 +189,5 @@ fromField' field mb = do
] ]
printSqlOpa :: Default Unpackspec a a => Query a -> IO () printSqlOpa :: Default Unpackspec a a => Query a -> IO ()
printSqlOpa = putStrLn . maybe "Empty query" identity . showSqlForPostgres printSqlOpa = putStrLn . maybe "Empty query" identity . showSql
...@@ -268,13 +268,13 @@ viewAuthorsDoc cId _ nt = proc () -> do ...@@ -268,13 +268,13 @@ viewAuthorsDoc cId _ nt = proc () -> do
-} -}
restrict -< _node_id contact' .== (toNullable $ pgNodeId cId) restrict -< _node_id contact' .== (toNullable $ pgNodeId cId)
restrict -< _node_typename doc .== (pgInt4 $ toDBid nt) restrict -< _node_typename doc .== (sqlInt4 $ toDBid nt)
returnA -< FacetDoc (_node_id doc) returnA -< FacetDoc (_node_id doc)
(_node_date doc) (_node_date doc)
(_node_name doc) (_node_name doc)
(_node_hyperdata doc) (_node_hyperdata doc)
(toNullable $ pgInt4 1) (toNullable $ sqlInt4 1)
(toNullable $ pgDouble 1) (toNullable $ pgDouble 1)
(toNullable $ pgDouble 1) (toNullable $ pgDouble 1)
...@@ -350,13 +350,13 @@ viewDocuments cId t ntId mQuery = proc () -> do ...@@ -350,13 +350,13 @@ viewDocuments cId t ntId mQuery = proc () -> do
nn <- queryNodeNodeTable -< () nn <- queryNodeNodeTable -< ()
restrict -< n^.ns_id .== nn^.nn_node2_id restrict -< n^.ns_id .== nn^.nn_node2_id
restrict -< nn^.nn_node1_id .== (pgNodeId cId) restrict -< nn^.nn_node1_id .== (pgNodeId cId)
restrict -< n^.ns_typename .== (pgInt4 ntId) restrict -< n^.ns_typename .== (sqlInt4 ntId)
restrict -< if t then nn^.nn_category .== (pgInt4 0) restrict -< if t then nn^.nn_category .== (sqlInt4 0)
else nn^.nn_category .>= (pgInt4 1) else nn^.nn_category .>= (sqlInt4 1)
let query = (fromMaybe "" mQuery) let query = (fromMaybe "" mQuery)
-- iLikeQuery = T.intercalate "" ["%", query, "%"] -- iLikeQuery = T.intercalate "" ["%", query, "%"]
-- restrict -< (n^.node_name) `ilike` (pgStrictText iLikeQuery) -- restrict -< (n^.node_name) `ilike` (sqlStrictText iLikeQuery)
restrict -< if query == "" restrict -< if query == ""
then pgBool True then pgBool True
--else (n^.ns_search_title) @@ (pgTSQuery (T.unpack query)) --else (n^.ns_search_title) @@ (pgTSQuery (T.unpack query))
...@@ -371,7 +371,7 @@ viewDocuments cId t ntId mQuery = proc () -> do ...@@ -371,7 +371,7 @@ viewDocuments cId t ntId mQuery = proc () -> do
(toNullable $ nn^.nn_score) (toNullable $ nn^.nn_score)
------------------------------------------------------------------------ ------------------------------------------------------------------------
filterWith :: (PGOrd date, PGOrd title, PGOrd category, PGOrd score, hyperdata ~ Column SqlJsonb) => filterWith :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ Column SqlJsonb) =>
Maybe Gargantext.Core.Types.Offset Maybe Gargantext.Core.Types.Offset
-> Maybe Gargantext.Core.Types.Limit -> Maybe Gargantext.Core.Types.Limit
-> Maybe OrderBy -> Maybe OrderBy
...@@ -380,7 +380,7 @@ filterWith :: (PGOrd date, PGOrd title, PGOrd category, PGOrd score, hyperdata ~ ...@@ -380,7 +380,7 @@ filterWith :: (PGOrd date, PGOrd title, PGOrd category, PGOrd score, hyperdata ~
filterWith o l order q = limit' l $ offset' o $ orderBy (orderWith order) q filterWith o l order q = limit' l $ offset' o $ orderBy (orderWith order) q
orderWith :: (PGOrd b1, PGOrd b2, PGOrd b3, PGOrd b4) orderWith :: (SqlOrd b1, SqlOrd b2, SqlOrd b3, SqlOrd b4)
=> Maybe OrderBy => Maybe OrderBy
-> Order (Facet id (Column b1) (Column b2) (Column SqlJsonb) (Column b3) ngramCount (Column b4)) -> Order (Facet id (Column b1) (Column b2) (Column SqlJsonb) (Column b3) ngramCount (Column b4))
orderWith (Just DateAsc) = asc facetDoc_created orderWith (Just DateAsc) = asc facetDoc_created
...@@ -397,7 +397,7 @@ orderWith (Just SourceDesc) = desc facetDoc_source ...@@ -397,7 +397,7 @@ orderWith (Just SourceDesc) = desc facetDoc_source
orderWith _ = asc facetDoc_created orderWith _ = asc facetDoc_created
facetDoc_source :: PGIsJson a facetDoc_source :: SqlIsJson a
=> Facet id created title (Column a) favorite ngramCount score => Facet id created title (Column a) favorite ngramCount score
-> Column (Nullable PGText) -> Column (Nullable PGText)
facetDoc_source x = toNullable (facetDoc_hyperdata x) .->> pgString "source" facetDoc_source x = toNullable (facetDoc_hyperdata x) .->> pgString "source"
...@@ -39,7 +39,7 @@ import Gargantext.Database.Types ...@@ -39,7 +39,7 @@ import Gargantext.Database.Types
import Gargantext.Prelude import Gargantext.Prelude
queryNgramsTable :: Query NgramsRead queryNgramsTable :: Query NgramsRead
queryNgramsTable = queryTable ngramsTable queryNgramsTable = selectTable ngramsTable
selectNgramsByDoc :: [ListId] -> DocId -> NgramsType -> Cmd err [Text] selectNgramsByDoc :: [ListId] -> DocId -> NgramsType -> Cmd err [Text]
selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt) selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt)
......
...@@ -44,7 +44,7 @@ import Gargantext.Prelude hiding (sum, head) ...@@ -44,7 +44,7 @@ import Gargantext.Prelude hiding (sum, head)
queryNodeSearchTable :: Query NodeSearchRead queryNodeSearchTable :: Query NodeSearchRead
queryNodeSearchTable = queryTable nodeTableSearch queryNodeSearchTable = selectTable nodeTableSearch
selectNode :: Column PGInt4 -> Query NodeRead selectNode :: Column PGInt4 -> Query NodeRead
selectNode id' = proc () -> do selectNode id' = proc () -> do
...@@ -78,20 +78,26 @@ selectNodesWith' parentId maybeNodeType = proc () -> do ...@@ -78,20 +78,26 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
let typeId' = maybe 0 toDBid maybeNodeType let typeId' = maybe 0 toDBid maybeNodeType
restrict -< if typeId' > 0 restrict -< if typeId' > 0
then typeId .== (pgInt4 (typeId' :: Int)) then typeId .== (sqlInt4 (typeId' :: Int))
else (pgBool True) else (pgBool True)
returnA -< row ) -< () returnA -< row ) -< ()
returnA -< node' returnA -< node'
deleteNode :: NodeId -> Cmd err Int deleteNode :: NodeId -> Cmd err Int
deleteNode n = mkCmd $ \conn -> deleteNode n = mkCmd $ \conn ->
fromIntegral <$> runDelete conn nodeTable fromIntegral <$> runDelete_ conn
(\(Node n_id _ _ _ _ _ _ _) -> n_id .== pgNodeId n) (Delete nodeTable
(\(Node n_id _ _ _ _ _ _ _) -> n_id .== pgNodeId n)
rCount
)
deleteNodes :: [NodeId] -> Cmd err Int deleteNodes :: [NodeId] -> Cmd err Int
deleteNodes ns = mkCmd $ \conn -> deleteNodes ns = mkCmd $ \conn ->
fromIntegral <$> runDelete conn nodeTable fromIntegral <$> runDelete_ conn
(\(Node n_id _ _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id) (Delete nodeTable
(\(Node n_id _ _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id)
rCount
)
-- TODO: NodeType should match with `a' -- TODO: NodeType should match with `a'
getNodesWith :: (JSONB a, HasDBid NodeType) => NodeId -> proxy a -> Maybe NodeType getNodesWith :: (JSONB a, HasDBid NodeType) => NodeId -> proxy a -> Maybe NodeType
...@@ -168,7 +174,7 @@ getNodesWithType nt _ = runOpaQuery $ selectNodesWithType nt ...@@ -168,7 +174,7 @@ getNodesWithType nt _ = runOpaQuery $ selectNodesWithType nt
=> NodeType -> Query NodeRead => NodeType -> Query NodeRead
selectNodesWithType nt' = proc () -> do selectNodesWithType nt' = proc () -> do
row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< () row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
restrict -< tn .== (pgInt4 $ toDBid nt') restrict -< tn .== (sqlInt4 $ toDBid nt')
returnA -< row returnA -< row
getNodesIdWithType :: (HasNodeError err, HasDBid NodeType) => NodeType -> Cmd err [NodeId] getNodesIdWithType :: (HasNodeError err, HasDBid NodeType) => NodeType -> Cmd err [NodeId]
...@@ -180,7 +186,7 @@ selectNodesIdWithType :: HasDBid NodeType ...@@ -180,7 +186,7 @@ selectNodesIdWithType :: HasDBid NodeType
=> NodeType -> Query (Column PGInt4) => NodeType -> Query (Column PGInt4)
selectNodesIdWithType nt = proc () -> do selectNodesIdWithType nt = proc () -> do
row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< () row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
restrict -< tn .== (pgInt4 $ toDBid nt) restrict -< tn .== (sqlInt4 $ toDBid nt)
returnA -< _node_id row returnA -< _node_id row
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -229,10 +235,10 @@ node :: (ToJSON a, Hyperdata a, HasDBid NodeType) ...@@ -229,10 +235,10 @@ node :: (ToJSON a, Hyperdata a, HasDBid NodeType)
-> NodeWrite -> NodeWrite
node nodeType name hyperData parentId userId = node nodeType name hyperData parentId userId =
Node Nothing Nothing Node Nothing Nothing
(pgInt4 typeId) (sqlInt4 typeId)
(pgInt4 userId) (sqlInt4 userId)
(pgNodeId <$> parentId) (pgNodeId <$> parentId)
(pgStrictText name) (sqlStrictText name)
Nothing Nothing
(pgJSONB $ cs $ encode hyperData) (pgJSONB $ cs $ encode hyperData)
where where
...@@ -250,10 +256,10 @@ insertNodes' ns = mkCmd $ \conn -> runInsert_ conn ...@@ -250,10 +256,10 @@ insertNodes' ns = mkCmd $ \conn -> runInsert_ conn
ns' :: [NodeWrite] ns' :: [NodeWrite]
ns' = map (\(Node i t u p n d h) ns' = map (\(Node i t u p n d h)
-> Node (pgNodeId <$> i) -> Node (pgNodeId <$> i)
(pgInt4 $ toDBid t) (sqlInt4 $ toDBid t)
(pgInt4 u) (sqlInt4 u)
(pgNodeId <$> p) (pgNodeId <$> p)
(pgStrictText n) (sqlStrictText n)
(pgUTCTime <$> d) (pgUTCTime <$> d)
(pgJSONB $ cs $ encode h) (pgJSONB $ cs $ encode h)
) ns ) ns
...@@ -275,7 +281,7 @@ insertNodesWithParentR pid ns = insertNodesR (set node_parent_id (pgNodeId <$> p ...@@ -275,7 +281,7 @@ insertNodesWithParentR pid ns = insertNodesR (set node_parent_id (pgNodeId <$> p
node2table :: HasDBid NodeType node2table :: HasDBid NodeType
=> UserId -> Maybe ParentId -> Node' -> NodeWrite => UserId -> Maybe ParentId -> Node' -> NodeWrite
node2table uid pid (Node' nt txt v []) = Node Nothing Nothing (pgInt4 $ toDBid nt) (pgInt4 uid) (fmap pgNodeId pid) (pgStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v) node2table uid pid (Node' nt txt v []) = Node Nothing Nothing (sqlInt4 $ toDBid nt) (sqlInt4 uid) (fmap pgNodeId pid) (sqlStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v)
node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet" node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet"
......
...@@ -75,7 +75,7 @@ selectChildren parentId maybeNodeType = proc () -> do ...@@ -75,7 +75,7 @@ selectChildren parentId maybeNodeType = proc () -> do
(NodeNode n1id n2id _ _) <- queryNodeNodeTable -< () (NodeNode n1id n2id _ _) <- queryNodeNodeTable -< ()
let nodeType = maybe 0 toDBid maybeNodeType let nodeType = maybe 0 toDBid maybeNodeType
restrict -< typeName .== pgInt4 nodeType restrict -< typeName .== sqlInt4 nodeType
restrict -< (.||) (parent_id .== (pgNodeId parentId)) restrict -< (.||) (parent_id .== (pgNodeId parentId))
( (.&&) (n1id .== pgNodeId parentId) ( (.&&) (n1id .== pgNodeId parentId)
......
...@@ -31,8 +31,8 @@ selectNodesWithUsername nt u = runOpaQuery (q u) ...@@ -31,8 +31,8 @@ selectNodesWithUsername nt u = runOpaQuery (q u)
where where
q u' = proc () -> do q u' = proc () -> do
(n,usrs) <- join' -< () (n,usrs) <- join' -< ()
restrict -< user_username usrs .== (toNullable $ pgStrictText u') restrict -< user_username usrs .== (toNullable $ sqlStrictText u')
restrict -< _node_typename n .== (pgInt4 $ toDBid nt) restrict -< _node_typename n .== (sqlInt4 $ toDBid nt)
returnA -< _node_id n returnA -< _node_id n
join' :: Query (NodeRead, UserReadNull) join' :: Query (NodeRead, UserReadNull)
......
...@@ -54,7 +54,7 @@ import Gargantext.Prelude ...@@ -54,7 +54,7 @@ import Gargantext.Prelude
queryNodeNodeTable :: Query NodeNodeRead queryNodeNodeTable :: Query NodeNodeRead
queryNodeNodeTable = queryTable nodeNodeTable queryNodeNodeTable = selectTable nodeNodeTable
-- | not optimized (get all ngrams without filters) -- | not optimized (get all ngrams without filters)
_nodesNodes :: Cmd err [NodeNode] _nodesNodes :: Cmd err [NodeNode]
...@@ -87,7 +87,7 @@ getNodeNodeWith pId _ maybeNodeType = runOpaQuery query ...@@ -87,7 +87,7 @@ getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
(NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< () (NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
let nodeType = maybe 0 toDBid maybeNodeType let nodeType = maybe 0 toDBid maybeNodeType
restrict -< typeName .== pgInt4 nodeType restrict -< typeName .== sqlInt4 nodeType
restrict -< (.||) (parent_id .== (pgNodeId parentId)) restrict -< (.||) (parent_id .== (pgNodeId parentId))
( (.&&) (n1id .== pgNodeId parentId) ( (.&&) (n1id .== pgNodeId parentId)
...@@ -105,7 +105,7 @@ insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn ...@@ -105,7 +105,7 @@ insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
-> NodeNode (pgNodeId n1) -> NodeNode (pgNodeId n1)
(pgNodeId n2) (pgNodeId n2)
(pgDouble <$> x) (pgDouble <$> x)
(pgInt4 <$> y) (sqlInt4 <$> y)
) ns ) ns
...@@ -116,9 +116,13 @@ type Node2_Id = NodeId ...@@ -116,9 +116,13 @@ type Node2_Id = NodeId
deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int
deleteNodeNode n1 n2 = mkCmd $ \conn -> deleteNodeNode n1 n2 = mkCmd $ \conn ->
fromIntegral <$> runDelete conn nodeNodeTable fromIntegral <$> runDelete_ conn
(\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1 (Delete nodeNodeTable
.&& n2_id .== pgNodeId n2 ) (\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1
.&& n2_id .== pgNodeId n2
)
rCount
)
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Favorite management -- | Favorite management
...@@ -177,8 +181,8 @@ selectCountDocs cId = runCountOpaQuery (queryCountDocs cId) ...@@ -177,8 +181,8 @@ selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
queryCountDocs cId' = proc () -> do queryCountDocs cId' = proc () -> do
(n, nn) <- joinInCorpus -< () (n, nn) <- joinInCorpus -< ()
restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId') restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId')
restrict -< nn^.nn_category .>= (toNullable $ pgInt4 1) restrict -< nn^.nn_category .>= (toNullable $ sqlInt4 1)
restrict -< n^.node_typename .== (pgInt4 $ toDBid NodeDocument) restrict -< n^.node_typename .== (sqlInt4 $ toDBid NodeDocument)
returnA -< n returnA -< n
...@@ -198,8 +202,8 @@ queryDocs :: HasDBid NodeType => CorpusId -> O.Query (Column PGJsonb) ...@@ -198,8 +202,8 @@ queryDocs :: HasDBid NodeType => CorpusId -> O.Query (Column PGJsonb)
queryDocs cId = proc () -> do queryDocs cId = proc () -> do
(n, nn) <- joinInCorpus -< () (n, nn) <- joinInCorpus -< ()
restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId) restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId)
restrict -< nn^.nn_category .>= (toNullable $ pgInt4 1) restrict -< nn^.nn_category .>= (toNullable $ sqlInt4 1)
restrict -< n^.node_typename .== (pgInt4 $ toDBid NodeDocument) restrict -< n^.node_typename .== (sqlInt4 $ toDBid NodeDocument)
returnA -< view (node_hyperdata) n returnA -< view (node_hyperdata) n
selectDocNodes :: HasDBid NodeType =>CorpusId -> Cmd err [Node HyperdataDocument] selectDocNodes :: HasDBid NodeType =>CorpusId -> Cmd err [Node HyperdataDocument]
...@@ -209,8 +213,8 @@ queryDocNodes :: HasDBid NodeType =>CorpusId -> O.Query NodeRead ...@@ -209,8 +213,8 @@ queryDocNodes :: HasDBid NodeType =>CorpusId -> O.Query NodeRead
queryDocNodes cId = proc () -> do queryDocNodes cId = proc () -> do
(n, nn) <- joinInCorpus -< () (n, nn) <- joinInCorpus -< ()
restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId) restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId)
restrict -< nn^.nn_category .>= (toNullable $ pgInt4 1) restrict -< nn^.nn_category .>= (toNullable $ sqlInt4 1)
restrict -< n^.node_typename .== (pgInt4 $ toDBid NodeDocument) restrict -< n^.node_typename .== (sqlInt4 $ toDBid NodeDocument)
returnA -< n returnA -< n
joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull) joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
...@@ -227,13 +231,13 @@ joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond ...@@ -227,13 +231,13 @@ joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
------------------------------------------------------------------------ ------------------------------------------------------------------------
selectPublicNodes :: HasDBid NodeType => (Hyperdata a, QueryRunnerColumnDefault PGJsonb a) selectPublicNodes :: HasDBid NodeType => (Hyperdata a, DefaultFromField PGJsonb a)
=> Cmd err [(Node a, Maybe Int)] => Cmd err [(Node a, Maybe Int)]
selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic) selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
queryWithType :: HasDBid NodeType =>NodeType -> O.Query (NodeRead, Column (Nullable PGInt4)) queryWithType :: HasDBid NodeType =>NodeType -> O.Query (NodeRead, Column (Nullable PGInt4))
queryWithType nt = proc () -> do queryWithType nt = proc () -> do
(n, nn) <- joinOn1 -< () (n, nn) <- joinOn1 -< ()
restrict -< n^.node_typename .== (pgInt4 $ toDBid nt) restrict -< n^.node_typename .== (sqlInt4 $ toDBid nt)
returnA -< (n, nn^.nn_node2_id) returnA -< (n, nn^.nn_node2_id)
...@@ -31,7 +31,7 @@ import Prelude ...@@ -31,7 +31,7 @@ import Prelude
queryNodeNodeNgramsTable :: Query NodeNodeNgramsRead queryNodeNodeNgramsTable :: Query NodeNodeNgramsRead
queryNodeNodeNgramsTable = queryTable nodeNodeNgramsTable queryNodeNodeNgramsTable = selectTable nodeNodeNgramsTable
-- | Insert utils -- | Insert utils
insertNodeNodeNgrams :: [NodeNodeNgrams] -> Cmd err Int insertNodeNodeNgrams :: [NodeNodeNgrams] -> Cmd err Int
...@@ -39,7 +39,7 @@ insertNodeNodeNgrams = insertNodeNodeNgramsW ...@@ -39,7 +39,7 @@ insertNodeNodeNgrams = insertNodeNodeNgramsW
. map (\(NodeNodeNgrams n1 n2 ng nt w) -> . map (\(NodeNodeNgrams n1 n2 ng nt w) ->
NodeNodeNgrams (pgNodeId n1) NodeNodeNgrams (pgNodeId n1)
(pgNodeId n2) (pgNodeId n2)
(pgInt4 ng) (sqlInt4 ng)
(pgNgramsTypeId nt) (pgNgramsTypeId nt)
(pgDouble w) (pgDouble w)
) )
......
...@@ -29,14 +29,14 @@ import Prelude ...@@ -29,14 +29,14 @@ import Prelude
_queryNodeNodeNgrams2Table :: Query NodeNodeNgrams2Read _queryNodeNodeNgrams2Table :: Query NodeNodeNgrams2Read
_queryNodeNodeNgrams2Table = queryTable nodeNodeNgrams2Table _queryNodeNodeNgrams2Table = selectTable nodeNodeNgrams2Table
-- | Insert utils -- | Insert utils
insertNodeNodeNgrams2 :: [NodeNodeNgrams2] -> Cmd err Int insertNodeNodeNgrams2 :: [NodeNodeNgrams2] -> Cmd err Int
insertNodeNodeNgrams2 = insertNodeNodeNgrams2W insertNodeNodeNgrams2 = insertNodeNodeNgrams2W
. map (\(NodeNodeNgrams2 n1 n2 w) -> . map (\(NodeNodeNgrams2 n1 n2 w) ->
NodeNodeNgrams2 (pgNodeId n1) NodeNodeNgrams2 (pgNodeId n1)
(pgInt4 n2) (sqlInt4 n2)
(pgDouble w) (pgDouble w)
) )
......
...@@ -43,7 +43,7 @@ import Gargantext.Prelude ...@@ -43,7 +43,7 @@ import Gargantext.Prelude
queryNode_NodeNgrams_NodeNgrams_Table :: Query Node_NodeNgrams_NodeNgrams_Read queryNode_NodeNgrams_NodeNgrams_Table :: Query Node_NodeNgrams_NodeNgrams_Read
queryNode_NodeNgrams_NodeNgrams_Table = queryTable node_NodeNgrams_NodeNgrams_Table queryNode_NodeNgrams_NodeNgrams_Table = selectTable node_NodeNgrams_NodeNgrams_Table
-- | Select NodeNgramsNgrams -- | Select NodeNgramsNgrams
-- TODO not optimized (get all ngrams without filters) -- TODO not optimized (get all ngrams without filters)
...@@ -56,8 +56,8 @@ insert_Node_NodeNgrams_NodeNgrams :: [Node_NodeNgrams_NodeNgrams] -> Cmd err Int ...@@ -56,8 +56,8 @@ insert_Node_NodeNgrams_NodeNgrams :: [Node_NodeNgrams_NodeNgrams] -> Cmd err Int
insert_Node_NodeNgrams_NodeNgrams = insert_Node_NodeNgrams_NodeNgrams_W insert_Node_NodeNgrams_NodeNgrams = insert_Node_NodeNgrams_NodeNgrams_W
. map (\(Node_NodeNgrams_NodeNgrams n ng1 ng2 maybeWeight) -> . map (\(Node_NodeNgrams_NodeNgrams n ng1 ng2 maybeWeight) ->
Node_NodeNgrams_NodeNgrams (pgNodeId n ) Node_NodeNgrams_NodeNgrams (pgNodeId n )
(pgInt4 <$> ng1) (sqlInt4 <$> ng1)
(pgInt4 ng2) (sqlInt4 ng2)
(pgDouble <$> maybeWeight) (pgDouble <$> maybeWeight)
) )
......
...@@ -30,7 +30,7 @@ import Gargantext.Prelude ...@@ -30,7 +30,7 @@ import Gargantext.Prelude
selectPatches :: Query RepoDbRead selectPatches :: Query RepoDbRead
selectPatches = proc () -> do selectPatches = proc () -> do
repos <- queryTable repoTable -< () repos <- selectTable repoTable -< ()
returnA -< repos returnA -< repos
_selectRepo :: Cmd err [RepoDbNgrams] _selectRepo :: Cmd err [RepoDbNgrams]
...@@ -41,5 +41,5 @@ _insertRepos ns = mkCmd $ \conn -> runInsert_ conn $ Insert repoTable (toWrite n ...@@ -41,5 +41,5 @@ _insertRepos ns = mkCmd $ \conn -> runInsert_ conn $ Insert repoTable (toWrite n
where where
toWrite :: [NgramsStatePatch] -> [RepoDbWrite] toWrite :: [NgramsStatePatch] -> [RepoDbWrite]
toWrite = undefined toWrite = undefined
--ns' = map (\(RepoDbNgrams v ps) -> RepoDbWrite (pgInt4 v) (pgJSONB ps)) ns --ns' = map (\(RepoDbNgrams v ps) -> RepoDbWrite (sqlInt4 v) (pgJSONB ps)) ns
...@@ -54,8 +54,10 @@ insertUsers us = mkCmd $ \c -> runInsert_ c insert ...@@ -54,8 +54,10 @@ insertUsers us = mkCmd $ \c -> runInsert_ c insert
insert = Insert userTable us rCount Nothing insert = Insert userTable us rCount Nothing
deleteUsers :: [Username] -> Cmd err Int64 deleteUsers :: [Username] -> Cmd err Int64
deleteUsers us = mkCmd $ \c -> runDelete c userTable deleteUsers us = mkCmd $ \c -> runDelete_ c
(\user -> in_ (map pgStrictText us) (user_username user)) $ Delete userTable
(\user -> in_ (map sqlStrictText us) (user_username user))
rCount
-- Updates email or password only (for now) -- Updates email or password only (for now)
updateUserDB :: UserWrite -> Cmd err Int64 updateUserDB :: UserWrite -> Cmd err Int64
...@@ -76,11 +78,11 @@ updateUserDB us = mkCmd $ \c -> runUpdate_ c (updateUserQuery us) ...@@ -76,11 +78,11 @@ updateUserDB us = mkCmd $ \c -> runUpdate_ c (updateUserQuery us)
----------------------------------------------------------------------- -----------------------------------------------------------------------
toUserWrite :: NewUser HashPassword -> UserWrite toUserWrite :: NewUser HashPassword -> UserWrite
toUserWrite (NewUser u m (Auth.PasswordHash p)) = toUserWrite (NewUser u m (Auth.PasswordHash p)) =
UserDB (Nothing) (pgStrictText p) UserDB (Nothing) (sqlStrictText p)
(Nothing) (pgBool True) (pgStrictText u) (Nothing) (pgBool True) (sqlStrictText u)
(pgStrictText "first_name") (sqlStrictText "first_name")
(pgStrictText "last_name") (sqlStrictText "last_name")
(pgStrictText m) (sqlStrictText m)
(pgBool True) (pgBool True)
(pgBool True) Nothing (pgBool True) Nothing
...@@ -91,25 +93,23 @@ getUsersWith u = map toUserLight <$> runOpaQuery (selectUsersLightWith u) ...@@ -91,25 +93,23 @@ getUsersWith u = map toUserLight <$> runOpaQuery (selectUsersLightWith u)
selectUsersLightWith :: Username -> Query UserRead selectUsersLightWith :: Username -> Query UserRead
selectUsersLightWith u = proc () -> do selectUsersLightWith u = proc () -> do
row <- queryUserTable -< () row <- queryUserTable -< ()
restrict -< user_username row .== pgStrictText u restrict -< user_username row .== sqlStrictText u
returnA -< row returnA -< row
---------------------------------------------------------- ----------------------------------------------------------
getUsersWithId :: Int -> Cmd err [UserLight] getUsersWithId :: Int -> Cmd err [UserLight]
getUsersWithId i = map toUserLight <$> runOpaQuery (selectUsersLightWithId i) getUsersWithId i = map toUserLight <$> runOpaQuery (selectUsersLightWithId i)
where where
selectUsersLightWithId :: Int -> Query UserRead selectUsersLightWithId :: Int -> Query UserRead
selectUsersLightWithId i' = proc () -> do selectUsersLightWithId i' = proc () -> do
row <- queryUserTable -< () row <- queryUserTable -< ()
restrict -< user_id row .== pgInt4 i' restrict -< user_id row .== sqlInt4 i'
returnA -< row returnA -< row
queryUserTable :: Query UserRead queryUserTable :: Query UserRead
queryUserTable = queryTable userTable queryUserTable = selectTable userTable
------------------------------------------------------------------ ------------------------------------------------------------------
-- | Select User with some parameters -- | Select User with some parameters
...@@ -147,5 +147,5 @@ insertNewUsers newUsers = do ...@@ -147,5 +147,5 @@ insertNewUsers newUsers = do
insertUsers $ map toUserWrite users' insertUsers $ map toUserWrite users'
---------------------------------------------------------------------- ----------------------------------------------------------------------
instance QueryRunnerColumnDefault PGTimestamptz (Maybe UTCTime) where instance DefaultFromField PGTimestamptz (Maybe UTCTime) where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
...@@ -31,7 +31,7 @@ import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead) ...@@ -31,7 +31,7 @@ import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead)
import Gargantext.Database.Schema.Node (queryNodeTable) import Gargantext.Database.Schema.Node (queryNodeTable)
import Gargantext.Prelude import Gargantext.Prelude
import Opaleye (restrict, (.==), Query) import Opaleye (restrict, (.==), Query)
import Opaleye.PGTypes (pgStrictText, pgInt4) import Opaleye.SqlTypes (sqlStrictText, sqlInt4)
getRootId :: (HasNodeError err) => User -> Cmd err NodeId getRootId :: (HasNodeError err) => User -> Cmd err NodeId
...@@ -119,21 +119,21 @@ selectRoot :: User -> Query NodeRead ...@@ -119,21 +119,21 @@ selectRoot :: User -> Query NodeRead
selectRoot (UserName username) = proc () -> do selectRoot (UserName username) = proc () -> do
row <- queryNodeTable -< () row <- queryNodeTable -< ()
users <- queryUserTable -< () users <- queryUserTable -< ()
restrict -< _node_typename row .== (pgInt4 $ toDBid NodeUser) restrict -< _node_typename row .== (sqlInt4 $ toDBid NodeUser)
restrict -< user_username users .== (pgStrictText username) restrict -< user_username users .== (sqlStrictText username)
restrict -< _node_user_id row .== (user_id users) restrict -< _node_user_id row .== (user_id users)
returnA -< row returnA -< row
selectRoot (UserDBId uid) = proc () -> do selectRoot (UserDBId uid) = proc () -> do
row <- queryNodeTable -< () row <- queryNodeTable -< ()
restrict -< _node_typename row .== (pgInt4 $ toDBid NodeUser) restrict -< _node_typename row .== (sqlInt4 $ toDBid NodeUser)
restrict -< _node_user_id row .== (pgInt4 uid) restrict -< _node_user_id row .== (sqlInt4 uid)
returnA -< row returnA -< row
selectRoot (RootId nid) = selectRoot (RootId nid) =
proc () -> do proc () -> do
row <- queryNodeTable -< () row <- queryNodeTable -< ()
restrict -< _node_typename row .== (pgInt4 $ toDBid NodeUser) restrict -< _node_typename row .== (sqlInt4 $ toDBid NodeUser)
restrict -< _node_id row .== (pgNodeId nid) restrict -< _node_id row .== (pgNodeId nid)
returnA -< row returnA -< row
selectRoot UserPublic = panic {-nodeError $ NodeError-} "[G.D.Q.T.Root.selectRoot] No root for Public" selectRoot UserPublic = panic {-nodeError $ NodeError-} "[G.D.Q.T.Root.selectRoot] No root for Public"
...@@ -65,9 +65,9 @@ makeLenses ''NgramsPoly ...@@ -65,9 +65,9 @@ makeLenses ''NgramsPoly
ngramsTable :: Table NgramsWrite NgramsRead ngramsTable :: Table NgramsWrite NgramsRead
ngramsTable = Table "ngrams" (pNgramsDb NgramsDB { _ngrams_id = optional "id" ngramsTable = Table "ngrams" (pNgramsDb NgramsDB { _ngrams_id = optionalTableField "id"
, _ngrams_terms = required "terms" , _ngrams_terms = requiredTableField "terms"
, _ngrams_n = required "n" , _ngrams_n = requiredTableField "n"
} }
) )
...@@ -117,15 +117,15 @@ instance ToParamSchema NgramsType where ...@@ -117,15 +117,15 @@ instance ToParamSchema NgramsType where
toParamSchema _ = toParamSchema (Proxy :: Proxy TODO) toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
instance QueryRunnerColumnDefault (Nullable PGInt4) NgramsTypeId instance DefaultFromField (Nullable PGInt4) NgramsTypeId
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
pgNgramsType :: NgramsType -> Column PGInt4 pgNgramsType :: NgramsType -> Column PGInt4
pgNgramsType = pgNgramsTypeId . ngramsTypeId pgNgramsType = pgNgramsTypeId . ngramsTypeId
pgNgramsTypeId :: NgramsTypeId -> Column PGInt4 pgNgramsTypeId :: NgramsTypeId -> Column PGInt4
pgNgramsTypeId (NgramsTypeId n) = pgInt4 n pgNgramsTypeId (NgramsTypeId n) = sqlInt4 n
ngramsTypeId :: NgramsType -> NgramsTypeId ngramsTypeId :: NgramsType -> NgramsTypeId
ngramsTypeId Authors = 1 ngramsTypeId Authors = 1
......
...@@ -55,22 +55,22 @@ $(makeAdaptorAndInstance "pNode" ''NodePoly) ...@@ -55,22 +55,22 @@ $(makeAdaptorAndInstance "pNode" ''NodePoly)
$(makeLensesWith abbreviatedFields ''NodePoly) $(makeLensesWith abbreviatedFields ''NodePoly)
nodeTable :: Table NodeWrite NodeRead nodeTable :: Table NodeWrite NodeRead
nodeTable = Table "nodes" (pNode Node { _node_id = optional "id" nodeTable = Table "nodes" (pNode Node { _node_id = optionalTableField "id"
, _node_hash_id = optional "hash_id" , _node_hash_id = optionalTableField "hash_id"
, _node_typename = required "typename" , _node_typename = requiredTableField "typename"
, _node_user_id = required "user_id" , _node_user_id = requiredTableField "user_id"
, _node_parent_id = optional "parent_id" , _node_parent_id = optionalTableField "parent_id"
, _node_name = required "name" , _node_name = requiredTableField "name"
, _node_date = optional "date" , _node_date = optionalTableField "date"
, _node_hyperdata = required "hyperdata" , _node_hyperdata = requiredTableField "hyperdata"
-- ignoring ts_vector field here -- ignoring ts_vector field here
} }
) )
queryNodeTable :: Query NodeRead queryNodeTable :: Query NodeRead
queryNodeTable = queryTable nodeTable queryNodeTable = selectTable nodeTable
------------------------------------------------------------------------ ------------------------------------------------------------------------
type NodeWrite = NodePoly (Maybe (Column PGInt4) ) type NodeWrite = NodePoly (Maybe (Column PGInt4) )
(Maybe (Column PGText) ) (Maybe (Column PGText) )
...@@ -164,17 +164,17 @@ $(makeLenses ''NodePolySearch) ...@@ -164,17 +164,17 @@ $(makeLenses ''NodePolySearch)
nodeTableSearch :: Table NodeSearchWrite NodeSearchRead nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
nodeTableSearch = Table "nodes" ( pNodeSearch nodeTableSearch = Table "nodes" ( pNodeSearch
NodeSearch { _ns_id = optional "id" NodeSearch { _ns_id = optionalTableField "id"
, _ns_typename = required "typename" , _ns_typename = requiredTableField "typename"
, _ns_user_id = required "user_id" , _ns_user_id = requiredTableField "user_id"
, _ns_parent_id = required "parent_id" , _ns_parent_id = requiredTableField "parent_id"
, _ns_name = required "name" , _ns_name = requiredTableField "name"
, _ns_date = optional "date" , _ns_date = optionalTableField "date"
, _ns_hyperdata = required "hyperdata" , _ns_hyperdata = requiredTableField "hyperdata"
, _ns_search = optional "search" , _ns_search = optionalTableField "search"
, _ns_search_title = optional "search_title" , _ns_search_title = optionalTableField "search_title"
} }
) )
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -56,25 +56,25 @@ nodeNodeTable :: Table NodeNodeWrite NodeNodeRead ...@@ -56,25 +56,25 @@ nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
nodeNodeTable = nodeNodeTable =
Table "nodes_nodes" Table "nodes_nodes"
( pNodeNode ( pNodeNode
NodeNode { _nn_node1_id = required "node1_id" NodeNode { _nn_node1_id = requiredTableField "node1_id"
, _nn_node2_id = required "node2_id" , _nn_node2_id = requiredTableField "node2_id"
, _nn_score = optional "score" , _nn_score = optionalTableField "score"
, _nn_category = optional "category" , _nn_category = optionalTableField "category"
} }
) )
instance QueryRunnerColumnDefault (Nullable PGInt4) Int where instance DefaultFromField (Nullable PGInt4) Int where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault (Nullable PGFloat8) Int where instance DefaultFromField (Nullable PGFloat8) Int where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault (Nullable PGFloat8) Double where instance DefaultFromField (Nullable PGFloat8) Double where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where instance DefaultFromField PGFloat8 (Maybe Double) where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where instance DefaultFromField PGInt4 (Maybe Int) where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
...@@ -62,11 +62,11 @@ makeLenses ''NodeNodeNgramsPoly ...@@ -62,11 +62,11 @@ makeLenses ''NodeNodeNgramsPoly
nodeNodeNgramsTable :: Table NodeNodeNgramsWrite NodeNodeNgramsRead nodeNodeNgramsTable :: Table NodeNodeNgramsWrite NodeNodeNgramsRead
nodeNodeNgramsTable = Table "node_node_ngrams" nodeNodeNgramsTable = Table "node_node_ngrams"
( pNodeNodeNgrams NodeNodeNgrams ( pNodeNodeNgrams NodeNodeNgrams
{ _nnng_node1_id = required "node1_id" { _nnng_node1_id = requiredTableField "node1_id"
, _nnng_node2_id = required "node2_id" , _nnng_node2_id = requiredTableField "node2_id"
, _nnng_ngrams_id = required "ngrams_id" , _nnng_ngrams_id = requiredTableField "ngrams_id"
, _nnng_ngramsType = required "ngrams_type" , _nnng_ngramsType = requiredTableField "ngrams_type"
, _nnng_weight = required "weight" , _nnng_weight = requiredTableField "weight"
} }
) )
...@@ -53,9 +53,9 @@ makeLenses ''NodeNodeNgrams2Poly ...@@ -53,9 +53,9 @@ makeLenses ''NodeNodeNgrams2Poly
nodeNodeNgrams2Table :: Table NodeNodeNgrams2Write NodeNodeNgrams2Read nodeNodeNgrams2Table :: Table NodeNodeNgrams2Write NodeNodeNgrams2Read
nodeNodeNgrams2Table = Table "node_node_ngrams2" nodeNodeNgrams2Table = Table "node_node_ngrams2"
( pNodeNodeNgrams2 NodeNodeNgrams2 ( pNodeNodeNgrams2 NodeNodeNgrams2
{ _nnng2_node_id = required "node_id" { _nnng2_node_id = requiredTableField "node_id"
, _nnng2_nodengrams_id = required "nodengrams_id" , _nnng2_nodengrams_id = requiredTableField "nodengrams_id"
, _nnng2_weight = required "weight" , _nnng2_weight = requiredTableField "weight"
} }
) )
...@@ -72,16 +72,16 @@ node_NodeNgrams_NodeNgrams_Table :: Table Node_NodeNgrams_NodeNgrams_Write Node_ ...@@ -72,16 +72,16 @@ node_NodeNgrams_NodeNgrams_Table :: Table Node_NodeNgrams_NodeNgrams_Write Node_
node_NodeNgrams_NodeNgrams_Table = node_NodeNgrams_NodeNgrams_Table =
Table "node_nodengrams_nodengrams" Table "node_nodengrams_nodengrams"
( pNode_NodeNgrams_NodeNgrams Node_NodeNgrams_NodeNgrams ( pNode_NodeNgrams_NodeNgrams Node_NodeNgrams_NodeNgrams
{ _nnn_node_id = required "node_id" { _nnn_node_id = requiredTableField "node_id"
, _nnn_nng1_id = optional "node_ngrams1_id" , _nnn_nng1_id = optionalTableField "node_ngrams1_id"
, _nnn_nng2_id = required "node_ngrams2_id" , _nnn_nng2_id = requiredTableField "node_ngrams2_id"
, _nnn_weight = optional "weight" , _nnn_weight = optionalTableField "weight"
} }
) )
instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where instance DefaultFromField PGInt4 (Maybe Int) where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where instance DefaultFromField PGFloat8 (Maybe Double) where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
...@@ -46,17 +46,17 @@ type RepoDbNgrams = RepoDbPoly Int NgramsStatePatch ...@@ -46,17 +46,17 @@ type RepoDbNgrams = RepoDbPoly Int NgramsStatePatch
$(makeAdaptorAndInstance "pRepoDbNgrams" ''RepoDbPoly) $(makeAdaptorAndInstance "pRepoDbNgrams" ''RepoDbPoly)
makeLenses ''RepoDbPoly makeLenses ''RepoDbPoly
instance QueryRunnerColumnDefault PGJsonb instance DefaultFromField PGJsonb
(PatchMap NgramsType (PatchMap NgramsType
(PatchMap NodeId NgramsTablePatch)) (PatchMap NodeId NgramsTablePatch))
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn defaultFromField = fieldQueryRunnerColumn
repoTable :: Table RepoDbWrite RepoDbRead repoTable :: Table RepoDbWrite RepoDbRead
repoTable = Table "nodes_ngrams_repo" repoTable = Table "nodes_ngrams_repo"
(pRepoDbNgrams RepoDbNgrams (pRepoDbNgrams RepoDbNgrams
{ _rdp_version = required "version" { _rdp_version = requiredTableField "version"
, _rdp_patches = required "patches" , _rdp_patches = requiredTableField "patches"
} }
) )
...@@ -94,17 +94,17 @@ $(makeLensesWith abbreviatedFields ''UserPoly) ...@@ -94,17 +94,17 @@ $(makeLensesWith abbreviatedFields ''UserPoly)
userTable :: Table UserWrite UserRead userTable :: Table UserWrite UserRead
userTable = Table "auth_user" userTable = Table "auth_user"
(pUserDB UserDB { user_id = optional "id" (pUserDB UserDB { user_id = optionalTableField "id"
, user_password = required "password" , user_password = requiredTableField "password"
, user_lastLogin = optional "last_login" , user_lastLogin = optionalTableField "last_login"
, user_isSuperUser = required "is_superuser" , user_isSuperUser = requiredTableField "is_superuser"
, user_username = required "username" , user_username = requiredTableField "username"
, user_firstName = required "first_name" , user_firstName = requiredTableField "first_name"
, user_lastName = required "last_name" , user_lastName = requiredTableField "last_name"
, user_email = required "email" , user_email = requiredTableField "email"
, user_isStaff = required "is_staff" , user_isStaff = requiredTableField "is_staff"
, user_isActive = required "is_active" , user_isActive = requiredTableField "is_active"
, user_dateJoined = optional "date_joined" , user_dateJoined = optionalTableField "date_joined"
} }
) )
......
...@@ -43,10 +43,8 @@ extra-deps: ...@@ -43,10 +43,8 @@ extra-deps:
commit: 8cb8aaf2962ad44d319fcea48442e4397b3c49e8 commit: 8cb8aaf2962ad44d319fcea48442e4397b3c49e8
# Databases libs # Databases libs
#- git: https://github.com/delanoe/haskell-opaleye.git #- opaleye-0.6.7002.0) - git: https://github.com/delanoe/haskell-opaleye.git
# commit: 63ee65d974e9d20eaaf17a2e83652175988cbb79 commit: 9089fa71006d99d01916375818620d78a565b743
- git: https://github.com/cgenie/haskell-opaleye.git
commit: 41e3212e7da83d295cd6d0fa4f0a2b55b86bbbca
- git: https://github.com/delanoe/hsparql.git - git: https://github.com/delanoe/hsparql.git
commit: 308c74b71a1abb0a91546fa57d353131248e3a7f commit: 308c74b71a1abb0a91546fa57d353131248e3a7f
- git: https://github.com/robstewart57/rdf4h.git - git: https://github.com/robstewart57/rdf4h.git
......
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