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