Skip to content

H
haskell-gargantext
Commit 68bef8fc authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[SPECS/DOC] Adding Swagger Documentation, first draft POC.

parent cd57e038
Expand all Show whitespace changes
Inline Side-by-side
Showing with 781 additions and 181 deletions
gargantext.cabal
View file @ 68bef8fc
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: 9ca7bccb26ab6144a79d1d7467c3d0a7db86824f3e03332d586ec2cfec04e503 -- hash: 77bf1f45b7b9eececd1b8192dcff6ab64602222d598b7571ccafd4e14c0b6267
name: gargantext name: gargantext
version: 0.1.0.0 version: 0.1.0.0
...@@ -19,6 +19,48 @@ build-type: Simple ...@@ -19,6 +19,48 @@ build-type: Simple
cabal-version: >= 1.10 cabal-version: >= 1.10
library library
exposed-modules:
Gargantext
Gargantext.Analysis
Gargantext.DSL
Gargantext.Database
Gargantext.Database.Instances
Gargantext.Database.Ngram
Gargantext.Database.Node
Gargantext.Database.Facet
Gargantext.Database.NodeNgram
Gargantext.Database.NodeNgramNgram
Gargantext.Database.NodeNode
Gargantext.Database.NodeNodeNgram
Gargantext.Database.Utils
Gargantext.Database.User
Gargantext.Ngrams
Gargantext.Ngrams.Count
Gargantext.Ngrams.CoreNLP
Gargantext.Ngrams.Parser
Gargantext.Ngrams.Lang.En
Gargantext.Ngrams.Lang.Fr
Gargantext.Ngrams.Metrics
Gargantext.Ngrams.TextMining
Gargantext.Ngrams.Occurrences
Gargantext.Parsers
Gargantext.Parsers.WOS
Gargantext.Parsers.Date
Gargantext.Prelude
Gargantext.RCT
Gargantext.API
Gargantext.API.Auth
Gargantext.Types
Gargantext.Types.Main
Gargantext.Types.Node
Gargantext.Utils.DateUtils
Gargantext.Utils.Prefix
other-modules:
Gargantext.API.Count
Gargantext.API.Node
Gargantext.Database.Queries
Gargantext.Utils
Paths_gargantext
hs-source-dirs: hs-source-dirs:
src src
default-extensions: NoImplicitPrelude default-extensions: NoImplicitPrelude
...@@ -27,6 +69,7 @@ library ...@@ -27,6 +69,7 @@ library
QuickCheck QuickCheck
, aeson , aeson
, aeson-lens , aeson-lens
, aeson-pretty
, async , async
, attoparsec , attoparsec
, base >=4.7 && <5 , base >=4.7 && <5
...@@ -67,6 +110,7 @@ library ...@@ -67,6 +110,7 @@ library
, servant-server , servant-server
, servant-swagger , servant-swagger
, split , split
, swagger2
, tagsoup , tagsoup
, text , text
, text-metrics , text-metrics
...@@ -82,52 +126,12 @@ library ...@@ -82,52 +126,12 @@ library
, yaml , yaml
, zip , zip
, zlib , zlib
exposed-modules:
Gargantext
Gargantext.Analysis
Gargantext.DSL
Gargantext.Database
Gargantext.Database.Instances
Gargantext.Database.Ngram
Gargantext.Database.Node
Gargantext.Database.Facet
Gargantext.Database.NodeNgram
Gargantext.Database.NodeNgramNgram
Gargantext.Database.NodeNode
Gargantext.Database.NodeNodeNgram
Gargantext.Database.Utils
Gargantext.Database.User
Gargantext.Ngrams
Gargantext.Ngrams.Count
Gargantext.Ngrams.CoreNLP
Gargantext.Ngrams.Parser
Gargantext.Ngrams.Lang.En
Gargantext.Ngrams.Lang.Fr
Gargantext.Ngrams.Metrics
Gargantext.Ngrams.TextMining
Gargantext.Ngrams.Occurrences
Gargantext.Parsers
Gargantext.Parsers.WOS
Gargantext.Parsers.Date
Gargantext.Prelude
Gargantext.RCT
Gargantext.API
Gargantext.API.Auth
Gargantext.Types
Gargantext.Types.Main
Gargantext.Types.Node
Gargantext.Utils.DateUtils
Gargantext.Utils.Prefix
other-modules:
Gargantext.API.Count
Gargantext.API.Node
Gargantext.Database.Queries
Gargantext.Utils
Paths_gargantext
default-language: Haskell2010 default-language: Haskell2010
executable gargantext executable gargantext
main-is: Main.hs main-is: Main.hs
other-modules:
Paths_gargantext
hs-source-dirs: hs-source-dirs:
app app
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2
...@@ -138,13 +142,13 @@ executable gargantext ...@@ -138,13 +142,13 @@ executable gargantext
, ini , ini
, text , text
, unordered-containers , unordered-containers
other-modules:
Paths_gargantext
default-language: Haskell2010 default-language: Haskell2010
test-suite garg-doctest test-suite garg-doctest
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
main-is: Main.hs main-is: Main.hs
other-modules:
Paths_gargantext
hs-source-dirs: hs-source-dirs:
src-doctest src-doctest
ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N
...@@ -156,13 +160,19 @@ test-suite garg-doctest ...@@ -156,13 +160,19 @@ test-suite garg-doctest
, extra , extra
, gargantext , gargantext
, text , text
other-modules:
Paths_gargantext
default-language: Haskell2010 default-language: Haskell2010
test-suite garg-test test-suite garg-test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
main-is: Main.hs main-is: Main.hs
other-modules:
Ngrams.Lang
Ngrams.Lang.En
Ngrams.Lang.Fr
Ngrams.Lang.Occurrences
Ngrams.Metrics
Parsers.WOS
Paths_gargantext
hs-source-dirs: hs-source-dirs:
src-test src-test
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
...@@ -173,12 +183,4 @@ test-suite garg-test ...@@ -173,12 +183,4 @@ test-suite garg-test
, gargantext , gargantext
, hspec , hspec
, text , text
other-modules:
Ngrams.Lang
Ngrams.Lang.En
Ngrams.Lang.Fr
Ngrams.Lang.Occurrences
Ngrams.Metrics
Parsers.WOS
Paths_gargantext
default-language: Haskell2010 default-language: Haskell2010
package.yaml
View file @ 68bef8fc
...@@ -61,6 +61,7 @@ library: ...@@ -61,6 +61,7 @@ library:
- QuickCheck - QuickCheck
- aeson - aeson
- aeson-lens - aeson-lens
- aeson-pretty
- async - async
- attoparsec - attoparsec
- base >=4.7 && <5 - base >=4.7 && <5
...@@ -100,6 +101,7 @@ library: ...@@ -100,6 +101,7 @@ library:
- servant-server - servant-server
- servant-swagger - servant-swagger
- split - split
- swagger2
- tagsoup - tagsoup
- text-metrics - text-metrics
- time - time
......
src/Gargantext/API.hs
View file @ 68bef8fc
...@@ -23,25 +23,35 @@ Thanks @yannEsposito for this. ...@@ -23,25 +23,35 @@ Thanks @yannEsposito for this.
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
---------------------------------------------------------------------
module Gargantext.API module Gargantext.API
where where
---------------------------------------------------------------------
import Gargantext.Prelude import Gargantext.Prelude
import System.IO (FilePath, print)
import Control.Lens
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Swagger
import Data.Text (pack)
import Database.PostgreSQL.Simple (Connection, connect)
import Network.Wai import Network.Wai
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
import Servant import Servant
import Servant.Mock (mock) import Servant.Mock (mock)
import Servant.Swagger
-- import Servant.API.Stream -- import Servant.API.Stream
import Data.Text (pack)
import Database.PostgreSQL.Simple (Connection, connect)
import System.IO (FilePath, print)
-- import Gargantext.API.Auth -- import Gargantext.API.Auth
import Gargantext.API.Node ( Roots , roots import Gargantext.API.Node ( Roots , roots
...@@ -49,7 +59,6 @@ import Gargantext.API.Node ( Roots , roots ...@@ -49,7 +59,6 @@ import Gargantext.API.Node ( Roots , roots
, NodesAPI , nodesAPI , NodesAPI , nodesAPI
) )
import Gargantext.API.Count ( CountAPI, count, Query) import Gargantext.API.Count ( CountAPI, count, Query)
import Gargantext.Database.Utils (databaseParameters) import Gargantext.Database.Utils (databaseParameters)
--------------------------------------------------------------------- ---------------------------------------------------------------------
...@@ -79,10 +88,11 @@ startGargantextMock port = do ...@@ -79,10 +88,11 @@ startGargantextMock port = do
run port ( serve api $ mock api Proxy ) run port ( serve api $ mock api Proxy )
--------------------------------------------------------------------- ---------------------------------------------------------------------
--------------------------------------------------------------------- -- | API Global
type API = GargAPI
-- | Main routes of the API are typed -- | API for serving main operational routes of @gargantext.org@
type API = "roots" :> Roots type GargAPI = "roots" :> Roots
:<|> "node" :> Capture "id" Int :> NodeAPI :<|> "node" :> Capture "id" Int :> NodeAPI
:<|> "nodes" :> ReqBody '[JSON] [Int] :> NodesAPI :<|> "nodes" :> ReqBody '[JSON] [Int] :> NodesAPI
...@@ -97,8 +107,7 @@ type API = "roots" :> Roots ...@@ -97,8 +107,7 @@ type API = "roots" :> Roots
-- :<|> "list" :> Capture "id" Int :> NodeAPI -- :<|> "list" :> Capture "id" Int :> NodeAPI
-- :<|> "ngrams" :> Capture "id" Int :> NodeAPI -- :<|> "ngrams" :> Capture "id" Int :> NodeAPI
-- :<|> "auth" :> Capture "id" Int :> NodeAPI -- :<|> "auth" :> Capture "id" Int :> NodeAPI
---------------------------------------------------------------------
-- | Server declaration -- | Server declaration
server :: Connection -> Server API server :: Connection -> Server API
server conn = roots conn server conn = roots conn
...@@ -106,7 +115,6 @@ server conn = roots conn ...@@ -106,7 +115,6 @@ server conn = roots conn
:<|> nodesAPI conn :<|> nodesAPI conn
:<|> count :<|> count
---------------------------------------------------------------------
--------------------------------------------------------------------- ---------------------------------------------------------------------
app :: Connection -> Application app :: Connection -> Application
app = serve api . server app = serve api . server
...@@ -114,5 +122,21 @@ app = serve api . server ...@@ -114,5 +122,21 @@ app = serve api . server
api :: Proxy API api :: Proxy API
api = Proxy api = Proxy
--------------------------------------------------------------------- ---------------------------------------------------------------------
---------------------------------------------------------------------
-- | Swagger Specifications
gargSwagger :: Swagger
gargSwagger = toSwagger api
& info.title .~ "Gargantext API"
& info.version .~ "O.1.0"
& info.description ?~ "This is the main API of Gargantext"
& info.license ?~ ("AGPL and CECILLv3" & url ?~ URL "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE")
-- | API for serving @swagger.json@
-- TODO Do we need to add this in the API ?
-- type SwaggerAPI = "swagger.json" :> Get '[JSON] Swagger
-- | Output generated @swagger.json@ file for the @'TodoAPI'@.
writeSwaggerJSON :: IO ()
writeSwaggerJSON = BL8.writeFile "swagger.json" (encodePretty gargSwagger)
src/Gargantext/API/Count.hs
View file @ 68bef8fc
...@@ -23,15 +23,18 @@ module Gargantext.API.Count ...@@ -23,15 +23,18 @@ module Gargantext.API.Count
import Gargantext.Prelude import Gargantext.Prelude
import GHC.Generics (Generic)
import Prelude (Bounded, Enum, minBound, maxBound) import Prelude (Bounded, Enum, minBound, maxBound)
import Data.Eq (Eq()) import Data.Eq (Eq())
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Servant
import GHC.Generics (Generic)
import Data.Aeson hiding (Error) import Data.Aeson hiding (Error)
import Data.List (repeat, permutations)
import Data.Swagger
import Servant
import Test.QuickCheck.Arbitrary import Test.QuickCheck.Arbitrary
import Test.QuickCheck (elements) import Test.QuickCheck (elements)
import Data.List (repeat, permutations)
-- import Control.Applicative ((<*>)) -- import Control.Applicative ((<*>))
----------------------------------------------------------------------- -----------------------------------------------------------------------
...@@ -50,7 +53,8 @@ instance ToJSON Scraper ...@@ -50,7 +53,8 @@ instance ToJSON Scraper
instance Arbitrary Scraper where instance Arbitrary Scraper where
arbitrary = elements scrapers arbitrary = elements scrapers
----------------------------------------------------------------------- instance ToSchema Scraper
----------------------------------------------------------------------- -----------------------------------------------------------------------
data QueryBool = QueryBool Text data QueryBool = QueryBool Text
...@@ -65,7 +69,8 @@ instance Arbitrary QueryBool where ...@@ -65,7 +69,8 @@ instance Arbitrary QueryBool where
instance FromJSON QueryBool instance FromJSON QueryBool
instance ToJSON QueryBool instance ToJSON QueryBool
instance ToSchema QueryBool
-----------------------------------------------------------------------
data Query = Query { query_query :: QueryBool data Query = Query { query_query :: QueryBool
, query_name :: Maybe [Scraper] , query_name :: Maybe [Scraper]
...@@ -80,12 +85,13 @@ instance Arbitrary Query where ...@@ -80,12 +85,13 @@ instance Arbitrary Query where
, n <- take 10 $ permutations scrapers , n <- take 10 $ permutations scrapers
] ]
----------------------------------------------------------------------- instance ToSchema Query
----------------------------------------------------------------------- -----------------------------------------------------------------------
type Code = Integer type Code = Integer
type Error = Text type Error = Text
type Errors = [Error] type Errors = [Error]
-----------------------------------------------------------------------
data Message = Message Code Errors data Message = Message Code Errors
deriving (Eq, Show, Generic) deriving (Eq, Show, Generic)
...@@ -106,7 +112,7 @@ instance Arbitrary Message where ...@@ -106,7 +112,7 @@ instance Arbitrary Message where
instance FromJSON Message instance FromJSON Message
instance ToJSON Message instance ToJSON Message
----------------------------------------------------------------------- instance ToSchema Message
----------------------------------------------------------------------- -----------------------------------------------------------------------
data Counts = Counts [Count] data Counts = Counts [Count]
deriving (Eq, Show, Generic) deriving (Eq, Show, Generic)
...@@ -114,19 +120,6 @@ data Counts = Counts [Count] ...@@ -114,19 +120,6 @@ data Counts = Counts [Count]
instance FromJSON Counts instance FromJSON Counts
instance ToJSON Counts instance ToJSON Counts
data Count = Count { count_name :: Scraper
, count_count :: Maybe Int
, count_message :: Maybe Message
}
deriving (Eq, Show, Generic)
instance FromJSON Count
instance ToJSON Count
--
--instance Arbitrary Count where
-- arbitrary = Count <$> arbitrary <*> arbitrary <*> arbitrary
instance Arbitrary Counts where instance Arbitrary Counts where
arbitrary = elements $ select arbitrary = elements $ select
$ map Counts $ map Counts
...@@ -139,6 +132,23 @@ instance Arbitrary Counts where ...@@ -139,6 +132,23 @@ instance Arbitrary Counts where
Message 200 _ -> (Just c , Nothing ) Message 200 _ -> (Just c , Nothing )
message -> (Nothing, Just message) message -> (Nothing, Just message)
instance ToSchema Counts
-----------------------------------------------------------------------
data Count = Count { count_name :: Scraper
, count_count :: Maybe Int
, count_message :: Maybe Message
}
deriving (Eq, Show, Generic)
instance FromJSON Count
instance ToJSON Count
instance ToSchema Count
--instance Arbitrary Count where
-- arbitrary = Count <$> arbitrary <*> arbitrary <*> arbitrary
----------------------------------------------------------------------- -----------------------------------------------------------------------
count :: Query -> Handler Counts count :: Query -> Handler Counts
count _ = undefined count _ = undefined
src/Gargantext/API/Node.hs
View file @ 68bef8fc
...@@ -16,39 +16,46 @@ Node API ...@@ -16,39 +16,46 @@ Node API
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
-------------------------------------------------------------------
module Gargantext.API.Node module Gargantext.API.Node
where where
-------------------------------------------------------------------
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Data.Aeson (Value())
import Servant
-- import Servant.Multipart
--import System.IO (putStrLn, readFile) --import System.IO (putStrLn, readFile)
import Data.Text (Text())
-- import Data.Aeson (Value())
--import Data.Text (Text(), pack) --import Data.Text (Text(), pack)
import Data.Text (Text())
import Database.PostgreSQL.Simple (Connection) import Database.PostgreSQL.Simple (Connection)
import Servant
-- import Servant.Multipart
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Types.Node import Gargantext.Types.Node
import Gargantext.Database.Node (getNodesWithParentId import Gargantext.Database.Node (getNodesWithParentId
, getNode, getNodesWith , getNode, getNodesWith
, deleteNode, deleteNodes) , deleteNode, deleteNodes)
import Gargantext.Database.Facet (FacetDoc, getDocFacet) import Gargantext.Database.Facet (FacetDoc, getDocFacet)
-------------------------------------------------------------------
-------------------------------------------------------------------
-- | Node API Types management -- | Node API Types management
type Roots = Get '[JSON] [Node Value] type Roots = Get '[JSON] [Node HyperdataDocument]
type NodesAPI = Delete '[JSON] Int type NodesAPI = Delete '[JSON] Int
type NodeAPI = Get '[JSON] (Node Value) type NodeAPI = Get '[JSON] (Node HyperdataDocument)
:<|> Delete '[JSON] Int :<|> Delete '[JSON] Int
:<|> "children" :> QueryParam "type" NodeType :<|> "children" :> QueryParam "type" NodeType
:> QueryParam "offset" Int :> QueryParam "offset" Int
:> QueryParam "limit" Int :> QueryParam "limit" Int
:> Get '[JSON] [Node Value] :> Get '[JSON] [Node HyperdataDocument]
:<|> "facet" :> QueryParam "type" NodeType :<|> "facet" :> QueryParam "type" NodeType
...@@ -89,7 +96,7 @@ deleteNode' :: Connection -> NodeId -> Handler Int ...@@ -89,7 +96,7 @@ deleteNode' :: Connection -> NodeId -> Handler Int
deleteNode' conn id = liftIO (deleteNode conn id) deleteNode' conn id = liftIO (deleteNode conn id)
getNodesWith' :: Connection -> NodeId -> Maybe NodeType -> Maybe Int -> Maybe Int getNodesWith' :: Connection -> NodeId -> Maybe NodeType -> Maybe Int -> Maybe Int
-> Handler [Node Value] -> Handler [Node HyperdataDocument]
getNodesWith' conn id nodeType offset limit = liftIO (getNodesWith conn id nodeType offset limit) getNodesWith' conn id nodeType offset limit = liftIO (getNodesWith conn id nodeType offset limit)
getDocFacet' :: Connection -> NodeId -> Maybe NodeType -> Maybe Int -> Maybe Int getDocFacet' :: Connection -> NodeId -> Maybe NodeType -> Maybe Int -> Maybe Int
......
src/Gargantext/Database/Facet.hs
View file @ 68bef8fc
...@@ -20,41 +20,45 @@ Portability : POSIX ...@@ -20,41 +20,45 @@ Portability : POSIX
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE NoMonomorphismRestriction #-}
------------------------------------------------------------------------
module Gargantext.Database.Facet where module Gargantext.Database.Facet where
------------------------------------------------------------------------
import Prelude hiding (null, id, map, sum, not) import Prelude hiding (null, id, map, sum, not)
import GHC.Generics (Generic)
import Gargantext.Types
import Gargantext.Types.Node (NodeType)
import Gargantext.Database.NodeNode
import Gargantext.Database.NodeNodeNgram
import Gargantext.Database.Node
import Gargantext.Database.Queries
import Gargantext.Utils.Prefix (unPrefix)
-- import Gargantext.Database.NodeNgram
-- import Data.Aeson (Value) -- import Data.Aeson (Value)
import Data.Aeson.TH (deriveJSON)
import Control.Arrow (returnA) import Control.Arrow (returnA)
import Control.Lens.TH (makeLensesWith, abbreviatedFields) import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import Data.Aeson.TH (deriveJSON)
import Data.Maybe (Maybe) import Data.Maybe (Maybe)
import Data.Profunctor.Product.Default (Default)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Data.Time (UTCTime) import Data.Time (UTCTime)
import Data.Time.Segment (jour)
import Data.Swagger
import Database.PostgreSQL.Simple (Connection) import Database.PostgreSQL.Simple (Connection)
import Opaleye import Opaleye
import Opaleye.Internal.Join (NullMaker) import Opaleye.Internal.Join (NullMaker)
import qualified Opaleye.Internal.Unpackspec() import qualified Opaleye.Internal.Unpackspec()
import Data.Profunctor.Product.Default (Default)
import Data.Time.Segment (jour)
import Test.QuickCheck.Arbitrary import Test.QuickCheck.Arbitrary
import Test.QuickCheck (elements) import Test.QuickCheck (elements)
import Gargantext.Types
import Gargantext.Types.Node (NodeType)
import Gargantext.Database.NodeNode
import Gargantext.Database.NodeNodeNgram
import Gargantext.Database.Node
import Gargantext.Database.Queries
import Gargantext.Utils.Prefix (unPrefix)
-- import Gargantext.Database.NodeNgram
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------
-- | DocFacet -- | DocFacet
type FacetDoc = Facet NodeId UTCTime HyperdataDocument Bool -- Double type FacetDoc = Facet NodeId UTCTime HyperdataDocument Bool -- Double
...@@ -63,19 +67,24 @@ data Facet id created hyperdata favorite = ...@@ -63,19 +67,24 @@ data Facet id created hyperdata favorite =
, facetDoc_created :: created , facetDoc_created :: created
, facetDoc_hyperdata :: hyperdata , facetDoc_hyperdata :: hyperdata
, facetDoc_favorite :: favorite , facetDoc_favorite :: favorite
} deriving (Show) } deriving (Show, Generic)
$(deriveJSON (unPrefix "facetDoc_") ''Facet) $(deriveJSON (unPrefix "facetDoc_") ''Facet)
instance Arbitrary FacetDoc where instance Arbitrary FacetDoc where
arbitrary = elements [ FacetDoc id' (jour year 01 01) hp fav arbitrary = elements [ FacetDoc id' (jour year 01 01) hp fav
| id' <- [1..10] | id' <- [ 1..10 ]
, year <- [1990..2000] , year <- [1990..2000 ]
, fav <- [True, False] , fav <- [True, False]
, hp <- hyperdataDocuments , hp <- hyperdataDocuments
] ]
instance ToSchema FacetDoc
-- Facets / Views for the Front End -- Facets / Views for the Front End
type FacetDocRead = Facet (Column PGInt4) (Column PGTimestamptz) (Column PGJsonb) (Column PGBool) -- (Column PGFloat8) type FacetDocRead = Facet (Column PGInt4 )
(Column PGTimestamptz)
(Column PGJsonb )
(Column PGBool ) -- (Column PGFloat8)
$(makeAdaptorAndInstance "pFacetDoc" ''Facet) $(makeAdaptorAndInstance "pFacetDoc" ''Facet)
$(makeLensesWith abbreviatedFields ''Facet) $(makeLensesWith abbreviatedFields ''Facet)
...@@ -114,13 +123,19 @@ $(makeLensesWith abbreviatedFields ''Facet') ...@@ -114,13 +123,19 @@ $(makeLensesWith abbreviatedFields ''Facet')
------------------------------------------------------------------------ ------------------------------------------------------------------------
getDocFacet :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [FacetDoc] getDocFacet :: Connection -> Int -> Maybe NodeType
-> Maybe Offset -> Maybe Limit
-> IO [FacetDoc]
getDocFacet conn parentId nodeType maybeOffset maybeLimit = getDocFacet conn parentId nodeType maybeOffset maybeLimit =
runQuery conn $ selectDocFacet parentId nodeType maybeOffset maybeLimit runQuery conn $ selectDocFacet parentId nodeType maybeOffset maybeLimit
selectDocFacet :: ParentId -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Query FacetDocRead selectDocFacet :: ParentId -> Maybe NodeType
-> Maybe Offset -> Maybe Limit
-> Query FacetDocRead
selectDocFacet parentId maybeNodeType maybeOffset maybeLimit = selectDocFacet parentId maybeNodeType maybeOffset maybeLimit =
limit' maybeLimit $ offset' maybeOffset $ orderBy (asc facetDoc_created) $ selectDocFacet' parentId maybeNodeType limit' maybeLimit $ offset' maybeOffset
$ orderBy (asc facetDoc_created)
$ selectDocFacet' parentId maybeNodeType
-- | Left join to the favorites -- | Left join to the favorites
......
src/Gargantext/Database/Node.hs
View file @ 68bef8fc
...@@ -151,7 +151,7 @@ deleteNodes conn ns = fromIntegral ...@@ -151,7 +151,7 @@ deleteNodes conn ns = fromIntegral
getNodesWith :: Connection -> Int -> Maybe NodeType getNodesWith :: Connection -> Int -> Maybe NodeType
-> Maybe Offset -> Maybe Limit -> IO [Node Value] -> Maybe Offset -> Maybe Limit -> IO [Node HyperdataDocument]
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
...@@ -159,7 +159,7 @@ getNodesWith conn parentId nodeType maybeOffset maybeLimit = ...@@ -159,7 +159,7 @@ getNodesWith conn parentId nodeType maybeOffset maybeLimit =
-- NP check type -- NP check type
getNodesWithParentId :: Connection -> Int getNodesWithParentId :: Connection -> Int
-> Maybe Text -> IO [Node Value] -> Maybe Text -> IO [Node HyperdataDocument]
getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
selectNodesWithParentID :: Int -> Query NodeRead selectNodesWithParentID :: Int -> Query NodeRead
...@@ -179,11 +179,11 @@ selectNodesWithType type_id = proc () -> do ...@@ -179,11 +179,11 @@ selectNodesWithType type_id = proc () -> do
restrict -< tn .== type_id restrict -< tn .== type_id
returnA -< row returnA -< row
getNode :: Connection -> Int -> IO (Node Value) getNode :: Connection -> Int -> IO (Node HyperdataDocument)
getNode conn id = do getNode conn id = do
fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes (pgInt4 id)) fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes (pgInt4 id))
getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value] getNodesWithType :: Connection -> Column PGInt4 -> IO [Node HyperdataDocument]
getNodesWithType conn type_id = do getNodesWithType conn type_id = do
runQuery conn $ selectNodesWithType type_id runQuery conn $ selectNodesWithType type_id
......
src/Gargantext/Types/Main.hs
View file @ 68bef8fc
{-| {-|
Module : .Gargantext.Types.Main Module : Gargantext.Types.Main
Description : Short description Description : Short description
Copyright : (c) CNRS, 2017 Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
Maintainer : team@gargantext.org Maintainer : team@gargantext.org
Stability : experimental Stability : experimental
...@@ -17,18 +17,22 @@ commentary with @some markup@. ...@@ -17,18 +17,22 @@ commentary with @some markup@.
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
------------------------------------------------------------------------
module Gargantext.Types.Main where module Gargantext.Types.Main where
------------------------------------------------------------------------
import Prelude import Prelude
import Protolude (fromMaybe)
import Data.Eq (Eq()) import Data.Eq (Eq())
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Protolude (fromMaybe)
--import Data.ByteString (ByteString())
import Data.Text (Text) import Data.Text (Text)
import Data.List (lookup) import Data.List (lookup)
import Gargantext.Types.Node import Gargantext.Types.Node
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Language of a Text -- | Language of a Text
-- For simplicity, we suppose text has an homogenous language -- For simplicity, we suppose text has an homogenous language
......
src/Gargantext/Types/Node.hs
View file @ 68bef8fc
...@@ -13,39 +13,40 @@ Portability : POSIX ...@@ -13,39 +13,40 @@ Portability : POSIX
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
-- {-# LANGUAGE DuplicateRecordFields #-} -- {-# LANGUAGE DuplicateRecordFields #-}
module Gargantext.Types.Node where module Gargantext.Types.Node where
import Gargantext.Prelude
import Text.Show (Show())
import Data.Text (Text, unpack)
import Text.Read (read)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Data.Aeson
import Data.Aeson (Value(),toJSON)
import Data.Aeson.TH (deriveJSON)
import Data.Either
import Data.Eq (Eq) import Data.Eq (Eq)
import Data.Text (Text, unpack)
import Data.Time (UTCTime) import Data.Time (UTCTime)
import Gargantext.Utils.Prefix (unPrefix) import Data.Time.Segment (jour)
import Data.Aeson.TH (deriveJSON) import Data.Swagger
import Data.Aeson import Data.Maybe (fromJust)
import Text.Read (read)
import Text.Show (Show())
import Servant import Servant
import Data.Either
import Test.QuickCheck.Arbitrary import Test.QuickCheck.Arbitrary
import Test.QuickCheck (elements) import Test.QuickCheck (elements)
-- Instances: import Gargantext.Prelude
import Data.Time.Segment (jour) import Gargantext.Utils.Prefix (unPrefix)
import Data.Aeson (Value(),toJSON)
------------------------------------------------------------------------ ------------------------------------------------------------------------
data Status = Status { status_Date :: Maybe UTCTime data Status = Status { status_date :: Maybe UTCTime
, status_Error :: Maybe Text , status_error :: Maybe Text
, status_Action :: Maybe Text , status_action :: Maybe Text
, status_Complete :: Maybe Bool , status_complete :: Maybe Bool
, status_Progress :: Maybe Int , status_progress :: Maybe Int
} deriving (Show, Generic) } deriving (Show, Generic)
$(deriveJSON (unPrefix "status_") ''Status) $(deriveJSON (unPrefix "status_") ''Status)
...@@ -54,21 +55,21 @@ instance Arbitrary Status where ...@@ -54,21 +55,21 @@ instance Arbitrary Status where
------------------------------------------------------------------------ ------------------------------------------------------------------------
data HyperdataDocument = HyperdataDocument { hyperdataDocument_Bdd :: Maybe Text data HyperdataDocument = HyperdataDocument { hyperdataDocument_bdd :: Maybe Text
, hyperdataDocument_Doi :: Maybe Text , hyperdataDocument_doi :: Maybe Text
, hyperdataDocument_Url :: Maybe Text , hyperdataDocument_url :: Maybe Text
, hyperdataDocument_Page :: Maybe Int , hyperdataDocument_page :: Maybe Int
, hyperdataDocument_Title :: Maybe Text , hyperdataDocument_title :: Maybe Text
, hyperdataDocument_Authors :: Maybe Text , hyperdataDocument_authors :: Maybe Text
, hyperdataDocument_Abstract :: Maybe Text , hyperdataDocument_abstract :: Maybe Text
, hyperdataDocument_Statuses :: Maybe [Status] , hyperdataDocument_statuses :: Maybe [Status]
, hyperdataDocument_Publication_date :: Maybe Text , hyperdataDocument_publication_date :: Maybe Text
, hyperdataDocument_Publication_year :: Maybe Double , hyperdataDocument_publication_year :: Maybe Double
, hyperdataDocument_Publication_month :: Maybe Double , hyperdataDocument_publication_month :: Maybe Double
, hyperdataDocument_Publication_hour :: Maybe Double , hyperdataDocument_publication_hour :: Maybe Double
, hyperdataDocument_Publication_minute :: Maybe Double , hyperdataDocument_publication_minute :: Maybe Double
, hyperdataDocument_Publication_second :: Maybe Double , hyperdataDocument_publication_second :: Maybe Double
, hyperdataDocument_LanguageIso2 :: Maybe Text , hyperdataDocument_languageIso2 :: Maybe Text
} deriving (Show, Generic) } deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataDocument_") ''HyperdataDocument) $(deriveJSON (unPrefix "hyperdataDocument_") ''HyperdataDocument)
...@@ -185,6 +186,7 @@ type Project = Folder -- NP Node HyperdataProject ? ...@@ -185,6 +186,7 @@ type Project = Folder -- NP Node HyperdataProject ?
type Corpus = Node HyperdataCorpus type Corpus = Node HyperdataCorpus
type Document = Node HyperdataDocument type Document = Node HyperdataDocument
------------------------------------------------------------------------
data NodeType = NodeUser | Project | Corpus | Document | DocumentCopy data NodeType = NodeUser | Project | Corpus | Document | DocumentCopy
| Classification | Classification
| Lists | Lists
...@@ -193,8 +195,13 @@ data NodeType = NodeUser | Project | Corpus | Document | DocumentCopy ...@@ -193,8 +195,13 @@ data NodeType = NodeUser | Project | Corpus | Document | DocumentCopy
instance FromJSON NodeType instance FromJSON NodeType
instance ToJSON NodeType instance ToJSON NodeType
instance FromHttpApiData NodeType where parseUrlPiece = Right . read . unpack
instance FromHttpApiData NodeType
where
parseUrlPiece = Right . read . unpack
instance ToParamSchema NodeType
instance ToSchema NodeType
------------------------------------------------------------------------ ------------------------------------------------------------------------
data NodePoly id typename userId parentId name date hyperdata = Node { node_id :: id data NodePoly id typename userId parentId name date hyperdata = Node { node_id :: id
...@@ -206,7 +213,7 @@ data NodePoly id typename userId parentId name date hyperdata = Node { node_id ...@@ -206,7 +213,7 @@ data NodePoly id typename userId parentId name date hyperdata = Node { node_id
, node_date :: date , node_date :: date
, node_hyperdata :: hyperdata , node_hyperdata :: hyperdata
-- , node_titleAbstract :: titleAbstract -- , node_titleAbstract :: titleAbstract
} deriving (Show) } deriving (Show, Generic)
$(deriveJSON (unPrefix "node_") ''NodePoly) $(deriveJSON (unPrefix "node_") ''NodePoly)
instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime Value) where instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime Value) where
...@@ -216,5 +223,23 @@ instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId N ...@@ -216,5 +223,23 @@ instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId N
instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime Value) where instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime Value) where
arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) (toJSON ("{}"::Text))] arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) (toJSON ("{}"::Text))]
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))]
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]
hyperdataDocument :: HyperdataDocument
hyperdataDocument = fromJust $ decode "{\"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\",\"statuses\":[],\"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}"
instance ToSchema HyperdataDocument where
declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
instance ToSchema (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime HyperdataDocument)
instance ToSchema (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime HyperdataDocument)
instance ToSchema Status
swagger.json 0 → 100644
View file @ 68bef8fc
This diff is collapsed.
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