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