Commit 3321965a authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] Count improving type.

parent 1049ea25
......@@ -23,7 +23,6 @@ library:
- -Werror
exposed-modules:
- Gargantext
- Gargantext.DSL
- Gargantext.Database
- Gargantext.Database.Instances
- Gargantext.Database.Ngram
......@@ -50,7 +49,6 @@ library:
- Gargantext.Parsers.WOS
- Gargantext.Parsers.Date
- Gargantext.Prelude
- Gargantext.RCT
- Gargantext.API
- Gargantext.API.Auth
- Gargantext.Types
......
......@@ -28,6 +28,7 @@ import Prelude (Bounded, Enum, minBound, maxBound)
import Data.Aeson hiding (Error)
import Data.Aeson.TH (deriveJSON)
import Data.Eq (Eq())
import Data.Either
import Data.List (repeat, permutations)
import Data.Swagger
import Data.Text (Text, pack)
......@@ -105,8 +106,6 @@ messages :: [Message]
messages = toMessage $ [ (400, ["Ill formed query "])
, (300, ["API connexion error "])
, (300, ["Internal Gargantext Error "])
, (300, ["Connexion to Gargantext Error"])
, (300, ["Token has expired "])
] <> take 10 ( repeat (200, [""]))
instance Arbitrary Message where
......@@ -117,23 +116,19 @@ instance ToJSON Message
instance ToSchema Message
-----------------------------------------------------------------------
data Counts = Counts [Count]
deriving (Eq, Show, Generic)
data Counts = Counts { results :: [Either Message Count]
} deriving (Eq, Show, Generic)
instance FromJSON Counts
instance ToJSON Counts
instance Arbitrary Counts where
arbitrary = elements $ select
$ map Counts
$ map (\xs -> zipWith (\s (c,m) -> Count s c m) scrapers xs)
$ 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)
arbitrary = elements [Counts [ Right (Count Pubmed (Just 20 ))
, Right (Count IsTex (Just 150))
, Right (Count Hal (Just 150))
]
]
instance ToSchema Counts
......@@ -141,7 +136,6 @@ instance ToSchema Counts
-----------------------------------------------------------------------
data Count = Count { count_name :: Scraper
, count_count :: Maybe Int
, count_message :: Maybe Message
}
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
, module Gargantext.Ngrams.TextMining
, module Gargantext.Ngrams.Metrics
, Ngrams(..), ngrams, occ, sumOcc, text2fis
, NgramsList(..)
--, module Gargantext.Ngrams.Words
) where
......@@ -38,6 +39,7 @@ import Gargantext.Ngrams.Metrics
import qualified Gargantext.Ngrams.FrequentItemSet as FIS
-----------------------------------------------------------------
import Data.List (sort)
import Data.Char (Char, isAlpha, isSpace)
import Data.Text (Text, words, filter, toLower)
import Data.Map.Strict (Map
......@@ -56,14 +58,16 @@ import Gargantext.Prelude hiding (filter)
--import Language.Aspell.Options (ACOption(..))
data NgramsList = Stop | Candidate | Graph
deriving (Show, Eq)
data Ngrams = Ngrams { _ngramsNgrams :: Text
, _ngramsStem :: Text
data Ngrams = Ngrams { _ngramsNgrams :: [Text]
, _ngramsStem :: [Text]
, _ngramsList :: Maybe NgramsList
} deriving (Show)
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 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
-- | Lower case leading character
unCapitalize :: String -> String
unCapitalize [] = []
unCapitalize (c:cs) = toLower c : cs
--unCapitalize (c:cs) = toLower c : cs
unCapitalize cs = map toLower cs
-- | Remove given prefix
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