[API][PHYLO] Get + Post (put not implemented yet) + Del same as others nodes.

src/Gargantext/API.hs

@@ -8,15 +8,8 @@ Stability   : experimental
 Portability : POSIX
 
 Main REST API of Gargantext (both Server and Client sides)
+Thanks @yannEsposito for our discussions at the beginning of this project :).
 
-TODO App type, the main monad in which the bot code is written with.
-
-Provide config, state, logs and IO
- type App m a =  ( MonadState AppState m
-                 , MonadReader Conf m
-                 , MonadLog (WithSeverity Doc) m
-                 , MonadIO m) => m a
-Thanks @yannEsposito for this.
 -}
 
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}

src/Gargantext/Viz/Phylo.hs

@@ -238,21 +238,21 @@ data PhyloError = LevelDoesNotExist
 data Cluster = Fis FisParams
              | RelatedComponents RCParams
              | Louvain LouvainParams
-        deriving (Generic, Show, Eq)
+        deriving (Generic, Show, Eq, Read)
 
 -- | Parameters for Fis clustering
 data FisParams = FisParams
   { _fis_keepMinorFis :: Bool
   , _fis_minSupport   :: Support
-  } deriving (Generic, Show, Eq)
+  } deriving (Generic, Show, Eq, Read)
 
 -- | Parameters for RelatedComponents clustering
 data RCParams = RCParams
-  { _rc_proximity :: Proximity } deriving (Generic, Show, Eq)
+  { _rc_proximity :: Proximity } deriving (Generic, Show, Eq, Read)
 
 -- | Parameters for Louvain clustering
 data LouvainParams = LouvainParams
-  { _louvain_proximity :: Proximity } deriving (Generic, Show, Eq)
+  { _louvain_proximity :: Proximity } deriving (Generic, Show, Eq, Read)
 
 
 -------------------
@@ -264,17 +264,17 @@ data LouvainParams = LouvainParams
 data Proximity = WeightedLogJaccard WLJParams
                | Hamming HammingParams
                | Filiation
-          deriving (Generic, Show, Eq)
+          deriving (Generic, Show, Eq, Read)
 
 -- | Parameters for WeightedLogJaccard proximity
 data WLJParams = WLJParams
   { _wlj_threshold   :: Double
   , _wlj_sensibility :: Double
-  } deriving (Generic, Show, Eq)
+  } deriving (Generic, Show, Eq, Read)
 
 -- | Parameters for Hamming proximity
 data HammingParams = HammingParams
-  { _hamming_threshold :: Double } deriving (Generic, Show, Eq)
+  { _hamming_threshold :: Double } deriving (Generic, Show, Eq, Read)
 
 
 ----------------

src/Gargantext/Viz/Phylo/API.hs

@@ -24,6 +24,8 @@ Portability : POSIX
 module Gargantext.Viz.Phylo.API
   where
 
+--import Control.Monad.Reader (ask)
+import Data.Text (Text)
 import Data.Swagger
 import Gargantext.API.Types
 import Gargantext.Database.Types.Node (PhyloId, ListId, CorpusId)
@@ -32,6 +34,7 @@ import Gargantext.Viz.Phylo
 import Gargantext.Viz.Phylo.Example
 import Gargantext.Viz.Phylo.Tools
 import Gargantext.Viz.Phylo.View.ViewMaker
+import Gargantext.Viz.Phylo.LevelMaker
 import Servant
 import Servant.Job.Utils (swaggerOptions)
 import Test.QuickCheck (elements)
@@ -40,19 +43,15 @@ 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
+        --    :<|> PutPhylo
+            :<|> PostPhylo
 
 
 phyloAPI :: PhyloId -> GargServer PhyloAPI
-phyloAPI n = getPhylo n
-        :<|> putPhylo n
-           -- :<|> pure . (postPhylo n)
-
+phyloAPI n = getPhylo  n
+        -- :<|> putPhylo  n
+        :<|> postPhylo n
 
 ------------------------------------------------------------------------
 type GetPhylo =  QueryParam "listId"      ListId
@@ -66,7 +65,7 @@ type GetPhylo =  QueryParam "listId"      ListId
               :> QueryParam "minNodes"   Int
               :> QueryParam "taggers"    [Tagger]
               :> QueryParam "sort"       Sort
-              :> QueryParam "sort"       Order
+              :> QueryParam "order"      Order
               :> QueryParam "display"    DisplayMode
               :> QueryParam "verbose"     Bool
               :> Get '[JSON] PhyloView
@@ -84,22 +83,35 @@ getPhylo _phyloId _lId l f b l' ms x y z ts s o d b' = do
   pure (toPhyloView  q phylo)
 
 ------------------------------------------------------------------------
