[Phylo] readings

src/Gargantext/Core/Viz/Phylo/API.hs

@@ -115,11 +115,11 @@ postPhylo :: CorpusId -> UserId -> GargServer PostPhylo
 postPhylo n userId _lId = do
   -- TODO get Reader settings
   -- s <- ask
-  let
+  -- let
     -- _vrs = Just ("1" :: Text)
     -- _sft = Just (Software "Gargantext" "4")
     -- _prm = initPhyloParam vrs sft (Just q)
-  phy  <- flowPhylo n
+  phy <- flowPhylo n
   pId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just n) userId]
   pure $ NodeId (fromIntegral pId)
 
@@ -136,64 +136,25 @@ putPhylo = 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 Order
-
-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 Arbitrary Phylo             where arbitrary     = elements [phylo]
+instance Arbitrary PhyloGroup        where arbitrary     = elements []
+instance Arbitrary PhyloView         where arbitrary     = elements [phyloView]
+instance FromHttpApiData DisplayMode where parseUrlPiece = readTextData
+instance FromHttpApiData ExportMode  where parseUrlPiece = readTextData
+instance FromHttpApiData Filiation   where parseUrlPiece = readTextData
+instance FromHttpApiData Metric      where parseUrlPiece = readTextData
+instance FromHttpApiData Order       where parseUrlPiece = readTextData
+instance FromHttpApiData Sort        where parseUrlPiece = readTextData
+instance FromHttpApiData Tagger      where parseUrlPiece = readTextData
+instance FromHttpApiData [Metric]    where parseUrlPiece = readTextData
+instance FromHttpApiData [Tagger]    where parseUrlPiece = readTextData
 instance ToParamSchema   DisplayMode
-instance FromHttpApiData DisplayMode
-  where
-    parseUrlPiece = readTextData
-
-
 instance ToParamSchema   ExportMode
-instance FromHttpApiData ExportMode
-  where
-    parseUrlPiece = readTextData    
-
-
-instance FromHttpApiData Sort
-  where
-    parseUrlPiece = readTextData
-instance ToParamSchema Sort
-
-instance FromHttpApiData [Tagger]
-  where
-    parseUrlPiece = readTextData
-instance FromHttpApiData Tagger
-  where
-    parseUrlPiece = readTextData
-instance ToParamSchema   Tagger
-
-instance FromHttpApiData Filiation
-  where
-    parseUrlPiece = readTextData
 instance ToParamSchema   Filiation
+instance ToParamSchema   Tagger
+instance ToParamSchema Metric
+instance ToParamSchema Order
+instance ToParamSchema Sort
+instance ToSchema Order
 
 

src/Gargantext/Core/Viz/Phylo/LevelMaker.hs

@@ -195,9 +195,13 @@ toPhylo q c termList fis = toNthLevel (getNthLevel q) (getInterTemporalMatching
     phyloDocs = groupDocsByPeriod date (getPhyloPeriods phyloBase) c
     --------------------------------------
     phyloBase :: Phylo
-    phyloBase = tracePhyloBase 
-              $ toPhyloBase q (initPhyloParam (Just defaultPhyloVersion) (Just defaultSoftware) (Just q)) c termList fis
-    --------------------------------------       
+    phyloBase = tracePhyloBase
+              $ toPhyloBase q init c termList fis
+      where
+        init = initPhyloParam (Just defaultPhyloVersion)
+                              (Just defaultSoftware    )
+                              (Just q                  )
+    ---------------------------------------
 
 
 -- | To incrementally add new Levels to a Phylo by making all the linking and aggregation tasks
@@ -205,17 +209,16 @@ toNthLevel :: Level -> Proximity -> Cluster -> Phylo -> Phylo
 toNthLevel lvlMax prox clus p
   | lvl >= lvlMax = p
   | otherwise     = toNthLevel lvlMax prox clus
-                  $ traceBranches (lvl + 1)
+                  $ traceBranches    (lvl + 1)
                   $ setPhyloBranches (lvl + 1)
                   -- \$ transposePeriodLinks (lvl + 1)
-                  $ traceTranspose (lvl + 1) Descendant
-                  $ transposeLinks (lvl + 1) Descendant
-                  $ traceTranspose (lvl + 1) Ascendant
-                  $ transposeLinks (lvl + 1) Ascendant
-                  $ tracePhyloN (lvl + 1)
-                  $ setLevelLinks (lvl, lvl + 1)
-                  $ addPhyloLevel (lvl + 1)
-                    (clusters) p
+                  $ traceTranspose   (lvl + 1) Descendant
+                  $ transposeLinks   (lvl + 1) Descendant
+                  $ traceTranspose   (lvl + 1) Ascendant
+                  $ transposeLinks   (lvl + 1) Ascendant
+                  $ tracePhyloN      (lvl + 1)
+                  $ setLevelLinks    (lvl, lvl + 1)
+                  $ addPhyloLevel    (lvl + 1) (clusters) p
   where
     --------------------------------------
     clusters :: Map (Date,Date) [PhyloCluster]

src/Gargantext/Core/Viz/Phylo/Main.hs

@@ -35,12 +35,14 @@ import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Prelude
 import Gargantext.Core.Text.Context (TermList)
 import Gargantext.Core.Text.Terms.WithList
+
 import Gargantext.Core.Viz.Phylo hiding (Svg, Dot)
-import Gargantext.Core.Viz.Phylo.LevelMaker
+import Gargantext.Core.Viz.Phylo.LevelMaker (toPhylo)
 import Gargantext.Core.Viz.Phylo.Tools
 import Gargantext.Core.Viz.Phylo.View.Export
 import Gargantext.Core.Viz.Phylo.View.ViewMaker    -- TODO Just Maker is fine
 
+
 type MinSizeBranch = Int
 
 flowPhylo :: FlowCmdM env err m
@@ -48,14 +50,14 @@ flowPhylo :: FlowCmdM env err m
           -> m Phylo
 flowPhylo cId = do
 
-  list       <- defaultList cId
+  list     <- defaultList cId
   termList <- Map.toList <$> getTermsWith Text.words [list] NgramsTerms MapTerm
 
   docs' <- catMaybes
-          <$> map (\h -> (,) <$> _hd_publication_year h
-                             <*> _hd_abstract h
-                  )
-          <$> selectDocs cId
+        <$> map (\h -> (,) <$> _hd_publication_year h
+                           <*> _hd_abstract h
+                )
+        <$> selectDocs cId
 
   let
     patterns = buildPatterns termList
@@ -65,10 +67,13 @@ flowPhylo cId = do
       where
         --------------------------------------
         termsInText :: Patterns -> Text -> [Text]
-        termsInText pats txt = List.nub $ List.concat $ map (map Text.unwords) $ extractTermsWithList pats txt
+        termsInText pats txt = List.nub
+                             $ List.concat
+                             $ map (map Text.unwords)
+                             $ extractTermsWithList pats txt
         --------------------------------------
 
-    docs = map ( (\(y,t) -> Document y t) . filterTerms patterns) docs'
+    docs = map ((\(y,t) -> Document y t) . filterTerms patterns) docs'
 
   --liftBase $ flowPhylo' (List.sortOn date docs) termList l m fp
   pure $ buildPhylo (List.sortOn date docs) termList
@@ -76,9 +81,9 @@ flowPhylo cId = do
 
 -- TODO SortedList Document
 flowPhylo' :: [Document] -> TermList      -- ^Build
-          -> Level      -> MinSizeBranch -- ^View
-          -> FilePath
-          -> IO FilePath
+           -> Level       -> MinSizeBranch -- ^View
+           -> FilePath
+           -> IO FilePath
 flowPhylo' corpus terms l m fp = do
   let
     phylo = buildPhylo corpus terms
@@ -116,3 +121,7 @@ writePhylo fp phview = runGraphviz (viewToDot phview) Svg fp
 viewPhylo2Svg :: PhyloView -> IO DB.ByteString
 viewPhylo2Svg p = graphvizWithHandle Dot (viewToDot p) Svg DB.hGetContents
 
+
+
+
+