[DBFLOW] getViewDocument + uniqIdBdd (enables duplicatas from different Database...
[gargantext.git] / src / Gargantext / API / Count.hs
index 314390c77d8f1bf7610fac85f41a2e0944fa0a25..cca261095a9201027f8530dca78afaa8d630e273 100644 (file)
@@ -11,29 +11,38 @@ Count API part of Gargantext.
 -}
 
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-{-# LANGUAGE DataKinds                   #-}
-{-# LANGUAGE TemplateHaskell             #-}
-{-# LANGUAGE TypeOperators               #-}
-{-# LANGUAGE DeriveGeneric               #-}
-{-# LANGUAGE DeriveAnyClass              #-}
-{-# LANGUAGE OverloadedStrings           #-}
+
+{-# LANGUAGE NoImplicitPrelude  #-}
+{-# LANGUAGE DataKinds          #-}
+{-# LANGUAGE TemplateHaskell    #-}
+{-# LANGUAGE TypeOperators      #-}
+{-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE DeriveAnyClass     #-}
+{-# LANGUAGE OverloadedStrings  #-}
 
 module Gargantext.API.Count
       where
 
-import Gargantext.Prelude
 
+import GHC.Generics (Generic)
 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)
+
 import Servant
-import GHC.Generics (Generic)
-import Data.Aeson hiding (Error)
 import Test.QuickCheck.Arbitrary
 import Test.QuickCheck (elements)
-import Data.List (repeat, permutations)
 -- import Control.Applicative ((<*>))
 
+import Gargantext.Prelude
+import Gargantext.Core.Utils.Prefix (unPrefix)
+
 -----------------------------------------------------------------------
 type CountAPI = Post '[JSON] Counts
 
@@ -50,9 +59,9 @@ instance ToJSON   Scraper
 instance Arbitrary Scraper where
     arbitrary = elements scrapers
 
------------------------------------------------------------------------
------------------------------------------------------------------------
+instance ToSchema Scraper
 
+-----------------------------------------------------------------------
 data QueryBool = QueryBool Text
         deriving (Eq, Show, Generic)
 
@@ -65,7 +74,8 @@ instance Arbitrary QueryBool where
 instance FromJSON QueryBool
 instance ToJSON   QueryBool
 
-
+instance ToSchema QueryBool
+-----------------------------------------------------------------------
 
 data Query = Query { query_query :: QueryBool
                    , query_name  :: Maybe [Scraper]
@@ -80,12 +90,13 @@ instance Arbitrary Query where
                          , n <- take 10 $ permutations scrapers
                          ]
 
------------------------------------------------------------------------
+instance ToSchema Query
 -----------------------------------------------------------------------
 type Code = Integer
 type Error  = Text
 type Errors = [Error]
 
+-----------------------------------------------------------------------
 data Message = Message Code Errors
         deriving (Eq, Show, Generic)
 
@@ -96,8 +107,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
@@ -106,39 +115,36 @@ instance Arbitrary Message where
 instance FromJSON Message
 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 [Counts [ Right (Count Pubmed (Just 20 ))
+                                 , Right (Count IsTex  (Just 150))
+                                 , Right (Count Hal    (Just 150))
+                                 ]
+                         ]
+
+instance ToSchema Counts
+
+-----------------------------------------------------------------------
 data Count = Count { count_name    :: Scraper
                    , count_count   :: Maybe Int
-                   , count_message :: Maybe Message
                    }
                    deriving (Eq, Show, Generic)
 
-instance FromJSON Count
-instance ToJSON   Count
---
+$(deriveJSON (unPrefix "count_") ''Count)
+
+instance ToSchema Count
 --instance Arbitrary Count where
 --    arbitrary = Count <$> arbitrary <*> arbitrary <*> arbitrary
 
-
-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)
-
 -----------------------------------------------------------------------
 count :: Query -> Handler Counts
 count _ = undefined