[REST][PHYLO] Parameters, todo: test query.

src/Gargantext/API/Node.hs

@@ -56,13 +56,10 @@ import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNode, deleteNo
 import Gargantext.Database.Schema.NodeNode (nodesToFavorite, nodesToTrash)
 import Gargantext.Database.Tree (treeDB, HasTreeError(..), TreeError(..))
 import Gargantext.Database.Types.Node
-import Gargantext.Database.Types.Node (CorpusId, ContactId)
 import Gargantext.Database.Utils -- (Cmd, CmdM)
 import Gargantext.Prelude
 import Gargantext.Text.Metrics (Scored(..))
-
-import Gargantext.Viz.Phylo hiding (Tree)
-import Gargantext.Viz.Phylo.API (getPhylo)
+import Gargantext.Viz.Phylo.API (PhyloAPI, phyloAPI)
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
@@ -276,16 +273,6 @@ type ChartApi = Summary " Chart API"
 ------------------------------------------------------------------------
 
 
-type PhyloAPI = Summary "Phylo API"
-     --         :> QueryParam "param" PhyloQueryView
-              :> Get '[JSON] PhyloView
-
-
-phyloAPI :: NodeId -> GargServer PhyloAPI
-phyloAPI n = pure $ getPhylo n
-
-
-
 instance HasNodeError ServantErr where
   _NodeError = prism' mk (const Nothing) -- $ panic "HasNodeError ServantErr: not a prism")
     where

src/Gargantext/Viz/Chart.hs

+{-|
+Module      : Gargantext.Viz.Chart
+Description : Chart management
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Gargantext.Viz.Chart where
+
+

src/Gargantext/Viz/Graph/API.hs

@@ -43,7 +43,7 @@ import qualified Data.Map as Map
 -- | There is no Delete specific API for Graph since it can be deleted
 -- as simple Node.
 type GraphAPI   =  Get  '[JSON] Graph
-              :<|> Post '[JSON] [NodeId]
+              :<|> Post '[JSON] [GraphId]
               :<|> Put  '[JSON] Int
 
 

src/Gargantext/Viz/Phylo.hs

@@ -29,6 +29,7 @@ one 8, e54847.
 
 module Gargantext.Viz.Phylo where
 
+import Prelude (Bounded)
 import Control.Lens (makeLenses)
 import Data.Aeson.TH (deriveJSON,defaultOptions)
 import Data.Maybe   (Maybe)
@@ -89,7 +90,7 @@ data PhyloPeaks =
                  deriving (Generic, Show, Eq)
 
 -- | A Tree of Ngrams where each node is a label
-data Tree a = Empty | Node a [Tree a] deriving (Show, Eq)
+data Tree a = Empty | Node a [Tree a] deriving (Generic, Show, Eq)
 
 
 -- | Date : a simple Integer
@@ -297,7 +298,7 @@ data SBParams = SBParams
 
 
 -- | Metric constructors
-data Metric = BranchAge deriving (Generic, Show, Eq)
+data Metric = BranchAge deriving (Generic, Show, Eq, Read)
 
 
 ----------------
@@ -306,7 +307,8 @@ data Metric = BranchAge deriving (Generic, Show, Eq)
 
 
 -- | Tagger constructors
-data Tagger = BranchLabelFreq | GroupLabelCooc | GroupDynamics deriving (Show)
+data Tagger = BranchLabelFreq | GroupLabelCooc | GroupDynamics
+  deriving (Generic, Show, Read)
 
 
 --------------
@@ -315,8 +317,8 @@ data Tagger = BranchLabelFreq | GroupLabelCooc | GroupDynamics deriving (Show)
 
 
 -- | Sort constructors
-data Sort  = ByBranchAge deriving (Generic, Show)
-data Order = Asc | Desc  deriving (Generic, Show)
+data Sort  = ByBranchAge deriving (Generic, Show, Read, Enum, Bounded)
+data Order = Asc | Desc  deriving (Generic, Show, Read)
 
 
 --------------------
@@ -348,7 +350,7 @@ data PhyloQueryBuild = PhyloQueryBuild
     } deriving (Generic, Show, Eq)
 
 -- | To choose the Phylo edge you want to export : --> <-- <--> <=>