+{-
 type PutPhylo = (Put '[JSON] Phylo  )
 --putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo
 putPhylo :: PhyloId -> GargServer PutPhylo
 putPhylo = undefined
-
-
+-}
 ------------------------------------------------------------------------
-type PostPhylo = (Post '[JSON] Phylo)
---postPhylo :: CorpusId -> Maybe ListId -> PhyloQueryBuild -> Phylo
-postPhylo :: CorpusId -> Phylo
-postPhylo = undefined
+type PostPhylo =  QueryParam "listId" ListId
+               :> ReqBody '[JSON] PhyloQueryBuild
+               :> (Post '[JSON] Phylo)
+
+postPhylo :: CorpusId -> GargServer PostPhylo
+postPhylo _n _lId q = 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 corpus actants actantsTrees)
+
 
 ------------------------------------------------------------------------
 -- | DELETE Phylo == delete a node
 ------------------------------------------------------------------------
 
+
+
+
 -- | Instances
 instance Arbitrary PhyloView
   where
@@ -115,8 +127,6 @@ instance Arbitrary Phylo
     arbitrary = elements [phylo]
 
 
-
-
 instance ToSchema Cluster
 instance ToSchema EdgeType
 instance ToSchema Filiation
@@ -194,4 +204,3 @@ instance FromHttpApiData Filiation
 instance ToParamSchema   Filiation
 
 
-

src/Gargantext/Viz/Phylo/Tools.hs

@@ -146,7 +146,9 @@ initPhyloBase pds fds pks prm = Phylo ((fst . (head' "initPhyloBase")) pds, (snd
 
 -- | To init the param of a Phylo
 initPhyloParam :: Maybe Text -> Maybe Software -> Maybe PhyloQueryBuild -> PhyloParam
-initPhyloParam (def defaultPhyloVersion -> v) (def defaultSoftware -> s) (def defaultQuery -> q) = PhyloParam v s q
+initPhyloParam (def defaultPhyloVersion -> v)
+               (def defaultSoftware     -> s)
+               (def defaultQueryBuild   -> q) = PhyloParam v s q
 
 -- | To get the foundations of a Phylo
 getFoundations :: Phylo -> Vector Ngrams
@@ -655,10 +657,14 @@ initWeightedLogJaccard (def 0 -> thr) (def 0.01 -> sens) = WLJParams thr sens
 
 
 -- | To initialize a PhyloQuery from given and default parameters
-initPhyloQuery :: Text -> Text -> Maybe Int -> Maybe Int -> Maybe Cluster -> Maybe [Metric] -> Maybe [Filter] -> Maybe Proximity -> Maybe Level -> Maybe Cluster -> PhyloQueryBuild
-initPhyloQuery name desc (def 5 -> grain) (def 3 -> steps) (def defaultFis -> cluster) (def [] -> metrics) (def [] -> filters)
+initPhyloQueryBuild :: Maybe Text -> Maybe Text -> Maybe Int -> Maybe Int -> Maybe Cluster -> Maybe [Metric] -> Maybe [Filter] -> Maybe Proximity -> Maybe Level -> Maybe Cluster -> PhyloQueryBuild
+initPhyloQueryBuild name desc (def 5 -> grain) (def 3 -> steps) (def defaultFis -> cluster) (def [] -> metrics) (def [] -> filters)
   (def defaultWeightedLogJaccard -> matching') (def 2 -> nthLevel) (def defaultRelatedComponents -> nthCluster) =
-    PhyloQueryBuild name desc grain steps cluster metrics filters matching' nthLevel nthCluster
+    PhyloQueryBuild name' desc' grain steps cluster metrics filters matching' nthLevel nthCluster
+      where
+        name' = maybe "Phylo Title" identity name
+        desc' = maybe "Phylo Desc"  identity desc
+
 
 
 -- | To initialize a PhyloQueryView default parameters
@@ -706,9 +712,12 @@ defaultWeightedLogJaccard = WeightedLogJaccard (initWeightedLogJaccard Nothing N
 
 -- Queries
 
-defaultQuery :: PhyloQueryBuild
-defaultQuery = initPhyloQuery "Cesar et Cleôpatre" "An example of Phylomemy (french without accent)"
-                              Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+defaultQueryBuild :: PhyloQueryBuild
+defaultQueryBuild = initPhyloQueryBuild (Just "Cesar et Cleôpatre")
+                                   (Just "An example of Phylomemy (french without accent)")
+                                    Nothing Nothing Nothing
+                                    Nothing Nothing Nothing
+                                    Nothing Nothing
 
 defaultQueryView :: PhyloQueryView
 defaultQueryView = initPhyloQueryView Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing