Commit b1117dc0 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'master' into dbflow

parents 410f4e06 84e6f29f
......@@ -45,7 +45,6 @@ import GHC.Generics (D1, Meta (..), Rep)
import GHC.TypeLits (AppendSymbol, Symbol)
import Control.Lens
import Data.Aeson (Value)
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Swagger
......@@ -71,7 +70,9 @@ import Gargantext.API.Node ( Roots , roots
, NodesAPI , nodesAPI
, GraphAPI , graphAPI
, TreeAPI , treeAPI
, HyperdataAny
, HyperdataCorpus
, HyperdataAnnuaire
)
import Gargantext.Database.Types.Node ()
import Gargantext.API.Count ( CountAPI, count, Query)
......@@ -208,12 +209,16 @@ type GargAPI' =
-- Node endpoint
:<|> "node" :> Summary "Node endpoint"
:> Capture "id" Int :> NodeAPI Value
:> Capture "id" Int :> NodeAPI HyperdataAny
-- Corpus endpoint
:<|> "corpus":> Summary "Corpus endpoint"
:> Capture "id" Int :> NodeAPI HyperdataCorpus
-- Annuaire endpoint
:<|> "annuaire":> Summary "Annuaire endpoint"
:> Capture "id" Int :> NodeAPI HyperdataAnnuaire
-- Corpus endpoint
:<|> "nodes" :> Summary "Nodes endpoint"
:> ReqBody '[JSON] [Int] :> NodesAPI
......@@ -256,8 +261,9 @@ server env = do
-- orchestrator <- scrapyOrchestrator env
pure $ swaggerFront
:<|> roots conn
:<|> nodeAPI conn (Proxy :: Proxy Value)
:<|> nodeAPI conn (Proxy :: Proxy HyperdataAny)
:<|> nodeAPI conn (Proxy :: Proxy HyperdataCorpus)
:<|> nodeAPI conn (Proxy :: Proxy HyperdataAnnuaire)
:<|> nodesAPI conn
:<|> count -- TODO: undefined
:<|> search conn
......
......@@ -23,6 +23,8 @@ Node API
-------------------------------------------------------------------
module Gargantext.API.Node
( module Gargantext.API.Node
, HyperdataAny(..)
, HyperdataAnnuaire(..)
, HyperdataCorpus(..)
, HyperdataResource(..)
, HyperdataUser(..)
......@@ -37,7 +39,7 @@ import Control.Monad ((>>))
--import System.IO (putStrLn, readFile)
import Data.Either(Either(Left))
import Data.Aeson (FromJSON, ToJSON, Value())
import Data.Aeson (FromJSON, ToJSON)
--import Data.Text (Text(), pack)
import Data.Text (Text())
import Data.Swagger
......@@ -83,7 +85,7 @@ nodesAPI conn ids = deleteNodes' conn ids
------------------------------------------------------------------------
-- | TODO: access by admin only
-- To manager the Users roots
type Roots = Get '[JSON] [Node Value]
type Roots = Get '[JSON] [NodeAny]
:<|> Post '[JSON] Int -- TODO
:<|> Put '[JSON] Int -- TODO
:<|> Delete '[JSON] Int -- TODO
......
......@@ -77,7 +77,6 @@ module Gargantext.Database.Bashql ( get
import Control.Monad.Reader -- (Reader, ask)
import Data.Text (Text)
import Data.Aeson
import Data.List (concat, last)
import Gargantext.Core.Types
......@@ -101,7 +100,7 @@ mv :: NodeId -> ParentId -> Cmd [Int]
mv n p = mkCmd $ \conn -> U.update (U.Move n p) conn
-- | TODO get Children or Node
get :: PWD -> Cmd [Node Value]
get :: PWD -> Cmd [NodeAny]
get [] = pure []
get pwd = Cmd . ReaderT $ \conn -> runQuery conn $ selectNodesWithParentID (last pwd)
......@@ -110,10 +109,10 @@ home :: Cmd PWD
home = map _node_id <$> Cmd (ReaderT (getNodesWithParentId 0 Nothing))
-- | ls == get Children
ls :: PWD -> Cmd [Node Value]
ls :: PWD -> Cmd [NodeAny]
ls = get
tree :: PWD -> Cmd [Node Value]
tree :: PWD -> Cmd [NodeAny]
tree p = do
ns <- get p
children <- mapM (\n -> get [_node_id n]) ns
......
......@@ -40,7 +40,7 @@ import Prelude hiding (null, id, map, sum)
import Gargantext.Core (Lang(..))
import Gargantext.Core.Types
import Gargantext.Database.Types.Node (NodeType, defaultCorpus)
import Gargantext.Database.Types.Node (NodeType, defaultCorpus, Hyperdata)
import Gargantext.Database.Queries
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Prelude hiding (sum)
......@@ -95,6 +95,9 @@ type DocId = Int
type UserId = Int
type TypeId = Int
------------------------------------------------------------------------
instance FromField HyperdataAny where
fromField = fromField'
instance FromField HyperdataCorpus where
fromField = fromField'
......@@ -106,7 +109,13 @@ instance FromField HyperdataDocumentV3 where
instance FromField HyperdataUser where
fromField = fromField'
instance FromField HyperdataAnnuaire where
fromField = fromField'
------------------------------------------------------------------------
instance QueryRunnerColumnDefault PGJsonb HyperdataAny where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGJsonb HyperdataDocument where
queryRunnerColumnDefault = fieldQueryRunnerColumn
......@@ -118,6 +127,9 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus where
instance QueryRunnerColumnDefault PGJsonb HyperdataUser where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGJsonb HyperdataAnnuaire where
queryRunnerColumnDefault = fieldQueryRunnerColumn
------------------------------------------------------------------------
fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DB.ByteString -> Conversion b
......@@ -184,7 +196,7 @@ selectNode id = proc () -> do
restrict -< _node_id row .== id
returnA -< row
runGetNodes :: Query NodeRead -> Cmd [Node Value]
runGetNodes :: Query NodeRead -> Cmd [NodeAny]
runGetNodes q = mkCmd $ \conn -> runQuery conn q
------------------------------------------------------------------------
......@@ -248,11 +260,11 @@ getNodesWith conn parentId _ nodeType maybeOffset maybeLimit =
-- NP check type
getNodesWithParentId :: Int
-> Maybe Text -> Connection -> IO [Node Value]
-> Maybe Text -> Connection -> IO [NodeAny]
getNodesWithParentId n _ conn = runQuery conn $ selectNodesWithParentID n
getNodesWithParentId' :: Int
-> Maybe Text -> Connection -> IO [Node Value]
-> Maybe Text -> Connection -> IO [NodeAny]
getNodesWithParentId' n _ conn = runQuery conn $ selectNodesWithParentID n
......@@ -306,7 +318,7 @@ defaultUser :: HyperdataUser
defaultUser = HyperdataUser (Just $ (pack . show) EN)
nodeUserW :: Maybe Name -> Maybe HyperdataUser -> UserId -> NodeWrite'
nodeUserW maybeName maybeHyperdata = node NodeUser name (Hyperdata user) Nothing
nodeUserW maybeName maybeHyperdata = node NodeUser name user Nothing
where
name = maybe "User" identity maybeName
user = maybe defaultUser identity maybeHyperdata
......@@ -315,14 +327,14 @@ defaultFolder :: HyperdataFolder
defaultFolder = HyperdataFolder (Just "Markdown Description")
nodeFolderW :: Maybe Name -> Maybe HyperdataFolder -> ParentId -> UserId -> NodeWrite'
nodeFolderW maybeName maybeFolder pid = node NodeFolder name (Hyperdata folder) (Just pid)
nodeFolderW maybeName maybeFolder pid = node NodeFolder name folder (Just pid)
where
name = maybe "Folder" identity maybeName
folder = maybe defaultFolder identity maybeFolder
------------------------------------------------------------------------
nodeCorpusW :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> NodeWrite'
nodeCorpusW maybeName maybeCorpus pId = node NodeCorpus name (Hyperdata corpus) (Just pId)
nodeCorpusW maybeName maybeCorpus pId = node NodeCorpus name corpus (Just pId)
where
name = maybe "Corpus" identity maybeName
corpus = maybe defaultCorpus identity maybeCorpus
......@@ -331,7 +343,7 @@ defaultDocument :: HyperdataDocument
defaultDocument = hyperdataDocument
nodeDocumentW :: Maybe Name -> Maybe HyperdataDocument -> CorpusId -> UserId -> NodeWrite'
nodeDocumentW maybeName maybeDocument cId = node NodeDocument name (Hyperdata doc) (Just cId)
nodeDocumentW maybeName maybeDocument cId = node NodeDocument name doc (Just cId)
where
name = maybe "Document" identity maybeName
doc = maybe defaultDocument identity maybeDocument
......@@ -340,7 +352,7 @@ defaultAnnuaire :: HyperdataAnnuaire
defaultAnnuaire = HyperdataAnnuaire (Just "Title") (Just "Description")
nodeAnnuaireW :: Maybe Name -> Maybe HyperdataAnnuaire -> ParentId -> UserId -> NodeWrite'
nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name (Hyperdata annuaire) (Just pId)
nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name annuaire (Just pId)
where
name = maybe "Annuaire" identity maybeName
annuaire = maybe defaultAnnuaire identity maybeAnnuaire
......@@ -349,17 +361,17 @@ defaultContact :: HyperdataContact
defaultContact = HyperdataContact (Just "Name") (Just "email@here")
nodeContactW :: Maybe Name -> Maybe HyperdataContact -> AnnuaireId -> UserId -> NodeWrite'
nodeContactW maybeName maybeContact aId = node NodeContact name (Hyperdata contact) (Just aId)
nodeContactW maybeName maybeContact aId = node NodeContact name contact (Just aId)
where
name = maybe "Contact" identity maybeName
contact = maybe defaultContact identity maybeContact
------------------------------------------------------------------------
------------------------------------------------------------------------
node :: ToJSON a => NodeType -> Name -> Hyperdata a -> Maybe ParentId -> UserId -> NodeWrite'
node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite'
node nodeType name hyperData parentId userId = Node Nothing typeId userId parentId name Nothing byteData
where
typeId = nodeTypeId nodeType
byteData = DB.pack $ DBL.unpack $ encode $ unHyperdata hyperData
byteData = DB.pack . DBL.unpack $ encode hyperData
-------------------------------
node2row :: (Functor maybe1, Functor maybe2, Functor maybe3) =>
......@@ -479,7 +491,7 @@ mk c nt pId name = mk' c nt userId pId name
mk' :: Connection -> NodeType -> UserId -> Maybe ParentId -> Text -> IO [Int]
mk' c nt uId pId name = map fromIntegral <$> insertNodesWithParentR pId [node nt name hd pId uId] c
where
hd = Hyperdata (HyperdataUser (Just $ (pack . show) EN))
hd = HyperdataUser . Just . pack $ show EN
type Name = Text
......
This diff is collapsed.
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