Commit 7697da0d authored by Alexandre Delanoë's avatar Alexandre Delanoë

[WIP] needs improved type

parent 333956ba
#!/bin/bash #!/bin/bash
stack install --profile --test # --haddock stack install --profile --test --fast # --haddock
...@@ -15,11 +15,8 @@ Portability : POSIX ...@@ -15,11 +15,8 @@ Portability : POSIX
module Gargantext.Core.Flow.Types where module Gargantext.Core.Flow.Types where
import Control.Lens import Control.Lens
import Data.Map (Map)
import Gargantext.Core.Text (HasText(..))
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Schema.Ngrams (Ngrams, NgramsType)
import Gargantext.Database.Schema.Node (node_hash_id) import Gargantext.Database.Schema.Node (node_hash_id)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Prelude.Crypto.Hash (Hash) import Gargantext.Prelude.Crypto.Hash (Hash)
......
...@@ -43,12 +43,11 @@ import Data.Traversable ...@@ -43,12 +43,11 @@ import Data.Traversable
import GHC.Base (String) import GHC.Base (String)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import qualified Data.List as List import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.HashMap.Strict as HashMap
import Gargantext.Core import Gargantext.Core
import Gargantext.Core.Flow.Types
import Gargantext.Core.Text (sentences, HasText(..)) import Gargantext.Core.Text (sentences, HasText(..))
import Gargantext.Core.Text.Terms.Eleve (mainEleveWith, Tries, Token, buildTries, toToken) import Gargantext.Core.Text.Terms.Eleve (mainEleveWith, Tries, Token, buildTries, toToken)
import Gargantext.Core.Text.Terms.Mono (monoTerms) import Gargantext.Core.Text.Terms.Mono (monoTerms)
...@@ -61,7 +60,6 @@ import Gargantext.Database.Query.Table.Ngrams (insertNgrams) ...@@ -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.Query.Table.NgramsPostag (NgramsPostag(..), insertNgramsPostag, np_form, np_lem)
import Gargantext.Database.Schema.Ngrams (Ngrams(..), NgramsType(..), ngramsTerms, text2ngrams, NgramsId) import Gargantext.Database.Schema.Ngrams (Ngrams(..), NgramsType(..), ngramsTerms, text2ngrams, NgramsId)
import Gargantext.Prelude import Gargantext.Prelude
import qualified Gargantext.Data.HashMap.Strict.Utils as HashMap
data TermType lang data TermType lang
= Mono { _tt_lang :: !lang } = Mono { _tt_lang :: !lang }
...@@ -115,7 +113,7 @@ withLang l _ = l ...@@ -115,7 +113,7 @@ withLang l _ = l
------------------------------------------------------------------------ ------------------------------------------------------------------------
data ExtractedNgrams = SimpleNgrams { unSimpleNgrams :: Ngrams } data ExtractedNgrams = SimpleNgrams { unSimpleNgrams :: Ngrams }
| EnrichedNgrams { unEnrichedNgrams :: NgramsPostag } | EnrichedNgrams { unEnrichedNgrams :: NgramsPostag }
deriving (Eq, Ord, Generic) deriving (Eq, Ord, Generic, Show)
instance Hashable ExtractedNgrams instance Hashable ExtractedNgrams
...@@ -149,18 +147,21 @@ extracted2ngrams (SimpleNgrams ng) = ng ...@@ -149,18 +147,21 @@ extracted2ngrams (SimpleNgrams ng) = ng
extracted2ngrams (EnrichedNgrams ng) = view np_form ng extracted2ngrams (EnrichedNgrams ng) = view np_form ng
isSimpleNgrams :: ExtractedNgrams -> Bool ---------------------------
isSimpleNgrams (SimpleNgrams _) = True
isSimpleNgrams _ = False
insertExtractedNgrams :: [ ExtractedNgrams ] -> Cmd err (HashMap Text NgramsId) insertExtractedNgrams :: [ ExtractedNgrams ] -> Cmd err (HashMap Text NgramsId)
insertExtractedNgrams ngs = do insertExtractedNgrams ngs = do
let (s, e) = List.partition isSimpleNgrams ngs let (s, e) = List.partition isSimpleNgrams ngs
m1 <- insertNgrams (map unSimpleNgrams s) m1 <- if List.null s
m2 <- insertNgramsPostag (map unEnrichedNgrams e) 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 pure $ m1 <> m2
isSimpleNgrams :: ExtractedNgrams -> Bool
isSimpleNgrams (SimpleNgrams _) = True
isSimpleNgrams _ = False
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Terms from Text -- | Terms from Text
......
...@@ -23,7 +23,7 @@ module Gargantext.Core.Types ( module Gargantext.Core.Types.Main ...@@ -23,7 +23,7 @@ module Gargantext.Core.Types ( module Gargantext.Core.Types.Main
, Name , Name
, TableResult(..), NodeTableResult , TableResult(..), NodeTableResult
, Ordering(..) , Ordering(..)
, Typed(..) , Typed(..), withType , unTyped
, TODO(..) , TODO(..)
) where ) where
......
...@@ -17,10 +17,10 @@ Portability : POSIX ...@@ -17,10 +17,10 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ConstrainedClassMethods #-} {-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Action.Flow -- (flowDatabase, ngrams2list) module Gargantext.Database.Action.Flow -- (flowDatabase, ngrams2list)
...@@ -54,7 +54,7 @@ import Data.Map (Map, lookup) ...@@ -54,7 +54,7 @@ import Data.Map (Map, lookup)
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Data.Monoid import Data.Monoid
import Data.Swagger import Data.Swagger
import Data.Text (splitOn, intercalate) import Data.Text (splitOn)
import Data.Traversable (traverse) import Data.Traversable (traverse)
import Data.Tuple.Extra (first, second) import Data.Tuple.Extra (first, second)
import GHC.Generics (Generic) import GHC.Generics (Generic)
...@@ -73,7 +73,7 @@ import Gargantext.Core.Text.Corpus.Parsers (parseFile, FileFormat) ...@@ -73,7 +73,7 @@ import Gargantext.Core.Text.Corpus.Parsers (parseFile, FileFormat)
import Gargantext.Core.Text.List (buildNgramsLists) import Gargantext.Core.Text.List (buildNgramsLists)
import Gargantext.Core.Text.Terms import Gargantext.Core.Text.Terms
import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt) 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.Individu (User(..))
import Gargantext.Core.Types.Main import Gargantext.Core.Types.Main
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
...@@ -413,7 +413,8 @@ instance ExtractNgramsT HyperdataDocument ...@@ -413,7 +413,8 @@ instance ExtractNgramsT HyperdataDocument
<$> concat <$> concat
<$> liftBase (extractTerms lang' $ hasText doc) <$> liftBase (extractTerms lang' $ hasText doc)
pure $ HashMap.fromList $ [(SimpleNgrams source, Map.singleton Sources 1)] pure $ HashMap.fromList
$ [(SimpleNgrams source, Map.singleton Sources 1) ]
<> [(SimpleNgrams i', Map.singleton Institutes 1) | i' <- institutes ] <> [(SimpleNgrams i', Map.singleton Institutes 1) | i' <- institutes ]
<> [(SimpleNgrams a', Map.singleton Authors 1) | a' <- authors ] <> [(SimpleNgrams a', Map.singleton Authors 1) | a' <- authors ]
<> [(EnrichedNgrams t', Map.singleton NgramsTerms 1) | t' <- terms' ] <> [(EnrichedNgrams t', Map.singleton NgramsTerms 1) | t' <- terms' ]
......
...@@ -28,12 +28,10 @@ import Gargantext.Core.Types (HasInvalidError(..), assertValid) ...@@ -28,12 +28,10 @@ import Gargantext.Core.Types (HasInvalidError(..), assertValid)
import Gargantext.Core.Types.Main (ListType(CandidateTerm)) import Gargantext.Core.Types.Main (ListType(CandidateTerm))
import Gargantext.Core.Utils (something) import Gargantext.Core.Utils (something)
import Gargantext.Database.Action.Flow.Types import Gargantext.Database.Action.Flow.Types
import Gargantext.Database.Action.Flow.Utils (DocumentIdWithNgrams(..))
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Query.Table.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb, getCgramsId) import Gargantext.Database.Query.Table.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb, getCgramsId)
import Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams import Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams
import Gargantext.Database.Schema.Ngrams (Ngrams(..), NgramsType(..)) import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.Database.Types
import Gargantext.Prelude import Gargantext.Prelude
import qualified Data.List as List import qualified Data.List as List
import qualified Data.Map as Map import qualified Data.Map as Map
......
...@@ -24,7 +24,6 @@ module Gargantext.Database.Query.Table.Ngrams ...@@ -24,7 +24,6 @@ module Gargantext.Database.Query.Table.Ngrams
import Control.Lens ((^.)) import Control.Lens ((^.))
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import Data.ByteString.Internal (ByteString) import Data.ByteString.Internal (ByteString)
import Data.Map (Map, fromList)
import Data.Text (Text) import Data.Text (Text)
import qualified Database.PostgreSQL.Simple as PGS import qualified Database.PostgreSQL.Simple as PGS
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
......
...@@ -16,11 +16,10 @@ Portability : POSIX ...@@ -16,11 +16,10 @@ Portability : POSIX
module Gargantext.Database.Query.Table.NgramsPostag module Gargantext.Database.Query.Table.NgramsPostag
where where
import Control.Lens (makeLenses) import Control.Lens (view)
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import Data.Hashable (Hashable) import Data.Hashable (Hashable)
import Data.Text (Text) import Data.Text (Text)
import GHC.Generics (Generic)
import Gargantext.Core import Gargantext.Core
import Gargantext.Core.Types import Gargantext.Core.Types
import Gargantext.Database.Prelude (Cmd, runPGSQuery) import Gargantext.Database.Prelude (Cmd, runPGSQuery)
...@@ -38,7 +37,7 @@ data NgramsPostag = NgramsPostag { _np_lang :: Lang ...@@ -38,7 +37,7 @@ data NgramsPostag = NgramsPostag { _np_lang :: Lang
, _np_form :: Ngrams , _np_form :: Ngrams
, _np_lem :: Ngrams , _np_lem :: Ngrams
} }
deriving (Eq, Ord, Generic) deriving (Eq, Ord, Generic, Show)
makeLenses ''NgramsPostag makeLenses ''NgramsPostag
...@@ -58,10 +57,10 @@ toInsert (NgramsPostag l a p form lem) = ...@@ -58,10 +57,10 @@ toInsert (NgramsPostag l a p form lem) =
( toDBid l ( toDBid l
, toDBid a , toDBid a
, cs $ show p , cs $ show p
, _ngramsTerms form , view ngramsTerms form
, _ngramsSize form , view ngramsSize form
, _ngramsTerms lem , view ngramsTerms lem
, _ngramsSize lem , view ngramsSize lem
) )
insertNgramsPostag :: [NgramsPostag] -> Cmd err (HashMap Text NgramsId) insertNgramsPostag :: [NgramsPostag] -> Cmd err (HashMap Text NgramsId)
......
...@@ -26,11 +26,10 @@ import Control.Lens (over) ...@@ -26,11 +26,10 @@ import Control.Lens (over)
import Control.Monad (mzero) import Control.Monad (mzero)
import Data.Aeson import Data.Aeson
import Data.Aeson.Types (toJSONKeyText) import Data.Aeson.Types (toJSONKeyText)
import Data.Map (Map, fromList, lookup) import Data.Map (fromList, lookup)
import Data.Text (Text, splitOn, pack, strip) import Data.Text (Text, splitOn, pack, strip)
import Gargantext.Core.Types (TODO(..), Typed(..)) import Gargantext.Core.Types (TODO(..), Typed(..))
import Gargantext.Prelude import Gargantext.Prelude
import Prelude (Functor)
import Servant (FromHttpApiData, parseUrlPiece, Proxy(..)) import Servant (FromHttpApiData, parseUrlPiece, Proxy(..))
import Text.Read (read) import Text.Read (read)
import Gargantext.Database.Types import Gargantext.Database.Types
......
...@@ -22,9 +22,7 @@ module Gargantext.Database.Schema.NgramsPostag ...@@ -22,9 +22,7 @@ module Gargantext.Database.Schema.NgramsPostag
import Control.Lens import Control.Lens
import Data.Text (Text) import Data.Text (Text)
import Gargantext.Core
import Gargantext.Database.Schema.Prelude import Gargantext.Database.Schema.Prelude
import Gargantext.API.Ngrams.Types
import Gargantext.Prelude import Gargantext.Prelude
import qualified Database.PostgreSQL.Simple as PGS import qualified Database.PostgreSQL.Simple as PGS
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment