merge conflict resolved

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/API/Metrics.hs

@@ -25,15 +25,19 @@ Metrics API
 module Gargantext.API.Metrics
     where
 
+import Data.Aeson.TH (deriveJSON)
+import Data.Swagger
+import Data.Time (UTCTime)
 import Data.Text (Text)
 import GHC.Generics (Generic)
-import Gargantext.Prelude
-import Data.Aeson.TH (deriveJSON)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import Gargantext.Core.Types (ListType(..))
 import Gargantext.Core.Utils.Prefix (unPrefix)
-import Data.Swagger
-
+import Gargantext.Database.Utils
+import Gargantext.Core.Types (CorpusId)
+import Gargantext.Prelude
+import Gargantext.Viz.Chart
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
 data Metrics = Metrics
   { metrics_data :: [Metric]}
@@ -63,3 +67,46 @@ deriveJSON (unPrefix "metrics_") ''Metrics
 deriveJSON (unPrefix "m_") ''Metric
 
 
+-------------------------------------------------------------
+
+data ChartMetrics a = ChartMetrics { chartMetrics_data :: a }
+  deriving (Generic, Show)
+
+instance (ToSchema a) => ToSchema (ChartMetrics a)
+instance (Arbitrary a) => Arbitrary (ChartMetrics a)
+  where
+    arbitrary = ChartMetrics <$> arbitrary
+
+deriveJSON (unPrefix "chartMetrics_") ''ChartMetrics
+
+-------------------------------------------------------------
+instance ToSchema Histo
+instance Arbitrary Histo
+  where
+    arbitrary = elements [ Histo ["2012"] [1]
+                         , Histo ["2013"] [1]
+                         ]
+deriveJSON (unPrefix "histo_") ''Histo
+
+
+-- TODO add start / end
+getChart :: CorpusId -> Maybe UTCTime -> Maybe UTCTime -> Cmd err (ChartMetrics Histo)
+getChart cId _start _end = do
+  h <- histoData cId
+  pure (ChartMetrics h)
+
+
+
+{-
+data FacetChart = FacetChart { facetChart_time  :: UTCTime'
+                             , facetChart_count :: Double
+                        }
+        deriving (Show, Generic)
+$(deriveJSON (unPrefix "facetChart_") ''FacetChart)
+instance ToSchema FacetChart
+
+instance Arbitrary FacetChart where
+    arbitrary = FacetChart <$> arbitrary <*> arbitrary
+
+-}
+

src/Gargantext/API/Node.hs

@@ -50,19 +50,17 @@ import Gargantext.API.Search ( SearchAPI, searchIn, SearchInQuery)
 import Gargantext.API.Types
 import Gargantext.Core.Types (Offset, Limit)
 import Gargantext.Core.Types.Main (Tree, NodeTree)
-import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..),FacetChart,runViewAuthorsDoc)
+import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..),runViewAuthorsDoc)
 import Gargantext.Database.Node.Children (getChildren)
 import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, NodeError(..), HasNodeError(..))
 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 Gargantext.Viz.Chart
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
@@ -127,9 +125,6 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "listGet"   :> TableNgramsApiGet
              :<|> "pairing"   :> PairingApi
              
-             -- VIZ
-             :<|> "chart"     :> ChartApi
-             :<|> "phylo"     :> PhyloAPI
              
              :<|> "favorites" :> FavApi
              :<|> "documents" :> DocsApi
@@ -139,7 +134,11 @@ type NodeAPI a = Get '[JSON] (Node a)
                         :> QueryParam "limit"  Int
                         :> QueryParam "order"  OrderBy
                         :> SearchAPI
-            :<|> "metrics" :> MetricsAPI
+             
+             -- VIZ
+             :<|> "metrics" :> MetricsAPI
+             :<|> "chart"     :> ChartApi
+             :<|> "phylo"     :> PhyloAPI
 
 -- TODO-ACCESS: check userId CanRenameNode nodeId
 -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
