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.Set            as Set
  45 import qualified Data.Text           as Text
  46
  47 type MinSizeBranch = Int
  48
  49 flowPhylo :: FlowCmdM env err m
  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       where
  69         --------------------------------------
  70         termsInText :: Patterns -> Text -> [Text]
  71         termsInText pats txt = List.nub
  72                              $ List.concat
  73                              $ map (map Text.unwords)
  74                              $ extractTermsWithList pats txt
  75         --------------------------------------
  76
  77     docs = map ((\(y,t) -> Document y t) . filterTerms patterns) docs'
  78
  79   --liftBase $ flowPhylo' (List.sortOn date docs) termList l m fp
  80   pure $ buildPhylo (List.sortOn date docs) termList
  81
  82
  83 -- TODO SortedList Document
  84 flowPhylo' :: [Document] -> TermList      -- ^Build
  85            -> Level       -> MinSizeBranch -- ^View
  86            -> FilePath
  87            -> IO FilePath
  88 flowPhylo' corpus terms l m fp = do
  89   let
  90     phylo = buildPhylo corpus terms
  91     phVie = viewPhylo  l m phylo
  92
  93   writePhylo fp phVie
  94
  95
  96 defaultQuery :: PhyloQueryBuild
  97 defaultQuery = undefined
  98 -- defaultQuery = defaultQueryBuild'
  99 --   "Default Title"
 100 --   "Default Description"
 101
 102 buildPhylo :: [Document] -> TermList -> Phylo
 103 buildPhylo = trace (show defaultQuery) $ buildPhylo' defaultQuery
 104
 105 buildPhylo' :: PhyloQueryBuild -> [Document] -> TermList -> Phylo
 106 buildPhylo' _ _ _ = undefined
 107 -- buildPhylo' q corpus termList = toPhylo q corpus termList Map.empty
 108
 109 -- refactor 2021
 110 -- queryView :: Level -> MinSizeBranch -> PhyloQueryView
 111 -- queryView level _minSizeBranch = PhyloQueryView level Merge False 2
 112 --            [BranchAge]
 113 --            []
 114 --            -- [SizeBranch $ SBParams minSizeBranch]
 115 --            [BranchPeakFreq,GroupLabelCooc]
 116 --            (Just (ByBranchAge,Asc))
 117 --            Json Flat True
 118
 119 queryView :: Level -> MinSizeBranch -> PhyloQueryView
 120 queryView _level _minSizeBranch = undefined
 121
 122 viewPhylo :: Level -> MinSizeBranch -> Phylo -> PhyloView
 123 viewPhylo _l _b _phylo = undefined
 124 -- viewPhylo l b phylo = toPhyloView (queryView l b) phylo
 125
 126 writePhylo :: FilePath -> PhyloView -> IO FilePath
 127 writePhylo _fp _phview = undefined
 128 -- writePhylo fp phview = runGraphviz (viewToDot phview) Svg fp
 129
 130 -- refactor 2021
 131 -- viewPhylo2Svg :: PhyloView -> IO DB.ByteString
 132 -- viewPhylo2Svg p = graphvizWithHandle Dot (viewToDot p) Svg DB.hGetContents
 133