Skip to content

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

[API][NGRAMS] routes added.

parent 11fab9ed
Show whitespace changes
Inline Side-by-side
Showing with 166 additions and 45 deletions
src/Gargantext/API/Ngrams.hs
View file @ cbc7f171
......@@ -19,35 +19,70 @@ add get
-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
module Gargantext.API.Ngrams
where
import Prelude (Enum, Bounded, minBound, maxBound)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (FromJSON, ToJSON)
import Data.Either(Either(Left))
import Data.Aeson.TH (deriveJSON)
import Database.PostgreSQL.Simple (Connection)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as DM
import Data.Map.Strict.Patch (Patch, apply, Edit, EditV, replace, transformWith, fromList)
import GHC.Generics (Generic)
--import qualified Data.Map.Strict as DM
--import Data.Map.Strict.Patch (Patch, replace, fromList)
import Data.Text (Text)
import Data.Maybe (catMaybes)
--import Data.Maybe (catMaybes)
import Data.Set (Set)
import qualified Data.Set as Set
--import qualified Data.Set as Set
import GHC.Generics (Generic)
import Gargantext.Database.Ngram (NgramsId)
import Gargantext.Database.NodeNgram (updateNodeNgrams)
import Gargantext.Database.User (UserId)
import Gargantext.Text.List.Types (ListType(..))
import Gargantext.Core.Types.Main (Tree(..))
import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Prelude
import Servant hiding (Patch)
import Data.Swagger (ToSchema, ToParamSchema)
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
------------------------------------------------------------------------
--data FacetFormat = Table | Chart
data TabType = Docs | Terms | Sources | Authors | Trash
deriving (Generic, Enum, Bounded)
instance FromHttpApiData TabType
where
parseUrlPiece "Docs" = pure Docs
parseUrlPiece "Terms" = pure Terms
parseUrlPiece "Sources" = pure Sources
parseUrlPiece "Authors" = pure Authors
parseUrlPiece "Trash" = pure Trash
parseUrlPiece _ = Left "Unexpected value of TabType"
instance ToParamSchema TabType
instance ToJSON TabType
instance FromJSON TabType
instance ToSchema TabType
instance Arbitrary TabType
where
arbitrary = elements [minBound .. maxBound]
------------------------------------------------------------------------
data NgramsElement =
NgramsElement { _ne_id :: Int
, _ne_ngrams :: Text
......@@ -59,14 +94,15 @@ $(deriveJSON (unPrefix "_ne_") ''NgramsElement)
data NgramsTable = NgramsTable { _ngramsTable :: [Tree NgramsElement] }
deriving (Ord, Eq, Generic)
$(deriveJSON (unPrefix "_") ''NgramsTable)
instance ToJSON NgramsTable
instance FromJSON NgramsTable
instance FromJSON (Tree NgramsElement)
-- TODO
instance FromJSON (Tree NgramsElement)
instance ToJSON (Tree NgramsElement)
------------------------------------------------------------------------
-- On the Client side:
--data Action = InGroup NgramsId NgramsId
-- | OutGroup NgramsId NgramsId
-- | SetListType NgramsId ListType
......@@ -76,12 +112,41 @@ data NgramsPatch =
, _np_add_children :: Set NgramsId
, _np_rem_children :: Set NgramsId
}
deriving (Ord, Eq, Show)
deriving (Ord, Eq, Show, Generic)
$(deriveJSON (unPrefix "_np_") ''NgramsPatch)
type NgramsIdPatch = Patch NgramsId NgramsPatch
instance ToSchema NgramsPatch
instance Arbitrary NgramsPatch where
arbitrary = NgramsPatch <$> arbitrary <*> arbitrary <*> arbitrary
--
data NgramsIdPatch =
NgramsIdPatch { _nip_ngramsId :: NgramsId
, _nip_ngramsPatch :: NgramsPatch
}
deriving (Ord, Eq, Show, Generic)
$(deriveJSON (unPrefix "_nip_") ''NgramsIdPatch)
instance ToSchema NgramsIdPatch
instance Arbitrary NgramsIdPatch where
arbitrary = NgramsIdPatch <$> arbitrary <*> arbitrary
--
data NgramsIdPatchs =
NgramsIdPatchs { _nip_ngramsIdPatchs :: [NgramsIdPatch] }
deriving (Ord, Eq, Show, Generic)
$(deriveJSON (unPrefix "_nip_") ''NgramsIdPatchs)
instance ToSchema NgramsIdPatchs
instance Arbitrary NgramsIdPatchs where
arbitrary = NgramsIdPatchs <$> arbitrary
------------------------------------------------------------------------
------------------------------------------------------------------------
type Version = Int
......@@ -91,21 +156,59 @@ data Versioned a = Versioned
}
{-
-- TODO sequencs of modifications (Patchs)
type NgramsIdPatch = Patch NgramsId NgramsPatch
ngramsPatch :: Int -> NgramsPatch
ngramsPatch n = NgramsPatch (DM.fromList [(1, StopList)]) (Set.fromList [n]) Set.empty
{-
toEdit :: NgramsId -> NgramsPatch -> Edit NgramsId NgramsPatch
toEdit n p = Edit n p
-}
ngramsIdPatch :: Patch NgramsId NgramsPatch
ngramsIdPatch = fromList $ catMaybes $ reverse [ replace (1::NgramsId) (Just $ ngramsPatch 1) Nothing
, replace (1::NgramsId) Nothing (Just $ ngramsPatch 2)
, replace (2::NgramsId) Nothing (Just $ ngramsPatch 2)
]
-- applyPatchBack :: Patch -> IO Patch
-- isEmptyPatch = Map.all (\x -> Set.isEmpty (add_children x) && Set.isEmpty ... )
-}
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
type CorpusId = Int
type ListId = Int
type TableNgramsApi = Summary " Table Ngrams API"
:> QueryParam "list" ListId
:> ReqBody '[JSON] NgramsIdPatchs
:> Put '[JSON] NgramsIdPatchsBack
type NgramsIdPatchsFeed = NgramsIdPatchs
type NgramsIdPatchsBack = NgramsIdPatchs
getDefaultList :: Connection -> CorpusId -> IO ListId
getDefaultList = undefined
type NgramsIdParent = Int
type NgramsIdChild = Int
data Action = Del | Add
doNgramsGroup :: Connection -> ListId -> Action -> [(NgramsIdParent, NgramsIdChild)] -> IO [Int]
doNgramsGroup = undefined
tableNgramsPatch :: Connection -> CorpusId -> Maybe ListId -> NgramsIdPatchsFeed -> IO NgramsIdPatchsBack
tableNgramsPatch conn corpusId maybeList patchs = do
listId <- case maybeList of
Nothing -> getDefaultList conn corpusId
Just listId' -> pure listId'
--_ <- doNgramsGroups conn listId Add $
--_ <- delNgramsGroups conn listId
--_ <- updateNodeNgrams conn
pure (NgramsIdPatchs [])
src/Gargantext/API/Node.hs
View file @ cbc7f171
......@@ -32,13 +32,11 @@ module Gargantext.API.Node
, HyperdataDocumentV3(..)
) where
-------------------------------------------------------------------
import Prelude (Enum, Bounded, minBound, maxBound)
import Control.Lens (prism')
import Control.Monad.IO.Class (liftIO)
import Control.Monad ((>>))
--import System.IO (putStrLn, readFile)
import Data.Either(Either(Left))
import Data.Aeson (FromJSON, ToJSON)
--import Data.Text (Text(), pack)
import Data.Text (Text())
......@@ -50,6 +48,7 @@ import Database.PostgreSQL.Simple (Connection)
import GHC.Generics (Generic)
import Servant
import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, tableNgramsPatch, NgramsIdPatchsFeed, NgramsIdPatchsBack, ListId)
import Gargantext.Prelude
import Gargantext.Database.Types.Node
import Gargantext.Database.Node ( runCmd
......@@ -106,7 +105,11 @@ type NodeAPI a = Get '[JSON] (Node a)
:<|> Put '[JSON] Int
:<|> Delete '[JSON] Int
:<|> "children" :> ChildrenApi a
-- TODO gather it
:<|> "table" :> TableApi
:<|> "list" :> TableNgramsApi
:<|> "chart" :> ChartApi
:<|> "favorites" :> FavApi
:<|> "documents" :> DocsApi
......@@ -134,7 +137,11 @@ nodeAPI conn p id
:<|> putNode conn id
:<|> deleteNode' conn id
:<|> getNodesWith' conn id p
-- TODO gather it
:<|> getTable conn id
:<|> tableNgramsPatch' conn id
:<|> getChart conn id
:<|> favApi conn id
:<|> delDocs conn id
......@@ -150,7 +157,6 @@ instance ToSchema RenameNode
instance Arbitrary RenameNode where
arbitrary = elements [RenameNode "test"]
------------------------------------------------------------------------
data PostNode = PostNode { pn_name :: Text
, pn_typename :: NodeType}
deriving (Generic)
......@@ -204,28 +210,6 @@ favApi :: Connection -> CorpusId -> (Favorites -> Handler [Int])
:<|> (Favorites -> Handler [Int])
favApi c cId = putFav c cId :<|> delFav c cId
------------------------------------------------------------------------
--data FacetFormat = Table | Chart
data TabType = Docs | Terms | Sources | Authors | Trash
deriving (Generic, Enum, Bounded)
instance FromHttpApiData TabType
where
parseUrlPiece "Docs" = pure Docs
parseUrlPiece "Terms" = pure Terms
parseUrlPiece "Sources" = pure Sources
parseUrlPiece "Authors" = pure Authors
parseUrlPiece "Trash" = pure Trash
parseUrlPiece _ = Left "Unexpected value of TabType"
instance ToParamSchema TabType
instance ToJSON TabType
instance FromJSON TabType
instance ToSchema TabType
instance Arbitrary TabType
where
arbitrary = elements [minBound .. maxBound]
------------------------------------------------------------------------
type TableApi = Summary " Table API"
:> QueryParam "view" TabType
......@@ -234,12 +218,12 @@ type TableApi = Summary " Table API"
:> QueryParam "order" OrderBy
:> Get '[JSON] [FacetDoc]
------------------------------------------------------------------------
type ChartApi = Summary " Chart API"
:> QueryParam "from" UTCTime
:> QueryParam "to" UTCTime
:> Get '[JSON] [FacetChart]
-- Depending on the Type of the Node, we could post
-- New documents for a corpus
-- New map list terms
......@@ -300,6 +284,8 @@ getNodesWith' :: JSONB a => Connection -> NodeId -> proxy a -> Maybe NodeType
-> Maybe Int -> Maybe Int -> Handler [Node a]
getNodesWith' conn id p nodeType offset limit = liftIO (getNodesWith conn id p nodeType offset limit)
tableNgramsPatch' :: Connection -> CorpusId -> Maybe ListId -> NgramsIdPatchsFeed -> Handler NgramsIdPatchsBack
tableNgramsPatch' c cId mL ns = liftIO $ tableNgramsPatch c cId mL ns
query :: Text -> Handler Text
query s = pure s
......
src/Gargantext/Database/NodeNgram.hs
View file @ cbc7f171
......@@ -21,16 +21,20 @@ if Node is a List then it is listing (either Stop, Candidate or Map)
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.NodeNgram where
import Gargantext.Prelude
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Gargantext.Database.Node (mkCmd, Cmd(..))
import Gargantext.Prelude
import Opaleye
import qualified Database.PostgreSQL.Simple as PGS (Connection, query, Only(..))
-- | TODO : remove id
data NodeNgramPoly id node_id ngram_id weight ngrams_type
......@@ -90,3 +94,22 @@ insertNodeNgramW nns =
mkCmd $ \c -> fromIntegral
<$> runInsertMany c nodeNgramTable nns
-- TODO: remove these type (duplicate with others)
type ListId = Int
type NgramsId = Int
type ListTypeId = Int
updateNodeNgrams :: PGS.Connection -> [(ListId, NgramsId, ListTypeId)] -> IO [PGS.Only Int]
updateNodeNgrams c input = PGS.query c updateQuery (PGS.Only $ Values fields $ input)
where
fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
updateQuery = [sql| UPDATE nodes_ngrams as old SET
ngrams_type = new.typeList
from (?) as new(node_id,ngram_id,typeList)
WHERE old.node_id = new.node_id
AND old.gram_id = new.gram_id
RETURNING new.ngram_id
|]
src/Gargantext/Database/NodeNode.hs
View file @ cbc7f171
......@@ -133,8 +133,8 @@ nodeToTrash c cId dId b = PGS.query c trashQuery (b,cId,dId)
-- | Trash Massive
nodesToTrash :: PGS.Connection -> [(CorpusId,DocId,Bool)] -> IO [Int]
nodesToTrash c inputData = map (\(PGS.Only a) -> a)
<$> PGS.query c trashQuery (PGS.Only $ Values fields inputData)
nodesToTrash c input = map (\(PGS.Only a) -> a)
<$> PGS.query c trashQuery (PGS.Only $ Values fields input)
where
fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","bool"]
trashQuery :: PGS.Query
......
src/Gargantext/Text/List/Types.hs
View file @ cbc7f171
......@@ -23,6 +23,10 @@ import Data.Text (Text)
import GHC.Generics (Generic)
import Gargantext.Prelude
import Prelude (Bounded, Enum, minBound, maxBound)
import Data.Swagger (ToSchema)
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
-------------------------------------------------------------------
data ListType = GraphList | StopList | CandidateList
......@@ -30,6 +34,9 @@ data ListType = GraphList | StopList | CandidateList
instance FromJSON ListType
instance ToJSON ListType
instance ToSchema ListType
instance Arbitrary ListType where
arbitrary = elements [minBound..maxBound]
type Lists = Map ListType (Map Text [Text])
......
stack.yaml
View file @ cbc7f171
......@@ -6,6 +6,8 @@ packages:
- 'deps/servant-job'
- 'deps/clustering-louvain'
- 'deps/patches-map'
- 'deps/patches-class'
#- 'deps/imt-api-client'
allow-newer: true
......
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