Add the PhyloParam to the Phylo constructor

src/Gargantext/Viz/Phylo.hs

@@ -42,30 +42,31 @@ import Gargantext.Database.Schema.Ngrams (NgramsId)
 import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Prelude
 
-------------------------------------------------------------------------
-data PhyloExport =
-     PhyloExport { _phyloExport_param :: PhyloParam
-                 , _phyloExport_data :: Phylo
-     } deriving (Generic, Show)
 
--- | .phylo parameters
+--------------------
+-- | PhyloParam | --
+--------------------
+
+
+-- | Global parameters of a Phylo
 data PhyloParam = 
-     PhyloParam { _phyloParam_version     :: Text -- Double ?
-                , _phyloParam_software    :: Software
-                , _phyloParam_params      :: Hash
-                , _phyloParam_query       :: Maybe PhyloQuery
+     PhyloParam { _phyloParam_version  :: Text -- Double ?
+                , _phyloParam_software :: Software
+                , _phyloParam_query    :: PhyloQuery
      } deriving (Generic, Show)
 
-type Hash = Text
 
--- | Software
--- TODO move somewhere since it is generic
+-- | Software parameters
 data Software =
      Software { _software_name    :: Text
               , _software_version :: Text
      } deriving (Generic, Show)
 
-------------------------------------------------------------------------
+
+---------------
+-- | Phylo | --
+---------------
+
 
 -- | Phylo datatype of a phylomemy
 -- Duration    : time Segment of the whole Phylo
@@ -75,6 +76,7 @@ data Phylo =
      Phylo { _phylo_duration    :: (Start, End)
            , _phylo_foundations :: Vector Ngrams
            , _phylo_periods     :: [PhyloPeriod]
+           , _phylo_param       :: PhyloParam
            }
            deriving (Generic, Show)
 
@@ -88,6 +90,12 @@ type Date = Int
 type Start   = Date
 type End     = Date
 
+
+---------------------
+-- | PhyloPeriod | --
+---------------------
+
+
 -- | PhyloStep : steps of phylomemy on temporal axis
 -- Period: tuple (start date, end date) of the step of the phylomemy
 -- Levels: levels of granularity
@@ -98,6 +106,11 @@ data PhyloPeriod =
                  deriving (Generic, Show)
 
 
+--------------------
+-- | PhyloLevel | --
+--------------------
+
+
 -- | PhyloLevel : levels of phylomemy on level axis
 -- Levels description:
 -- Level -1: Ngram equals itself         (by identity) == _phylo_Ngrams
@@ -111,6 +124,11 @@ data PhyloLevel =
                 deriving (Generic, Show)
 
 
+--------------------
+-- | PhyloGroup | --
+--------------------
+
+
 -- | PhyloGroup : group of ngrams at each level and step
 -- Label : maybe has a label as text
 -- Ngrams: set of terms that build the group
@@ -155,7 +173,9 @@ type Pointer = (PhyloGroupId, Weight)
 type Ngrams = Text
 
 
+--------------------
 -- | Aggregates | --
+--------------------
 
 
 -- | Document : a piece of Text linked to a Date
@@ -189,14 +209,17 @@ type GroupGraph = (GroupNodes,GroupEdges)
 -- | Error | --
 ---------------
 
+
 data PhyloError = LevelDoesNotExist
                 | LevelUnassigned
           deriving (Show)               
 
+
 -----------------
 -- | Cluster | --
 -----------------
 
+
 -- | Cluster constructors
 data Cluster = Fis FisParams 
              | RelatedComponents RCParams
@@ -218,10 +241,12 @@ data RCParams = RCParams
 data LouvainParams = LouvainParams
   { _louvain_proximity :: Proximity } deriving (Show)
 
+
 -------------------
 -- | Proximity | --
 -------------------
 
+
 -- | Proximity constructors
 data Proximity = WeightedLogJaccard WLJParams
                | Hamming HammingParams
@@ -238,10 +263,12 @@ data WLJParams = WLJParams
 data HammingParams = HammingParams 
   { _hamming_threshold :: Double } deriving (Show)
 
+
 ----------------
 -- | Filter | --
 ----------------
 
+
 -- | Filter constructors
 data Filter = LonelyBranch LBParams deriving (Show)
 
@@ -251,36 +278,44 @@ data LBParams = LBParams
   , _lb_periodsSup :: Int
   , _lb_minNodes   :: Int } deriving (Show) 
 
+
 ----------------
 -- | Metric | -- 
 ----------------
 
+
 -- | Metric constructors
 data Metric = BranchAge deriving (Show)
 
+
 ----------------
 -- | Tagger | --
 ----------------
 
+
 -- | Tagger constructors
 data Tagger = BranchLabelFreq | GroupLabelCooc | GroupDynamics deriving (Show)
 
+
 --------------
 -- | Sort | --
 --------------
 
+
 -- | Sort constructors
 data Sort  = ByBranchAge deriving (Show)
 data Order = Asc | Desc deriving (Show)
 
+
 --------------------
 -- | PhyloQuery | --
 --------------------
 
+
 -- | A Phyloquery describes a phylomemic reconstruction 
 data PhyloQuery = PhyloQuery 
-    { _q_phyloName :: Text
-    , _q_phyloDesc :: Text
+    { _q_phyloTitle :: Text
+    , _q_phyloDesc  :: Text
 
     -- Grain and Steps for the PhyloPeriods 
     , _q_periodGrain :: Int
@@ -301,14 +336,16 @@ data PhyloQuery = PhyloQuery
 data Filiation = Ascendant | Descendant | Complete deriving (Show)
 data EdgeType  = PeriodEdge | LevelEdge deriving (Show)
 
+
 -------------------
 -- | PhyloView | --
 -------------------
 
+
 -- | A PhyloView is the output type of a Phylo
 data PhyloView = PhyloView
   { _phylo_viewParam       :: PhyloParam
-  , _phylo_viewLabel       :: Text
+  , _phylo_viewTitle       :: Text
   , _phylo_viewDescription :: Text
   , _phylo_viewFiliation   :: Filiation
   , _phylo_viewMeta        :: Map Text Double
@@ -342,10 +379,12 @@ data PhyloNode = PhyloNode
   , _phylo_nodeChilds    :: [PhyloNode]
   } deriving (Show)
 
+
 ------------------------
 -- | PhyloQueryView | --
 ------------------------
 
+
 data DisplayMode = Flat | Nested 
 
 -- | A PhyloQueryView describes a Phylo as an output view
@@ -373,12 +412,13 @@ data PhyloQueryView = PhyloQueryView
   , _qv_verbose :: Bool
   }
 
+
 ----------------
 -- | Lenses | --
 ----------------
 
+
 makeLenses ''PhyloParam
-makeLenses ''PhyloExport
 makeLenses ''Software
 --
 makeLenses ''Phylo
@@ -398,10 +438,12 @@ makeLenses ''PhyloBranch
 makeLenses ''PhyloNode
 makeLenses ''PhyloEdge
 
+
 ------------------------
 -- | JSON instances | --
 ------------------------ 
 
+
 $(deriveJSON (unPrefix "_phylo_"       ) ''Phylo       ) 
 $(deriveJSON (unPrefix "_phylo_period" ) ''PhyloPeriod )
 $(deriveJSON (unPrefix "_phylo_level"  ) ''PhyloLevel  )
@@ -409,7 +451,6 @@ $(deriveJSON (unPrefix "_phylo_group"  ) ''PhyloGroup  )
 -- 
 $(deriveJSON (unPrefix "_software_"    ) ''Software    )
 $(deriveJSON (unPrefix "_phyloParam_"  ) ''PhyloParam  )
-$(deriveJSON (unPrefix "_phyloExport_" ) ''PhyloExport )
 --
 $(deriveJSON defaultOptions ''Cluster   )
 $(deriveJSON defaultOptions ''Proximity )
@@ -422,6 +463,7 @@ $(deriveJSON (unPrefix "_wlj_" )     ''WLJParams     )
 --
 $(deriveJSON (unPrefix "_q_" ) ''PhyloQuery )
 
+
 ----------------------------
 -- | TODO XML instances | --
 ----------------------------

src/Gargantext/Viz/Phylo/Aggregates/Cooc.hs

@@ -49,4 +49,8 @@ fisToCooc m p = map   (/docs)
     --------------------------------------
     cooc :: Map (Int, Int) (Double)
     cooc = Map.fromList $ map (\x -> (x,0)) (listToUnDirectedCombiWith (\x -> getIdxInFoundations x p) fisNgrams)
-    --------------------------------------
+    --------------------------------------
\ No newline at end of file
+
+
+-- phyloCooc :: Map (Int, Int) Double
+-- phyloCooc = fisToCooc phyloFis phylo1_0_1
\ No newline at end of file

src/Gargantext/Viz/Phylo/LevelMaker.hs

@@ -144,16 +144,6 @@ toPhyloLevel lvl m p = alterPhyloPeriods
                                         ) period) p
 
 
