[Community] Query search contact with text query on documents
[gargantext.git] / src / Gargantext / Viz / Phylo / API.hs
index de2e49a293f0888ff39702d3359f2ce52e09f3f5..8f56cd2cab6a6821593f14357eb1ca9b3555cb62 100644 (file)
@@ -11,41 +11,35 @@ Portability : POSIX
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-{-# LANGUAGE RankNTypes         #-}
-{-# LANGUAGE DataKinds          #-}
-{-# LANGUAGE NoImplicitPrelude  #-}
-{-# LANGUAGE OverloadedStrings  #-}   -- allows to write Text literals
 {-# LANGUAGE OverloadedLists    #-}   -- allows to write Map and HashMap as lists
 {-# LANGUAGE TypeOperators      #-}
-{-# LANGUAGE FlexibleInstances  #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 
 module Gargantext.Viz.Phylo.API
   where
 
+import Control.Lens ((^.))
+import Data.String.Conversions
 --import Control.Monad.Reader (ask)
 import qualified Data.ByteString as DB
-import qualified Data.ByteString.Lazy.Char8 as DBL (pack)
-import Data.Text (Text)
-import Data.Map  (empty)
+import qualified Data.ByteString.Lazy as DBL
+import Data.Proxy (Proxy(..))
 import Data.Swagger
-import Gargantext.API.Types
-import Gargantext.Database.Types.Node (PhyloId, ListId, CorpusId)
-import Gargantext.Prelude
-import Gargantext.Viz.Phylo
-import Gargantext.Viz.Phylo.Main
-import Gargantext.Viz.Phylo.Aggregates
-import Gargantext.Viz.Phylo.Example
-import Gargantext.Viz.Phylo.Tools
---import Gargantext.Viz.Phylo.View.ViewMaker
-import Gargantext.Viz.Phylo.LevelMaker
+import Network.HTTP.Media ((//), (/:))
 import Servant
-import Servant.Job.Utils (swaggerOptions)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import Web.HttpApiData (parseUrlPiece, readTextData)
-import Control.Monad.IO.Class (liftIO)
-import Network.HTTP.Media ((//), (/:))
+
+import Gargantext.API.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata
+import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
+import Gargantext.Database.Query.Table.Node (insertNodes, node, getNodeWith)
+import Gargantext.Database.Schema.Node (node_hyperdata)
+import Gargantext.Prelude
+import Gargantext.Viz.Phylo
+import Gargantext.Viz.Phylo.Main
+import Gargantext.Viz.Phylo.Example
+import Gargantext.Core.Types (TODO(..))
 
 ------------------------------------------------------------------------
 type PhyloAPI = Summary "Phylo API"
@@ -54,17 +48,17 @@ type PhyloAPI = Summary "Phylo API"
             :<|> PostPhylo
 
 
-phyloAPI :: PhyloId -> GargServer PhyloAPI
-phyloAPI n = getPhylo'  n
+phyloAPI :: PhyloId -> UserId -> GargServer PhyloAPI
+phyloAPI n u = getPhylo  n
+        :<|> postPhylo n u
         -- :<|> putPhylo  n
-        :<|> postPhylo n
+        -- :<|> deletePhylo  n
 
 newtype SVG = SVG DB.ByteString
 
 instance ToSchema SVG
   where
-    declareNamedSchema = undefined
-    --genericDeclareNamedSchemaUnrestricted (swaggerOptions "")
+    declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
 
 instance Show SVG where
   show (SVG a) = show a
@@ -75,13 +69,14 @@ instance Accept SVG where
 instance Show a => MimeRender PlainText a where
    mimeRender _ val = cs ("" <> show val)
 
-instance Show a => MimeRender SVG a where
-   mimeRender _ val = DBL.pack $ ("SVG" <> show val)
+instance MimeRender SVG SVG where
+   mimeRender _ (SVG s) = DBL.fromStrict s
 
 ------------------------------------------------------------------------
 type GetPhylo =  QueryParam "listId"      ListId
               :> QueryParam "level"       Level
-              :> QueryParam "filiation"   Filiation
+              :> QueryParam "minSizeBranch" MinSizeBranch
+   {-           :> QueryParam "filiation"   Filiation
               :> QueryParam "childs"      Bool
               :> QueryParam "depth"       Level
               :> QueryParam "metrics"    [Metric]
@@ -94,55 +89,51 @@ type GetPhylo =  QueryParam "listId"      ListId
               :> QueryParam "export"    ExportMode
               :> QueryParam "display"    DisplayMode
               :> QueryParam "verbose"     Bool
+    -}
               :> Get '[SVG] SVG
 
 -- | TODO
 -- Add real text processing
 -- Fix Filter parameters
-{-
 getPhylo :: PhyloId -> GargServer GetPhylo
-getPhylo _phyloId _lId l f b l' ms x y z ts s o e d b' = do
+getPhylo phId _lId l msb  = do
+  phNode     <- getNodeWith phId (Proxy :: Proxy HyperdataPhylo)
   let
-    fs' = maybe (Just []) (\p -> Just [p]) $ LonelyBranch <$> (LBParams <$> x <*> y <*> z)
-    so  = (,) <$> s <*> o
-    q = initPhyloQueryView l f b l' ms fs' ts so e d b'
-  -- | TODO remove phylo for real data here
-  pure (toPhyloView  q phylo)
-  -- TODO remove phylo for real data here
--}
+    level = maybe 2 identity l
+    branc = maybe 2 identity msb
+    maybePhylo = phNode ^. (node_hyperdata . hp_data)
 
-getPhylo' :: PhyloId -> GargServer GetPhylo
-getPhylo' _phyloId _lId _l _f _b _l' _ms _x _y _z _ts _s _o _e _d _b' = do
-  p <- liftIO $ viewPhylo2Svg phyloView
+  p <- liftBase $ viewPhylo2Svg
+                $ viewPhylo level branc
+                $ maybe phyloFromQuery identity maybePhylo
   pure (SVG p)
 ------------------------------------------------------------------------
-{-
-type PutPhylo = (Put '[JSON] Phylo  )
---putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo
-putPhylo :: PhyloId -> GargServer PutPhylo
-putPhylo = undefined
--}
-------------------------------------------------------------------------
 type PostPhylo =  QueryParam "listId" ListId
-               :> ReqBody '[JSON] PhyloQueryBuild
-               :> (Post '[JSON] Phylo)
+               -- :> ReqBody '[JSON] PhyloQueryBuild
+               :> (Post '[JSON] NodeId)
 
-postPhylo :: CorpusId -> GargServer PostPhylo
-postPhylo _n _lId q = do
+postPhylo :: CorpusId -> UserId -> GargServer PostPhylo
+postPhylo n userId _lId = do
   -- TODO get Reader settings
   -- s <- ask
   let
-    vrs = Just ("1" :: Text)
-    sft = Just (Software "Gargantext" "4")
-    prm = initPhyloParam vrs sft (Just q)
-  pure (toPhyloBase q prm (parseDocs (initFoundationsRoots actants) corpus) termList empty)
-
+    -- _vrs = Just ("1" :: Text)
+    -- _sft = Just (Software "Gargantext" "4")
+    -- _prm = initPhyloParam vrs sft (Just q)
+  phy  <- flowPhylo n
+  pId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just n) userId]
+  pure $ NodeId (fromIntegral pId)
 
 ------------------------------------------------------------------------
 -- | DELETE Phylo == delete a node
 ------------------------------------------------------------------------
-
-
+------------------------------------------------------------------------
+{-
+type PutPhylo = (Put '[JSON] Phylo  )
+--putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo
+putPhylo :: PhyloId -> GargServer PutPhylo
+putPhylo = undefined
+-}
 
 
 -- | Instances
@@ -159,34 +150,7 @@ instance Arbitrary Phylo
   where
     arbitrary = elements [phylo]
 
-
-instance ToSchema Cluster
-instance ToSchema EdgeType
-instance ToSchema Filiation
-instance ToSchema Filter
-instance ToSchema FisParams
-instance ToSchema HammingParams
-instance ToSchema LouvainParams
-instance ToSchema Metric
 instance ToSchema Order
-instance ToSchema Phylo
-instance ToSchema PhyloFis
-instance ToSchema PhyloBranch
-instance ToSchema PhyloEdge
-instance ToSchema PhyloGroup
-instance ToSchema PhyloLevel
-instance ToSchema PhyloNode
-instance ToSchema PhyloParam
-instance ToSchema PhyloFoundations
-instance ToSchema PhyloPeriod
-instance ToSchema PhyloQueryBuild
-instance ToSchema PhyloView
-instance ToSchema RCParams
-instance ToSchema LBParams
-instance ToSchema SBParams
-instance ToSchema Software
-instance ToSchema WLJParams
-
 
 instance ToParamSchema Order
 instance FromHttpApiData Order
@@ -220,13 +184,6 @@ instance FromHttpApiData Sort
     parseUrlPiece = readTextData
 instance ToParamSchema Sort
 
-
-instance ToSchema Proximity
-  where
-    declareNamedSchema = genericDeclareNamedSchemaUnrestricted
-                       $ swaggerOptions ""
-
-
 instance FromHttpApiData [Tagger]
   where
     parseUrlPiece = readTextData