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