--- | To init a Phylo
-initPhylo :: Grain -> Step -> [(Date,Text)] -> [Ngrams] -> (Ngrams -> Ngrams) -> Phylo
-initPhylo g s c a f = addPhyloLevel 0 (corpusToDocs f c base) base
-  where
-    -------------------------------------- 
-    base :: Phylo
-    base = initPhyloBase (initPeriods g s $ both fst (head c,last c)) (initFoundations a)
-    --------------------------------------
-
-
 -- | To incrementally add new Levels to a Phylo by making all the linking and aggregation tasks 
 toNthLevel :: Level -> Proximity -> Cluster -> Phylo -> Phylo
 toNthLevel lvlMax prox clus p 
@@ -198,8 +188,8 @@ toPhylo0 d p = addPhyloLevel 0 d p
 
 
 -- | To reconstruct the Base of a Phylo
-toPhyloBase :: PhyloQuery -> [(Date, Text)] -> [Ngrams] -> Phylo 
-toPhyloBase q c a = initPhyloBase periods foundations
+toPhyloBase :: PhyloQuery -> PhyloParam -> [(Date, Text)] -> [Ngrams] -> Phylo 
+toPhyloBase q p c a = initPhyloBase periods foundations p
   where 
     --------------------------------------
     periods :: [(Date,Date)] 
@@ -226,5 +216,5 @@ toPhylo q c a = toNthLevel (getNthLevel q) (getInterTemporalMatching q) (getNthC
     phyloDocs = corpusToDocs groupNgramsWithTrees c phyloBase
     -------------------------------------- 
     phyloBase :: Phylo
-    phyloBase = toPhyloBase q c a
+    phyloBase = toPhyloBase q (initPhyloParam (Just defaultPhyloVersion) (Just defaultSoftware) (Just q)) c a
     -------------------------------------- 
\ No newline at end of file

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

@@ -125,21 +125,25 @@ addChildNodes shouldDo lvl lvlMin vb fl p v =
 
 
 -- | To transform a PhyloQuery into a PhyloView
-queryToView :: PhyloQueryView -> Phylo -> PhyloView
-queryToView q p = processDisplay (q ^. qv_display)
+toPhyloView :: PhyloQueryView -> Phylo -> PhyloView
+toPhyloView q p = processDisplay (q ^. qv_display)
                 $ processSort (q ^. qv_sort) p
                 $ processTaggers (q ^. qv_taggers) p
                 $ processFilters (q ^. qv_filters) p
                 $ processMetrics (q ^. qv_metrics) p 
                 $ addChildNodes  (q ^. qv_childs) (q ^. qv_lvl) (q ^. qv_childsDepth) (q ^. qv_verbose) (q ^. qv_filiation) p
-                $ initPhyloView  (q ^. qv_lvl) "Phylo2000" "This is a Phylo" (q ^. qv_filiation) (q ^. qv_verbose) p
+                $ initPhyloView  (q ^. qv_lvl) (getPhyloTitle p) (getPhyloDescription p) (q ^. qv_filiation) (q ^. qv_verbose) p
 
 
--- | dirty params
-phyloParams :: PhyloParam
-phyloParams = PhyloParam "v0.1" (Software "Gargantext" "v4") "" Nothing
 
-
--- | To do : effectively get the PhyloParams of a Phylo
+-- | To get the PhyloParam of a Phylo
 getPhyloParams :: Phylo -> PhyloParam 
-getPhyloParams p = phyloParams
+getPhyloParams = _phylo_param
\ No newline at end of file
+
+-- | To get the title of a Phylo
+getPhyloTitle :: Phylo -> Text 
+getPhyloTitle p = _q_phyloTitle $ _phyloParam_query $ getPhyloParams p
+
+-- | To get the desc of a Phylo
+getPhyloDescription :: Phylo -> Text 
+getPhyloDescription p = _q_phyloTitle $ _phyloParam_query $ getPhyloParams p
\ No newline at end of file