Commit 9d76403e authored by Alexandre Delanoë's avatar Alexandre Delanoë

[MERGE]

parents 7e9eeaf1 50d10679
......@@ -148,5 +148,5 @@ api
:: (Typeable env, HasConnectionPool env, HasConfig env, HasMail env, HasJobEnv' env)
=> ServerT API (GargM env GargError)
api (SAS.Authenticated _auser) = httpPubApp [] app :<|> pure httpPlayground
api _ = panic "401 in graphql" --SAS.throwAll (_ServerError # err401)
--api _ = httpPubApp [] app :<|> pure httpPlayground
--api _ = panic "401 in graphql" --SAS.throwAll (_ServerError # err401)
api _ = httpPubApp [] app :<|> pure httpPlayground
......@@ -4,6 +4,7 @@
module Gargantext.API.GraphQL.Node where
import Data.Either (Either(..))
import Data.Morpheus.Types
( GQLType
, Resolver
......@@ -11,16 +12,18 @@ import Data.Morpheus.Types
, lift
)
import Data.Text (Text)
import qualified Data.Text as T
import Gargantext.API.Prelude (GargM, GargError)
import Gargantext.Core.Mail.Types (HasMail)
import Gargantext.Database.Admin.Config (fromNodeTypeId)
import Gargantext.Database.Admin.Types.Node (NodeId(..))
import Gargantext.Database.Admin.Types.Node (NodeId(..), NodeType)
import qualified Gargantext.Database.Admin.Types.Node as NN
import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, getNode)
import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
import qualified Gargantext.Database.Schema.Node as N
import Gargantext.Prelude
import GHC.Generics (Generic)
import qualified Prelude as Prelude
import Text.Read (readEither)
data Node = Node
{ id :: Int
......@@ -51,25 +54,31 @@ dbNodes node_id = do
data NodeParentArgs
= NodeParentArgs
{ node_id :: Int
, parent_type_id :: Int
{ node_id :: Int
, parent_type :: Text
} deriving (Generic, GQLType)
resolveNodeParent
:: (HasConnectionPool env, HasConfig env, HasMail env)
=> NodeParentArgs -> GqlM e env [Node]
resolveNodeParent NodeParentArgs { node_id, parent_type_id } = dbParentNodes node_id parent_type_id
resolveNodeParent NodeParentArgs { node_id, parent_type } = dbParentNodes node_id parent_type
dbParentNodes
:: (HasConnectionPool env, HasConfig env, HasMail env)
=> Int -> Int -> GqlM e env [Node]
dbParentNodes node_id parent_type_id = do
mNodeId <- lift $ getClosestParentIdByType (NodeId node_id) (fromNodeTypeId parent_type_id)
case mNodeId of
Nothing -> pure []
Just id -> do
node <- lift $ getNode id
pure [toNode node]
=> Int -> Text -> GqlM e env [Node]
dbParentNodes node_id parent_type = do
let mParentType = readEither (T.unpack parent_type) :: Either Prelude.String NodeType
case mParentType of
Left err -> do
lift $ printDebug "[dbParentNodes] error reading parent type" (T.pack err)
pure []
Right parentType -> do
mNodeId <- lift $ getClosestParentIdByType (NodeId node_id) parentType -- (fromNodeTypeId parent_type_id)
case mNodeId of
Nothing -> pure []
Just id -> do
node <- lift $ getNode id
pure [toNode node]
toNode :: NN.Node json -> Node
toNode (N.Node { .. }) = Node { id = NN.unNodeId _node_id
......
......@@ -73,3 +73,9 @@ getHyperdataFrameContents (HyperdataFrame { _hf_base, _hf_frame_id }) = do
let path = T.concat [_hf_base, "/", _hf_frame_id, "/download"]
r <- Wreq.get $ T.unpack path
pure $ decodeUtf8 $ toStrict $ r ^. Wreq.responseBody
getHyperdataFrameCSV :: HyperdataFrame -> IO Text
getHyperdataFrameCSV (HyperdataFrame { _hf_base, _hf_frame_id }) = do
let path = T.concat [_hf_base, "/", _hf_frame_id, ".csv"]
r <- Wreq.get $ T.unpack path
pure $ decodeUtf8 $ toStrict $ r ^. Wreq.responseBody
......@@ -2,6 +2,7 @@ resolver:
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/18.yaml
flags: {}
extra-package-dbs: []
skip-ghc-check: true
packages:
- .
#- 'deps/gargantext-graph'
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment