Count.hs 4.25 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12
{-|
Module      : Gargantext.API.Count
Description : Server API
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

Count API part of Gargantext.
-}

13 14 15
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeOperators      #-}
{-# LANGUAGE DeriveAnyClass     #-}
16 17 18 19 20

module Gargantext.API.Count
      where

import Data.Aeson hiding (Error)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
21
import Data.Aeson.TH (deriveJSON)
22
import Data.Either
23
import Data.List (permutations)
24
import Data.Swagger
Alexandre Delanoë's avatar
Alexandre Delanoë committed
25
import Data.Text (Text, pack)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
26 27 28
import GHC.Generics (Generic)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Prelude
29
import Servant
Alexandre Delanoë's avatar
Alexandre Delanoë committed
30
import Test.QuickCheck (elements)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
31
import Test.QuickCheck.Arbitrary
Alexandre Delanoë's avatar
Alexandre Delanoë committed
32

Alexandre Delanoë's avatar
Alexandre Delanoë committed
33
-----------------------------------------------------------------------
34 35
-- TODO-ACCESS: CanCount
-- TODO-EVENTS: No events as this is a read only query.
36
type CountAPI = Post '[JSON] Counts
37

Alexandre Delanoë's avatar
Alexandre Delanoë committed
38 39 40
-----------------------------------------------------------------------
data Scraper = Pubmed | Hal | IsTex | Isidore
  deriving (Eq, Show, Generic, Enum, Bounded)
41

Alexandre Delanoë's avatar
Alexandre Delanoë committed
42 43
scrapers :: [Scraper]
scrapers = [minBound..maxBound]
44 45 46 47

instance FromJSON Scraper
instance ToJSON   Scraper

Alexandre Delanoë's avatar
Alexandre Delanoë committed
48 49 50
instance Arbitrary Scraper where
    arbitrary = elements scrapers

51 52
instance ToSchema Scraper

Alexandre Delanoë's avatar
Alexandre Delanoë committed
53 54 55 56 57 58
-----------------------------------------------------------------------
data QueryBool = QueryBool Text
        deriving (Eq, Show, Generic)

queries :: [QueryBool]
queries =  [QueryBool (pack "(X OR X') AND (Y OR Y') NOT (Z OR Z')")]
59
--queries =  [QueryBool (pack "(X + X') * (Y + Y') - (Z + Z')")]
Alexandre Delanoë's avatar
Alexandre Delanoë committed
60 61 62 63 64 65 66

instance Arbitrary QueryBool where
    arbitrary = elements queries

instance FromJSON QueryBool
instance ToJSON   QueryBool

67 68
instance ToSchema QueryBool
-----------------------------------------------------------------------
69

Alexandre Delanoë's avatar
Alexandre Delanoë committed
70
data Query = Query { query_query :: QueryBool
71 72
                   , query_name  :: Maybe [Scraper]
                   }
Alexandre Delanoë's avatar
Alexandre Delanoë committed
73
                   deriving (Eq, Show, Generic)
74 75
instance FromJSON Query
instance ToJSON   Query
76

Alexandre Delanoë's avatar
Alexandre Delanoë committed
77 78 79 80 81 82
instance Arbitrary Query where
    arbitrary = elements [ Query q (Just n) 
                         | q <- queries
                         , n <- take 10 $ permutations scrapers
                         ]

83 84 85
instance ToSchema Query where
  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")

Alexandre Delanoë's avatar
Alexandre Delanoë committed
86
-----------------------------------------------------------------------
87
type Code = Integer
88 89
type Error  = Text
type Errors = [Error]
Alexandre Delanoë's avatar
Alexandre Delanoë committed
90

91
-----------------------------------------------------------------------
92
data Message = Message Code Errors
93
        deriving (Eq, Show, Generic)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
94

95 96
toMessage :: [(Code, Errors)] -> [Message]
toMessage = map (\(c,err) -> Message c err)
97

98 99 100 101
messages :: [Message]
messages =  toMessage $ [ (400, ["Ill formed query             "])
                        , (300, ["API connexion error          "])
                        , (300, ["Internal Gargantext Error    "])
102
                        ] <> take 10 ( repeat (200, [""]))
Alexandre Delanoë's avatar
Alexandre Delanoë committed
103

104 105
instance Arbitrary Message where
    arbitrary = elements messages
Alexandre Delanoë's avatar
Alexandre Delanoë committed
106

107 108
instance FromJSON Message
instance ToJSON   Message
Alexandre Delanoë's avatar
Alexandre Delanoë committed
109

110
instance ToSchema Message
Alexandre Delanoë's avatar
Alexandre Delanoë committed
111
-----------------------------------------------------------------------
112 113 114
data Counts = Counts { results :: [Either Message Count]
                     } deriving (Eq, Show, Generic)

115 116 117 118 119

instance FromJSON Counts
instance ToJSON   Counts

instance Arbitrary Counts where
120 121 122 123 124
    arbitrary = elements [Counts [ Right (Count Pubmed (Just 20 ))
                                 , Right (Count IsTex  (Just 150))
                                 , Right (Count Hal    (Just 150))
                                 ]
                         ]
125

126 127 128 129 130 131 132 133
instance ToSchema Counts

-----------------------------------------------------------------------
data Count = Count { count_name    :: Scraper
                   , count_count   :: Maybe Int
                   }
                   deriving (Eq, Show, Generic)

Alexandre Delanoë's avatar
Alexandre Delanoë committed
134
$(deriveJSON (unPrefix "count_") ''Count)
135

136 137
instance ToSchema Count where
  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "count_")
138 139 140
--instance Arbitrary Count where
--    arbitrary = Count <$> arbitrary <*> arbitrary <*> arbitrary

Alexandre Delanoë's avatar
Alexandre Delanoë committed
141
-----------------------------------------------------------------------
142
count :: Monad m => Query -> m Counts
Alexandre Delanoë's avatar
Alexandre Delanoë committed
143
count _ = undefined