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

[DEP] haskell-opaleye dep upgrade

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