[phylo] some refactoring

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

@@ -46,6 +46,8 @@ import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude
 import Prelude
+import System.FilePath ((</>))
+import System.IO.Temp (withTempDirectory)
 import System.Process      as Shell
 import qualified Data.ByteString.Lazy                    as Lazy
 import qualified Data.List as List
@@ -67,30 +69,35 @@ savePhylo = undefined
 --------------------------------------------------------------------
 phylo2dot2json :: Phylo -> IO Value
 phylo2dot2json phylo = do
+  withTempDirectory "/tmp" "phylo" $ \dirPath -> do
+    let fileFrom = dirPath </> "phyloFrom.dot"
+        fileDot  = dirPath </> "phylo.dot"
+        fileToJson = dirPath </> "output.json"
 
-  let
-    file_from    = "/tmp/fromPhylo.json"
-    file_dot     = "/tmp/tmp.dot"
-    file_to_json = "/tmp/toPhylo.json"
+    dotToFile fileFrom (toPhyloExport phylo)
 
-  _ <- dotToFile file_from (toPhyloExport phylo)
-  _ <- Shell.callProcess "dot" ["-Tdot", "-o", file_dot, file_from]
-  _ <- Shell.callProcess "dot" ["-Txdot_json", "-o", file_to_json, file_dot]
+    Shell.callProcess "dot" ["-Tdot", "-o", fileDot, fileFrom]
+    Shell.callProcess "dot" ["-Txdot_json", "-o", fileToJson, fileDot]
 
-  maybeValue <- decodeFileStrict file_to_json
-  print maybeValue
-  _ <- Shell.callProcess "/bin/rm" ["-rf", file_from, file_to_json, file_dot]
+    ffrom <- readFile fileFrom
+    writeFile "/tmp/fileFrom.json" ffrom
+    fdot <- readFile fileDot
+    writeFile "/tmp/file.dot" fdot
+    fto <- readFile fileToJson
+    writeFile "/tmp/fileTo.json" fto
 
-  case maybeValue of
-    Nothing -> panic "[G.C.V.Phylo.API.phylo2dot2json] Error no file"
-    Just v  -> pure v
+    maybeValue <- decodeFileStrict fileToJson
+    print maybeValue
 
+    case maybeValue of
+      Nothing -> panic "[G.C.V.Phylo.API.phylo2dot2json] Error no file"
+      Just v  -> pure v
 
 
 flowPhyloAPI :: PhyloConfig -> CorpusId -> GargNoServer Phylo
 flowPhyloAPI config cId = do
   (_, corpus) <- corpusIdtoDocuments (timeUnit config) cId
-  phyloWithCliques <- pure $ toPhyloWithoutLink corpus config
+  let phyloWithCliques = toPhyloWithoutLink corpus config
   -- writePhylo phyloWithCliquesFile phyloWithCliques
   pure $ toPhylo (setConfig config phyloWithCliques)
 
@@ -172,19 +179,15 @@ toDays y m d = fromIntegral
 
 toPhyloDate :: Int -> Int -> Int -> TimeUnit -> Date
 toPhyloDate y m d tu = case tu of
-  Year  _ _ _ -> y
-  Month _ _ _ -> toMonths (Prelude.toInteger y) m d
-  Week  _ _ _ -> div (toDays (Prelude.toInteger y) m d) 7
-  Day   _ _ _ -> toDays (Prelude.toInteger y) m d
-  _           -> panic "[G.C.V.Phylo.API] toPhyloDate"
+  Year  {} -> y
+  Month {} -> toMonths (Prelude.toInteger y) m d
+  Week  {} -> div (toDays (Prelude.toInteger y) m d) 7
+  Day   {} -> toDays (Prelude.toInteger y) m d
+  _        -> panic "[G.C.V.Phylo.API] toPhyloDate"
 
 toPhyloDate' :: Int -> Int -> Int -> TimeUnit -> Text
