just finalized the dot export

src/Gargantext/Viz/Phylo.hs

@@ -364,6 +364,7 @@ data PhyloView = PhyloView
   , _pv_title       :: Text
   , _pv_description :: Text
   , _pv_filiation   :: Filiation
+  , _pv_level       :: Level
   , _pv_metrics     :: Map Text [Double]
   , _pv_branches    :: [PhyloBranch]
   , _pv_nodes       :: [PhyloNode]
@@ -400,6 +401,7 @@ data PhyloNode = PhyloNode
 ------------------------
 
 
+data ExportMode = Json | Dot | Svg
 data DisplayMode = Flat | Nested
   deriving (Generic, Show, Read)
 
@@ -424,6 +426,7 @@ data PhyloQueryView = PhyloQueryView
   , _qv_sort :: Maybe (Sort,Order)
 
   -- A display mode to apply to the PhyloGraph, ie: [Node[Node,Edge],Edge] or [[Node,Node],[Edge,Edge]]
+  , _qv_export  :: ExportMode
   , _qv_display :: DisplayMode
   , _qv_verbose :: Bool
   }

src/Gargantext/Viz/Phylo/Example.hs

@@ -28,6 +28,7 @@ TODO:
 
 module Gargantext.Viz.Phylo.Example where
 
+import Data.GraphViz.Types.Generalised (DotGraph)
 import Data.Text (Text)
 import Data.List        ((++), last)
 import Data.Map         (Map)
@@ -44,6 +45,7 @@ import Gargantext.Viz.Phylo.LevelMaker
 import Gargantext.Viz.Phylo.LinkMaker
 import Gargantext.Viz.Phylo.Tools
 import Gargantext.Viz.Phylo.View.ViewMaker
+import Gargantext.Viz.Phylo.View.Export
 import qualified Data.List   as List
 
 
@@ -52,6 +54,9 @@ import qualified Data.List   as List
 ------------------------------------------------------
 
 
