Commit 39826d6a authored by Alexandre Delanoë's avatar Alexandre Delanoë

[REFACT] Indexed type more generic

parent 44100b6d
......@@ -333,9 +333,6 @@ mergeData rs = catMaybes . map toDocumentWithId . Map.toList
<*> Just hpd
------------------------------------------------------------------------
instance HasText HyperdataContact
where
hasText = undefined
------------------------------------------------------------------------
------------------------------------------------------------------------
documentIdWithNgrams :: HasNodeError err
......@@ -363,12 +360,6 @@ instance ExtractNgramsT HyperdataContact
pure $ Map.fromList $ [(a', Map.singleton Authors 1) | a' <- authors ]
instance HasText HyperdataDocument
where
hasText h = catMaybes [ _hd_title h
, _hd_abstract h
]
instance ExtractNgramsT HyperdataDocument
where
......
......@@ -82,7 +82,7 @@ insertDocNgramsOn cId dn =
$ (map (docNgrams2nodeNodeNgrams cId) dn)
insertDocNgrams :: CorpusId
-> Map (Indexed Ngrams) (Map NgramsType (Map NodeId Int))
-> Map (Indexed Int Ngrams) (Map NgramsType (Map NodeId Int))
-> Cmd err Int
insertDocNgrams cId m =
insertDocNgramsOn cId [ DocNgrams n (_index ng) (ngramsTypeId t) (fromIntegral i)
......
......@@ -25,7 +25,7 @@ module Gargantext.Database.Admin.Types.Hyperdata.Contact
import Data.Time.Segment (jour)
import Data.Time (UTCTime)
import Gargantext.Core.Text (HasText(..))
import Gargantext.Database.Admin.Types.Hyperdata.Prelude
import Gargantext.Prelude
......@@ -42,7 +42,9 @@ data HyperdataContact =
} deriving (Eq, Show, Generic)
instance HasText HyperdataContact
where
hasText = undefined
defaultHyperdataContact :: HyperdataContact
defaultHyperdataContact = HyperdataContact (Just "bdd")
......
......@@ -20,11 +20,12 @@ Portability : POSIX
module Gargantext.Database.Admin.Types.Hyperdata.Document where
import Data.Maybe (catMaybes)
import Gargantext.Prelude
import Gargantext.Core.Text (HasText(..))
import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
import Gargantext.Database.Admin.Types.Hyperdata.Prelude
------------------------------------------------------------------------
data HyperdataDocument = HyperdataDocument { _hd_bdd :: !(Maybe Text)
, _hd_doi :: !(Maybe Text)
......@@ -49,6 +50,12 @@ data HyperdataDocument = HyperdataDocument { _hd_bdd :: !(Maybe T
deriving (Show, Generic)
instance HasText HyperdataDocument
where
hasText h = catMaybes [ _hd_title h
, _hd_abstract h
]
defaultHyperdataDocument :: HyperdataDocument
defaultHyperdataDocument = case decode docExample of
Just hp -> hp
......
......@@ -68,7 +68,7 @@ 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]
insertNgrams' :: [Ngrams] -> Cmd err [Indexed Int Text]
insertNgrams' ns = runPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
where
fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
......
......@@ -37,7 +37,7 @@ type NgramsPostagInsert = ( Int
)
insertNgramsPostag :: [NgramsPostagInsert] -> Cmd err [Indexed Text]
insertNgramsPostag :: [NgramsPostagInsert] -> Cmd err [Indexed Int Text]
insertNgramsPostag ns = runPGSQuery queryInsertNgramsPostag (PGS.Only $ Values fields ns)
where
......
......@@ -179,17 +179,17 @@ instance Functor NgramsT where
withMap :: Map Text NgramsId -> Text -> NgramsId
withMap m n = maybe (panic "withMap: should not happen") identity (lookup n m)
indexNgramsT :: Map Text NgramsId -> NgramsT Ngrams -> NgramsT (Indexed Ngrams)
indexNgramsT :: Map Text NgramsId -> NgramsT Ngrams -> NgramsT (Indexed Int Ngrams)
indexNgramsT = fmap . indexNgramsWith . withMap
-- | TODO replace NgramsT whith Typed NgramsType Ngrams
indexTypedNgrams :: Map Text NgramsId
-> Typed NgramsType Ngrams
-> Typed NgramsType (Indexed Ngrams)
-> Typed NgramsType (Indexed Int Ngrams)
indexTypedNgrams = fmap . indexNgramsWith . withMap
indexNgrams :: Map Text NgramsId -> Ngrams -> Indexed Ngrams
indexNgrams :: Map Text NgramsId -> Ngrams -> Indexed Int Ngrams
indexNgrams = indexNgramsWith . withMap
indexNgramsWith :: (Text -> NgramsId) -> Ngrams -> Indexed Ngrams
indexNgramsWith :: (Text -> NgramsId) -> Ngrams -> Indexed Int Ngrams
indexNgramsWith f n = Indexed (f $ _ngramsTerms n) n
......@@ -20,15 +20,14 @@ import qualified Database.PostgreSQL.Simple as PGS
-- | Index memory of any type in Gargantext
type Index = Int
data Indexed a =
Indexed { _index :: Index
data Indexed i a =
Indexed { _index :: i
, _unIndex :: a
}
deriving (Show, Generic, Eq, Ord)
makeLenses ''Indexed
instance (FromField a) => PGS.FromRow (Indexed a) where
instance (FromField i, FromField a) => PGS.FromRow (Indexed i a) where
fromRow = Indexed <$> field <*> field
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