Commit 44100b6d authored by Alexandre Delanoë's avatar Alexandre Delanoë

[CLEAN] replace NgramsTerms with Text to avoid ambiguity with Types of Ngrams

parent 02eb40eb
Pipeline #1330 failed with stage
...@@ -31,7 +31,6 @@ import Data.Maybe (catMaybes) ...@@ -31,7 +31,6 @@ import Data.Maybe (catMaybes)
import Data.Set (Set) import Data.Set (Set)
import Gargantext.Prelude import Gargantext.Prelude
import HLCM import HLCM
import Prelude (Functor(..)) -- TODO
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.Vector as V import qualified Data.Vector as V
......
...@@ -23,10 +23,11 @@ module Gargantext.Core.Types ( module Gargantext.Core.Types.Main ...@@ -23,10 +23,11 @@ module Gargantext.Core.Types ( module Gargantext.Core.Types.Main
, Name , Name
, TableResult(..), NodeTableResult , TableResult(..), NodeTableResult
, Ordering(..) , Ordering(..)
, Typed(..)
, TODO(..) , TODO(..)
) where ) where
import Control.Lens (Prism', (#)) import Control.Lens (Prism', (#), makeLenses, over)
import Control.Monad.Except (MonadError(throwError)) import Control.Monad.Except (MonadError(throwError))
import Data.Aeson import Data.Aeson
import Data.Aeson.TH (deriveJSON) import Data.Aeson.TH (deriveJSON)
...@@ -146,7 +147,7 @@ type NodeTableResult a = TableResult (Node a) ...@@ -146,7 +147,7 @@ type NodeTableResult a = TableResult (Node a)
data TableResult a = TableResult { tr_count :: Int data TableResult a = TableResult { tr_count :: Int
, tr_docs :: [a] , tr_docs :: [a]
} deriving (Generic) } deriving (Generic)
$(deriveJSON (unPrefix "tr_") ''TableResult) $(deriveJSON (unPrefix "tr_") ''TableResult)
...@@ -157,6 +158,18 @@ instance (Typeable a, ToSchema a) => ToSchema (TableResult a) where ...@@ -157,6 +158,18 @@ instance (Typeable a, ToSchema a) => ToSchema (TableResult a) where
instance Arbitrary a => Arbitrary (TableResult a) where instance Arbitrary a => Arbitrary (TableResult a) where
arbitrary = TableResult <$> arbitrary <*> arbitrary arbitrary = TableResult <$> arbitrary <*> arbitrary
----------------------------------------------------------------------------
data Typed a b =
Typed { _withType :: a
, _unTyped :: b
}
deriving (Generic, Show, Eq, Ord)
makeLenses ''Typed
instance Functor (Typed a) where
fmap = over unTyped
---------------------------------------------------------------------------- ----------------------------------------------------------------------------
-- TO BE removed -- TO BE removed
data TODO = TODO data TODO = TODO
......
...@@ -64,8 +64,8 @@ _dbGetNgramsDb = runOpaQuery queryNgramsTable ...@@ -64,8 +64,8 @@ _dbGetNgramsDb = runOpaQuery queryNgramsTable
-- TODO-ACCESS: access must not be checked here but when insertNgrams is called. -- TODO-ACCESS: access must not be checked here but when insertNgrams is called.
insertNgrams :: [Ngrams] -> Cmd err (Map NgramsTerms NgramsId) insertNgrams :: [Ngrams] -> Cmd err (Map Text NgramsId)
insertNgrams ns = fromList <$> map (\(Indexed t i) -> (t, i)) <$> (insertNgrams' ns) insertNgrams ns = fromList <$> map (\(Indexed i t) -> (t, i)) <$> (insertNgrams' ns)
-- TODO-ACCESS: access must not be checked here but when insertNgrams' is called. -- TODO-ACCESS: access must not be checked here but when insertNgrams' is called.
insertNgrams' :: [Ngrams] -> Cmd err [Indexed Text] insertNgrams' :: [Ngrams] -> Cmd err [Indexed Text]
...@@ -73,7 +73,7 @@ insertNgrams' ns = runPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns) ...@@ -73,7 +73,7 @@ insertNgrams' ns = runPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
where where
fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"] fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
_insertNgrams_Debug :: [(NgramsTerms, Size)] -> Cmd err ByteString _insertNgrams_Debug :: [(Text, Size)] -> Cmd err ByteString
_insertNgrams_Debug ns = formatPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns) _insertNgrams_Debug ns = formatPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
where where
fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"] fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
......
...@@ -27,7 +27,7 @@ import Data.Aeson ...@@ -27,7 +27,7 @@ import Data.Aeson
import Data.Aeson.Types (toJSONKeyText) import Data.Aeson.Types (toJSONKeyText)
import Data.Map (Map, fromList, lookup) import Data.Map (Map, fromList, lookup)
import Data.Text (Text, splitOn, pack, strip) import Data.Text (Text, splitOn, pack, strip)
import Gargantext.Core.Types (TODO(..)) import Gargantext.Core.Types (TODO(..), Typed(..))
import Gargantext.Prelude import Gargantext.Prelude
import Prelude (Functor) import Prelude (Functor)
import Servant (FromHttpApiData, parseUrlPiece, Proxy(..)) import Servant (FromHttpApiData, parseUrlPiece, Proxy(..))
...@@ -37,9 +37,8 @@ import Gargantext.Database.Schema.Prelude ...@@ -37,9 +37,8 @@ import Gargantext.Database.Schema.Prelude
import qualified Database.PostgreSQL.Simple as PGS import qualified Database.PostgreSQL.Simple as PGS
type NgramsId = Int type NgramsId = Int
type NgramsTerms = Text type Size = Int
type Size = Int
data NgramsPoly id terms n = NgramsDB { _ngrams_id :: !id data NgramsPoly id terms n = NgramsDB { _ngrams_id :: !id
, _ngrams_terms :: !terms , _ngrams_terms :: !terms
...@@ -175,15 +174,22 @@ makeLenses ''NgramsT ...@@ -175,15 +174,22 @@ makeLenses ''NgramsT
instance Functor NgramsT where instance Functor NgramsT where
fmap = over ngramsT fmap = over ngramsT
----------------------------------------------------------------------- -----------------------------------------------------------------------
withMap :: Map NgramsTerms NgramsId -> NgramsTerms -> NgramsId withMap :: Map Text NgramsId -> Text -> NgramsId
withMap m n = maybe (panic "withMap: should not happen") identity (lookup n m) withMap m n = maybe (panic "withMap: should not happen") identity (lookup n m)
indexNgramsT :: Map NgramsTerms NgramsId -> NgramsT Ngrams -> NgramsT (Indexed Ngrams) indexNgramsT :: Map Text NgramsId -> NgramsT Ngrams -> NgramsT (Indexed Ngrams)
indexNgramsT = fmap . indexNgramsWith . withMap indexNgramsT = fmap . indexNgramsWith . withMap
indexNgrams :: Map NgramsTerms NgramsId -> Ngrams -> Indexed Ngrams -- | TODO replace NgramsT whith Typed NgramsType Ngrams
indexTypedNgrams :: Map Text NgramsId
-> Typed NgramsType Ngrams
-> Typed NgramsType (Indexed Ngrams)
indexTypedNgrams = fmap . indexNgramsWith . withMap
indexNgrams :: Map Text NgramsId -> Ngrams -> Indexed Ngrams
indexNgrams = indexNgramsWith . withMap indexNgrams = indexNgramsWith . withMap
indexNgramsWith :: (NgramsTerms -> NgramsId) -> Ngrams -> Indexed Ngrams indexNgramsWith :: (Text -> NgramsId) -> Ngrams -> Indexed Ngrams
indexNgramsWith f n = Indexed n (f $ _ngramsTerms n) indexNgramsWith f n = Indexed (f $ _ngramsTerms n) n
...@@ -52,10 +52,7 @@ data PosTag = PosTag { unPosTag :: Text } ...@@ -52,10 +52,7 @@ data PosTag = PosTag { unPosTag :: Text }
type NgramsPostag = NgramsPostagPoly (Maybe Int) Lang PostTagAlgo (Maybe PosTag) NgramsTerm NgramsTerm (Maybe Int) type NgramsPostag = NgramsPostagPoly (Maybe Int) Lang PostTagAlgo (Maybe PosTag) NgramsTerm NgramsTerm (Maybe Int)
type NgramsPostagDB = NgramsPostagPoly (Maybe Int) Int Int (Maybe Text) Int Int Int type NgramsPostagDB = NgramsPostagPoly (Maybe Int) Int Int (Maybe Text) Int Int Int
------------------------------------------------------------------------ ------------------------------------------------------------------------
type NgramsPosTagWrite = NgramsPostagPoly (Maybe (Column PGInt4)) type NgramsPosTagWrite = NgramsPostagPoly (Maybe (Column PGInt4))
(Column PGInt4) (Column PGInt4)
(Column PGInt4) (Column PGInt4)
......
...@@ -22,8 +22,8 @@ import qualified Database.PostgreSQL.Simple as PGS ...@@ -22,8 +22,8 @@ import qualified Database.PostgreSQL.Simple as PGS
-- | Index memory of any type in Gargantext -- | Index memory of any type in Gargantext
type Index = Int type Index = Int
data Indexed a = data Indexed a =
Indexed { _unIndex :: a Indexed { _index :: Index
, _index :: Index , _unIndex :: a
} }
deriving (Show, Generic, Eq, Ord) deriving (Show, Generic, Eq, Ord)
......
...@@ -44,6 +44,7 @@ import Protolude ( Bool(True, False), Int, Int64, Double, Integer ...@@ -44,6 +44,7 @@ import Protolude ( Bool(True, False), Int, Int64, Double, Integer
, Fractional, Num, Maybe(Just,Nothing) , Fractional, Num, Maybe(Just,Nothing)
, Enum, Bounded, Float , Enum, Bounded, Float
, Floating, Char, IO , Floating, Char, IO
, Functor(..)
, pure, (>>=), (=<<), (<*>), (<$>), (<&>), (>>) , pure, (>>=), (=<<), (<*>), (<$>), (<&>), (>>)
, head, flip , head, flip
, Ord, Integral, Foldable, RealFrac, Monad, filter , Ord, Integral, Foldable, RealFrac, Monad, filter
......
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