Skip to content

H
haskell-gargantext
Commit ee2b59e9 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[FLOW] preparing Hyperdata ToNode instance

parent 898dca82
Hide whitespace changes
Inline Side-by-side
Showing with 72 additions and 27 deletions
src/Gargantext/Core/Flow/Types.hs
View file @ ee2b59e9
......@@ -23,10 +23,11 @@ import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Schema.Ngrams (Ngrams, NgramsType)
import Gargantext.Prelude
import Gargantext.Prelude.Crypto.Hash (Hash)
class UniqId a
where
uniqId :: Lens' a (Maybe HashId)
uniqId :: Lens' a (Maybe Hash)
instance UniqId HyperdataDocument
where
......
src/Gargantext/Core/Text.hs
View file @ ee2b59e9
......@@ -21,7 +21,6 @@ import NLP.FullStop (segment)
import qualified Data.Text as DT
-----------------------------------------------------------------
class HasText h
where
hasText :: h -> [Text]
......
src/Gargantext/Database/Action/Flow.hs
View file @ ee2b59e9
......@@ -49,10 +49,11 @@ import Data.Either
import Data.List (concat)
import qualified Data.Map as Map
import Data.Map (Map, lookup)
import Data.Maybe (Maybe(..), catMaybes)
import Data.Maybe (Maybe(..), catMaybes, fromMaybe)
import Data.Monoid
import Data.Swagger
import Data.Text (splitOn, intercalate)
import Data.Time.Segment (jour)
import Data.Traversable (traverse)
import Data.Tuple.Extra (first, second)
import GHC.Generics (Generic)
......@@ -70,7 +71,7 @@ import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
import Gargantext.Database.Query.Tree.Root (getOrMkRoot, getOrMk_RootWithCorpus)
import Gargantext.Database.Action.Search (searchDocInDatabase)
import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
import Gargantext.Database.Admin.Config (userMaster, corpusMasterName, nodeTypeId)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
......@@ -78,17 +79,20 @@ import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Ngrams
import Gargantext.Database.Query.Table.NodeNgrams (listInsertDb , getCgramsId)
import Gargantext.Database.Query.Table.NodeNodeNgrams2
import Gargantext.Database.Schema.Node (NodePoly(..))
import Gargantext.Core.Ext.IMT (toSchoolName)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Core.Ext.IMTUser (deserialiseImtUsersFromFile)
import Gargantext.Core.Text
import Gargantext.Prelude
import Gargantext.Prelude.Crypto.Hash (Hash)
import Gargantext.Core.Text.Corpus.Parsers (parseFile, FileFormat)
import Gargantext.Core.Text.List (buildNgramsLists,StopSize(..))
import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
import Gargantext.Core.Text.Terms
import qualified Gargantext.Database.Query.Table.Node.Document.Add as Doc (add)
import qualified Gargantext.Core.Text.Corpus.API as API
import qualified Data.Text as DT
------------------------------------------------------------------------
-- TODO use internal with API name (could be old data)
......@@ -242,6 +246,19 @@ insertDocs uId cId hs = do
_ <- Doc.add cId newIds'
pure (newIds', documentsWithId)
{-
-- TODO Maybe NodeId
toNode :: Hyperdata a => NodeType -> ParentId -> UserId -> a -> Node a
toNode NodeDocument p u h = Node 0 "" (nodeTypeId nt) u (Just p) n date h
where
n = maybe "No Title" (DT.take 255) (_hd_title h)
date = jour y m d
y = maybe 0 fromIntegral $ _hd_publication_year h
m = fromMaybe 1 $ _hd_publication_month h
d = fromMaybe 1 $ _hd_publication_day h
toNode _ _ _ _ = undefined
-}
insertMasterDocs :: ( FlowCmdM env err m
, FlowCorpus a
......@@ -254,6 +271,7 @@ insertMasterDocs :: ( FlowCmdM env err m
insertMasterDocs c lang hs = do
(masterUserId, _, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left corpusMasterName) c
(ids', documentsWithId) <- insertDocs masterUserId masterCorpusId hs
-- (ids', documentsWithId) <- insertDocs masterUserId masterCorpusId (map (toNode NodeDocument masterCorpusId masterUserId ) hs )
_ <- Doc.add masterCorpusId ids'
-- TODO
-- create a corpus with database name (CSV or PubMed)
......@@ -292,20 +310,20 @@ insertMasterDocs c lang hs = do
------------------------------------------------------------------------
viewUniqId' :: UniqId a
=> a
-> (HashId, a)
-> (Hash, a)
viewUniqId' d = maybe err (\h -> (h,d)) (view uniqId d)
where
err = panic "[ERROR] Database.Flow.toInsert"
toInserted :: [ReturnId]
-> Map HashId ReturnId
-> Map Hash ReturnId
toInserted =
Map.fromList . map (\r -> (reUniqId r, r) )
. filter (\r -> reInserted r == True)
mergeData :: Map HashId ReturnId
-> Map HashId a
mergeData :: Map Hash ReturnId
-> Map Hash a
-> [DocumentWithId a]
mergeData rs = catMaybes . map toDocumentWithId . Map.toList
where
......@@ -350,6 +368,16 @@ instance HasText HyperdataDocument
, _hd_abstract h
]
instance HasText (Node HyperdataDocument)
where
hasText n = catMaybes [ _hd_title h
, _hd_abstract h
]
where
h = _node_hyperdata n
instance ExtractNgramsT HyperdataDocument
where
extractNgramsT :: TermType Lang
......
src/Gargantext/Database/Action/Flow/Types.hs
View file @ ee2b59e9
......@@ -39,5 +39,6 @@ type FlowCorpus a = ( AddUniqId a
, InsertDb a
, ExtractNgramsT a
, HasText a
-- , ToNode a
)
src/Gargantext/Database/Admin/Types/Node.hs
View file @ ee2b59e9
......@@ -38,6 +38,7 @@ import Servant
import qualified Opaleye as O
import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGInt4, PGTSVector, Nullable, fieldQueryRunnerColumn)
import Test.QuickCheck (elements)
import Gargantext.Prelude.Crypto.Hash (Hash)
import Test.QuickCheck.Arbitrary
import Test.QuickCheck.Instances.Text ()
import Test.QuickCheck.Instances.Time ()
......@@ -51,10 +52,9 @@ import Gargantext.Prelude
type UserId = Int
type MasterUserId = UserId
type HashId = Text
------------------------------------------------------------------------
-- | NodePoly indicates that Node has a Polymorphism Type
type Node json = NodePoly NodeId HashId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
type Node json = NodePoly NodeId Hash NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
-- | NodeSearch (queries)
-- type NodeSearch json = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
......@@ -62,7 +62,7 @@ type Node json = NodePoly NodeId HashId NodeTypeId UserId (Maybe ParentId) Nod
------------------------------------------------------------------------
instance (Typeable hyperdata, ToSchema hyperdata) =>
ToSchema (NodePoly NodeId HashId NodeTypeId
ToSchema (NodePoly NodeId Hash NodeTypeId
(Maybe UserId)
ParentId NodeName
UTCTime hyperdata
......@@ -70,7 +70,7 @@ instance (Typeable hyperdata, ToSchema hyperdata) =>
declareNamedSchema = wellNamedSchema "_node_"
instance (Typeable hyperdata, ToSchema hyperdata) =>
ToSchema (NodePoly NodeId HashId NodeTypeId
ToSchema (NodePoly NodeId Hash NodeTypeId
UserId
(Maybe ParentId) NodeName
UTCTime hyperdata
......@@ -93,12 +93,12 @@ instance (Typeable hyperdata, ToSchema hyperdata) =>
) where
declareNamedSchema = wellNamedSchema "_ns_"
instance (Arbitrary hyperdata
,Arbitrary nodeId
instance (Arbitrary nodeId
,Arbitrary hashId
,Arbitrary nodeTypeId
,Arbitrary userId
,Arbitrary nodeParentId
, Arbitrary hyperdata
) => Arbitrary (NodePoly nodeId hashId nodeTypeId userId nodeParentId
NodeName UTCTime hyperdata) where
--arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
......
src/Gargantext/Database/Query/Table/Node/Document/Insert.hs
View file @ ee2b59e9
......@@ -57,7 +57,7 @@ module Gargantext.Database.Query.Table.Node.Document.Insert
import Control.Lens (set, view)
import Control.Lens.Cons
import Control.Lens.Prism
import Data.Aeson (toJSON{-, ToJSON-})
import Data.Aeson (toJSON, encode{-, ToJSON-})
import Data.Maybe (maybe)
import Data.Text (Text)
-- import Data.ByteString (ByteString)
......@@ -73,22 +73,11 @@ import Gargantext.Database.Admin.Config (nodeTypeId)
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd, runPGSQuery{-, formatPGSQuery-})
import Gargantext.Database.Schema.Node (NodePoly(..))
import Gargantext.Prelude
import Gargantext.Prelude.Crypto.Hash (hash)
import qualified Data.Text as DT (pack, concat, take)
-- TODO : the import of Document constructor below does not work
-- import Gargantext.Database.Types.Node (Document)
--import Gargantext.Database.Types.Node (docExample, hyperdataDocument, HyperdataDocument(..)
-- , hyperdataDocument_uniqId
-- , hyperdataDocument_title
-- , hyperdataDocument_abstract
-- , hyperdataDocument_source
-- , Node(..), node_typename
-- , node_userId
-- , node_parentId, node_name, node_hyperdata, hyperdataDocuments
-- , NodeTypeId
-- )
{-| To Print result query
import Data.ByteString.Internal (ByteString)
import Database.PostgreSQL.Simple (formatQuery)
......@@ -134,6 +123,17 @@ instance InsertDb HyperdataContact
, (toField . toJSON) h
]
instance InsertDb (Node HyperdataDocument)
where
insertDb' _u _p (Node _nid hashId t u p n d h) = [ toField hashId
, toField t
, toField u
, toField p
, toField n
, toField d
, toField h
]
-- | Debug SQL function
--
-- to print rendered query (Debug purpose) use @formatQuery@ function.
......@@ -212,6 +212,22 @@ instance AddUniqId HyperdataDocument
, \d -> maybeText (_hd_source d)
, \d -> maybeText (_hd_publication_date d)
]
-- TODO put this elsewhere (fix bin/gargantext-init/Main.hs too)
secret :: Text
secret = "Database secret to change"
instance AddUniqId (Node HyperdataDocument)
where
addUniqId (Node nid _ t u p n d h) = Node nid hashId t u p n d h
where
hashId = "\\x" <> (hash $ DT.concat params)
params = [ secret
, cs $ show $ nodeTypeId NodeDocument
, n
, cs $ show p
, cs $ encode h
]
---------------------------------------------------------------------------
-- * Uniqueness of document definition
......
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