Skip to content

haskell-gargantext
haskell-gargantext
Commit 670baca2 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[MERGE]

parents 373f1d39 2ca441e5
Hide whitespace changes
Inline Side-by-side
Showing with 73 additions and 24 deletions
src/Gargantext/API.hs
View file @ 670baca2
...@@ -45,6 +45,7 @@ import GHC.Generics (D1, Meta (..), Rep) ...@@ -45,6 +45,7 @@ import GHC.Generics (D1, Meta (..), Rep)
import GHC.TypeLits (AppendSymbol, Symbol) import GHC.TypeLits (AppendSymbol, Symbol)
import Control.Lens import Control.Lens
import Data.Aeson (Value)
import Data.Aeson.Encode.Pretty (encodePretty) import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy.Char8 as BL8 import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Swagger import Data.Swagger
...@@ -70,7 +71,9 @@ import Gargantext.API.Node ( Roots , roots ...@@ -70,7 +71,9 @@ import Gargantext.API.Node ( Roots , roots
, NodesAPI , nodesAPI , NodesAPI , nodesAPI
, GraphAPI , graphAPI , GraphAPI , graphAPI
, TreeAPI , treeAPI , TreeAPI , treeAPI
, HyperdataCorpus
) )
import Gargantext.Database.Types.Node ()
import Gargantext.API.Count ( CountAPI, count, Query) import Gargantext.API.Count ( CountAPI, count, Query)
import Gargantext.API.Search ( SearchAPI, search, SearchQuery) import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
--import Gargantext.API.Orchestrator --import Gargantext.API.Orchestrator
...@@ -206,12 +209,12 @@ type GargAPI' = ...@@ -206,12 +209,12 @@ type GargAPI' =
-- Node endpoint -- Node endpoint
:<|> "node" :> Summary "Node endpoint" :<|> "node" :> Summary "Node endpoint"
:> Capture "id" Int :> NodeAPI :> Capture "id" Int :> NodeAPI Value
-- Corpus endpoint -- Corpus endpoint
:<|> "corpus":> Summary "Corpus endpoint" :<|> "corpus":> Summary "Corpus endpoint"
:> Capture "id" Int :> NodeAPI :> Capture "id" Int :> NodeAPI HyperdataCorpus
-- Corpus endpoint -- Corpus endpoint
:<|> "nodes" :> Summary "Nodes endpoint" :<|> "nodes" :> Summary "Nodes endpoint"
...@@ -255,8 +258,8 @@ server env = do ...@@ -255,8 +258,8 @@ server env = do
-- orchestrator <- scrapyOrchestrator env -- orchestrator <- scrapyOrchestrator env
pure $ swaggerFront pure $ swaggerFront
:<|> roots conn :<|> roots conn
:<|> nodeAPI conn :<|> nodeAPI conn (Proxy :: Proxy Value)
:<|> nodeAPI conn :<|> nodeAPI conn (Proxy :: Proxy HyperdataCorpus)
:<|> nodesAPI conn :<|> nodesAPI conn
:<|> count -- TODO: undefined :<|> count -- TODO: undefined
:<|> search conn :<|> search conn
......
src/Gargantext/API/Node.hs
View file @ 670baca2
...@@ -14,6 +14,7 @@ Node API ...@@ -14,6 +14,7 @@ Node API
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
...@@ -21,7 +22,13 @@ Node API ...@@ -21,7 +22,13 @@ Node API
------------------------------------------------------------------- -------------------------------------------------------------------
module Gargantext.API.Node module Gargantext.API.Node
where ( module Gargantext.API.Node
, HyperdataCorpus(..)
, HyperdataResource(..)
, HyperdataUser(..)
, HyperdataDocument(..)
, HyperdataDocumentV3(..)
) where
------------------------------------------------------------------- -------------------------------------------------------------------
import Control.Lens (prism') import Control.Lens (prism')
...@@ -46,7 +53,7 @@ import Gargantext.Database.Types.Node ...@@ -46,7 +53,7 @@ import Gargantext.Database.Types.Node
import Gargantext.Database.Node ( runCmd import Gargantext.Database.Node ( runCmd
, getNodesWithParentId , getNodesWithParentId
, getNode, getNodesWith , getNode, getNodesWith
, deleteNode, deleteNodes, mk) , deleteNode, deleteNodes, mk, JSONB)
import qualified Gargantext.Database.Node.Update as U (update, Update(..)) import qualified Gargantext.Database.Node.Update as U (update, Update(..))
import Gargantext.Database.Facet (FacetDoc, getDocFacet import Gargantext.Database.Facet (FacetDoc, getDocFacet
,FacetChart) ,FacetChart)
...@@ -96,7 +103,7 @@ instance Arbitrary PostNode where ...@@ -96,7 +103,7 @@ instance Arbitrary PostNode where
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
type NodeAPI = Get '[JSON] (Node Value) type NodeAPI a = Get '[JSON] (Node a)
:<|> "rename" :> Summary " RenameNode Node" :<|> "rename" :> Summary " RenameNode Node"
:> ReqBody '[JSON] RenameNode :> ReqBody '[JSON] RenameNode
:> Put '[JSON] [Int] :> Put '[JSON] [Int]
...@@ -109,7 +116,7 @@ type NodeAPI = Get '[JSON] (Node Value) ...@@ -109,7 +116,7 @@ type NodeAPI = Get '[JSON] (Node Value)
:> QueryParam "type" NodeType :> QueryParam "type" NodeType
:> QueryParam "offset" Int :> QueryParam "offset" Int
:> QueryParam "limit" Int :> QueryParam "limit" Int
:> Get '[JSON] [Node Value] :> Get '[JSON] [Node a]
:<|> "facet" :> Summary " Facet documents" :<|> "facet" :> Summary " Facet documents"
:> "documents" :> FacetDocAPI :> "documents" :> FacetDocAPI
-- :<|> "facet" :<|> "sources" :<|> FacetSourcesAPI -- :<|> "facet" :<|> "sources" :<|> FacetSourcesAPI
...@@ -167,13 +174,15 @@ type TreeAPI = Get '[JSON] (Tree NodeTree) ...@@ -167,13 +174,15 @@ type TreeAPI = Get '[JSON] (Tree NodeTree)
treeAPI :: Connection -> NodeId -> Server TreeAPI treeAPI :: Connection -> NodeId -> Server TreeAPI
treeAPI = treeDB treeAPI = treeDB
nodeAPI :: Connection -> NodeId -> Server NodeAPI -- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
nodeAPI conn id = liftIO (putStrLn ("/node" :: Text) >> getNode conn id ) nodeAPI :: JSONB a => Connection -> proxy a -> NodeId -> Server (NodeAPI a)
nodeAPI conn p id
= liftIO (getNode conn id p)
:<|> rename conn id :<|> rename conn id
:<|> postNode conn id :<|> postNode conn id
:<|> putNode conn id :<|> putNode conn id
:<|> deleteNode' conn id :<|> deleteNode' conn id
:<|> getNodesWith' conn id :<|> getNodesWith' conn id p
:<|> getFacet conn id :<|> getFacet conn id
:<|> getChart conn id :<|> getChart conn id
-- :<|> upload -- :<|> upload
...@@ -198,9 +207,9 @@ deleteNodes' conn ids = liftIO (runCmd conn $ deleteNodes ids) ...@@ -198,9 +207,9 @@ deleteNodes' conn ids = liftIO (runCmd conn $ deleteNodes ids)
deleteNode' :: Connection -> NodeId -> Handler Int deleteNode' :: Connection -> NodeId -> Handler Int
deleteNode' conn id = liftIO (runCmd conn $ deleteNode id) deleteNode' conn id = liftIO (runCmd conn $ deleteNode id)
getNodesWith' :: Connection -> NodeId -> Maybe NodeType -> Maybe Int -> Maybe Int getNodesWith' :: JSONB a => Connection -> NodeId -> proxy a -> Maybe NodeType
-> Handler [Node Value] -> Maybe Int -> Maybe Int -> Handler [Node a]
getNodesWith' conn id nodeType offset limit = liftIO (getNodesWith conn id nodeType offset limit) getNodesWith' conn id p nodeType offset limit = liftIO (getNodesWith conn id p nodeType offset limit)
getFacet :: Connection -> NodeId -> Maybe Int -> Maybe Int getFacet :: Connection -> NodeId -> Maybe Int -> Maybe Int
......
src/Gargantext/Database/Bashql.hs
View file @ 670baca2
...@@ -76,10 +76,8 @@ module Gargantext.Database.Bashql ( get ...@@ -76,10 +76,8 @@ module Gargantext.Database.Bashql ( get
import Control.Monad.Reader -- (Reader, ask) import Control.Monad.Reader -- (Reader, ask)
import Safe (lastMay)
import Data.Text (Text) import Data.Text (Text)
import Data.Aeson import Data.Aeson
import Data.Aeson.Types
import Data.List (concat, last) import Data.List (concat, last)
import Gargantext.Core.Types import Gargantext.Core.Types
...@@ -151,7 +149,7 @@ put u = mkCmd $ U.update u ...@@ -151,7 +149,7 @@ put u = mkCmd $ U.update u
-- jump NodeId -- jump NodeId
-- touch Dir -- touch Dir
type Name = Text -- type Name = Text
--mkCorpus :: ToJSON a => Name -> (a -> Text) -> [a] -> Cmd NewNode --mkCorpus :: ToJSON a => Name -> (a -> Text) -> [a] -> Cmd NewNode
......
src/Gargantext/Database/Facet.hs
View file @ 670baca2
...@@ -219,7 +219,7 @@ leftJoin3''' = leftJoin3 queryNodeNodeTable queryNodeTable queryNodeTable cond12 ...@@ -219,7 +219,7 @@ leftJoin3''' = leftJoin3 queryNodeNodeTable queryNodeTable queryNodeTable cond12
-- | Building the facet -- | Building the facet
selectDocFacet' :: NodeType -> ParentId -> Maybe NodeType -> Query FacetDocRead selectDocFacet' :: NodeType -> ParentId -> Maybe NodeType -> Query FacetDocRead
selectDocFacet' _ pId _ = proc () -> do selectDocFacet' _ pId _ = proc () -> do
(n1,(nn,n2)) <- leftJoin3''' -< () (n1,(nn,_n2)) <- leftJoin3''' -< ()
restrict -< (.&&) (_node_parentId n1 .== (toNullable $ pgInt4 pId)) restrict -< (.&&) (_node_parentId n1 .== (toNullable $ pgInt4 pId))
(_node_typename n1 .== (pgInt4 $ nodeTypeId NodeDocument)) (_node_typename n1 .== (pgInt4 $ nodeTypeId NodeDocument))
......
src/Gargantext/Database/Node.hs
View file @ 670baca2
...@@ -13,6 +13,8 @@ Portability : POSIX ...@@ -13,6 +13,8 @@ Portability : POSIX
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
...@@ -235,9 +237,9 @@ deleteNodes ns = mkCmd $ \conn -> ...@@ -235,9 +237,9 @@ deleteNodes ns = mkCmd $ \conn ->
(\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id) (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
getNodesWith :: Connection -> Int -> Maybe NodeType getNodesWith :: JSONB a => Connection -> Int -> proxy a -> Maybe NodeType
-> Maybe Offset -> Maybe Limit -> IO [Node Value] -> Maybe Offset -> Maybe Limit -> IO [Node a]
getNodesWith conn parentId nodeType maybeOffset maybeLimit = getNodesWith conn parentId _ nodeType maybeOffset maybeLimit =
runQuery conn $ selectNodesWith runQuery conn $ selectNodesWith
parentId nodeType maybeOffset maybeLimit parentId nodeType maybeOffset maybeLimit
...@@ -279,9 +281,10 @@ selectNodesWithType type_id = proc () -> do ...@@ -279,9 +281,10 @@ selectNodesWithType type_id = proc () -> do
restrict -< tn .== type_id restrict -< tn .== type_id
returnA -< row returnA -< row
type JSONB = QueryRunnerColumnDefault PGJsonb
getNode :: Connection -> Int -> IO (Node Value) getNode :: JSONB a => Connection -> Int -> proxy a -> IO (Node a)
getNode conn id = do getNode conn id _ = do
fromMaybe (error $ "Node does node exist: " <> show id) . headMay <$> runQuery conn (limit 1 $ selectNode (pgInt4 id)) fromMaybe (error $ "Node does node exist: " <> show id) . headMay <$> runQuery conn (limit 1 $ selectNode (pgInt4 id))
...@@ -467,6 +470,7 @@ childWith _ _ (Node' _ _ _ _) = panic "This NodeType can not be a c ...@@ -467,6 +470,7 @@ childWith _ _ (Node' _ _ _ _) = panic "This NodeType can not be a c
-- TODO: remove hardcoded userId (with Reader) -- TODO: remove hardcoded userId (with Reader)
-- TODO: user Reader in the API and adapt this function -- TODO: user Reader in the API and adapt this function
userId :: Int
userId = 1 userId = 1
mk :: Connection -> NodeType -> Maybe ParentId -> Text -> IO [Int] mk :: Connection -> NodeType -> Maybe ParentId -> Text -> IO [Int]
......
src/Gargantext/Database/Types/Node.hs
View file @ 670baca2
...@@ -157,6 +157,9 @@ instance ToJSON EventLevel ...@@ -157,6 +157,9 @@ instance ToJSON EventLevel
instance Arbitrary EventLevel where instance Arbitrary EventLevel where
arbitrary = elements [minBound..maxBound] arbitrary = elements [minBound..maxBound]
instance ToSchema EventLevel where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
------------------------------------------------------------------------ ------------------------------------------------------------------------
data Event = Event { event_level :: EventLevel data Event = Event { event_level :: EventLevel
...@@ -168,6 +171,9 @@ $(deriveJSON (unPrefix "event_") ''Event) ...@@ -168,6 +171,9 @@ $(deriveJSON (unPrefix "event_") ''Event)
instance Arbitrary Event where instance Arbitrary Event where
arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
instance ToSchema Event where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
------------------------------------------------------------------------ ------------------------------------------------------------------------
type Text' = Text type Text' = Text
...@@ -187,6 +193,9 @@ $(deriveJSON (unPrefix "resource_") ''Resource) ...@@ -187,6 +193,9 @@ $(deriveJSON (unPrefix "resource_") ''Resource)
instance Arbitrary Resource where instance Arbitrary Resource where
arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
instance ToSchema Resource where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
------------------------------------------------------------------------ ------------------------------------------------------------------------
data Hyperdata a = Hyperdata { unHyperdata :: a} data Hyperdata a = Hyperdata { unHyperdata :: a}
...@@ -335,10 +344,11 @@ instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) N ...@@ -335,10 +344,11 @@ instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) N
instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime HyperdataDocument) where instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime HyperdataDocument) where
arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) ((hyperdataDocument))] arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) ((hyperdataDocument))]
instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime HyperdataDocument) where instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime HyperdataDocument) where
arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) hyperdataDocument] arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) hyperdataDocument]
instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime HyperdataCorpus) where
arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) hyperdataCorpus]
------------------------------------------------------------------------ ------------------------------------------------------------------------
hyperdataDocument :: HyperdataDocument hyperdataDocument :: HyperdataDocument
...@@ -352,6 +362,19 @@ hyperdataDocument = case decode docExample of ...@@ -352,6 +362,19 @@ hyperdataDocument = case decode docExample of
docExample :: ByteString docExample :: ByteString
docExample = "{\"doi\":\"sdfds\",\"publication_day\":6,\"language_iso2\":\"en\",\"publication_minute\":0,\"publication_month\":7,\"language_iso3\":\"eng\",\"publication_second\":0,\"authors\":\"Nils Hovdenak, Kjell Haram\",\"publication_year\":2012,\"publication_date\":\"2012-07-06 00:00:00+00:00\",\"language_name\":\"English\",\"realdate_full_\":\"2012 01 12\",\"source\":\"European journal of obstetrics, gynecology, and reproductive biology\",\"abstract\":\"The literature was searched for publications on minerals and vitamins during pregnancy and the possible influence of supplements on pregnancy outcome.\",\"title\":\"Influence of mineral and vitamin supplements on pregnancy outcome.\",\"publication_hour\":0}" docExample = "{\"doi\":\"sdfds\",\"publication_day\":6,\"language_iso2\":\"en\",\"publication_minute\":0,\"publication_month\":7,\"language_iso3\":\"eng\",\"publication_second\":0,\"authors\":\"Nils Hovdenak, Kjell Haram\",\"publication_year\":2012,\"publication_date\":\"2012-07-06 00:00:00+00:00\",\"language_name\":\"English\",\"realdate_full_\":\"2012 01 12\",\"source\":\"European journal of obstetrics, gynecology, and reproductive biology\",\"abstract\":\"The literature was searched for publications on minerals and vitamins during pregnancy and the possible influence of supplements on pregnancy outcome.\",\"title\":\"Influence of mineral and vitamin supplements on pregnancy outcome.\",\"publication_hour\":0}"
corpusExample :: ByteString
corpusExample = "" -- TODO
hyperdataCorpus :: HyperdataCorpus
hyperdataCorpus = case decode corpusExample of
Just hp -> hp
Nothing -> HyperdataCorpus Nothing Nothing Nothing Nothing Nothing
instance ToSchema HyperdataCorpus where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
L.& mapped.schema.description ?~ "a corpus"
L.& mapped.schema.example ?~ toJSON hyperdataCorpus
instance ToSchema HyperdataDocument where instance ToSchema HyperdataDocument where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
...@@ -376,6 +399,18 @@ instance ToSchema (NodePoly NodeId NodeTypeId ...@@ -376,6 +399,18 @@ instance ToSchema (NodePoly NodeId NodeTypeId
UTCTime HyperdataDocument UTCTime HyperdataDocument
) )
instance ToSchema (NodePoly NodeId NodeTypeId
(Maybe NodeUserId)
NodeParentId NodeName
UTCTime HyperdataCorpus
)
instance ToSchema (NodePoly NodeId NodeTypeId
(NodeUserId)
(Maybe NodeParentId) NodeName
UTCTime HyperdataCorpus
)
instance ToSchema (NodePoly NodeId NodeTypeId instance ToSchema (NodePoly NodeId NodeTypeId
(Maybe NodeUserId) (Maybe NodeUserId)
NodeParentId NodeName NodeParentId NodeName
......
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