-toPhyloDate' y m d tu = case tu of
-  Epoch _ _ _ -> pack $ show $ posixSecondsToUTCTime $ fromIntegral y
-  Year  _ _ _ -> pack $ showGregorian $ fromGregorian (toInteger y) m d
-  Month _ _ _ -> pack $ showGregorian $ fromGregorian (toInteger y) m d
-  Week  _ _ _ -> pack $ showGregorian $ fromGregorian (toInteger y) m d
-  Day   _ _ _ -> pack $ showGregorian $ fromGregorian (toInteger y) m d
+toPhyloDate' y _m _d (Epoch {}) = pack $ show $ posixSecondsToUTCTime $ fromIntegral y
+toPhyloDate' y  m  d _          = pack $ showGregorian $ fromGregorian (toInteger y) m d
 
 -- Utils
 
@@ -204,4 +207,4 @@ readPhylo path = do
 
 -- | To read and decode a Json file
 readJson :: FilePath -> IO Lazy.ByteString
-readJson path = Lazy.readFile path
+readJson = Lazy.readFile

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

@@ -375,8 +375,8 @@ processSort sort' elev export = case sort' of
     ByBirthDate o -> sortByBirthDate o export
     ByHierarchy _ -> case elev of
             Constante  s s' ->  export & export_branches .~ (branchToIso' s s' $ sortByHierarchy 0 (export ^. export_branches))
-            Adaptative _ ->  export & export_branches .~ (branchToIso $ sortByHierarchy 0 (export ^. export_branches)) 
-            Evolving   _ ->  export & export_branches .~ (branchToIso $ sortByHierarchy 0 (export ^. export_branches)) 
+            Adaptative _ ->  export & export_branches .~ (branchToIso $ sortByHierarchy 0 (export ^. export_branches))
+            Evolving   _ ->  export & export_branches .~ (branchToIso $ sortByHierarchy 0 (export ^. export_branches))
 
 -----------------
 -- | Metrics | --
@@ -568,7 +568,7 @@ toDynamics n elders g m =
         isNew :: Bool
         isNew = not $ elem n $ concat $ map _phylo_groupNgrams elders
 
-type FdtId = Int 
+type FdtId = Int
 processDynamics :: [PhyloGroup] -> [PhyloGroup]
 processDynamics groups =
     map (\g ->
@@ -652,7 +652,7 @@ toHorizon phylo =
             Adaptative _ -> 0
             Evolving   _ -> 0
        -- in headsToAncestors nbDocs diago Similarity heads groups []
-       in map (\ego -> toAncestor nbDocs diago sim step noHeads ego)
+       in map (toAncestor nbDocs diago sim step noHeads)
         $ headsToAncestors nbDocs diago sim step heads []
       ) periods
     -- | 3) process this task concurrently
@@ -684,17 +684,18 @@ toPhyloExport phylo = exportToDot phylo
                       let seaLvl = (g ^. phylo_groupMeta) ! "seaLevels"
                           breaks = (g ^. phylo_groupMeta) ! "breaks"
                           canonId = take (round $ (last' "export" breaks) + 2) (snd $ g ^. phylo_groupBranchId)
-                       in PhyloBranch (g ^. phylo_groupBranchId)
-                                      canonId
-                                      seaLvl
-                                      0
-                                      (last' "export" (take (round $ (last' "export" breaks) + 1) seaLvl))
-                                      0
-                                      0
-                                      "" empty)
-                  $ map (\gs -> head' "export" gs)
+                       in PhyloBranch { _branch_id = g ^. phylo_groupBranchId
+                                      , _branch_canonId = canonId
+                                      , _branch_seaLevel = seaLvl
+                                      , _branch_x = 0
+                                      , _branch_y = last' "export" $ take (round $ (last' "export" breaks) + 1) seaLvl
+                                      , _branch_w = 0
+                                      , _branch_t = 0
+                                      , _branch_label = ""
+                                      , _branch_meta = empty })
+                  $ map (head' "export")
                   $ groupBy (\g g' -> g ^. phylo_groupBranchId == g' ^. phylo_groupBranchId)
-                  $ sortOn (\g -> g ^. phylo_groupBranchId) groups
+                  $ sortOn (^. phylo_groupBranchId) groups
         --------------------------------------
         groups :: [PhyloGroup]
         groups = traceExportGroups
@@ -724,4 +725,3 @@ traceExportGroups groups = trace ("\n" <> "-- | Export "
     <> show(length groups) <> " groups and "
     <> show(length $ nub $ concat $ map (\g -> g ^. phylo_groupNgrams) groups) <> " terms"
   ) groups
-