src/Gargantext/Core/Viz/Phylo/Legacy/LegacyMain.hs

   1 {-|
   2 Module      : Gargantext.Core.Viz.Phylo.Main
   3 Description : Phylomemy Main
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 {-# LANGUAGE ViewPatterns      #-}
  13
  14 module Gargantext.Core.Viz.Phylo.Legacy.LegacyMain
  15   where
  16
  17 -- import Data.GraphViz
  18 -- import qualified Data.ByteString as DB
  19 import qualified Data.List as List
  20 import Data.Maybe
  21 import Data.Text (Text)
  22 import Debug.Trace (trace)
  23 import GHC.IO (FilePath)
  24 import Gargantext.API.Ngrams.Tools (getTermsWith)
  25 import Gargantext.API.Ngrams.Types
  26 import Gargantext.Database.Admin.Types.Node
  27 import Gargantext.Core.Text.Context (TermList)
  28 import Gargantext.Core.Text.Terms.WithList
  29 import Gargantext.Database.Query.Table.Node(defaultList)
  30 import Gargantext.Prelude
  31 import Gargantext.Database.Action.Flow.Types
  32 import Gargantext.Core.Viz.LegacyPhylo hiding (Svg, Dot)
  33 import Gargantext.Database.Admin.Types.Hyperdata
  34 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
  35 import Gargantext.Database.Query.Table.NodeContext (selectDocs)
  36 import Gargantext.Core.Types
  37 import Gargantext.Core (HasDBid)
  38
  39 -- import Gargantext.Core.Viz.Phylo.LevelMaker (toPhylo)
  40 -- import Gargantext.Core.Viz.Phylo.Tools
  41 -- import Gargantext.Core.Viz.Phylo.View.Export
  42 -- import Gargantext.Core.Viz.Phylo.View.ViewMaker    -- TODO Just Maker is fine
  43 import qualified Data.HashMap.Strict as HashMap
  44 import qualified Data.Set            as Set
  45 import qualified Data.Text           as Text
  46
  47 type MinSizeBranch = Int
  48
  49 flowPhylo :: (FlowCmdM env err m, HasDBid NodeType)
  50           => CorpusId
  51           -> m Phylo
  52 flowPhylo cId = do
  53
  54   list     <- defaultList cId
  55   termList <- HashMap.toList <$> getTermsWith (Text.words . unNgramsTerm) [list] NgramsTerms (Set.singleton MapTerm)
  56
  57   docs' <- catMaybes
  58         <$> map (\h -> (,) <$> _hd_publication_year h
  59                            <*> _hd_abstract h
  60                 )
  61         <$> selectDocs cId
  62
  63   let
  64     patterns = buildPatterns termList
  65     -- | To filter the Ngrams of a document based on the termList
  66     filterTerms :: Patterns -> (Date, Text) -> (Date, [Text])
  67     filterTerms patterns' (y,d) = (y,termsInText patterns' d)
  68
  69     docs = map ((\(y,t) -> Document y t) . filterTerms patterns) docs'
  70
  71   --liftBase $ flowPhylo' (List.sortOn date docs) termList l m fp
  72   pure $ buildPhylo (List.sortOn date docs) termList
  73
  74
  75 -- TODO SortedList Document
  76 flowPhylo' :: [Document] -> TermList      -- ^Build
  77            -> Level       -> MinSizeBranch -- ^View
  78            -> FilePath
  79            -> IO FilePath
  80 flowPhylo' corpus terms l m fp = do
  81   let
  82     phylo = buildPhylo corpus terms
  83     phVie = viewPhylo  l m phylo
  84
  85   writePhylo fp phVie
  86
  87
  88 defaultQuery :: PhyloQueryBuild
  89 defaultQuery = undefined
  90 -- defaultQuery = defaultQueryBuild'
  91 --   "Default Title"
  92 --   "Default Description"
  93
  94 buildPhylo :: [Document] -> TermList -> Phylo
  95 buildPhylo = trace (show defaultQuery) $ buildPhylo' defaultQuery
  96
  97 buildPhylo' :: PhyloQueryBuild -> [Document] -> TermList -> Phylo
  98 buildPhylo' _ _ _ = undefined
  99 -- buildPhylo' q corpus termList = toPhylo q corpus termList Map.empty
 100
 101 -- refactor 2021
 102 -- queryView :: Level -> MinSizeBranch -> PhyloQueryView
 103 -- queryView level _minSizeBranch = PhyloQueryView level Merge False 2
 104 --            [BranchAge]
 105 --            []
 106 --            -- [SizeBranch $ SBParams minSizeBranch]
 107 --            [BranchPeakFreq,GroupLabelCooc]
 108 --            (Just (ByBranchAge,Asc))
 109 --            Json Flat True
 110
 111 queryView :: Level -> MinSizeBranch -> PhyloQueryView
 112 queryView _level _minSizeBranch = undefined
 113
 114 viewPhylo :: Level -> MinSizeBranch -> Phylo -> PhyloView
 115 viewPhylo _l _b _phylo = undefined
 116 -- viewPhylo l b phylo = toPhyloView (queryView l b) phylo
 117
 118 writePhylo :: FilePath -> PhyloView -> IO FilePath
 119 writePhylo _fp _phview = undefined
 120 -- writePhylo fp phview = runGraphviz (viewToDot phview) Svg fp
 121
 122 -- refactor 2021
 123 -- viewPhylo2Svg :: PhyloView -> IO DB.ByteString
 124 -- viewPhylo2Svg p = graphvizWithHandle Dot (viewToDot p) Svg DB.hGetContents
 125