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
  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.NodeNode (selectDocs)
  36 import Gargantext.Core.Types
  37
  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.Text as Text
  45
  46 type MinSizeBranch = Int
  47
  48 flowPhylo :: FlowCmdM env err m
  49           => CorpusId
  50           -> m Phylo
  51 flowPhylo cId = do
  52
  53   list     <- defaultList cId
  54   termList <- HashMap.toList <$> getTermsWith (Text.words . unNgramsTerm) [list] NgramsTerms MapTerm
  55
  56   docs' <- catMaybes
  57         <$> map (\h -> (,) <$> _hd_publication_year h
  58                            <*> _hd_abstract h
  59                 )
  60         <$> selectDocs cId
  61
  62   let
  63     patterns = buildPatterns termList
  64     -- | To filter the Ngrams of a document based on the termList
  65     filterTerms :: Patterns -> (Date, Text) -> (Date, [Text])
  66     filterTerms patterns' (y,d) = (y,termsInText patterns' d)
  67       where
  68         --------------------------------------
  69         termsInText :: Patterns -> Text -> [Text]
  70         termsInText pats txt = List.nub
  71                              $ List.concat
  72                              $ map (map Text.unwords)
  73                              $ extractTermsWithList pats txt
  74         --------------------------------------
  75
  76     docs = map ((\(y,t) -> Document y t) . filterTerms patterns) docs'
  77
  78   --liftBase $ flowPhylo' (List.sortOn date docs) termList l m fp
  79   pure $ buildPhylo (List.sortOn date docs) termList
  80
  81
  82 -- TODO SortedList Document
  83 flowPhylo' :: [Document] -> TermList      -- ^Build
  84            -> Level       -> MinSizeBranch -- ^View
  85            -> FilePath
  86            -> IO FilePath
  87 flowPhylo' corpus terms l m fp = do
  88   let
  89     phylo = buildPhylo corpus terms
  90     phVie = viewPhylo  l m phylo
  91
  92   writePhylo fp phVie
  93
  94
  95 defaultQuery :: PhyloQueryBuild
  96 defaultQuery = undefined
  97 -- defaultQuery = defaultQueryBuild'
  98 --   "Default Title"
  99 --   "Default Description"
 100
 101 buildPhylo :: [Document] -> TermList -> Phylo
 102 buildPhylo = trace (show defaultQuery) $ buildPhylo' defaultQuery
 103
 104 buildPhylo' :: PhyloQueryBuild -> [Document] -> TermList -> Phylo
 105 buildPhylo' _ _ _ = undefined
 106 -- buildPhylo' q corpus termList = toPhylo q corpus termList Map.empty
 107
 108 -- refactor 2021
 109 -- queryView :: Level -> MinSizeBranch -> PhyloQueryView
 110 -- queryView level _minSizeBranch = PhyloQueryView level Merge False 2
 111 --            [BranchAge]
 112 --            []
 113 --            -- [SizeBranch $ SBParams minSizeBranch]
 114 --            [BranchPeakFreq,GroupLabelCooc]
 115 --            (Just (ByBranchAge,Asc))
 116 --            Json Flat True
 117
 118 queryView :: Level -> MinSizeBranch -> PhyloQueryView
 119 queryView _level _minSizeBranch = undefined
 120
 121 viewPhylo :: Level -> MinSizeBranch -> Phylo -> PhyloView
 122 viewPhylo _l _b _phylo = undefined
 123 -- viewPhylo l b phylo = toPhyloView (queryView l b) phylo
 124
 125 writePhylo :: FilePath -> PhyloView -> IO FilePath
 126 writePhylo _fp _phview = undefined
 127 -- writePhylo fp phview = runGraphviz (viewToDot phview) Svg fp
 128
 129 -- refactor 2021
 130 -- viewPhylo2Svg :: PhyloView -> IO DB.ByteString
 131 -- viewPhylo2Svg p = graphvizWithHandle Dot (viewToDot p) Svg DB.hGetContents
 132