src/Gargantext/API/Node.hs

   1 {-|
   2 Module      : Gargantext.API.Node
   3 Description : Server API
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Node API
  11 -}
  12
  13 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  14
  15 {-# LANGUAGE DataKinds          #-}
  16 {-# LANGUAGE DeriveGeneric      #-}
  17 {-# LANGUAGE NoImplicitPrelude  #-}
  18 {-# LANGUAGE OverloadedStrings  #-}
  19 {-# LANGUAGE TemplateHaskell    #-}
  20 {-# LANGUAGE TypeOperators      #-}
  21
  22 -------------------------------------------------------------------
  23 module Gargantext.API.Node
  24       where
  25 -------------------------------------------------------------------
  26
  27 import Control.Monad.IO.Class (liftIO)
  28 import Control.Monad ((>>))
  29 --import System.IO (putStrLn, readFile)
  30
  31 import Data.Aeson (FromJSON, ToJSON, Value())
  32 --import Data.Text (Text(), pack)
  33 import Data.Text (Text())
  34 import Data.Swagger
  35 import Data.Time (UTCTime)
  36
  37 import Database.PostgreSQL.Simple (Connection)
  38
  39 import GHC.Generics (Generic)
  40 import Servant
  41 -- import Servant.Multipart
  42
  43 import Gargantext.Prelude
  44 import Gargantext.Database.Types.Node
  45 import Gargantext.Database.Node ( getNodesWithParentId
  46                                 , getNode, getNodesWith
  47                                 , deleteNode, deleteNodes)
  48 import Gargantext.Database.Facet (FacetDoc, getDocFacet
  49                                  ,FacetChart)
  50
  51 -- Graph
  52 import Gargantext.TextFlow
  53 import Gargantext.Viz.Graph (Graph)
  54 import Gargantext.Core (Lang(..))
  55 import Gargantext.Core.Types.Main (Tree, NodeTree)
  56 import Gargantext.Text.Terms (TermType(..))
  57
  58 import Test.QuickCheck (elements)
  59 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  60 -------------------------------------------------------------------
  61 -- | Node API Types management
  62 type Roots =  Get    '[JSON] [Node Value]
  63          :<|> Post   '[JSON] Int
  64          :<|> Put    '[JSON] Int
  65          :<|> Delete '[JSON] Int
  66
  67 type NodesAPI  = Delete '[JSON] Int
  68
  69
  70
  71 data Rename = Rename { name :: Text }
  72   deriving (Generic)
  73
  74 instance FromJSON Rename
  75 instance ToJSON Rename
  76 instance ToSchema Rename
  77 instance Arbitrary Rename where
  78   arbitrary = elements [Rename "test"]
  79
  80 type NodeAPI   = Get '[JSON] (Node Value)
  81              :<|> "rename" :> Summary " Rename Node"
  82                            :> ReqBody '[JSON] Rename
  83                            :> Put     '[JSON] Int
  84              :<|> Post   '[JSON] Int
  85              :<|> Put    '[JSON] Int
  86              :<|> Delete '[JSON] Int
  87              :<|> "children" :> Summary " Summary children"
  88                              :> QueryParam "type"   NodeType
  89                              :> QueryParam "offset" Int
  90                              :> QueryParam "limit"  Int
  91                              :> Get '[JSON] [Node Value]
  92              :<|> "facet" :> Summary " Facet documents"
  93                           :> "documents" :> FacetDocAPI
  94 --             :<|> "facet" :<|> "sources"   :<|> FacetSourcesAPI
  95 --             :<|> "facet" :<|> "authors"   :<|> FacetAuthorsAPI
  96 --             :<|> "facet" :<|> "terms"     :<|> FacetTermsAPI
  97
  98 --data FacetFormat = Table | Chart
  99 --data FacetType   = Doc   | Term  | Source | Author
 100 --data Facet       = Facet Doc Format
 101
 102
 103 type FacetDocAPI = "table"
 104                    :> Summary " Table data"
 105                    :> QueryParam "offset" Int
 106                    :> QueryParam "limit"  Int
 107                    :> Get '[JSON] [FacetDoc]
 108
 109                 :<|> "chart"
 110                    :> Summary " Chart data"
 111                    :> QueryParam "from" UTCTime
 112                    :> QueryParam "to"   UTCTime
 113                    :> Get '[JSON] [FacetChart]
 114
 115                 -- Depending on the Type of the Node, we could post
 116                 -- New documents for a corpus
 117                 -- New map list terms
 118              -- :<|> "process"  :> MultipartForm MultipartData :> Post '[JSON] Text
 119
 120                 -- To launch a query and update the corpus
 121              -- :<|> "query"    :> Capture "string" Text       :> Get  '[JSON] Text
 122
 123
 124 -- | Node API functions
 125 roots :: Connection -> Server Roots
 126 roots conn = liftIO (putStrLn ( "/user" :: Text) >> getNodesWithParentId conn 0 Nothing)
 127           :<|> pure (panic "not implemented yet")
 128           :<|> pure (panic "not implemented yet")
 129           :<|> pure (panic "not implemented yet")
 130
 131
 132 type GraphAPI   = Get '[JSON] Graph
 133 graphAPI :: Connection -> NodeId -> Server GraphAPI
 134 graphAPI _ _ = liftIO $ textFlow (Mono EN) (Contexts contextText)
 135
 136 type TreeAPI   = Get '[JSON] (Tree NodeTree)
 137 treeAPI :: Connection -> NodeId -> Server TreeAPI
 138 treeAPI _ _ = undefined
 139
 140
 141 nodeAPI :: Connection -> NodeId -> Server NodeAPI
 142 nodeAPI conn id =  liftIO (putStrLn ("/node" :: Text) >> getNode              conn id )
 143               :<|> rename        conn id
 144               :<|> postNode      conn id
 145               :<|> putNode       conn id
 146               :<|> deleteNode'   conn id
 147               :<|> getNodesWith' conn id
 148               :<|> getFacet      conn id
 149               :<|> getChart      conn id
 150               -- :<|> upload
 151               -- :<|> query
 152 -- | Check if the name is less than 255 char
 153 --rename :: Connection -> NodeId -> Rename -> Server NodeAPI
 154 rename :: Connection -> NodeId -> Rename -> Handler Int
 155 rename = undefined
 156
 157 nodesAPI :: Connection -> [NodeId] -> Server NodesAPI
 158 nodesAPI conn ids = deleteNodes' conn ids
 159
 160 postNode :: Connection -> NodeId -> Handler Int
 161 postNode = undefined
 162
 163 putNode :: Connection -> NodeId -> Handler Int
 164 putNode = undefined
 165
 166 deleteNodes' :: Connection -> [NodeId] -> Handler Int
 167 deleteNodes' conn ids = liftIO (deleteNodes conn ids)
 168
 169 deleteNode' :: Connection -> NodeId -> Handler Int
 170 deleteNode' conn id = liftIO (deleteNode conn id)
 171
 172 getNodesWith' :: Connection -> NodeId -> Maybe NodeType -> Maybe Int -> Maybe Int
 173                         -> Handler [Node Value]
 174 getNodesWith' conn id nodeType offset limit  = liftIO (getNodesWith conn id nodeType offset limit)
 175
 176
 177 getFacet :: Connection -> NodeId -> Maybe Int -> Maybe Int
 178                         -> Handler [FacetDoc]
 179 getFacet conn id offset limit = liftIO (putStrLn ( "/facet" :: Text)) >> liftIO (getDocFacet conn NodeCorpus id (Just Document) offset limit)
 180
 181 getChart :: Connection -> NodeId -> Maybe UTCTime -> Maybe UTCTime
 182                         -> Handler [FacetChart]
 183 getChart _ _ _ _ = undefined
 184
 185
 186 query :: Text -> Handler Text
 187 query s = pure s
 188
 189
 190 -- | Upload files
 191 -- TODO Is it possible to adapt the function according to iValue input ?
 192 --upload :: MultipartData -> Handler Text
 193 --upload multipartData = do
 194 --  liftIO $ do
 195 --    putStrLn "Inputs:"
 196 --    forM_ (inputs multipartData) $ \input ->
 197 --      putStrLn $ "  " <> show (iName input)
 198 --            <> " -> " <> show (iValue input)
 199 --
 200 --    forM_ (files multipartData) $ \file -> do
 201 --      content <- readFile (fdFilePath file)
 202 --      putStrLn $ "Content of " <> show (fdFileName file)
 203 --              <> " at " <> fdFilePath file
 204 --      putStrLn content
 205 --  pure (pack "Data loaded")
 206