+phyloDot :: DotGraph DotId
+phyloDot = viewToDot phyloView
+
 phyloView :: PhyloView
 phyloView = toPhyloView (queryParser' queryViewEx) phyloFromQuery
 
@@ -69,7 +74,7 @@ queryViewEx = "level=3"
 
 
 phyloQueryView :: PhyloQueryView
-phyloQueryView = PhyloQueryView 2 Merge False 1 [BranchAge] [defaultSmallBranch] [BranchLabelFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Flat True
+phyloQueryView = PhyloQueryView 2 Merge False 1 [BranchAge] [defaultSmallBranch] [BranchLabelFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Json Flat True
 
 
 --------------------------------------------------

src/Gargantext/Viz/Phylo/Tools.hs

@@ -588,6 +588,55 @@ getViewBranchIds v = map getBranchId $ v ^. pv_branches
 -- | PhyloQuery & QueryView | --
 --------------------------------
 
+
+-- | To filter PhyloView's Branches by level
+filterBranchesByLevel :: Level -> PhyloView -> [PhyloBranch]
+filterBranchesByLevel lvl pv = filter (\pb -> lvl == (fst $ pb ^. pb_id)) 
+                          $ pv ^. pv_branches
+
+
+-- | To filter PhyloView's Edges by level
+filterEdgesByLevel :: Level -> [PhyloEdge] -> [PhyloEdge]
+filterEdgesByLevel lvl pes = filter (\pe -> (lvl == ((snd . fst) $ pe ^. pe_source))
+                                         && (lvl == ((snd . fst) $ pe ^. pe_target))) pes
+
+
+-- | To filter PhyloView's Edges by type
+filterEdgesByType :: EdgeType -> [PhyloEdge] -> [PhyloEdge]
+filterEdgesByType t pes = filter (\pe -> t == (pe ^. pe_type)) pes
+
+
+-- | To filter PhyloView's Nodes by the oldest Period
+filterNodesByFirstPeriod :: [PhyloNode] -> [PhyloNode]
+filterNodesByFirstPeriod pns = filter (\pn -> fstPrd == ((fst . fst) $ pn ^. pn_id)) pns
+    where 
+        --------------------------------------
+        fstPrd :: (Date,Date)
+        fstPrd = (head' "filterNodesByFirstPeriod")
+               $ sortOn fst 
+               $ map (\pn -> (fst . fst) $ pn ^. pn_id) pns 
+        --------------------------------------
+
+
+-- | To filter PhyloView's Nodes by Branch
+filterNodesByBranch :: PhyloBranchId -> [PhyloNode] -> [PhyloNode]
+filterNodesByBranch bId pns = filter (\pn -> if isJust $ pn ^. pn_bid
+                                             then if bId == (fromJust $ pn ^. pn_bid)
+                                                  then True
+                                                  else False
+                                             else False ) pns           
+
+
+-- | To filter PhyloView's Nodes by level
+filterNodesByLevel :: Level -> [PhyloNode] -> [PhyloNode]
+filterNodesByLevel lvl pns = filter (\pn -> lvl == ((snd . fst) $ pn ^. pn_id)) pns
+
+
+-- | To filter PhyloView's Nodes by Period
+filterNodesByPeriod :: PhyloPeriodId -> [PhyloNode] -> [PhyloNode]
+filterNodesByPeriod prd pns = filter (\pn -> prd == ((fst . fst) $ pn ^. pn_id)) pns
+
+
 -- | To get the first clustering method to apply to get the contextual units of a Phylo
 getContextualUnit :: PhyloQueryBuild -> Cluster
 getContextualUnit q = q ^. q_contextualUnit
@@ -673,9 +722,9 @@ initPhyloQueryBuild name desc (def 5 -> grain) (def 3 -> steps) (def defaultFis
 
 
 -- | To initialize a PhyloQueryView default parameters
-initPhyloQueryView :: Maybe Level -> Maybe Filiation -> Maybe Bool -> Maybe Level -> Maybe [Metric] -> Maybe [Filter] -> Maybe [Tagger] -> Maybe (Sort, Order) -> Maybe DisplayMode -> Maybe Bool -> PhyloQueryView
-initPhyloQueryView (def 2 -> lvl) (def Descendant -> f) (def False -> c) (def 1 -> d) (def [] -> ms) (def [] -> fs) (def [] -> ts) s (def Flat -> dm) (def True -> v) =
-  PhyloQueryView lvl f c d ms fs ts s dm v
+initPhyloQueryView :: Maybe Level -> Maybe Filiation -> Maybe Bool -> Maybe Level -> Maybe [Metric] -> Maybe [Filter] -> Maybe [Tagger] -> Maybe (Sort, Order) -> Maybe ExportMode -> Maybe DisplayMode -> Maybe Bool -> PhyloQueryView
+initPhyloQueryView (def 2 -> lvl) (def Descendant -> f) (def False -> c) (def 1 -> d) (def [] -> ms) (def [] -> fs) (def [] -> ts) s (def Json -> em) (def Flat -> dm) (def True -> v) =
+  PhyloQueryView lvl f c d ms fs ts s em dm v
 
 
 -- | To define some obvious boolean getters
@@ -725,7 +774,7 @@ defaultQueryBuild = initPhyloQueryBuild (Just "Cesar et Cleôpatre")
                                     Nothing Nothing
 
 defaultQueryView :: PhyloQueryView
-defaultQueryView = initPhyloQueryView Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+defaultQueryView = initPhyloQueryView Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 -- Software
 

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

@@ -43,11 +43,12 @@ toNestedView ns ns'
 
 
 -- | To process a DisplayMode to a PhyloView
-processDisplay :: DisplayMode -> PhyloView -> PhyloView
-processDisplay d v = case d of 
-                     Flat   -> v
-                     Nested -> let ns  = sortOn getNodeLevel $ v ^. pv_nodes
-                                   lvl = getNodeLevel $ head' "processDisplay" ns
-                               in v & pv_nodes .~ toNestedView (filter (\n -> lvl == getNodeLevel n) ns)
-                                                                      (filter (\n -> lvl <  getNodeLevel n) ns) 
-                     --_      -> panic "[ERR][Viz.Phylo.Example.processDisplay] display not found"
+processDisplay :: DisplayMode -> ExportMode -> PhyloView -> PhyloView
+processDisplay d e v = case e of 
+                       Json -> case d of 
+                               Flat   -> v
+                               Nested -> let ns  = sortOn getNodeLevel $ v ^. pv_nodes
+                                             lvl = getNodeLevel $ head' "processDisplay" ns
+                                         in v & pv_nodes .~ toNestedView (filter (\n -> lvl == getNodeLevel n) ns)
+                                                                         (filter (\n -> lvl <  getNodeLevel n) ns)
+                       _    -> v  

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

@@ -53,70 +53,47 @@ viewToSvg v = undefined
 -- | PhyloView to DOT | --
 --------------------------
 
--- From http://haroldcarr.com/posts/2014-02-28-using-graphviz-via-haskell.html
+-- | From http://haroldcarr.com/posts/2014-02-28-using-graphviz-via-haskell.html & https://hackage.haskell.org/package/graphviz
 
+
+-- | To create a custom Graphviz's Attribute
 setAttr :: AttributeName -> T'.Text -> CustomAttribute
 setAttr k v = customAttribute k v
 
+
+-- | To create customs Graphviz's Attributes out of some Metrics
 setAttrFromMetrics :: Map T.Text [Double] -> [CustomAttribute]
 setAttrFromMetrics attrs = map (\(k,v) -> setAttr (fromStrict k) 
                                                 $ (pack . unwords) 
                                                 $ map show v) $ toList attrs
 
-getBranchDotId :: PhyloBranchId -> DotId
-getBranchDotId (lvl,idx) = fromStrict $ T.pack $ (show lvl) ++ (show idx)
-
-getNodeDotId :: PhyloGroupId -> DotId
-getNodeDotId (((d,d'),lvl),idx) = fromStrict $ T.pack $ (show d) ++ (show d') ++ (show lvl) ++ (show idx)
-
-getPeriodDotId :: PhyloPeriodId -> DotId
-getPeriodDotId (d,d') = fromStrict $ T.pack $ (show d) ++ (show d')
-
-getPeriodDotLabel ::PhyloPeriodId -> Label
-getPeriodDotLabel (d,d') = toDotLabel $ T.pack $ (show d) ++ " " ++ (show d')
-
-getBranchesByLevel :: Level -> PhyloView -> [PhyloBranch]
-getBranchesByLevel lvl pv = filter (\pb -> lvl == (fst $ pb ^. pb_id)) 
-                          $ pv ^. pv_branches
-
-filterNodesByPeriod :: PhyloPeriodId -> [PhyloNode] -> [PhyloNode]
-filterNodesByPeriod prd pns = filter (\pn -> prd == ((fst . fst) $ pn ^. pn_id)) pns
 
-filterNodesByLevel :: Level -> [PhyloNode] -> [PhyloNode]
-filterNodesByLevel lvl pns = filter (\pn -> lvl == ((snd . fst) $ pn ^. pn_id)) pns
+-- | To transform a PhyloBranchId into a DotId
+toBranchDotId :: PhyloBranchId -> DotId
+toBranchDotId (lvl,idx) = fromStrict $ T.pack $ (show lvl) ++ (show idx)
 
 
-filterNodesByBranch :: PhyloBranchId -> [PhyloNode] -> [PhyloNode]
-filterNodesByBranch bId pns = filter (\pn -> if isJust $ pn ^. pn_bid
-                                             then if bId == (fromJust $ pn ^. pn_bid)
-                                                  then True
-                                                  else False
-                                             else False ) pns   
+-- | To transform a PhyloGroupId into a DotId
+toNodeDotId :: PhyloGroupId -> DotId
+toNodeDotId (((d,d'),lvl),idx) = fromStrict $ T.pack $ (show d) ++ (show d') ++ (show lvl) ++ (show idx)
 
 
-filterEdgesByType :: EdgeType -> [PhyloEdge] -> [PhyloEdge]
-filterEdgesByType t pes = filter (\pe -> t == (pe ^. pe_type)) pes
+-- | To transform a PhyloPeriodId into a DotId
+toPeriodDotId :: PhyloPeriodId -> DotId
+toPeriodDotId (d,d') = fromStrict $ T.pack $ (show d) ++ (show d')
 
-filterEdgesByLevel :: Level -> [PhyloEdge] -> [PhyloEdge]
-filterEdgesByLevel lvl pes = filter (\pe -> (lvl == ((snd . fst) $ pe ^. pe_source))
-                                         && (lvl == ((snd . fst) $ pe ^. pe_target))) pes
 
-
-filterNodesByFirstPeriod :: [PhyloNode] -> [PhyloNode]
-filterNodesByFirstPeriod pns = filter (\pn -> fstPrd == ((fst . fst) $ pn ^. pn_id)) pns
-    where 
-        --------------------------------------
-        fstPrd :: (Date,Date)
-        fstPrd = (head' "filterNodesByFirstPeriod")
-               $ sortOn fst 
-               $ map (\pn -> (fst . fst) $ pn ^. pn_id) pns 
-        --------------------------------------
+-- | To transform a PhyloPeriodId into a Graphviz's label
+toPeriodDotLabel ::PhyloPeriodId -> Label
+toPeriodDotLabel (d,d') = toDotLabel $ T.pack $ (show d) ++ " " ++ (show d')
 
 
+-- | To get all the Phyloperiods covered by a PhyloView
 getViewPeriods :: PhyloView -> [PhyloPeriodId]
 getViewPeriods pv = sortOn fst $ nub $ map (\pn -> (fst . fst) $ pn ^. pn_id) $ pv ^. pv_nodes
 
 
+-- | To get for each PhyloBranch, their corresponding oldest PhyloNodes
 getFirstNodes :: Level -> PhyloView -> [(PhyloBranchId,PhyloGroupId)]
 getFirstNodes lvl pv = concat
                      $ map (\bId -> map (\pn -> (bId,pn ^. pn_id))
@@ -127,21 +104,28 @@ getFirstNodes lvl pv = concat
     where
         --------------------------------------
         bIds :: [PhyloBranchId]
-        bIds = map getBranchId $ getBranchesByLevel lvl pv
+        bIds = map getBranchId $ filterBranchesByLevel lvl pv
         --------------------------------------
 
 
+-- | To transform a Text into a Graphviz's Label
 toDotLabel :: T.Text -> Label
 toDotLabel lbl = StrLabel $ fromStrict lbl
 
+
+-- | To set a Peak Node
 setPeakDotNode :: PhyloBranch -> Dot DotId
-setPeakDotNode pb = node (getBranchDotId $ pb ^. pb_id) 
+setPeakDotNode pb = node (toBranchDotId $ pb ^. pb_id) 
                       ([FillColor [toWColor CornSilk], FontName "Arial", FontSize 40, Shape Egg, Style [SItem Bold []], Label (toDotLabel $ pb ^. pb_label)]
                        <> (setAttrFromMetrics $ pb ^. pb_metrics))
 
+
+-- | To set a Peak Edge
 setPeakDotEdge ::  DotId -> DotId -> Dot DotId
 setPeakDotEdge bId nId = edge bId nId [Width 3, Color [toWColor Black], ArrowHead (AType [(ArrMod FilledArrow RightSide,DotArrow)])]
 
+
+-- | To set an HTML table
 setHtmlTable :: PhyloNode -> H.Label
 setHtmlTable pn = H.Table H.HTable
                     { H.tableFontAttrs = Just [H.PointSize 14, H.Align H.HLeft]
@@ -160,66 +144,70 @@ setHtmlTable pn = H.Table H.HTable
         --------------------------------------
 
 
+-- | To set a Node
 setDotNode :: PhyloNode -> Dot DotId
-setDotNode pn = node (getNodeDotId $ pn ^. pn_id)
+setDotNode pn = node (toNodeDotId $ pn ^. pn_id)
                      ([FontName "Arial", Shape Square, toLabel (setHtmlTable pn)])
 
 
+-- | To set an Edge
 setDotEdge :: PhyloEdge -> Dot DotId
-setDotEdge pe = edge (getNodeDotId $ pe ^. pe_source) (getNodeDotId $ pe ^. pe_target)  [Width 2, Color [toWColor Black]]
+setDotEdge pe = edge (toNodeDotId $ pe ^. pe_source) (toNodeDotId $ pe ^. pe_target)  [Width 2, Color [toWColor Black]]
+
 
+-- | To set a Period Edge
 setDotPeriodEdge :: (PhyloPeriodId,PhyloPeriodId) -> Dot DotId
-setDotPeriodEdge (prd,prd') = edge (getPeriodDotId prd) (getPeriodDotId prd') [Width 5, Color [toWColor Black]]
+setDotPeriodEdge (prd,prd') = edge (toPeriodDotId prd) (toPeriodDotId prd') [Width 5, Color [toWColor Black]]
 
 
-viewToDot :: PhyloView -> Level -> DotGraph DotId
-viewToDot pv lvl = digraph ((Str . fromStrict) $ pv ^. pv_title) 
+-- | To transform a given PhyloView into the corresponding GraphViz Graph (ie: Dot format)
+viewToDot :: PhyloView -> DotGraph DotId
+viewToDot pv = digraph ((Str . fromStrict) $ pv ^. pv_title) 
                  
-                 $ do
+             $ do
 
-                    -- set the global graph attributes
+                -- set the global graph attributes
 
-                    graphAttrs ( [Label (toDotLabel $ pv ^. pv_title)]
-                              <> [setAttr "description" $ fromStrict $ pv ^. pv_description]
-                              <> [setAttr "filiation"   $ (pack . show) $ pv ^. pv_filiation]
-                              <> (setAttrFromMetrics $ pv ^. pv_metrics)
-                              <> [FontSize (fromIntegral 30), LabelLoc VTop, Splines SplineEdges, Overlap ScaleOverlaps,
-                                  Ratio AutoRatio, Style [SItem Filled []],Color [toWColor White]])
+                graphAttrs ( [Label (toDotLabel $ pv ^. pv_title)]
+                          <> [setAttr "description" $ fromStrict $ pv ^. pv_description]
+                          <> [setAttr "filiation"   $ (pack . show) $ pv ^. pv_filiation]
+                          <> (setAttrFromMetrics $ pv ^. pv_metrics)
+                          <> [FontSize (fromIntegral 30), LabelLoc VTop, Splines SplineEdges, Overlap ScaleOverlaps,
+                              Ratio AutoRatio, Style [SItem Filled []],Color [toWColor White]])
 
-                    -- set the peaks
+                -- set the peaks
 
-                    subgraph (Str "Peaks") 
+                subgraph (Str "Peaks") $ do 
 
-                    $ do 
+                    graphAttrs [Rank SameRank]
 
-                        graphAttrs [Rank SameRank]
+                    mapM setPeakDotNode $ filterBranchesByLevel (pv ^. pv_level) pv
 
-                        mapM setPeakDotNode $ getBranchesByLevel lvl pv
+                -- set the nodes, period by period
 
-                    -- set the nodes, period by period
+                mapM (\prd ->
+                        subgraph (Str $ fromStrict $ T.pack $ "subGraph " ++ (show $ (fst prd)) ++ (show $ (snd prd))) 
 
-                    mapM (\prd ->
-                            subgraph (Str $ fromStrict $ T.pack $ "subGraph " ++ (show $ (fst prd)) ++ (show $ (snd prd))) 
+                        $ do
+                            
+                            graphAttrs [Rank SameRank]
 
-                            $ do
-                                
-                                graphAttrs [Rank SameRank]
+                            -- set the period label
+                            
+                            node (toPeriodDotId prd) [Shape Square, FontSize 50, Label (toPeriodDotLabel prd)]
 
-                                -- set the period label
-                                
-                                node (getPeriodDotId prd) [Shape Square, FontSize 50, Label (getPeriodDotLabel prd)]
+                            mapM setDotNode $ filterNodesByPeriod prd $ filterNodesByLevel (pv ^. pv_level) (pv ^.pv_nodes)
+                          
+                     ) $ getViewPeriods pv
 
-                                mapM setDotNode $ filterNodesByPeriod prd $ filterNodesByLevel lvl (pv ^.pv_nodes)
-                              
-                         ) $ getViewPeriods pv
+                -- set the edges : from peaks to nodes, from nodes to nodes, from periods to periods 
 
-                    -- set the edges : from peaks to nodes, from nodes to nodes, from periods to periods 
+                mapM (\(bId,nId) -> setPeakDotEdge (toBranchDotId bId) (toNodeDotId nId)) $ getFirstNodes (pv ^. pv_level) pv
 
-                    mapM (\(bId,nId) -> setPeakDotEdge (getBranchDotId bId) (getNodeDotId nId)) $ getFirstNodes lvl pv
+                mapM setDotEdge $ filterEdgesByLevel (pv ^. pv_level) $ filterEdgesByType PeriodEdge (pv ^. pv_edges)
 
-                    mapM setDotEdge $ filterEdgesByLevel lvl $ filterEdgesByType PeriodEdge (pv ^. pv_edges)
+                mapM setDotPeriodEdge $ listToSequentialCombi $ getViewPeriods pv
 
-                    mapM setDotPeriodEdge $ listToSequentialCombi $ getViewPeriods pv
 
 
 

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

@@ -46,7 +46,7 @@ initPhyloEdge id pts et = map (\pt -> PhyloEdge id (fst pt) et (snd pt)) pts
 
 -- | To init a PhyloView
 initPhyloView :: Level -> Text -> Text -> Filiation -> Bool -> Phylo -> PhyloView
-initPhyloView lvl lbl dsc fl vb p = PhyloView (getPhyloParams p) lbl dsc fl empty
+initPhyloView lvl lbl dsc fl vb p = PhyloView (getPhyloParams p) lbl dsc fl lvl empty
                                     ([] ++ (phyloToBranches lvl p))
                                     ([] ++ (groupsToNodes True vb (getPeaksLabels p) gs))
                                     ([] ++ (groupsToEdges fl PeriodEdge gs))
@@ -148,7 +148,7 @@ toPhyloView' :: Maybe Level
 toPhyloView' = initPhyloQueryView
 
 toPhyloView :: PhyloQueryView -> Phylo -> PhyloView
-toPhyloView q p = processDisplay (q ^. qv_display)
+toPhyloView q p = processDisplay (q ^. qv_display) (q ^. qv_export)
                 $ processSort    (q ^. qv_sort   ) p
                 $ processTaggers (q ^. qv_taggers) p
                 $ processFilters (q ^. qv_filters) p