Skip to content

haskell-gargantext
haskell-gargantext
Commit a5f2a719 authored by Mael NICOLAS's avatar Mael NICOLAS
Browse files
Options

Merge branch 'master' into fromRFC3339

parents cf12f83c ab2d8adb
Expand all Show whitespace changes
Inline Side-by-side
Showing with 1802 additions and 395 deletions
frontEnd/index.html 0 → 100644
View file @ a5f2a719
<!doctype>
<html>
<head>
<meta charset="utf-8"/>
<title>CNRS GarganText</title>
<link href="https://fonts.googleapis.com/icon?family=Material+Icons" rel="stylesheet">
<link href="css/login.min.css" rel="stylesheet">
<link href="css/bootstrap.css" rel="stylesheet">
<link href="css/lavish-bootstrap.css" rel="stylesheet">
<link rel="stylesheet" type="text/css" href="./dist/css/menu.css"/>
<link href="css/Login.css" rel="stylesheet">
</head>
<body>
<div id="app"></div>
<script src="bundle.js"></script>
<script src="https://ajax.googleapis.com/ajax/libs/jquery/1.12.4/jquery.min.js"></script>
<script src="../dist/js/bootstrap.min.js"></script>
<script type="text/javascript" src="/dist/lib/bootstrap/3.2.0/bootstrap.min.js"></script>
</body>
</html>
gargantext.cabal
View file @ a5f2a719
-- This file has been generated from package.yaml by hpack version 0.20.0.
-- This file has been generated from package.yaml by hpack version 0.21.2.
--
-- see: https://github.com/sol/hpack
--
-- hash: 84f85626582b6f0f3f7b0c3dadf65d7f797a14e8a50389db1167f6652ec74e28
-- hash: 4e7c51f92304a8a22c00c60b641f336bcfa0c3994bd4beac6f2e9eafa90c408a
name: gargantext
version: 0.1.0.0
synopsis: Deep (Collaborative) Text mining project
description: Please see README.md
category: Data
homepage: https://gargantext.org
license: BSD3
license-file: LICENSE
author: Gargantext Team
maintainer: team@gargantext.org
copyright: Copyright: (c) 2017-2018: see git logs and README
category: Data
license: BSD3
license-file: LICENSE
build-type: Simple
cabal-version: >= 1.10
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.API.Swagger
Gargantext.Database.Queries
Gargantext.Utils
Paths_gargantext
hs-source-dirs:
src
default-extensions: NoImplicitPrelude
ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Werror
build-depends:
aeson
QuickCheck
, aeson
, aeson-lens
, aeson-pretty
, async
, attoparsec
, base >=4.7 && <5
......@@ -35,6 +81,7 @@ library
, conduit-extra
, containers
, contravariant
, data-time-segment
, directory
, duckling
, extra
......@@ -60,9 +107,14 @@ library
, servant
, servant-auth
, servant-client
, servant-mock
, servant-multipart
, servant-server
, servant-static-th
, servant-swagger
, servant-swagger-ui
, split
, swagger2
, tagsoup
, text
, text-metrics
......@@ -78,50 +130,12 @@ library
, yaml
, zip
, zlib
exposed-modules:
Gargantext
Gargantext.Analysis
Gargantext.DSL
Gargantext.Database
Gargantext.Database.Instances
Gargantext.Database.Ngram
Gargantext.Database.Node
Gargantext.Database.NodeNgram
Gargantext.Database.NodeNgramNgram
Gargantext.Database.NodeNode
Gargantext.Database.NodeNodeNgram
Gargantext.Database.Private
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.Node
Gargantext.Utils
Paths_gargantext
default-language: Haskell2010
ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Werror
executable gargantext
main-is: Main.hs
other-modules:
Paths_gargantext
hs-source-dirs:
app
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2
......@@ -132,13 +146,13 @@ executable gargantext
, ini
, text
, unordered-containers
other-modules:
Paths_gargantext
default-language: Haskell2010
test-suite garg-doctest
type: exitcode-stdio-1.0
main-is: Main.hs
other-modules:
Paths_gargantext
hs-source-dirs:
src-doctest
ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N
......@@ -150,13 +164,19 @@ test-suite garg-doctest
, extra
, gargantext
, text
other-modules:
Paths_gargantext
default-language: Haskell2010
test-suite garg-test
type: exitcode-stdio-1.0
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:
src-test
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
......
package.yaml
View file @ a5f2a719
......@@ -29,11 +29,12 @@ library:
- 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.Private
- Gargantext.Database.Utils
- Gargantext.Database.User
- Gargantext.Ngrams
- Gargantext.Ngrams.Count
......@@ -57,18 +58,21 @@ library:
- Gargantext.Utils.DateUtils
- Gargantext.Utils.Prefix
dependencies:
- base >=4.7 && <5
- QuickCheck
- aeson
- aeson-lens
- attoparsec
- aeson-pretty
- async
- attoparsec
- base >=4.7 && <5
- base16-bytestring
- bytestring
- case-insensitive
- containers
- contravariant
- conduit
- conduit-extra
- containers
- contravariant
- data-time-segment
- directory
- duckling
- filepath
......@@ -78,8 +82,9 @@ library:
- lens
- logging-effect
- opaleye
- path
- parsec
- path
- path-io
- postgresql-simple
- pretty
- product-profunctors
......@@ -90,17 +95,21 @@ library:
- safe
- semigroups
- servant
- servant-auth
- servant-client
- servant-mock
- servant-multipart
- servant-server
- servant-auth
- servant-swagger
- servant-swagger-ui
- servant-static-th
- split
- swagger2
- tagsoup
- text-metrics
# - utc
- time
- timezone-series
- time-locale-compat
- timezone-series
- transformers
- unordered-containers
- uuid
......@@ -108,9 +117,9 @@ library:
- wai
- warp
- yaml
- zlib
- zip
- path-io
- zlib
# - utc
executable:
main: Main.hs
......
src/Gargantext/API.hs
View file @ a5f2a719
{-|
Module : Gargantext.Server
Module : Gargantext.API
Description : Server API
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
......@@ -9,72 +9,197 @@ Portability : POSIX
Main REST API of Gargantext (both Server and Client sides)
TODO/IDEA, use MOCK feature of Servant to generate fake data (for tests)
TODO App type, the main monad in which the bot code is written with.
Provide config, state, logs and IO
type App m a = ( MonadState AppState m
, MonadReader Conf m
, MonadLog (WithSeverity Doc) m
, MonadIO m) => m a
Thanks @yannEsposito for this.
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
---------------------------------------------------------------------
module Gargantext.API
where
---------------------------------------------------------------------
import Gargantext.Prelude
import System.IO (FilePath, print)
import GHC.Generics (D1, Meta (..), Rep)
import GHC.TypeLits (AppendSymbol, Symbol)
import Control.Lens
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Swagger
import Data.Text (Text, pack)
--import qualified Data.Set as Set
import Database.PostgreSQL.Simple (Connection, connect)
import Network.Wai
import Network.Wai.Handler.Warp
import Servant
import Database.PostgreSQL.Simple (Connection, connect)
import System.IO (FilePath, print)
import Servant
import Servant.Mock (mock)
import Servant.Swagger
import Servant.Swagger.UI
import Servant.Static.TH (createApiAndServerDecs)
-- import Servant.API.Stream
-- import Gargantext.API.Auth
import Gargantext.API.Node ( Roots , roots
, NodeAPI , nodeAPI
, NodesAPI , nodesAPI
)
import Gargantext.API.Count ( CountAPI, count, Query)
import Gargantext.Database.Utils (databaseParameters)
import Gargantext.Database.Private (databaseParameters)
---------------------------------------------------------------------
---------------------------------------------------------------------
type PortNumber = Int
---------------------------------------------------------------------
-- | API Global
-- | API for serving @swagger.json@
-- TODO Do we need to add this in the API ?
-- type SwaggerAPI = "swagger.json" :> Get '[JSON] Swagger
-- | startGargantext takes as parameters port number and Ini file.
startGargantext :: Int -> FilePath -> IO ()
startGargantext port file = do
print ("Starting server on port " <> show port)
param <- databaseParameters file
conn <- connect param
run port ( app conn )
type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
-- | Main routes of the API are typed
type API = "roots" :> Roots
:<|> "node" :> Capture "id" Int :> NodeAPI
:<|> "nodes" :> ReqBody '[JSON] [Int] :> NodesAPI
-- | API for serving main operational routes of @gargantext.org@
type GargAPI = "user" :> Summary "First user endpoint"
:> Roots
:<|> "node" :> Summary "Node endpoint"
:> Capture "id" Int :> NodeAPI
:<|> "corpus":> Summary "Corpus endpoint"
:> Capture "id" Int :> NodeAPI
:<|> "nodes" :> Summary "Nodes endpoint"
:> ReqBody '[JSON] [Int] :> NodesAPI
-- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
:<|> "count" :> Summary "Count endpoint"
:> ReqBody '[JSON] Query :> CountAPI
-- /mv/<id>/<id>
-- /merge/<id>/<id>
-- /rename/<id>
-- :<|> "static"
-- :<|> "list" :> Capture "id" Int :> NodeAPI
-- :<|> "ngrams" :> Capture "id" Int :> NodeAPI
-- :<|> "auth" :> Capture "id" Int :> NodeAPI
---------------------------------------------------------------------
-- | Serve front end files
$(createApiAndServerDecs "FrontEndAPI" "frontEndServer" "frontEnd")
type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
type API = SwaggerFrontAPI :<|> GargAPI
---------------------------------------------------------------------
-- | Server declaration
server :: Connection -> Server API
server conn = roots conn
server conn = swaggerFront
:<|> roots conn
:<|> nodeAPI conn
:<|> nodeAPI conn
:<|> nodesAPI conn
:<|> count
---------------------------------------------------------------------
swaggerFront :: Server SwaggerFrontAPI
swaggerFront = schemaUiServer swaggerDoc
:<|> frontEndServer
gargMock :: Server GargAPI
gargMock = mock apiGarg Proxy
-- | TODO App type, the main monad in which the bot code is written with.
-- Provide config, state, logs and IO
-- type App m a = ( MonadState AppState m
-- , MonadReader Conf m
-- , MonadLog (WithSeverity Doc) m
-- , MonadIO m) => m a
-- Thanks @yannEsposito for this.
---------------------------------------------------------------------
app :: Connection -> Application
app = serve api . server
appMock :: Application
appMock = serve api (swaggerFront :<|> gargMock)
---------------------------------------------------------------------
api :: Proxy API
api = Proxy
apiGarg :: Proxy GargAPI
apiGarg = Proxy
---------------------------------------------------------------------
schemaUiServer :: (Server api ~ Handler Swagger)
=> Swagger -> Server (SwaggerSchemaUI' dir api)
schemaUiServer = swaggerSchemaUIServer
-- Type Familiy for the Documentation
type family TypeName (x :: *) :: Symbol where
TypeName Int = "Int"
TypeName Text = "Text"
TypeName x = GenericTypeName x (Rep x ())
type family GenericTypeName t (r :: *) :: Symbol where
GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
-- | Swagger Specifications
swaggerDoc :: Swagger
swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
& info.title .~ "Gargantext"
& info.version .~ "0.1.0"
-- & info.base_url ?~ (URL "http://gargantext.org/")
& info.description ?~ "REST API specifications"
-- & tags .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
& applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
["Garg" & description ?~ "Main operations"]
& info.license ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
where
urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
-- | Output generated @swagger.json@ file for the @'TodoAPI'@.
swaggerWriteJSON :: IO ()
swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
-- | startGargantext takes as parameters port number and Ini file.
startGargantext :: PortNumber -> FilePath -> IO ()
startGargantext port file = do
print ("Starting Gargantext server" <> show port)
print ("http://localhost:" <> show port)
param <- databaseParameters file
conn <- connect param
run port (app conn)
startGargantextMock :: PortNumber -> IO ()
startGargantextMock port = do
print (pack "Starting Mock server")
print (pack $ "curl "
<> "-H \"content-type: application/json"
<> "-d \'{\"query_query\":\"query\"}\' "
<> "-v http://localhost:"
<> show port
<>"/count"
)
run port appMock
src/Gargantext/API/Count.hs 0 → 100644
View file @ a5f2a719
{-|
Module : Gargantext.API.Count
Description : Server API
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Count API part of Gargantext.
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
module Gargantext.API.Count
where
import Gargantext.Prelude
import GHC.Generics (Generic)
import Prelude (Bounded, Enum, minBound, maxBound)
import Data.Eq (Eq())
import Data.Text (Text, pack)
import Data.Aeson hiding (Error)
import Data.List (repeat, permutations)
import Data.Swagger
import Servant
import Test.QuickCheck.Arbitrary
import Test.QuickCheck (elements)
-- import Control.Applicative ((<*>))
-----------------------------------------------------------------------
type CountAPI = Post '[JSON] Counts
-----------------------------------------------------------------------
data Scraper = Pubmed | Hal | IsTex | Isidore
deriving (Eq, Show, Generic, Enum, Bounded)
scrapers :: [Scraper]
scrapers = [minBound..maxBound]
instance FromJSON Scraper
instance ToJSON Scraper
instance Arbitrary Scraper where
arbitrary = elements scrapers
instance ToSchema Scraper
-----------------------------------------------------------------------
data QueryBool = QueryBool Text
deriving (Eq, Show, Generic)
queries :: [QueryBool]
queries = [QueryBool (pack "(X OR X') AND (Y OR Y') NOT (Z OR Z')")]
instance Arbitrary QueryBool where
arbitrary = elements queries
instance FromJSON QueryBool
instance ToJSON QueryBool
instance ToSchema QueryBool
-----------------------------------------------------------------------
data Query = Query { query_query :: QueryBool
, query_name :: Maybe [Scraper]
}
deriving (Eq, Show, Generic)
instance FromJSON Query
instance ToJSON Query
instance Arbitrary Query where
arbitrary = elements [ Query q (Just n)
| q <- queries
, n <- take 10 $ permutations scrapers
]
instance ToSchema Query
-----------------------------------------------------------------------
type Code = Integer
type Error = Text
type Errors = [Error]
-----------------------------------------------------------------------
data Message = Message Code Errors
deriving (Eq, Show, Generic)
toMessage :: [(Code, Errors)] -> [Message]
toMessage = map (\(c,err) -> Message c err)
messages :: [Message]
messages = toMessage $ [ (400, ["Ill formed query "])
, (300, ["API connexion error "])
, (300, ["Internal Gargantext Error "])
, (300, ["Connexion to Gargantext Error"])
, (300, ["Token has expired "])
] <> take 10 ( repeat (200, [""]))
instance Arbitrary Message where
arbitrary = elements messages
instance FromJSON Message
instance ToJSON Message
instance ToSchema Message
-----------------------------------------------------------------------
data Counts = Counts [Count]
deriving (Eq, Show, Generic)
instance FromJSON Counts
instance ToJSON Counts
instance Arbitrary Counts where
arbitrary = elements $ select
$ map Counts
$ map (\xs -> zipWith (\s (c,m) -> Count s c m) scrapers xs)
$ chunkAlong (length scrapers) 1 $ (map filter' countOrErrors)
where
select xs = (take 10 xs) <> (take 10 $ drop 100 xs)
countOrErrors = [ (c,e) | c <- [500..1000], e <- reverse messages]
filter' (c,e) = case e of
Message 200 _ -> (Just c , Nothing )
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 _ = undefined
src/Gargantext/API/Node.hs
View file @ a5f2a719
......@@ -14,62 +14,86 @@ Node API
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
-------------------------------------------------------------------
module Gargantext.API.Node
where
-------------------------------------------------------------------
import System.IO (putStrLn)
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (Value())
import Servant
import Servant.Multipart
import System.IO (putStrLn, readFile)
import Data.Text (Text(), pack)
import Control.Monad ((>>))
--import System.IO (putStrLn, readFile)
-- import Data.Aeson (Value())
--import Data.Text (Text(), pack)
import Data.Text (Text())
import Database.PostgreSQL.Simple (Connection)
import Servant
-- import Servant.Multipart
import Gargantext.Prelude
import Gargantext.Types.Main (Node, NodeId, NodeType)
import Gargantext.Types.Node
import Gargantext.Database.Node (getNodesWithParentId
, getNode, getNodesWith
, deleteNode, deleteNodes)
import Gargantext.Database.Facet (FacetDoc, getDocFacet)
-------------------------------------------------------------------
-------------------------------------------------------------------
-- | Node API Types management
type Roots = Get '[JSON] [Node Value]
type Roots = Get '[JSON] [Node HyperdataDocument]
:<|> Post '[JSON] Int
:<|> Put '[JSON] Int
:<|> Delete '[JSON] Int
type NodesAPI = Delete '[JSON] Int
type NodeAPI = Get '[JSON] (Node Value)
type NodeAPI = Get '[JSON] (Node HyperdataDocument)
:<|> Delete '[JSON] Int
-- Example for Document Facet view, to populate the tabular:
-- http://localhost:8008/node/347476/children?type=Document&limit=3
-- /!\ FIXME : nodeType is case sensitive
-- /!\ see NodeTypes in Types/Main.hs
:<|> "children" :> QueryParam "type" NodeType
:<|> "children" :> Summary " Summary children"
:> QueryParam "type" NodeType
:> QueryParam "offset" Int
:> QueryParam "limit" Int
:> Get '[JSON] [Node HyperdataDocument]
:<|> "facet" :> QueryParam "type" NodeType
:> QueryParam "offset" Int
:> QueryParam "limit" Int
:> Get '[JSON] [Node Value]
:> Get '[JSON] [FacetDoc]
-- Depending on the Type of the Node, we could post
-- New documents for a corpus
-- New map list terms
:<|> "process" :> MultipartForm MultipartData :> Post '[JSON] Text
-- :<|> "process" :> MultipartForm MultipartData :> Post '[JSON] Text
-- To launch a query and update the corpus
:<|> "query" :> Capture "string" Text :> Get '[JSON] Text
-- :<|> "query" :> Capture "string" Text :> Get '[JSON] Text
-- | Node API functions
roots :: Connection -> Server Roots
roots conn = liftIO (getNodesWithParentId conn 0 Nothing)
roots conn = liftIO (putStrLn "Log Needed" >> getNodesWithParentId conn 0 Nothing)
:<|> pure (panic "not implemented yet")
:<|> pure (panic "not implemented yet")
:<|> pure (panic "not implemented yet")
nodeAPI :: Connection -> NodeId -> Server NodeAPI
nodeAPI conn id = liftIO (getNode conn id)
nodeAPI conn id = liftIO (putStrLn "getNode" >> getNode conn id )
:<|> deleteNode' conn id
:<|> getNodesWith' conn id
:<|> upload
:<|> query
:<|> getDocFacet' conn id
-- :<|> upload
-- :<|> query
nodesAPI :: Connection -> [NodeId] -> Server NodesAPI
nodesAPI conn ids = deleteNodes' conn ids
......@@ -81,9 +105,12 @@ deleteNode' :: Connection -> NodeId -> Handler Int
deleteNode' conn id = liftIO (deleteNode conn id)
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)
getDocFacet' :: Connection -> NodeId -> Maybe NodeType -> Maybe Int -> Maybe Int
-> Handler [FacetDoc]
getDocFacet' conn id nodeType offset limit = liftIO (getDocFacet conn id nodeType offset limit)
query :: Text -> Handler Text
query s = pure s
......@@ -91,18 +118,18 @@ query s = pure s
-- | Upload files
-- TODO Is it possible to adapt the function according to iValue input ?
upload :: MultipartData -> Handler Text
upload multipartData = do
liftIO $ do
putStrLn "Inputs:"
forM_ (inputs multipartData) $ \input ->
putStrLn $ " " <> show (iName input)
<> " -> " <> show (iValue input)
forM_ (files multipartData) $ \file -> do
content <- readFile (fdFilePath file)
putStrLn $ "Content of " <> show (fdFileName file)
<> " at " <> fdFilePath file
putStrLn content
pure (pack "Data loaded")
--upload :: MultipartData -> Handler Text
--upload multipartData = do
-- liftIO $ do
-- putStrLn "Inputs:"
-- forM_ (inputs multipartData) $ \input ->
-- putStrLn $ " " <> show (iName input)
-- <> " -> " <> show (iValue input)
--
-- forM_ (files multipartData) $ \file -> do
-- content <- readFile (fdFilePath file)
-- putStrLn $ "Content of " <> show (fdFileName file)
-- <> " at " <> fdFilePath file
-- putStrLn content
-- pure (pack "Data loaded")
src/Gargantext/Database.hs
View file @ a5f2a719
module Gargantext.Database (
module Gargantext.Database.Private
module Gargantext.Database.Utils
-- , module Gargantext.Database.Instances
, module Gargantext.Database.User
, module Gargantext.Database.Node
......@@ -14,7 +14,7 @@ module Gargantext.Database (
-- , module Gargantext.Database.NodeType
) where
import Gargantext.Database.Private
import Gargantext.Database.Utils
--import Gargantext.Database.Gargandb
import Gargantext.Database.User
import Gargantext.Database.Node
......@@ -26,3 +26,5 @@ import Gargantext.Database.NodeNgramNgram
--import Gargantext.Database.Simple
--import Gargantext.Database.NodeType
--import Gargantext.Database.InsertNode
src/Gargantext/Database/Facet.hs 0 → 100644
View file @ a5f2a719
This diff is collapsed.
src/Gargantext/Database/Instances.hs
View file @ a5f2a719
......@@ -6,12 +6,14 @@ module Gargantext.Database.Instances where
import Gargantext.Prelude
import Data.Text (Text)
import Data.Time (UTCTime)
import Opaleye (PGInt4, PGTimestamptz, PGFloat8
, QueryRunnerColumnDefault
, queryRunnerColumnDefault
, fieldQueryRunnerColumn
)
, Nullable, PGText)
instance QueryRunnerColumnDefault PGInt4 Integer where
queryRunnerColumnDefault = fieldQueryRunnerColumn
......@@ -25,4 +27,9 @@ instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
instance QueryRunnerColumnDefault PGTimestamptz (Maybe UTCTime) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault (Nullable PGInt4) Int where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault (Nullable PGText) Text where
queryRunnerColumnDefault = fieldQueryRunnerColumn
src/Gargantext/Database/Ngram.hs
View file @ a5f2a719
......@@ -24,15 +24,19 @@ data NgramPoly id terms n = Ngram { ngram_id :: id
, ngram_n :: n
} deriving (Show)
type NgramWrite = NgramPoly (Maybe (Column PGInt4)) (Column PGText) (Column PGInt4)
type NgramRead = NgramPoly (Column PGInt4) (Column PGText) (Column PGInt4)
type NgramWrite = NgramPoly (Maybe (Column PGInt4))
(Column PGText)
(Column PGInt4)
type NgramRead = NgramPoly (Column PGInt4)
(Column PGText)
(Column PGInt4)
type Ngram = NgramPoly Int Text Int
$(makeAdaptorAndInstance "pNgram" ''NgramPoly)
$(makeLensesWith abbreviatedFields ''NgramPoly)
ngramTable :: Table NgramWrite NgramRead
ngramTable = Table "ngrams" (pNgram Ngram { ngram_id = optional "id"
, ngram_terms = required "terms"
......@@ -40,7 +44,6 @@ ngramTable = Table "ngrams" (pNgram Ngram { ngram_id = optional "id"
}
)
queryNgramTable :: Query NgramRead
queryNgramTable = queryTable ngramTable
......
src/Gargantext/Database/Node.hs
View file @ a5f2a719
......@@ -25,14 +25,18 @@ import Database.PostgreSQL.Simple.FromField ( Conversion
, fromField
, returnError
)
import Prelude hiding (null, id, map)
import Gargantext.Types.Main (NodeType)
import Prelude hiding (null, id, map, sum)
import Gargantext.Types
import Gargantext.Types.Node (NodeType)
import Gargantext.Database.Queries
import Gargantext.Prelude hiding (sum)
import Database.PostgreSQL.Simple.Internal (Field)
import Control.Arrow (returnA)
import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import Data.Aeson
import Gargantext.Types
import Gargantext.Prelude
import Data.Maybe (Maybe, fromMaybe)
import Data.Text (Text)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
......@@ -44,15 +48,6 @@ import Opaleye
-- | Types for Node Database Management
data PGTSVector
type NodeWrite = NodePoly (Maybe (Column PGInt4)) (Column PGInt4)
(Column PGInt4) (Column (Nullable PGInt4))
(Column (PGText)) (Maybe (Column PGTimestamptz))
(Column PGJsonb) -- (Maybe (Column PGTSVector))
type NodeRead = NodePoly (Column PGInt4) (Column PGInt4)
(Column PGInt4) (Column (Nullable PGInt4))
(Column (PGText)) (Column PGTimestamptz)
(Column PGJsonb) -- (Column PGTSVector)
instance FromField HyperdataCorpus where
fromField = fromField'
......@@ -67,16 +62,6 @@ instance FromField HyperdataUser where
fromField = fromField'
fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DBI.ByteString -> Conversion b
fromField' field mb = do
v <- fromField field mb
valueToHyperdata v
where
valueToHyperdata v = case fromJSON v of
Success a -> pure a
Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
instance QueryRunnerColumnDefault PGJsonb HyperdataDocument where
queryRunnerColumnDefault = fieldQueryRunnerColumn
......@@ -89,15 +74,16 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataProject where
instance QueryRunnerColumnDefault PGJsonb HyperdataUser where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault (Nullable PGInt4) Int where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault (Nullable PGText) Text where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGInt4 Integer where
queryRunnerColumnDefault = fieldQueryRunnerColumn
fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DBI.ByteString -> Conversion b
fromField' field mb = do
v <- fromField field mb
valueToHyperdata v
where
valueToHyperdata v = case fromJSON v of
Success a -> pure a
Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
$(makeAdaptorAndInstance "pNode" ''NodePoly)
......@@ -130,26 +116,13 @@ selectNodes id = proc () -> do
runGetNodes :: Connection -> Query NodeRead -> IO [Node Value]
runGetNodes = runQuery
type ParentId = NodeId
type Limit = Int
type Offset = Int
-- | order by publication date
-- Favorites (Bool), node_ngrams
selectNodesWith :: ParentId -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Query NodeRead
selectNodesWith :: ParentId -> Maybe NodeType
-> Maybe Offset -> Maybe Limit -> Query NodeRead
selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
--offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
offset' maybeOffset $ limit' maybeLimit $ orderBy (asc node_id) $ selectNodesWith' parentId maybeNodeType
limit' :: Maybe Limit -> Query NodeRead -> Query NodeRead
limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit
offset' :: Maybe Offset -> Query NodeRead -> Query NodeRead
offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset
limit' maybeLimit $ offset' maybeOffset $ orderBy (asc node_id) $ selectNodesWith' parentId maybeNodeType
selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
selectNodesWith' parentId maybeNodeType = proc () -> do
......@@ -166,7 +139,6 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
returnA -< node
deleteNode :: Connection -> Int -> IO Int
deleteNode conn n = fromIntegral
<$> runDelete conn nodeTable
......@@ -178,14 +150,16 @@ deleteNodes conn ns = fromIntegral
(\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
getNodesWith :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [Node Value]
getNodesWith :: Connection -> Int -> Maybe NodeType
-> Maybe Offset -> Maybe Limit -> IO [Node HyperdataDocument]
getNodesWith conn parentId nodeType maybeOffset maybeLimit =
runQuery conn $ selectNodesWith
parentId nodeType maybeOffset maybeLimit
-- NP check type
getNodesWithParentId :: Connection -> Int -> Maybe Text -> IO [Node Value]
getNodesWithParentId :: Connection -> Int
-> Maybe Text -> IO [Node HyperdataDocument]
getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
selectNodesWithParentID :: Int -> Query NodeRead
......@@ -199,19 +173,17 @@ selectNodesWithParentID n = proc () -> do
returnA -< row
selectNodesWithType :: Column PGInt4 -> Query NodeRead
selectNodesWithType type_id = proc () -> do
row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
restrict -< tn .== type_id
returnA -< row
getNode :: Connection -> Int -> IO (Node Value)
getNode :: Connection -> Int -> IO (Node HyperdataDocument)
getNode conn id = do
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
runQuery conn $ selectNodesWithType type_id
......
src/Gargantext/Database/NodeNgram.hs
View file @ a5f2a719
......@@ -9,14 +9,11 @@
module Gargantext.Database.NodeNgram where
import Prelude
import Data.Maybe (Maybe)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import qualified Database.PostgreSQL.Simple as PGS
import Opaleye
data NodeNgramPoly id node_id ngram_id weight
= NodeNgram { nodeNgram_NodeNgramId :: id
, nodeNgram_NodeNgramNodeId :: node_id
......@@ -24,36 +21,31 @@ data NodeNgramPoly id node_id ngram_id weight
, nodeNgram_NodeNgramWeight :: weight
} deriving (Show)
type NodeNgramWrite = NodeNgramPoly (Maybe (Column PGInt4)) (Column PGInt4) (Column PGInt4) (Maybe (Column PGFloat8))
type NodeNgramRead = NodeNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) ((Column PGFloat8))
type NodeNgramWrite = NodeNgramPoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
type NodeNgramRead = NodeNgramPoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
type NodeNgram = NodeNgramPoly (Maybe Int) Int Int (Maybe Double)
type NodeNgram = NodeNgramPoly Int Int Int Double
$(makeAdaptorAndInstance "pNodeNgram" ''NodeNgramPoly)
$(makeLensesWith abbreviatedFields ''NodeNgramPoly)
nodeNgramTable :: Table NodeNgramWrite NodeNgramRead
nodeNgramTable = Table "nodes_ngrams" (pNodeNgram NodeNgram { nodeNgram_NodeNgramId = optional "id"
nodeNgramTable = Table "nodes_ngrams" ( pNodeNgram NodeNgram
{ nodeNgram_NodeNgramId = required "id"
, nodeNgram_NodeNgramNodeId = required "node_id"
, nodeNgram_NodeNgramNgramId = required "ngram_id"
, nodeNgram_NodeNgramWeight = optional "weight"
, nodeNgram_NodeNgramWeight = required "weight"
}
)
queryNodeNgramTable :: Query NodeNgramRead
queryNodeNgramTable = queryTable nodeNgramTable
instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
-- | not optimized (get all ngrams without filters)
nodeNgrams :: PGS.Connection -> IO [NodeNgram]
nodeNgrams conn = runQuery conn queryNodeNgramTable
src/Gargantext/Database/NodeNgramNgram.hs
View file @ a5f2a719
......@@ -23,18 +23,28 @@ data NodeNgramNgramPoly node_id ngram1_id ngram2_id weight
} deriving (Show)
type NodeNgramNgramWrite = NodeNgramNgramPoly (Maybe (Column PGInt4)) (Column PGInt4) (Column PGInt4) (Maybe (Column PGFloat8))
type NodeNgramNgramRead = NodeNgramNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) (Column PGFloat8)
type NodeNgramNgramWrite = NodeNgramNgramPoly (Maybe (Column PGInt4 ))
(Column PGInt4 )
(Column PGInt4 )
(Maybe (Column PGFloat8))
type NodeNgramNgramRead = NodeNgramNgramPoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
type NodeNgramNgram = NodeNgramNgramPoly (Maybe Int) Int Int (Maybe Double)
type NodeNgramNgram = NodeNgramNgramPoly (Maybe Int )
Int
Int
(Maybe Double)
$(makeAdaptorAndInstance "pNodeNgramNgram" ''NodeNgramNgramPoly)
$(makeLensesWith abbreviatedFields ''NodeNgramNgramPoly)
nodeNgramNgramTable :: Table NodeNgramNgramWrite NodeNgramNgramRead
nodeNgramNgramTable = Table "nodes_ngrams_ngrams" ( pNodeNgramNgram NodeNgramNgram
nodeNgramNgramTable = Table "nodes_ngrams_ngrams"
( pNodeNgramNgram NodeNgramNgram
{ nodeNgramNgram_NodeNgramNgram_NodeId = optional "node_id"
, nodeNgramNgram_NodeNgramNgram_Ngram1Id = required "ngram1_id"
, nodeNgramNgram_NodeNgramNgram_Ngram2Id = required "ngram2_id"
......@@ -42,11 +52,9 @@ nodeNgramNgramTable = Table "nodes_ngrams_ngrams" ( pNodeNgramNgram NodeNgramNg
}
)
queryNodeNgramNgramTable :: Query NodeNgramNgramRead
queryNodeNgramNgramTable = queryTable nodeNgramNgramTable
-- | not optimized (get all ngrams without filters)
nodeNgramNgrams :: PGS.Connection -> IO [NodeNgramNgram]
nodeNgramNgrams conn = runQuery conn queryNodeNgramNgramTable
......
src/Gargantext/Database/NodeNode.hs
View file @ a5f2a719
......@@ -22,24 +22,30 @@ data NodeNodePoly node1_id node2_id score
, nodeNode_score :: score
} deriving (Show)
type NodeNodeWrite = NodeNodePoly (Column PGInt4) (Column PGInt4) (Maybe (Column PGFloat8))
type NodeNodeRead = NodeNodePoly (Column PGInt4) (Column PGInt4) (Column PGFloat8)
type NodeNodeWrite = NodeNodePoly (Column (Nullable PGInt4))
(Column (PGInt4))
(Column (Nullable PGFloat8))
type NodeNodeRead = NodeNodePoly (Column (Nullable PGInt4))
(Column (PGInt4))
(Column (Nullable PGFloat8))
type NodeNodeReadNull = NodeNodePoly (Column (Nullable PGInt4))
(Column (Nullable PGInt4))
(Column (Nullable PGFloat8))
type NodeNode = NodeNodePoly Int Int (Maybe Double)
$(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
$(makeLensesWith abbreviatedFields ''NodeNodePoly)
nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
nodeNodeTable = Table "nodes_nodes" (pNodeNode NodeNode { nodeNode_node1_id = required "node1_id"
, nodeNode_node2_id = required "node2_id"
, nodeNode_score = optional "score"
, nodeNode_score = required "score"
}
)
queryNodeNodeTable :: Query NodeNodeRead
queryNodeNodeTable = queryTable nodeNodeTable
......@@ -48,5 +54,10 @@ queryNodeNodeTable = queryTable nodeNodeTable
nodeNodes :: PGS.Connection -> IO [NodeNode]
nodeNodes conn = runQuery conn queryNodeNodeTable
instance QueryRunnerColumnDefault (Nullable PGInt4) Int where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
src/Gargantext/Database/NodeNodeNgram.hs
View file @ a5f2a719
......@@ -25,18 +25,33 @@ data NodeNodeNgramPoly node1_id node2_id ngram_id score
} deriving (Show)
type NodeNodeNgramWrite = NodeNodeNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) (Maybe (Column PGFloat8))
type NodeNodeNgramRead = NodeNodeNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) (Column PGFloat8)
type NodeNodeNgramWrite = NodeNodeNgramPoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Maybe (Column PGFloat8))
type NodeNodeNgramRead = NodeNodeNgramPoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
type NodeNodeNgramReadNull = NodeNodeNgramPoly (Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGFloat8))
type NodeNodeNgram = NodeNodeNgramPoly Int
Int
Int
(Maybe Double)
type NodeNodeNgram = NodeNodeNgramPoly Int Int Int (Maybe Double)
$(makeAdaptorAndInstance "pNodeNodeNgram" ''NodeNodeNgramPoly)
$(makeLensesWith abbreviatedFields ''NodeNodeNgramPoly)
nodeNodeNgramTable :: Table NodeNodeNgramWrite NodeNodeNgramRead
nodeNodeNgramTable = Table "nodes_nodes_ngrams" ( pNodeNodeNgram NodeNodeNgram
nodeNodeNgramTable = Table "nodes_nodes_ngrams"
( pNodeNodeNgram NodeNodeNgram
{ nodeNodeNgram_node1_id = required "node1_id"
, nodeNodeNgram_node2_id = required "node2_id"
, nodeNodeNgram_ngram_id = required "ngram_id"
......@@ -48,11 +63,9 @@ nodeNodeNgramTable = Table "nodes_nodes_ngrams" ( pNodeNodeNgram NodeNodeNgram
queryNodeNodeNgramTable :: Query NodeNodeNgramRead
queryNodeNodeNgramTable = queryTable nodeNodeNgramTable
-- | not optimized (get all ngrams without filters)
nodeNodeNgrams :: PGS.Connection -> IO [NodeNodeNgram]
nodeNodeNgrams conn = runQuery conn queryNodeNodeNgramTable
instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
src/Gargantext/Database/Queries.hs 0 → 100644
View file @ a5f2a719
{-|
Module : Gargantext.Database.Queries
Description : Main requests of Node to the database
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Arrows #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.Database.Queries where
import Gargantext.Prelude
import Gargantext.Types (Limit, Offset, NodePoly)
import Data.Maybe (Maybe, maybe)
import Control.Arrow ((>>>))
import Control.Applicative ((<*>))
import Opaleye
-- (Query, limit, offset)
type NodeWrite = NodePoly (Maybe (Column PGInt4 ))
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column (PGText ))
(Maybe (Column PGTimestamptz))
(Column PGJsonb )
-- (Maybe (Column PGTSVector))
type NodeRead = NodePoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column (PGText ))
(Column PGTimestamptz )
(Column PGJsonb)
-- (Column PGTSVector)
type NodeReadNull = NodePoly (Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGText ))
(Column (Nullable PGTimestamptz ))
(Column (Nullable PGJsonb))
join3 :: Query columnsA -> Query columnsB -> Query columnsC
-> ((columnsA, columnsB, columnsC) -> Column PGBool)
-> Query (columnsA, columnsB, columnsC)
join3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond
--leftJoin3 :: Query columnsL1 -> Query columnsR -> Query columnsL
-- -> ((columnsL1, columnsR) -> Column PGBool)
-- -> ((columnsL, (columnsL1, nullableColumnsR1)) -> Column PGBool)
-- -> Query (columnsL, nullableColumnsR)
--leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
limit' :: Maybe Limit -> Query a -> Query a
limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit
offset' :: Maybe Offset -> Query a -> Query a
offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset
src/Gargantext/Database/Private.hs → src/Gargantext/Database/Utils.hs
View file @ a5f2a719
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module Gargantext.Database.Private where
module Gargantext.Database.Utils where
import qualified Database.PostgreSQL.Simple as PGS
......@@ -13,7 +13,13 @@ import Text.Read (read)
import Data.Ini (readIniFile, lookupValue)
import Data.Word (Word16)
import System.IO (FilePath)
import Database.PostgreSQL.Simple (Connection, connect)
-- Utilities
import Opaleye (Query, Unpackspec, showSqlForPostgres)
import Data.Profunctor.Product.Default (Default)
import Data.Maybe (maybe)
import Prelude (id, putStrLn)
-- TODO add a reader Monad here
-- read this in the init file
......@@ -32,7 +38,14 @@ databaseParameters fp = do
, PGS.connectPort = read (val "DB_PORT") :: Word16
, PGS.connectUser = val "DB_USER"
, PGS.connectPassword = val "DB_PASS"
, PGS.connectDatabase = val "DB_NAME" }
, PGS.connectDatabase = val "DB_NAME"
}
connectGargandb :: FilePath -> IO Connection
connectGargandb fp = do
parameters <- databaseParameters fp
connect parameters
printSql :: Default Unpackspec a a => Query a -> IO ()
printSql = putStrLn . maybe "Empty query" id . showSqlForPostgres
src/Gargantext/Ngrams/Count.hs
View file @ a5f2a719
......@@ -7,6 +7,7 @@ import Gargantext.Prelude
import Data.Foldable as F
import Data.Map.Strict (insertWith)
import Data.Map (Map)
import qualified Data.Map as M
......@@ -31,7 +32,7 @@ letters'' = DTL.foldr (\ch xs -> DTL.singleton ch : xs) []
-- number of punctuation
occurrences :: Ord a => [a] -> Map a Int
occurrences xs = foldl' (\x y -> M.insertWith' (+) y 1 x) M.empty xs
occurrences xs = foldl' (\x y -> insertWith (+) y 1 x) M.empty xs
-- for optimization :
--occurrences' :: Ord a => [a] -> Map a Integer
......
src/Gargantext/Prelude.hs
View file @ a5f2a719
......@@ -25,6 +25,7 @@ import Protolude ( Bool(True, False), Int, Double, Integer
, takeWhile, sqrt, undefined, identity
, abs, maximum, minimum, return, snd, truncate
, (+), (*), (/), (-), (.), (>=), ($), (**), (^), (<), (>), (==), (<>)
, toS
)
-- TODO import functions optimized in Utils.Count
......@@ -34,6 +35,7 @@ import Protolude ( Bool(True, False), Int, Double, Integer
import qualified Data.List as L hiding (head, sum)
import qualified Control.Monad as M
import qualified Data.Map as Map
import Data.Map.Strict (insertWith)
import qualified Data.Vector as V
import Safe (headMay)
import Text.Show (Show(), show)
......@@ -149,7 +151,7 @@ count2map xs = Map.map (/ (fromIntegral (length xs))) (count2map' xs)
-- | insert in a dict
count2map' :: (Ord k, Foldable t) => t k -> Map.Map k Double
count2map' xs = L.foldl' (\x y -> Map.insertWith' (+) y 1 x) Map.empty xs
count2map' xs = L.foldl' (\x y -> insertWith (+) y 1 x) Map.empty xs
trunc :: (RealFrac a, Integral c, Integral b) => b -> a -> c
......
src/Gargantext/Types/Main.hs
View file @ a5f2a719
{-|
Module : .Gargantext.Types.Main
Module : Gargantext.Types.Main
Description : Short description
Copyright : (c) CNRS, 2017
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
......@@ -10,35 +10,29 @@ Portability : POSIX
Here is a longer description of this module, containing some
commentary with @some markup@.
-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
------------------------------------------------------------------------
module Gargantext.Types.Main where
------------------------------------------------------------------------
import Prelude
import Protolude (fromMaybe)
import Data.Eq (Eq())
import Data.Monoid ((<>))
import Protolude (fromMaybe)
import Data.Aeson
import GHC.Generics
import Servant
import Data.Text (unpack)
import Text.Read (read)
import Data.Either (Either(Right))
--import Data.ByteString (ByteString())
import Data.Text (Text)
import Data.Time (UTCTime)
import Data.List (lookup)
import Gargantext.Types.Node ( NodePoly, HyperdataUser
, HyperdataFolder , HyperdataCorpus , HyperdataDocument
, HyperdataFavorites, HyperdataResource
, HyperdataList , HyperdataScore
, HyperdataGraph
, HyperdataPhylo
, HyperdataNotebook
)
import Gargantext.Types.Node
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Language of a Text
-- For simplicity, we suppose text has an homogenous language
......@@ -89,43 +83,15 @@ corpusTree = NodeT Corpus ( [ leafT Document ]
-- NP
-- * why NodeUser and not just User ?
-- * is this supposed to hold data ?
data NodeType = NodeUser | Project | Corpus | Document | DocumentCopy
| Classification
| Lists
| Metrics
deriving (Show, Read, Eq, Generic)
instance FromJSON NodeType
instance ToJSON NodeType
instance FromHttpApiData NodeType where parseUrlPiece = Right . read . unpack
data Classification = Favorites | MyClassifcation
data Lists = StopList | MainList | MapList | GroupList
data Metrics = Occurrences | Cooccurrences | Specclusion | Genclusion | Cvalue
| TfidfCorpus | TfidfGlobal | TirankLocal | TirankGlobal
-- | NodePoly indicates that Node has a Polymorphism Type
type Node json = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json -- NodeVector
-- type Node json = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
type NodeTypeId = Int
type NodeId = Int
type NodeParentId = Int
type NodeUserId = Int
type NodeName = Text
--type NodeVector = Vector
-- data Metrics = Occurrences | Cooccurrences | Specclusion | Genclusion | Cvalue
-- | TfidfCorpus | TfidfGlobal | TirankLocal | TirankGlobal
--type NodeUser = Node HyperdataUser
-- | Then a Node can be either a Folder or a Corpus or a Document
type NodeUser = Node HyperdataUser
type Folder = Node HyperdataFolder
type Project = Folder -- NP Node HyperdataProject ?
type Corpus = Node HyperdataCorpus
type Document = Node HyperdataDocument
-- | Community Manager Use Case
type Annuaire = Corpus
......@@ -176,7 +142,7 @@ nodeTypes = [ (NodeUser , 1)
-- , (MainList , 7)
-- , (MapList ,  8)
---- Scores
-- , (Occurrences , 10)
, (Occurrences , 10)
-- , (Cooccurrences , 9)
--
-- , (Specclusion , 11)
......@@ -200,10 +166,14 @@ nodeTypeId tn = fromMaybe (error $ "Typename " <> show tn <> " does not exist")
-- Temporary types to be removed
type Ngrams = (Text, Text, Text)
type ErrorMessage = Text
-- Queries
type ParentId = NodeId
type Limit = Int
type Offset = Int
src/Gargantext/Types/Node.hs
View file @ a5f2a719
This diff is collapsed.
stack.yaml
View file @ a5f2a719
......@@ -2,12 +2,25 @@ flags: {}
extra-package-dbs: []
packages:
- .
#- /home/alexandre/local/logiciels/haskell/servant/servant-multipart
#- /home/alexandre/local/logiciels/haskell/utc
allow-newer: true
extra-deps:
- aeson-1.0.2.1
- git: https://github.com/delanoe/data-time-segment.git
commit: 4e3d57d80e9dfe6624c8eeaa8595fc8fe64d8723
- aeson-1.2.4.0
- aeson-lens-0.5.0.0
- duckling-0.1.3.0
- extra-1.5.3
- haskell-src-exts-1.18.2
- http-types-0.12.1
- protolude-0.2
- servant-multipart-0.10.0.1
- servant-0.12.1
- servant-auth-0.3.0.1
resolver: lts-9.2
- servant-client-0.12.0.1
- servant-client-core-0.12
- servant-docs-0.11.1
- servant-multipart-0.11.1
- servant-server-0.12
- servant-swagger-ui-0.2.3.2.2.8
- text-1.2.3.0
- text-show-3.6.2
resolver: lts-10.6
swagger.json 0 → 100644
View file @ a5f2a719
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