@@ -172,14 +171,14 @@ nodeAPI p uId id
            :<|> tableNgramsPatch id
            :<|> getTableNgrams   id
            :<|> getPairing       id
-
-           :<|> getChart id
-           :<|> phyloAPI id
            
            :<|> favApi   id
            :<|> delDocs  id
            :<|> searchIn id
+           
            :<|> getMetrics id
+           :<|> getChart id
+           :<|> phyloAPI id
            -- Annuaire
            -- :<|> upload
            -- :<|> query
@@ -263,7 +262,7 @@ type PairingApi = Summary " Pairing API"
 type ChartApi = Summary " Chart API"
               :> QueryParam "from" UTCTime
               :> QueryParam "to"   UTCTime
-              :> Get '[JSON] [FacetChart]
+              :> Get '[JSON] (ChartMetrics Histo)
 
                 -- Depending on the Type of the Node, we could post
                 -- New documents for a corpus
@@ -276,16 +275,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
@@ -341,11 +330,6 @@ getPairing cId ft o l order =
     (Just Trash) -> runViewAuthorsDoc cId True  o l order
     _     -> panic "not implemented"
 
-
-getChart :: NodeId -> Maybe UTCTime -> Maybe UTCTime
-                   -> Cmd err [FacetChart]
-getChart _ _ _ = undefined -- TODO
-
 postNode :: HasNodeError err => UserId -> NodeId -> PostNode -> Cmd err [NodeId]
 postNode uId pId (PostNode nodeName nt) = mkNodeWithParent nt (Just pId) uId nodeName
 

src/Gargantext/Database/Facet.hs

@@ -166,17 +166,6 @@ type FacetDocRead = Facet (Column PGInt4       )
                           (Column PGInt4       )
 
 -----------------------------------------------------------------------
-
-data FacetChart = FacetChart { facetChart_time  :: UTCTime'
-                             , facetChart_count :: Double
-                        }
-        deriving (Show, Generic)
-$(deriveJSON (unPrefix "facetChart_") ''FacetChart)
-instance ToSchema FacetChart
-
-instance Arbitrary FacetChart where
-    arbitrary = FacetChart <$> arbitrary <*> arbitrary
-
 -----------------------------------------------------------------------
 type Trash   = Bool
 data OrderBy =  DateAsc   | DateDesc
@@ -254,10 +243,10 @@ viewDocuments :: CorpusId -> Trash -> NodeTypeId -> Query FacetDocRead
 viewDocuments cId t ntId = proc () -> do
   n  <- queryNodeTable     -< ()
   nn <- queryNodeNodeTable -< ()
-  restrict -< _node_id          n  .== nn_node2_id nn
-  restrict -< nn_node1_id nn .== (pgNodeId cId)
-  restrict -< _node_typename    n  .== (pgInt4 ntId)
-  restrict -< nn_delete   nn .== (pgBool t)
+  restrict -< _node_id        n .== nn_node2_id nn
+  restrict -< nn_node1_id    nn .== (pgNodeId cId)
+  restrict -< _node_typename  n .== (pgInt4 ntId)
+  restrict -< nn_delete      nn .== (pgBool t)
   returnA  -< FacetDoc (_node_id n) (_node_date n) (_node_name n) (_node_hyperdata n) (nn_favorite nn) (pgInt4 1)
 
 

src/Gargantext/Database/Flow.hs

@@ -164,7 +164,7 @@ flowCorpusUser l userName corpusName ctype ids = do
   --}
 
   -- User Dashboard Flow
-  -- _ <- mkDashboard userCorpusId userId
+  _ <- mkDashboard userCorpusId userId
 
   -- Annuaire Flow
   -- _ <- mkAnnuaire  rootUserId userId

src/Gargantext/Database/Schema/NodeNode.hs

@@ -25,17 +25,23 @@ commentary with @some markup@.
 
 module Gargantext.Database.Schema.NodeNode where
 
+import Control.Lens (view)
 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