-data Filiation = Ascendant | Descendant | Merge | Complete deriving (Generic, Show)
+data Filiation = Ascendant | Descendant | Merge | Complete deriving (Generic, Show, Read)
 data EdgeType  = PeriodEdge | LevelEdge deriving (Generic, Show)
 
 -------------------
@@ -400,6 +402,7 @@ data PhyloNode = PhyloNode
 
 
 data DisplayMode = Flat | Nested
+  deriving (Generic, Show, Read)
 
 -- | A PhyloQueryView describes a Phylo as an output view
 data PhyloQueryView = PhyloQueryView

src/Gargantext/Viz/Phylo/API.hs

@@ -12,39 +12,110 @@ Portability : POSIX
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}   -- allows to write Text literals
-{-# LANGUAGE OverloadedLists   #-}   -- allows to write Map and HashMap as lists
+
+{-# 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  #-}
 
 module Gargantext.Viz.Phylo.API
   where
 
 import Data.Swagger
-import Servant.Job.Utils (swaggerOptions)
+import Gargantext.API.Types
 import Gargantext.Database.Types.Node (PhyloId, ListId, CorpusId)
 import Gargantext.Prelude
 import Gargantext.Viz.Phylo
 import Gargantext.Viz.Phylo.Example
+import Gargantext.Viz.Phylo.Tools
+import Gargantext.Viz.Phylo.View.ViewMaker
+import Servant
+import Servant.Job.Utils (swaggerOptions)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import Web.HttpApiData (parseUrlPiece, readTextData)
+
+------------------------------------------------------------------------
+type PhyloAPI = Summary "Phylo API"
+     --         :> QueryParam "param" PhyloQueryView
+             -- :<|> 
+              :> GetPhylo
+            :<|> PutPhylo
+              -- :<|> Capture "id" PhyloId :> Post '[JSON] Phylo
+              -- :<|> Capture "id" PhyloId :> Put  '[JSON] Phylo
+
+
+phyloAPI :: PhyloId -> GargServer PhyloAPI
+phyloAPI n = getPhylo n
+        :<|> putPhylo n
+           -- :<|> pure . (postPhylo n)
+
+
+------------------------------------------------------------------------
+type GetPhylo =  QueryParam "listId"      ListId
+              :> QueryParam "level"       Level
+              :> QueryParam "filiation"   Filiation
+              :> QueryParam "childs"      Bool
+              :> QueryParam "depth"       Level
+              :> QueryParam "metrics"    [Metric]
+              :> QueryParam "periodsInf" Int
+              :> QueryParam "periodsSup" Int
+              :> QueryParam "minNodes"   Int
+              :> QueryParam "taggers"    [Tagger]
+              :> QueryParam "sort"       Sort
+              :> QueryParam "sort"       Order
+              :> QueryParam "display"    DisplayMode
+              :> QueryParam "verbose"     Bool
+              :> Get '[JSON] PhyloView
+
+-- | 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 d b' = do
+  let
+    fs' = maybe (Just []) (\p -> Just [p]) $ SmallBranch <$> (SBParams <$> x <*> y <*> z)
+    so  = (,) <$> s <*> o
+    q = initPhyloQueryView l f b l' ms fs' ts so d b'
+  -- | TODO remove phylo for real data here
+  pure (toPhyloView  q phylo)
+
+------------------------------------------------------------------------
+type PutPhylo = (Put '[JSON] Phylo  )
+--putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo
+putPhylo :: PhyloId -> GargServer PutPhylo
+putPhylo = undefined
 
 
-getPhylo :: PhyloId -> PhyloView
-getPhylo _phyloId = phyloView
---getPhylo :: PhyloId -> Maybe PhyloQueryView -> PhyloView
---getPhylo _phyloId _phyloQueryView = phyloView
-
-postPhylo :: CorpusId -> Maybe ListId -> PhyloQueryBuild -> Phylo
+------------------------------------------------------------------------
+type PostPhylo = (Post '[JSON] Phylo)
+--postPhylo :: CorpusId -> Maybe ListId -> PhyloQueryBuild -> Phylo
+postPhylo :: CorpusId -> Phylo
 postPhylo = undefined
 
-putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo
-putPhylo = undefined
+------------------------------------------------------------------------
+-- | DELETE Phylo == delete a node
+------------------------------------------------------------------------
+
+-- | Instances
+instance Arbitrary PhyloView
+  where
+    arbitrary = elements [phyloView]
+
+-- | TODO add phyloGroup ex
+instance Arbitrary PhyloGroup
+  where
+    arbitrary = elements []
+
+instance Arbitrary Phylo
+  where
+    arbitrary = elements [phylo]
 
-deletePhylo :: PhyloId -> IO ()
-deletePhylo = undefined
 
 
--- | Instances
 
 instance ToSchema Cluster
 instance ToSchema EdgeType
@@ -54,10 +125,16 @@ instance ToSchema FisParams
 instance ToSchema HammingParams
 instance ToSchema LouvainParams
 instance ToSchema Metric
+instance ToSchema Order
+instance ToSchema Phylo
 instance ToSchema PhyloBranch
 instance ToSchema PhyloEdge
+instance ToSchema PhyloGroup
+instance ToSchema PhyloLevel
 instance ToSchema PhyloNode
 instance ToSchema PhyloParam
+instance ToSchema PhyloPeaks
+instance ToSchema PhyloPeriod
 instance ToSchema PhyloQueryBuild
 instance ToSchema PhyloView
 instance ToSchema RCParams
@@ -65,12 +142,56 @@ instance ToSchema SBParams
 instance ToSchema Software
 instance ToSchema WLJParams
 
+
+instance ToParamSchema Order
+instance FromHttpApiData Order
+  where
+    parseUrlPiece = readTextData
+
+
+instance ToParamSchema Metric
+instance FromHttpApiData [Metric]
+  where
+    parseUrlPiece = readTextData
+instance FromHttpApiData Metric
+  where
+    parseUrlPiece = readTextData
+
+
+instance ToParamSchema   DisplayMode
+instance FromHttpApiData DisplayMode
+  where
+    parseUrlPiece = readTextData
+
+
+instance FromHttpApiData Sort
+  where
+    parseUrlPiece = readTextData
+instance ToParamSchema Sort
+
+instance (ToSchema a) => ToSchema (Tree a)
+  where
+    declareNamedSchema = genericDeclareNamedSchemaUnrestricted
+                       $ swaggerOptions ""
+
 instance ToSchema Proximity
   where
     declareNamedSchema = genericDeclareNamedSchemaUnrestricted
                        $ swaggerOptions ""
 
-instance Arbitrary PhyloView
+
+instance FromHttpApiData [Tagger]
   where
-    arbitrary = elements [phyloView]
+    parseUrlPiece = readTextData
+instance FromHttpApiData Tagger
+  where
+    parseUrlPiece = readTextData
+instance ToParamSchema   Tagger
+
+instance FromHttpApiData Filiation
+  where
+    parseUrlPiece = readTextData
+instance ToParamSchema   Filiation
+
+
 

src/Gargantext/Viz/Phylo/View/ViewMaker.hs

@@ -133,6 +133,19 @@ addChildNodes shouldDo lvl lvlMin vb fl p v =
 
 
 -- | To transform a PhyloQuery into a PhyloView
+toPhyloView' :: Maybe Level
+                      -> Maybe Filiation
+                      -> Maybe Bool
+                      -> Maybe Level
+                      -> Maybe [Metric]
+                      -> Maybe [Filter]
+                      -> Maybe [Tagger]
+                      -> Maybe (Sort, Order)
+                      -> Maybe DisplayMode
+                      -> Maybe Bool
+                      -> PhyloQueryView
+toPhyloView' = initPhyloQueryView
+
 toPhyloView :: PhyloQueryView -> Phylo -> PhyloView
 toPhyloView q p = processDisplay (q ^. qv_display)
                 $ processSort    (q ^. qv_sort   ) p