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