-import Data.Maybe (Maybe)
+import Data.Maybe (Maybe, catMaybes)
+import Data.Text (Text, splitOn)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
+import Gargantext.Database.Schema.Node 
+import Gargantext.Core.Types
 import Gargantext.Database.Utils
+import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Types.Node (CorpusId, DocId)
 import Gargantext.Prelude
 import Opaleye
-
+import Control.Arrow (returnA)
+import qualified Opaleye as O
 
 data NodeNodePoly node1_id node2_id score fav del
                    = NodeNode { nn_node1_id   :: node1_id
@@ -122,6 +128,34 @@ nodesToFavorite inputData = map (\(PGS.Only a) -> a)
                   |]
 
 ------------------------------------------------------------------------
+-- | TODO use UTCTime fast 
+selectDocsDates :: CorpusId -> Cmd err [Text]
+selectDocsDates cId = 
+                map (head' "selectDocsDates" . splitOn "-")
+               <$> catMaybes
+               <$> map (view hyperdataDocument_publication_date)
+               <$> selectDocs cId
+
+
+selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
+selectDocs cId = runOpaQuery (queryDocs cId)
+
+queryDocs :: CorpusId -> O.Query (Column PGJsonb)
+queryDocs cId = proc () -> do
+  (n, nn) <- joinInCorpus -< ()
+  restrict -< ( nn_node1_id nn)  .== (toNullable $ pgNodeId cId)
+  restrict -< ( nn_delete nn)    .== (toNullable $ pgBool False)
+  restrict -< (_node_typename n) .== (pgInt4 $ nodeTypeId NodeDocument)
+  returnA -< view (node_hyperdata) n
+
+
+joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
+joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
+  where
+    cond :: (NodeRead, NodeNodeRead) -> Column PGBool
+    cond (n, nn) = nn_node2_id nn .== (view node_id n)
+
+
 ------------------------------------------------------------------------
 -- | Trash management
 nodeToTrash :: CorpusId -> DocId -> Bool -> Cmd err [PGS.Only Int]
@@ -159,5 +193,3 @@ emptyTrash cId = runPGSQuery delQuery (PGS.Only cId)
                     RETURNING n.node2_id
                 |]
 ------------------------------------------------------------------------
-
-

src/Gargantext/Database/TextSearch.hs

@@ -31,7 +31,7 @@ import Gargantext.Prelude
 import Gargantext.Database.Facet
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.Ngrams
-import Gargantext.Database.Schema.NodeNode
+import Gargantext.Database.Schema.NodeNode hiding (joinInCorpus)
 import Gargantext.Database.Schema.NodeNgram
 import Gargantext.Database.Queries.Join (leftJoin6)
 import Gargantext.Database.Utils (Cmd, runPGSQuery, runOpaQuery)
@@ -65,6 +65,7 @@ queryInCorpus :: CorpusId -> Text -> O.Query FacetDocRead
 queryInCorpus cId q = proc () -> do
   (n, nn) <- joinInCorpus -< ()
   restrict -< ( nn_node1_id nn) .== (toNullable $ pgNodeId cId)
+  restrict -< ( nn_delete nn)   .== (toNullable $ pgBool False)
   restrict -< (_ns_search n)           @@ (pgTSQuery (unpack q))
   restrict -< (_ns_typename n)        .== (pgInt4 $ nodeTypeId NodeDocument)
   returnA  -< FacetDoc (_ns_id n) (_ns_date n) (_ns_name n) (_ns_hyperdata n) (pgBool True) (pgInt4 1)

src/Gargantext/Text/List/CSV.hs

@@ -43,7 +43,7 @@ csvGraphTermList fp = csv2list CsvMap <$> snd <$>  fromCsvListFile fp
 
 csv2list :: CsvListType -> Vector CsvList -> TermList
 csv2list lt vs = V.toList $ V.map (\(CsvList _ label forms)
-                           -> (DT.words label, filter (not . null) . map DT.words $ DT.splitOn csvListFormsDelimiter forms))
+                           -> (DT.words label, [DT.words label] <> (filter (not . null) . map DT.words $ DT.splitOn csvListFormsDelimiter forms)))
                          $ V.filter (\l -> csvList_status l == lt ) vs
 
 ------------------------------------------------------------------------

