[WIP] needs improved type

bin/install

 #!/bin/bash
 
-stack install --profile --test # --haddock
+stack install --profile --test --fast # --haddock

src/Gargantext/Core/Flow/Types.hs

@@ -15,11 +15,8 @@ Portability : POSIX
 module Gargantext.Core.Flow.Types where
 
 import Control.Lens
-import Data.Map (Map)
-import Gargantext.Core.Text (HasText(..))
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Schema.Ngrams (Ngrams, NgramsType)
 import Gargantext.Database.Schema.Node (node_hash_id)
 import Gargantext.Prelude
 import Gargantext.Prelude.Crypto.Hash (Hash)

src/Gargantext/Core/Text/Terms.hs

@@ -43,12 +43,11 @@ import Data.Traversable
 import GHC.Base (String)
 import GHC.Generics (Generic)
 import qualified Data.List as List
-import qualified Data.Map as Map
 import qualified Data.Set  as Set
 import qualified Data.Text as Text
+import qualified Data.HashMap.Strict as HashMap
 
 import Gargantext.Core
-import Gargantext.Core.Flow.Types
 import Gargantext.Core.Text (sentences, HasText(..))
 import Gargantext.Core.Text.Terms.Eleve (mainEleveWith, Tries, Token, buildTries, toToken)
 import Gargantext.Core.Text.Terms.Mono  (monoTerms)
@@ -61,7 +60,6 @@ import Gargantext.Database.Query.Table.Ngrams (insertNgrams)
 import Gargantext.Database.Query.Table.NgramsPostag (NgramsPostag(..), insertNgramsPostag, np_form, np_lem)
 import Gargantext.Database.Schema.Ngrams (Ngrams(..), NgramsType(..), ngramsTerms, text2ngrams, NgramsId)
 import Gargantext.Prelude
-import qualified Gargantext.Data.HashMap.Strict.Utils as HashMap
 
 data TermType lang
   = Mono      { _tt_lang :: !lang }
@@ -115,7 +113,7 @@ withLang l _ = l
 ------------------------------------------------------------------------
 data ExtractedNgrams = SimpleNgrams   { unSimpleNgrams   :: Ngrams       }
                      | EnrichedNgrams { unEnrichedNgrams :: NgramsPostag }
-  deriving (Eq, Ord, Generic)
+  deriving (Eq, Ord, Generic, Show)
 
 instance Hashable ExtractedNgrams
 
@@ -149,18 +147,21 @@ extracted2ngrams (SimpleNgrams   ng) = ng
 extracted2ngrams (EnrichedNgrams ng) = view np_form ng
 
 
-isSimpleNgrams :: ExtractedNgrams -> Bool
-isSimpleNgrams (SimpleNgrams _) = True
-isSimpleNgrams _                = False
-
-
+---------------------------
 insertExtractedNgrams :: [ ExtractedNgrams ] -> Cmd err (HashMap Text NgramsId)
 insertExtractedNgrams ngs = do
   let (s, e) = List.partition isSimpleNgrams ngs
-  m1 <- insertNgrams       (map unSimpleNgrams   s)
-  m2 <- insertNgramsPostag (map unEnrichedNgrams e)
+  m1 <- if List.null s
+           then pure HashMap.empty
+           else insertNgrams       (map unSimpleNgrams   s)
+  m2 <- if List.null e
+           then pure HashMap.empty
+           else insertNgramsPostag (map unEnrichedNgrams e)
   pure $ m1 <> m2
 
+isSimpleNgrams :: ExtractedNgrams -> Bool
+isSimpleNgrams (SimpleNgrams _) = True
+isSimpleNgrams _                = False
 
 ------------------------------------------------------------------------
 -- | Terms from Text

src/Gargantext/Core/Types.hs

@@ -23,7 +23,7 @@ module Gargantext.Core.Types ( module Gargantext.Core.Types.Main
                              , Name
                              , TableResult(..), NodeTableResult
                              , Ordering(..)
-                             , Typed(..)
+                             , Typed(..), withType , unTyped
                              , TODO(..)
                              ) where
 

src/Gargantext/Database/Action/Flow.hs

