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 System.IO (putStrLn)
  27
  28 import Control.Monad.IO.Class (liftIO)
  29 import Control.Monad ((>>))
  30 --import System.IO (putStrLn, readFile)
  31
  32 -- import Data.Aeson (Value())
  33 --import Data.Text (Text(), pack)
  34 import Data.Text (Text())
  35 import Data.Time (UTCTime)
  36
  37 import Database.PostgreSQL.Simple (Connection)
  38
  39 import Servant
  40 -- import Servant.Multipart
  41
  42 import Gargantext.Prelude
  43 import Gargantext.Types.Node
  44 import Gargantext.Database.Node ( getNodesWithParentId
  45                                 , getNode, getNodesWith
  46                                 , deleteNode, deleteNodes)
  47 import Gargantext.Database.Facet (FacetDoc, getDocFacet
  48                                  ,FacetChart)
  49
  50 -------------------------------------------------------------------
  51 -------------------------------------------------------------------
  52 -- | Node API Types management
  53 type Roots =  Get    '[JSON] [Node HyperdataDocument]
  54          :<|> Post   '[JSON] Int
  55          :<|> Put    '[JSON] Int
  56          :<|> Delete '[JSON] Int
  57
  58 type NodesAPI  = Delete '[JSON] Int
  59
  60 type NodeAPI   = Get '[JSON] (Node HyperdataDocument)
  61              :<|> Delete '[JSON] Int
  62              :<|> "children" :> Summary " Summary children"
  63                              :> QueryParam "type"   NodeType
  64                              :> QueryParam "offset" Int
  65                              :> QueryParam "limit"  Int
  66                              :> Get '[JSON] [Node HyperdataDocument]
  67              :<|> "facet" :> Summary " Facet documents"
  68                           :> "documents" :> FacetDocAPI
  69 --             :<|> "facet" :<|> "sources"   :<|> FacetSourcesAPI
  70 --             :<|> "facet" :<|> "authors"   :<|> FacetAuthorsAPI
  71 --             :<|> "facet" :<|> "terms"     :<|> FacetTermsAPI
  72
  73 --data FacetFormat = Table | Chart
  74 --data FacetType   = Doc   | Term  | Source | Author
  75 --data Facet       = Facet Doc Format
  76
  77
  78 type FacetDocAPI = "table"
  79                    :> Summary " Table data"
  80                    :> QueryParam "offset" Int
  81                    :> QueryParam "limit"  Int
  82                    :> Get '[JSON] [FacetDoc]
  83
  84                 :<|> "chart"
  85                    :> Summary " Chart data"
  86                    :> QueryParam "from" UTCTime
  87                    :> QueryParam "to"   UTCTime
  88                    :> Get '[JSON] [FacetChart]
  89 --
  90                 -- Depending on the Type of the Node, we could post
  91                 -- New documents for a corpus
  92                 -- New map list terms
  93              -- :<|> "process"  :> MultipartForm MultipartData :> Post '[JSON] Text
  94
  95                 -- To launch a query and update the corpus
  96              -- :<|> "query"    :> Capture "string" Text       :> Get  '[JSON] Text
  97
  98
  99 -- | Node API functions
 100 roots :: Connection -> Server Roots
 101 roots conn = liftIO (putStrLn "Log Needed" >> getNodesWithParentId conn 0 Nothing)
 102           :<|> pure (panic "not implemented yet")
 103           :<|> pure (panic "not implemented yet")
 104           :<|> pure (panic "not implemented yet")
 105
 106 nodeAPI :: Connection -> NodeId -> Server NodeAPI
 107 nodeAPI conn id =  liftIO (putStrLn "getNode" >> getNode              conn id )
 108               :<|> deleteNode'   conn id
 109               :<|> getNodesWith' conn id
 110               :<|> getFacet      conn id
 111               :<|> getChart      conn id
 112               -- :<|> upload
 113               -- :<|> query
 114
 115 nodesAPI :: Connection -> [NodeId] -> Server NodesAPI
 116 nodesAPI conn ids = deleteNodes' conn ids
 117
 118 deleteNodes' :: Connection -> [NodeId] -> Handler Int
 119 deleteNodes' conn ids = liftIO (deleteNodes conn ids)
 120
 121 deleteNode' :: Connection -> NodeId -> Handler Int
 122 deleteNode' conn id = liftIO (deleteNode conn id)
 123
 124 getNodesWith' :: Connection -> NodeId -> Maybe NodeType -> Maybe Int -> Maybe Int
 125                         -> Handler [Node HyperdataDocument]
 126 getNodesWith' conn id nodeType offset limit  = liftIO (getNodesWith conn id nodeType offset limit)
 127
 128
 129 getFacet :: Connection -> NodeId -> Maybe Int -> Maybe Int
 130                         -> Handler [FacetDoc]
 131 getFacet conn id offset limit = liftIO (getDocFacet conn id (Just Document) offset limit)
 132
 133 getChart :: Connection -> NodeId -> Maybe UTCTime -> Maybe UTCTime
 134                         -> Handler [FacetChart]
 135 getChart _ _ _ _ = undefined
 136
 137
 138 query :: Text -> Handler Text
 139 query s = pure s
 140
 141
 142 -- | Upload files
 143 -- TODO Is it possible to adapt the function according to iValue input ?
 144 --upload :: MultipartData -> Handler Text
 145 --upload multipartData = do
 146 --  liftIO $ do
 147 --    putStrLn "Inputs:"
 148 --    forM_ (inputs multipartData) $ \input ->
 149 --      putStrLn $ "  " <> show (iName input)
 150 --            <> " -> " <> show (iValue input)
 151 --
 152 --    forM_ (files multipartData) $ \file -> do
 153 --      content <- readFile (fdFilePath file)
 154 --      putStrLn $ "Content of " <> show (fdFileName file)
 155 --              <> " at " <> fdFilePath file
 156 --      putStrLn content
 157 --  pure (pack "Data loaded")
 158