Commit 20e087cf authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Database] Cosmetics.

parent b5925f0d
...@@ -198,8 +198,6 @@ subFlowAnnuaire username _cName = do ...@@ -198,8 +198,6 @@ subFlowAnnuaire username _cName = do
(username, userId, rootId, corpusId) (username, userId, rootId, corpusId)
pure (userId, rootId, corpusId) pure (userId, rootId, corpusId)
------------------------------------------------------------------------ ------------------------------------------------------------------------
toInsert :: [HyperdataDocument] -> Map HashId HyperdataDocument toInsert :: [HyperdataDocument] -> Map HashId HyperdataDocument
toInsert = DM.fromList . map (\d -> (maybe err identity (_hyperdataDocument_uniqId d), d)) toInsert = DM.fromList . map (\d -> (maybe err identity (_hyperdataDocument_uniqId d), d))
...@@ -223,16 +221,12 @@ mergeData rs = catMaybes . map toDocumentWithId . DM.toList ...@@ -223,16 +221,12 @@ mergeData rs = catMaybes . map toDocumentWithId . DM.toList
<*> Just hpd <*> Just hpd
------------------------------------------------------------------------ ------------------------------------------------------------------------
data DocumentIdWithNgrams = data DocumentIdWithNgrams =
DocumentIdWithNgrams DocumentIdWithNgrams
{ documentWithId :: !DocumentWithId { documentWithId :: !DocumentWithId
, document_ngrams :: !(Map (NgramsT Ngrams) Int) , document_ngrams :: !(Map (NgramsT Ngrams) Int)
} deriving (Show) } deriving (Show)
-- TODO add Terms (Title + Abstract)
-- add f :: Text -> Text
-- newtype Ngrams = Ngrams Text
-- TODO group terms -- TODO group terms
extractNgramsT :: HyperdataDocument -> Cmd err (Map (NgramsT Ngrams) Int) extractNgramsT :: HyperdataDocument -> Cmd err (Map (NgramsT Ngrams) Int)
extractNgramsT doc = do extractNgramsT doc = do
...@@ -250,7 +244,6 @@ extractNgramsT doc = do ...@@ -250,7 +244,6 @@ extractNgramsT doc = do
documentIdWithNgrams :: (HyperdataDocument -> Cmd err (Map (NgramsT Ngrams) Int)) documentIdWithNgrams :: (HyperdataDocument -> Cmd err (Map (NgramsT Ngrams) Int))
-> [DocumentWithId] -> Cmd err [DocumentIdWithNgrams] -> [DocumentWithId] -> Cmd err [DocumentIdWithNgrams]
documentIdWithNgrams f = mapM toDocumentIdWithNgrams documentIdWithNgrams f = mapM toDocumentIdWithNgrams
...@@ -272,8 +265,6 @@ indexNgrams ng2nId = do ...@@ -272,8 +265,6 @@ indexNgrams ng2nId = do
terms2id <- insertNgrams (map _ngramsT $ DM.keys ng2nId) terms2id <- insertNgrams (map _ngramsT $ DM.keys ng2nId)
pure $ DM.mapKeys (indexNgramsT terms2id) ng2nId pure $ DM.mapKeys (indexNgramsT terms2id) ng2nId
------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
flowList :: HasNodeError err => UserId -> CorpusId -> Map (NgramsT NgramsIndexed) (Map NodeId Int) -> Cmd err ListId flowList :: HasNodeError err => UserId -> CorpusId -> Map (NgramsT NgramsIndexed) (Map NodeId Int) -> Cmd err ListId
flowList uId cId ngs = do flowList uId cId ngs = do
...@@ -324,6 +315,4 @@ insertLists lId lngs = ...@@ -324,6 +315,4 @@ insertLists lId lngs =
insertNodeNgrams [ NodeNgram Nothing lId ngr (fromIntegral $ listTypeId l) (listTypeId l) insertNodeNgrams [ NodeNgram Nothing lId ngr (fromIntegral $ listTypeId l) (listTypeId l)
| (l,ngr) <- map (second _ngramsId) lngs | (l,ngr) <- map (second _ngramsId) lngs
] ]
------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -62,11 +62,6 @@ nodeError ne = throwError $ _NodeError # ne ...@@ -62,11 +62,6 @@ nodeError ne = throwError $ _NodeError # ne
catchNodeError :: (MonadError e m, HasNodeError e) => m a -> (NodeError -> m a) -> m a catchNodeError :: (MonadError e m, HasNodeError e) => m a -> (NodeError -> m a) -> m a
catchNodeError f g = catchError f (\e -> maybe (throwError e) g (e ^? _NodeError)) catchNodeError f g = catchError f (\e -> maybe (throwError e) g (e ^? _NodeError))
------------------------------------------------------------------------
type AnnuaireId = Int
type DocId = Int
type TypeId = Int
------------------------------------------------------------------------ ------------------------------------------------------------------------
instance FromField HyperdataAny where instance FromField HyperdataAny where
fromField = fromField' fromField = fromField'
...@@ -140,7 +135,6 @@ instance QueryRunnerColumnDefault PGInt4 (Maybe NodeParentId) ...@@ -140,7 +135,6 @@ instance QueryRunnerColumnDefault PGInt4 (Maybe NodeParentId)
queryRunnerColumnDefault = fieldQueryRunnerColumn queryRunnerColumnDefault = fieldQueryRunnerColumn
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- WIP -- WIP
-- TODO Classe HasDefault where -- TODO Classe HasDefault where
-- default NodeType = Hyperdata -- default NodeType = Hyperdata
...@@ -166,7 +160,6 @@ type NodeRead = NodePoly (Column PGInt4 ) ...@@ -166,7 +160,6 @@ type NodeRead = NodePoly (Column PGInt4 )
(Column PGTimestamptz ) (Column PGTimestamptz )
(Column PGJsonb ) (Column PGJsonb )
type NodeReadNull = NodePoly (Column (Nullable PGInt4 )) type NodeReadNull = NodePoly (Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 )) (Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 )) (Column (Nullable PGInt4 ))
...@@ -212,7 +205,6 @@ type NodeSearchRead = NodePolySearch (Column PGInt4 ) ...@@ -212,7 +205,6 @@ type NodeSearchRead = NodePolySearch (Column PGInt4 )
(Column PGJsonb) (Column PGJsonb)
(Column PGTSVector) (Column PGTSVector)
type NodeSearchReadNull = NodePolySearch (Column (Nullable PGInt4 )) type NodeSearchReadNull = NodePolySearch (Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 )) (Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 )) (Column (Nullable PGInt4 ))
...@@ -222,7 +214,6 @@ type NodeSearchReadNull = NodePolySearch (Column (Nullable PGInt4 )) ...@@ -222,7 +214,6 @@ type NodeSearchReadNull = NodePolySearch (Column (Nullable PGInt4 ))
(Column (Nullable PGJsonb)) (Column (Nullable PGJsonb))
(Column (Nullable PGTSVector)) (Column (Nullable PGTSVector))
--{- --{-
nodeTableSearch :: Table NodeSearchWrite NodeSearchRead nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id = optional "id" nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id = optional "id"
...@@ -242,14 +233,12 @@ nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id = optio ...@@ -242,14 +233,12 @@ nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id = optio
queryNodeSearchTable :: Query NodeSearchRead queryNodeSearchTable :: Query NodeSearchRead
queryNodeSearchTable = queryTable nodeTableSearch queryNodeSearchTable = queryTable nodeTableSearch
selectNode :: Column PGInt4 -> Query NodeRead selectNode :: Column PGInt4 -> Query NodeRead
selectNode id = proc () -> do selectNode id = proc () -> do
row <- queryNodeTable -< () row <- queryNodeTable -< ()
restrict -< _node_id row .== id restrict -< _node_id row .== id
returnA -< row returnA -< row
runGetNodes :: Query NodeRead -> Cmd err [NodeAny] runGetNodes :: Query NodeRead -> Cmd err [NodeAny]
runGetNodes = runOpaQuery runGetNodes = runOpaQuery
...@@ -291,20 +280,17 @@ deleteNodes ns = mkCmd $ \conn -> ...@@ -291,20 +280,17 @@ deleteNodes ns = mkCmd $ \conn ->
fromIntegral <$> runDelete conn nodeTable fromIntegral <$> runDelete conn nodeTable
(\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id) (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
-- TODO: NodeType should match with `a' -- TODO: NodeType should match with `a'
getNodesWith :: JSONB a => Int -> proxy a -> Maybe NodeType getNodesWith :: JSONB a => Int -> proxy a -> Maybe NodeType
-> Maybe Offset -> Maybe Limit -> Cmd err [Node a] -> Maybe Offset -> Maybe Limit -> Cmd err [Node a]
getNodesWith parentId _ nodeType maybeOffset maybeLimit = getNodesWith parentId _ nodeType maybeOffset maybeLimit =
runOpaQuery $ selectNodesWith parentId nodeType maybeOffset maybeLimit runOpaQuery $ selectNodesWith parentId nodeType maybeOffset maybeLimit
-- TODO: Why is the second parameter ignored? -- TODO: Why is the second parameter ignored?
-- TODO: Why not use getNodesWith? -- TODO: Why not use getNodesWith?
getNodesWithParentId :: Int -> Maybe Text -> Cmd err [NodeAny] getNodesWithParentId :: Int -> Maybe Text -> Cmd err [NodeAny]
getNodesWithParentId n _ = runOpaQuery $ selectNodesWithParentID n getNodesWithParentId n _ = runOpaQuery $ selectNodesWithParentID n
------------------------------------------------------------------------ ------------------------------------------------------------------------
getDocumentsV3WithParentId :: Int -> Cmd err [Node HyperdataDocumentV3] getDocumentsV3WithParentId :: Int -> Cmd err [Node HyperdataDocumentV3]
getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument) getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument)
...@@ -342,7 +328,6 @@ getNodesWithType :: Column PGInt4 -> Cmd err [Node HyperdataDocument] ...@@ -342,7 +328,6 @@ getNodesWithType :: Column PGInt4 -> Cmd err [Node HyperdataDocument]
getNodesWithType = runOpaQuery . selectNodesWithType getNodesWithType = runOpaQuery . selectNodesWithType
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
defaultUser :: HyperdataUser defaultUser :: HyperdataUser
defaultUser = HyperdataUser (Just $ (pack . show) EN) defaultUser = HyperdataUser (Just $ (pack . show) EN)
...@@ -418,8 +403,6 @@ nodeDashboardW maybeName maybeDashboard pId = node NodeDashboard name dashboard ...@@ -418,8 +403,6 @@ nodeDashboardW maybeName maybeDashboard pId = node NodeDashboard name dashboard
name = maybe "Dashboard" identity maybeName name = maybe "Dashboard" identity maybeName
dashboard = maybe arbitraryDashboard identity maybeDashboard dashboard = maybe arbitraryDashboard identity maybeDashboard
------------------------------------------------------------------------ ------------------------------------------------------------------------
node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite
node nodeType name hyperData parentId userId = Node Nothing (pgInt4 typeId) (pgInt4 userId) (pgInt4 <$> parentId) (pgStrictText name) Nothing (pgJSONB $ cs $ encode hyperData) node nodeType name hyperData parentId userId = Node Nothing (pgInt4 typeId) (pgInt4 userId) (pgInt4 <$> parentId) (pgStrictText name) Nothing (pgJSONB $ cs $ encode hyperData)
......
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