Commit a1f70708 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] Count improving type.

parent e55d7f3f
...@@ -23,7 +23,6 @@ library: ...@@ -23,7 +23,6 @@ library:
- -Werror - -Werror
exposed-modules: exposed-modules:
- Gargantext - Gargantext
- Gargantext.DSL
- Gargantext.Database - Gargantext.Database
- Gargantext.Database.Instances - Gargantext.Database.Instances
- Gargantext.Database.Ngram - Gargantext.Database.Ngram
...@@ -50,7 +49,6 @@ library: ...@@ -50,7 +49,6 @@ library:
- Gargantext.Parsers.WOS - Gargantext.Parsers.WOS
- Gargantext.Parsers.Date - Gargantext.Parsers.Date
- Gargantext.Prelude - Gargantext.Prelude
- Gargantext.RCT
- Gargantext.API - Gargantext.API
- Gargantext.API.Auth - Gargantext.API.Auth
- Gargantext.Types - Gargantext.Types
......
...@@ -28,6 +28,7 @@ import Prelude (Bounded, Enum, minBound, maxBound) ...@@ -28,6 +28,7 @@ import Prelude (Bounded, Enum, minBound, maxBound)
import Data.Aeson hiding (Error) import Data.Aeson hiding (Error)
import Data.Aeson.TH (deriveJSON) import Data.Aeson.TH (deriveJSON)
import Data.Eq (Eq()) import Data.Eq (Eq())
import Data.Either
import Data.List (repeat, permutations) import Data.List (repeat, permutations)
import Data.Swagger import Data.Swagger
import Data.Text (Text, pack) import Data.Text (Text, pack)
...@@ -105,8 +106,6 @@ messages :: [Message] ...@@ -105,8 +106,6 @@ messages :: [Message]
messages = toMessage $ [ (400, ["Ill formed query "]) messages = toMessage $ [ (400, ["Ill formed query "])
, (300, ["API connexion error "]) , (300, ["API connexion error "])
, (300, ["Internal Gargantext Error "]) , (300, ["Internal Gargantext Error "])
, (300, ["Connexion to Gargantext Error"])
, (300, ["Token has expired "])
] <> take 10 ( repeat (200, [""])) ] <> take 10 ( repeat (200, [""]))
instance Arbitrary Message where instance Arbitrary Message where
...@@ -117,23 +116,19 @@ instance ToJSON Message ...@@ -117,23 +116,19 @@ instance ToJSON Message
instance ToSchema Message instance ToSchema Message
----------------------------------------------------------------------- -----------------------------------------------------------------------
data Counts = Counts [Count] data Counts = Counts { results :: [Either Message Count]
deriving (Eq, Show, Generic) } deriving (Eq, Show, Generic)
instance FromJSON Counts instance FromJSON Counts
instance ToJSON Counts instance ToJSON Counts
instance Arbitrary Counts where instance Arbitrary Counts where
arbitrary = elements $ select arbitrary = elements [Counts [ Right (Count Pubmed (Just 20 ))
$ map Counts , Right (Count IsTex (Just 150))
$ map (\xs -> zipWith (\s (c,m) -> Count s c m) scrapers xs) , Right (Count Hal (Just 150))
$ chunkAlong (length scrapers) 1 $ (map filter' countOrErrors) ]
where ]
select xs = (take 10 xs) <> (take 10 $ drop 100 xs)
countOrErrors = [ (c,e) | c <- [500..1000], e <- reverse messages]
filter' (c,e) = case e of
Message 200 _ -> (Just c , Nothing )
message -> (Nothing, Just message)
instance ToSchema Counts instance ToSchema Counts
...@@ -141,7 +136,6 @@ instance ToSchema Counts ...@@ -141,7 +136,6 @@ instance ToSchema Counts
----------------------------------------------------------------------- -----------------------------------------------------------------------
data Count = Count { count_name :: Scraper data Count = Count { count_name :: Scraper
, count_count :: Maybe Int , count_count :: Maybe Int
, count_message :: Maybe Message
} }
deriving (Eq, Show, Generic) deriving (Eq, Show, Generic)
......
module Gargantext.DSL where
import Data.Text
type Username = Text
type Password = Text
--user :: Username -> Maybe User
--user username = undefined
--
--
--getNode :: Int -> IO Node
--getNode = undefined
--
--saveNode :: Node -> IO ()
--saveNode = undefined
--
--updateNode :: Node -> IO ()
--updateNode = undefined
--
--
--
--
--parents :: Node -> [Node]
--parents = undefined
--
--children :: Node -> [Node]
--children = undefined
--
--
--
-- projects :: User -> [Project]
-- projects u = undefined
...@@ -22,6 +22,7 @@ module Gargantext.Ngrams ( module Gargantext.Ngrams.Letters ...@@ -22,6 +22,7 @@ module Gargantext.Ngrams ( module Gargantext.Ngrams.Letters
, module Gargantext.Ngrams.TextMining , module Gargantext.Ngrams.TextMining
, module Gargantext.Ngrams.Metrics , module Gargantext.Ngrams.Metrics
, Ngrams(..), ngrams, occ, sumOcc, text2fis , Ngrams(..), ngrams, occ, sumOcc, text2fis
, NgramsList(..)
--, module Gargantext.Ngrams.Words --, module Gargantext.Ngrams.Words
) where ) where
...@@ -38,6 +39,7 @@ import Gargantext.Ngrams.Metrics ...@@ -38,6 +39,7 @@ import Gargantext.Ngrams.Metrics
import qualified Gargantext.Ngrams.FrequentItemSet as FIS import qualified Gargantext.Ngrams.FrequentItemSet as FIS
----------------------------------------------------------------- -----------------------------------------------------------------
import Data.List (sort)
import Data.Char (Char, isAlpha, isSpace) import Data.Char (Char, isAlpha, isSpace)
import Data.Text (Text, words, filter, toLower) import Data.Text (Text, words, filter, toLower)
import Data.Map.Strict (Map import Data.Map.Strict (Map
...@@ -56,14 +58,16 @@ import Gargantext.Prelude hiding (filter) ...@@ -56,14 +58,16 @@ import Gargantext.Prelude hiding (filter)
--import Language.Aspell.Options (ACOption(..)) --import Language.Aspell.Options (ACOption(..))
data NgramsList = Stop | Candidate | Graph
deriving (Show, Eq)
data Ngrams = Ngrams { _ngramsNgrams :: Text data Ngrams = Ngrams { _ngramsNgrams :: [Text]
, _ngramsStem :: Text , _ngramsStem :: [Text]
, _ngramsList :: Maybe NgramsList
} deriving (Show) } deriving (Show)
instance Eq Ngrams where instance Eq Ngrams where
Ngrams n1 s1 == Ngrams n2 s2 = n1 == n2 || s1 == s2 Ngrams n1 s1 _ == Ngrams n2 s2 _ = (sort n1) == (sort n2) || (sort s1) == (sort s2)
type Occ = Int type Occ = Int
--type Index = Int --type Index = Int
......
{-|
Module : Gargantext.
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE NoImplicitPrelude #-}
module Gargantext.RCT where
import Gargantext.Prelude
foo :: Int
foo = undefined
--import Data.Text (Text, words)
--import Data.Attoparsec.Text (anyChar, isEndOfLine, Parser, takeTill, many1, endOfLine, space, manyTill)
--import Control.Applicative (many)
-- RCT is the acronym for Referential ConText (of Text)
-- at the begin there was a byte
-- then a char
-- Char -> RCT [Char]
-- then a list of chars called a string, we call it a Form
-- (removing all weird charachters which are not alphanumeric)
-- Form -> RCT Sentence
-- These forms compose the RCT Sentence
-- an ngrams is composed with multiple forms
-- Paragraph = [Sentence]
-- type Title = Paragraph
-- data Block = [Paragraph]
-- Block is taken form Pandoc
-- data Document = [Block]
-- Set of databases
-- Database
-- Set of Articles
-- Article
-- Paragraph (abstract + title)
-- Sentence - Ngrams - Forms
--separateurs :: Parser Text
--separateurs = dropWhile isEndOfLine
--paragraphs :: Parser [Text]
--paragraphs = many paragraph
--
--paragraph :: Parser Text
--paragraph = takeTill isEndOfLine <* many1 endOfLine
--
-- forms :: Text -> [Text]
-- forms = words
-- Right Management
-----------------------------------------------------------------
-- data Management = RolesRights | NodesRights | OperationsRights
-----------------------------------------------------------------
-----------------------------------------------------------------
-- Role Rights Management
-- rights to create roles (group)
-- Node Rights Management
-- rights to read/write Node
-- Operation Rights Management
-- rights for which operations
-----------------------------------------------------------------
-- Roles Rights Management
-----------------------------------------------------------------
-- 2 main roles
-- admin : can create group and assign Node Rights to it
-- user : can not create group and assign Node rights inside his group (if he has the rights)
-- Use cases:
-- if all user are in public and have read/write permissions: everything is free inside the public group
-- else:
-- in X institution x admin can create an gx group or a gy group for each department and assign user to it
-- users y can share with user y withing the group if he has the rights for it
-- an admin can give admin group to a user
-- Roles Rights Management are stored in "User Node"
-- right to read on group called "x" == can share permissions inside group x
-- right to write on group called "x" == can modify group x itself
-- Question: how to manage the hierarchy of roles/groups ?
-- Example: use can create a group inside a group but not outside of it
-----------------------------------------------------------------
-- Node Rights Management
-----------------------------------------------------------------
-- Les actions sur un Node (if /= Graph) depends on the rights of his parent
-- | rightsOf:
-- technically : get the column Node (in table nodes) with rights (ACL)
rightsOf :: Node -> Rights
rightsOf n = undefined
rightsOfNode :: User -> Node -> Rights
rightsOfNode u n = case n of
UserNode -> rightsOf n
ProjectNode -> rightsOf n
CorpusNode -> rightsOf n
GraphNode -> rightsOf n
_ -> rightsOf (parentOf n)
rightsOfNodeNgram :: User -> NodeNgram -> Rights
rightsOfNodeNgram u n = rightsOf n'
where
n' = nodeOf n
rightsOfNodeNgramNgram :: User -> NodeNgramNgram -> Rights
rightsOfNodeNgramNgram u n = rightsOf n'
where
n' = nodeOf n
rightsOfNodeNodeNgram
rightsOfNodeNode
-----------------------------------------------------------------
-- Operation Rights Management
-----------------------------------------------------------------
data Operation = Read | Write
-- Starting with simple case:
-- type ModifyRights = Write
-- type Exec = Write
data Rights = { _rightsRead :: Bool
, _rightsWrite :: Bool
}
deriving (Show, Read, Eq)
data LogRightsMessage = RightsSuccess | RightsError
deriving (Show, Read, Eq)
type Read = Bool
type Write = Bool
-----------------------------------------------------------------
-- | TODO
-- find the tables where there is the relation Node / User / Rights
getRightsOfNodeWithUser :: Node -> User -> IO Rights
getRightsOfNodeWithUser n u = undefined
userCan :: Operation -> User -> Node -> IO Bool
userCan op u n = do
rights <- getRightsOfNodeWithUser u n
r = case op of
Read -> _rightsRead rights
Write -> _rightsWrite rights
pure (r == True)
-- | User can (or can not) give/change rights of the Node
userCanModifyRights :: User -> Node -> IO Bool
userCanModifyRights u n = True `==` <$> userCan Write u n
-- | User can see who has access to the Node
userCanReadRights :: User -> Node -> IO Bool
userCanReadRights u n = True `==` <$> userCan Read u n
chmod :: Rights -> User -> Node -> IO LogRightsMessage
chmod r u n = undefined
chmod' :: Read -> Write -> User -> Node -> IO LogRightsMessage
chmod' r w u n = chmod rights u n
where
rights = Rights r w
readAccessOnly :: User -> Node -> IO LogRightsMessage
readAccessOnly u n = chmod r u n
where
r = Rights True False
stopAccess :: User -> Node -> IO LogRightsMessage
stopAccess =
chmodAll :: Rights -> User -> [Node] -> IO [LogRightsMessage]
chmd b r u ns = map (chmod b r u n) ns
chmodChildren :: Rights -> User -> [Node] -> IO [LogRightsMessage]
chmodChildren b r u n = map (chmod br u n) ns'
where
ns' = childrenOf n
...@@ -21,7 +21,8 @@ unPrefix prefix = defaultOptions ...@@ -21,7 +21,8 @@ unPrefix prefix = defaultOptions
-- | Lower case leading character -- | Lower case leading character
unCapitalize :: String -> String unCapitalize :: String -> String
unCapitalize [] = [] unCapitalize [] = []
unCapitalize (c:cs) = toLower c : cs --unCapitalize (c:cs) = toLower c : cs
unCapitalize cs = map toLower cs
-- | Remove given prefix -- | Remove given prefix
dropPrefix :: String -> String -> String dropPrefix :: String -> String -> String
......
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