src/Gargantext/Viz/Phylo/Main.hs

   1 {-|
   2 Module      : Gargantext.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.Viz.Phylo.Main
  15   where
  16
  17
  18 import Data.GraphViz
  19 import Data.Maybe
  20 import Data.Text (Text)
  21 import Debug.Trace (trace)
  22 import GHC.IO (FilePath)
  23 import Gargantext.API.Ngrams.Tools (getTermsWith)
  24 import Gargantext.Core.Types
  25 import Gargantext.Database.Action.Flow
  26 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
  27 import Gargantext.Database.Query.Table.Node(defaultList)
  28 import Gargantext.Database.Query.Table.NodeNode (selectDocs)
  29 import Gargantext.Prelude
  30 import Gargantext.Text.Context (TermList)
  31 import Gargantext.Text.Terms.WithList
  32 import Gargantext.Viz.Phylo hiding (Svg, Dot)
  33 import Gargantext.Viz.Phylo.LevelMaker
  34 import Gargantext.Viz.Phylo.Tools
  35 import Gargantext.Viz.Phylo.View.Export
  36 import Gargantext.Viz.Phylo.View.ViewMaker    -- TODO Just Maker is fine
  37 import qualified Data.ByteString as DB
  38 import qualified Data.List as List
  39 import qualified Data.Map  as Map
  40 import qualified Data.Text as Text
  41
  42 type MinSizeBranch = Int
  43
  44 flowPhylo :: FlowCmdM env err m
  45           => CorpusId
  46           -> m Phylo
  47 flowPhylo cId = do
  48
  49   list       <- defaultList cId
  50   termList <- Map.toList <$> getTermsWith Text.words [list] NgramsTerms GraphTerm
  51
  52   docs' <- catMaybes
  53           <$> map (\h -> (,) <$> _hyperdataDocument_publication_year h
  54                              <*> _hyperdataDocument_abstract h
  55                   )
  56           <$> selectDocs cId
  57
  58   let
  59     patterns = buildPatterns termList
  60     -- | To filter the Ngrams of a document based on the termList
  61     filterTerms :: Patterns -> (Date, Text) -> (Date, [Text])
  62     filterTerms patterns' (y,d) = (y,termsInText patterns' d)
  63       where
  64         --------------------------------------
  65         termsInText :: Patterns -> Text -> [Text]
  66         termsInText pats txt = List.nub $ List.concat $ map (map Text.unwords) $ extractTermsWithList pats txt
  67         --------------------------------------
  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 = defaultQueryBuild'
  90   "Default Title"
  91   "Default Description"
  92
  93 buildPhylo :: [Document] -> TermList -> Phylo
  94 buildPhylo = trace (show defaultQuery) $ buildPhylo' defaultQuery
  95
  96 buildPhylo' :: PhyloQueryBuild -> [Document] -> TermList -> Phylo
  97 buildPhylo' q corpus termList = toPhylo q corpus termList Map.empty
  98
  99 queryView :: Level -> MinSizeBranch -> PhyloQueryView
 100 queryView level _minSizeBranch = PhyloQueryView level Merge False 2
 101            [BranchAge]
 102            []
 103            -- [SizeBranch $ SBParams minSizeBranch]
 104            [BranchPeakFreq,GroupLabelCooc]
 105            (Just (ByBranchAge,Asc))
 106            Json Flat True
 107
 108 viewPhylo :: Level -> MinSizeBranch -> Phylo -> PhyloView
 109 viewPhylo l b phylo = toPhyloView (queryView l b) phylo
 110
 111 writePhylo :: FilePath -> PhyloView -> IO FilePath
 112 writePhylo fp phview = runGraphviz (viewToDot phview) Svg fp
 113
 114 viewPhylo2Svg :: PhyloView -> IO DB.ByteString
 115 viewPhylo2Svg p = graphvizWithHandle Dot (viewToDot p) Svg DB.hGetContents
 116