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