@@ -17,10 +17,10 @@ Portability : POSIX
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-{-# LANGUAGE ConstraintKinds         #-}
 {-# LANGUAGE ConstrainedClassMethods #-}
 {-# LANGUAGE ConstraintKinds         #-}
 {-# LANGUAGE InstanceSigs            #-}
+{-# LANGUAGE ScopedTypeVariables     #-}
 {-# LANGUAGE TemplateHaskell         #-}
 
 module Gargantext.Database.Action.Flow -- (flowDatabase, ngrams2list)
@@ -54,7 +54,7 @@ import Data.Map (Map, lookup)
 import Data.Maybe (catMaybes)
 import Data.Monoid
 import Data.Swagger
-import Data.Text (splitOn, intercalate)
+import Data.Text (splitOn)
 import Data.Traversable (traverse)
 import Data.Tuple.Extra (first, second)
 import GHC.Generics (Generic)
@@ -73,7 +73,7 @@ import Gargantext.Core.Text.Corpus.Parsers (parseFile, FileFormat)
 import Gargantext.Core.Text.List (buildNgramsLists)
 import Gargantext.Core.Text.Terms
 import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
-import Gargantext.Core.Types (Terms(..), POS(NP))
+import Gargantext.Core.Types (POS(NP))
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Types.Main
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
@@ -285,9 +285,9 @@ insertMasterDocs c lang hs  =  do
            $ catMaybes [ NodeNodeNgrams2 <$> Just nId
                                          <*> getCgramsId mapCgramsId ngrams_type (_ngramsTerms terms'')
                                          <*> Just (fromIntegral w :: Double)
-                       | (terms'', mapNgramsTypes) <- HashMap.toList mapNgramsDocs
+                       | (terms'', mapNgramsTypes)      <- HashMap.toList mapNgramsDocs
                        , (ngrams_type, mapNodeIdWeight) <- Map.toList mapNgramsTypes
-                       , (nId, w) <- Map.toList mapNodeIdWeight
+                       , (nId, w)                       <- Map.toList mapNodeIdWeight
                        ]
 
   -- _cooc <- insertDefaultNode NodeListCooc lId masterUserId
@@ -413,10 +413,11 @@ instance ExtractNgramsT HyperdataDocument
                  <$> concat
                  <$> liftBase (extractTerms lang' $ hasText doc)
 
-          pure $ HashMap.fromList $  [(SimpleNgrams source, Map.singleton Sources 1)]
-                             <> [(SimpleNgrams i', Map.singleton Institutes  1) | i' <- institutes ]
-                             <> [(SimpleNgrams a', Map.singleton Authors     1) | a' <- authors    ]
-                             <> [(EnrichedNgrams t', Map.singleton NgramsTerms 1) | t' <- terms'     ]
+          pure $ HashMap.fromList
+               $  [(SimpleNgrams source, Map.singleton Sources     1)                    ]
+               <> [(SimpleNgrams     i', Map.singleton Institutes  1) | i' <- institutes ]
+               <> [(SimpleNgrams     a', Map.singleton Authors     1) | a' <- authors    ]
+               <> [(EnrichedNgrams   t', Map.singleton NgramsTerms 1) | t' <- terms'     ]
 
 instance (ExtractNgramsT a, HasText a) => ExtractNgramsT (Node a)
   where

src/Gargantext/Database/Action/Flow/List.hs

@@ -28,12 +28,10 @@ import Gargantext.Core.Types (HasInvalidError(..), assertValid)
 import Gargantext.Core.Types.Main (ListType(CandidateTerm))
 import Gargantext.Core.Utils (something)
 import Gargantext.Database.Action.Flow.Types
-import Gargantext.Database.Action.Flow.Utils (DocumentIdWithNgrams(..))
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Query.Table.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb, getCgramsId)
 import Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams
-import Gargantext.Database.Schema.Ngrams (Ngrams(..), NgramsType(..))
-import Gargantext.Database.Types
+import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Prelude
 import qualified Data.List as List
 import qualified Data.Map  as Map

src/Gargantext/Database/Query/Table/Ngrams.hs

@@ -24,7 +24,6 @@ module Gargantext.Database.Query.Table.Ngrams
 import Control.Lens ((^.))
 import Data.HashMap.Strict (HashMap)
 import Data.ByteString.Internal (ByteString)
-import Data.Map (Map, fromList)
 import Data.Text (Text)
 import qualified Database.PostgreSQL.Simple as PGS
 import qualified Data.HashMap.Strict as HashMap

src/Gargantext/Database/Query/Table/NgramsPostag.hs

@@ -16,11 +16,10 @@ Portability : POSIX
 module Gargantext.Database.Query.Table.NgramsPostag
     where
 
-import Control.Lens (makeLenses)
+import Control.Lens (view)
 import Data.HashMap.Strict (HashMap)
 import Data.Hashable (Hashable)
 import Data.Text (Text)
-import GHC.Generics (Generic)
 import Gargantext.Core
 import Gargantext.Core.Types
 import Gargantext.Database.Prelude (Cmd, runPGSQuery)
@@ -38,7 +37,7 @@ data NgramsPostag = NgramsPostag { _np_lang   :: Lang
                                  , _np_form   :: Ngrams
                                  , _np_lem    :: Ngrams
                                  }
-  deriving (Eq, Ord, Generic)
+  deriving (Eq, Ord, Generic, Show)
 
 makeLenses ''NgramsPostag
 
@@ -58,10 +57,10 @@ toInsert (NgramsPostag l a p form lem) =
   ( toDBid l
   , toDBid a
   , cs $ show p
-  , _ngramsTerms form
-  , _ngramsSize  form
-  , _ngramsTerms lem
-  , _ngramsSize  lem
+  , view ngramsTerms form
+  , view ngramsSize  form
+  , view ngramsTerms lem
+  , view ngramsSize  lem
   )
 
 insertNgramsPostag :: [NgramsPostag] -> Cmd err (HashMap Text NgramsId)

src/Gargantext/Database/Schema/Ngrams.hs

@@ -26,11 +26,10 @@ import Control.Lens (over)
 import Control.Monad (mzero)
 import Data.Aeson
 import Data.Aeson.Types (toJSONKeyText)
-import Data.Map (Map, fromList, lookup)
+import Data.Map (fromList, lookup)
 import Data.Text (Text, splitOn, pack, strip)
 import Gargantext.Core.Types (TODO(..), Typed(..))
 import Gargantext.Prelude
-import Prelude (Functor)
 import Servant (FromHttpApiData, parseUrlPiece, Proxy(..))
 import Text.Read (read)
 import Gargantext.Database.Types

src/Gargantext/Database/Schema/NgramsPostag.hs

@@ -22,9 +22,7 @@ module Gargantext.Database.Schema.NgramsPostag
 
 import Control.Lens
 import Data.Text (Text)
-import Gargantext.Core
 import Gargantext.Database.Schema.Prelude
-import Gargantext.API.Ngrams.Types
 import Gargantext.Prelude
 import qualified Database.PostgreSQL.Simple as PGS