[FIX] ngrams + ngramsPosTag insert
[gargantext.git] / src / Gargantext / Core / Viz / Phylo / Main.hs
index ac2659d631270f712796e2fd9d3dfcc3c2e2e568..20c1cc60a04b6892da805da0b62c3fbe6963db28 100644 (file)
@@ -14,32 +14,32 @@ Portability : POSIX
 module Gargantext.Core.Viz.Phylo.Main
   where
 
-
 import Data.GraphViz
-import qualified Data.ByteString as DB
-import qualified Data.List as List
-import qualified Data.Map  as Map
 import Data.Maybe
-import qualified Data.Text as Text
 import Data.Text (Text)
 import Debug.Trace (trace)
 import GHC.IO (FilePath)
-
 import Gargantext.API.Ngrams.Tools (getTermsWith)
+import Gargantext.API.Ngrams.Types
+import Gargantext.Core.Text.Context (TermList)
+import Gargantext.Core.Text.Terms.WithList
 import Gargantext.Core.Types
+import Gargantext.Core.Viz.Phylo hiding (Svg, Dot)
+import Gargantext.Core.Viz.Phylo.LevelMaker (toPhylo)
+import Gargantext.Core.Viz.Phylo.Tools
+import Gargantext.Core.Viz.Phylo.View.Export
+import Gargantext.Core.Viz.Phylo.View.ViewMaker    -- TODO Just Maker is fine
 import Gargantext.Database.Action.Flow
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Query.Table.Node(defaultList)
 import Gargantext.Database.Query.Table.NodeNode (selectDocs)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Prelude
-import Gargantext.Core.Text.Context (TermList)
-import Gargantext.Core.Text.Terms.WithList
-import Gargantext.Core.Viz.Phylo hiding (Svg, Dot)
-import Gargantext.Core.Viz.Phylo.LevelMaker
-import Gargantext.Core.Viz.Phylo.Tools
-import Gargantext.Core.Viz.Phylo.View.Export
-import Gargantext.Core.Viz.Phylo.View.ViewMaker    -- TODO Just Maker is fine
+import qualified Data.ByteString as DB
+import qualified Data.List as List
+import qualified Data.Map  as Map
+import qualified Data.Text as Text
+import qualified Data.HashMap.Strict as HashMap
 
 type MinSizeBranch = Int
 
@@ -48,14 +48,14 @@ flowPhylo :: FlowCmdM env err m
           -> m Phylo
 flowPhylo cId = do
 
-  list       <- defaultList cId
-  termList <- Map.toList <$> getTermsWith Text.words [list] NgramsTerms MapTerm
+  list     <- defaultList cId
+  termList <- HashMap.toList <$> getTermsWith (Text.words . unNgramsTerm) [list] NgramsTerms MapTerm
 
   docs' <- catMaybes
-          <$> map (\h -> (,) <$> _hd_publication_year h
-                             <*> _hd_abstract h
-                  )
-          <$> selectDocs cId
+        <$> map (\h -> (,) <$> _hd_publication_year h
+                           <*> _hd_abstract h
+                )
+        <$> selectDocs cId
 
   let
     patterns = buildPatterns termList
@@ -65,10 +65,13 @@ flowPhylo cId = do
       where
         --------------------------------------
         termsInText :: Patterns -> Text -> [Text]
-        termsInText pats txt = List.nub $ List.concat $ map (map Text.unwords) $ extractTermsWithList pats txt
+        termsInText pats txt = List.nub
+                             $ List.concat
+                             $ map (map Text.unwords)
+                             $ extractTermsWithList pats txt
         --------------------------------------
 
-    docs = map ( (\(y,t) -> Document y t) . filterTerms patterns) docs'
+    docs = map ((\(y,t) -> Document y t) . filterTerms patterns) docs'
 
   --liftBase $ flowPhylo' (List.sortOn date docs) termList l m fp
   pure $ buildPhylo (List.sortOn date docs) termList
@@ -76,9 +79,9 @@ flowPhylo cId = do
 
 -- TODO SortedList Document
 flowPhylo' :: [Document] -> TermList      -- ^Build
-          -> Level      -> MinSizeBranch -- ^View
-          -> FilePath
-          -> IO FilePath
+           -> Level       -> MinSizeBranch -- ^View
+           -> FilePath
+           -> IO FilePath
 flowPhylo' corpus terms l m fp = do
   let
     phylo = buildPhylo corpus terms