src/Gargantext/Viz/Chart.hs

+{-|
+Module      : Gargantext.Viz.Chart
+Description : Graph utils
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE RankNTypes        #-}
+
+module Gargantext.Viz.Chart
+  where
+
+
+import Data.Text (Text)
+import Data.List (unzip, sortOn)
+import Data.Map (toList)
+import GHC.Generics (Generic)
+import Gargantext.Prelude
+import Gargantext.Database.Schema.NodeNode (selectDocsDates)
+import Gargantext.Database.Utils
+import Gargantext.Database.Types.Node (CorpusId)
+import Gargantext.Text.Metrics.Count (occurrencesWith)
+
+
+data Chart = ChartHisto | ChartScatter | ChartPie
+  deriving (Generic)
+
+-- TODO use UTCTime
+data Histo = Histo { histo_dates :: [Text]
+                   , histo_count :: [Int]
+                   }
+  deriving (Generic)
+
+histoData :: CorpusId -> Cmd err Histo
+histoData cId = do
+  dates <- selectDocsDates cId
+  let (ls, css) = unzip
+                $ sortOn fst
+                $ toList
+                $ occurrencesWith identity dates
+  pure (Histo ls css)
+

src/Gargantext/Viz/Graph/API.hs

@@ -17,44 +17,46 @@ Portability : POSIX
 {-# LANGUAGE OverloadedStrings #-}   -- allows to write Text literals
 {-# LANGUAGE OverloadedLists   #-}   -- allows to write Map and HashMap as lists
 {-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE TypeOperators      #-}
 
 module Gargantext.Viz.Graph.API
   where
 
+import Data.List (sortOn)
+import Control.Lens (set, view)
 import Control.Monad.IO.Class (liftIO)
-import Control.Lens (set)
---import Servant.Job.Utils (swaggerOptions)
-import Gargantext.Database.Schema.Ngrams
-import Gargantext.API.Types
-import Gargantext.Database.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
-import Gargantext.Database.Schema.Node ( getNode)
-import Gargantext.Database.Types.Node -- (GraphId, ListId, CorpusId, NodeId)
-import Gargantext.Prelude
 import Gargantext.API.Ngrams.Tools
+import Gargantext.API.Types
 import Gargantext.Core.Types.Main
-import Gargantext.Viz.Graph.Tools -- (cooc2graph)
+import Gargantext.Database.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
+import Gargantext.Database.Schema.Ngrams
+import Gargantext.Database.Schema.Node (getNode)
 import Gargantext.Database.Schema.Node (defaultList)
+import Gargantext.Database.Types.Node hiding (node_id) -- (GraphId, ListId, CorpusId, NodeId)
+import Gargantext.Prelude
 import Gargantext.Viz.Graph
+import Gargantext.Viz.Graph.Tools -- (cooc2graph)
 import Servant
 import qualified Data.Map as Map
 
-{-
-getgraph :: GraphId -> GraphView
-getgraph _GraphId = phyloView
---getgraph :: GraphId -> Maybe PhyloQueryView -> PhyloView
---getgraph _GraphId _phyloQueryView = phyloView
+------------------------------------------------------------------------
 
-postgraph :: CorpusId -> Maybe ListId -> GraphQueryBuild -> Phylo
-postgraph = undefined
+-- | There is no Delete specific API for Graph since it can be deleted
+-- as simple Node.
+type GraphAPI   =  Get  '[JSON] Graph
+              :<|> Post '[JSON] [GraphId]
+              :<|> Put  '[JSON] Int
 
-putgraph :: GraphId -> Maybe ListId -> PhyloQueryBuild -> Phylo
-putgraph = undefined
--}
-
-type GraphAPI   = Get '[JSON] Graph
 
 graphAPI :: NodeId -> GargServer GraphAPI
-graphAPI nId = do
+graphAPI n =  getGraph  n
+         :<|> postGraph n
+         :<|> putGraph  n
+
+------------------------------------------------------------------------
+
+getGraph :: NodeId -> GargServer (Get '[JSON] Graph)
+getGraph nId = do
   nodeGraph <- getNode nId HyperdataGraph
 
   let metadata = GraphMetadata "Title" [maybe 0 identity $ _node_parentId nodeGraph]
@@ -71,7 +73,20 @@ graphAPI nId = do
                             <$> groupNodesByNgrams ngs
                             <$> getNodesByNgramsOnlyUser cId NgramsTerms (Map.keys ngs)
 
-  liftIO $ set graph_metadata (Just metadata) <$> cooc2graph myCooc
+  graph <- liftIO $ cooc2graph myCooc
+  pure $ set graph_metadata (Just metadata)
+       $ set graph_nodes ( sortOn node_id
+                         $ view graph_nodes graph
+                         ) graph
+
+
+postGraph :: NodeId -> GargServer (Post '[JSON] [NodeId])
+postGraph = undefined
+
+putGraph :: NodeId -> GargServer (Put '[JSON] Int)
+putGraph = undefined
+
+
 
 
 -- | Instances

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 PhyloRoots =
                  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
@@ -237,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)
 
 
 -------------------
@@ -263,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)
 
 
 ----------------
@@ -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,12 @@ data Metric = BranchAge deriving (Generic, Show, Eq)
 
 
 -- | Tagger constructors
+<<<<<<< HEAD
 data Tagger = BranchPeakFreq | GroupLabelCooc | GroupDynamics deriving (Show)
+=======
+data Tagger = BranchLabelFreq | GroupLabelCooc | GroupDynamics
+  deriving (Generic, Show, Read)
+>>>>>>> dev
 
 
 --------------
@@ -315,8 +321,8 @@ data Tagger = BranchPeakFreq | 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)
 
 
 --------------------
@@ -402,6 +408,7 @@ data PhyloNode = PhyloNode
 
 data ExportMode = Json | Dot | Svg
 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,120 @@ 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 Control.Monad.Reader (ask)
+import Data.Text (Text)
 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 Gargantext.Viz.Phylo.LevelMaker
+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"
+              :> GetPhylo
+        --    :<|> PutPhylo
+            :<|> PostPhylo
+
+
+phyloAPI :: PhyloId -> GargServer PhyloAPI
+phyloAPI n = getPhylo  n
+        -- :<|> putPhylo  n
+        :<|> 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 "order"      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
+-}
+------------------------------------------------------------------------
+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)
 
-getPhylo :: PhyloId -> PhyloView
-getPhylo _phyloId = phyloView
---getPhylo :: PhyloId -> Maybe PhyloQueryView -> PhyloView
---getPhylo _phyloId _phyloQueryView = phyloView
 
-postPhylo :: CorpusId -> Maybe ListId -> PhyloQueryBuild -> Phylo
-postPhylo = undefined
+------------------------------------------------------------------------
+-- | DELETE Phylo == delete a node
+------------------------------------------------------------------------
 
-putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo
-putPhylo = undefined
 
-deletePhylo :: PhyloId -> IO ()
-deletePhylo = undefined
 
 
 -- | 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]
+
 
 instance ToSchema Cluster
 instance ToSchema EdgeType
@@ -54,10 +135,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 +152,55 @@ 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/Tools.hs

@@ -151,7 +151,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 defaultQueryBuild -> 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
@@ -712,7 +714,11 @@ initWeightedLogJaccard (def 0 -> thr) (def 0.01 -> sens) = WLJParams thr sens
 initPhyloQueryBuild :: Text -> 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

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

@@ -138,6 +138,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) (q ^. qv_export)
                 $ processSort    (q ^. qv_sort   ) p