Skip to content

haskell-gargantext
haskell-gargantext
Commit bb0bbdb0 authored by Nicolas Pouillard's avatar Nicolas Pouillard
Browse files
Options

Fix ToSchema instances

parent addc2e44
Hide whitespace changes
Inline Side-by-side
Showing with 215 additions and 180 deletions
src/Gargantext/API/Auth.hs
View file @ bb0bbdb0
...@@ -40,7 +40,7 @@ import Data.Text.Lazy (toStrict) ...@@ -40,7 +40,7 @@ import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Encoding (decodeUtf8) import Data.Text.Lazy.Encoding (decodeUtf8)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Servant.Auth.Server import Servant.Auth.Server
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.API.Settings import Gargantext.API.Settings
import Gargantext.API.Types (HasJoseError(..), joseError) import Gargantext.API.Types (HasJoseError(..), joseError)
import Gargantext.Database.Root (getRoot) import Gargantext.Database.Root (getRoot)
...@@ -115,11 +115,12 @@ auth (AuthRequest u p) = do ...@@ -115,11 +115,12 @@ auth (AuthRequest u p) = do
Valid to trId -> pure $ AuthResponse (Just $ AuthValid to trId) Nothing Valid to trId -> pure $ AuthResponse (Just $ AuthValid to trId) Nothing
newtype AuthenticatedUser = AuthenticatedUser newtype AuthenticatedUser = AuthenticatedUser
{ _au_id :: NodeId { _authUser_id :: NodeId
} deriving (Generic) } deriving (Generic)
$(deriveJSON (unPrefix "_au_") ''AuthenticatedUser) $(deriveJSON (unPrefix "_authUser_") ''AuthenticatedUser)
instance ToSchema AuthenticatedUser instance ToSchema AuthenticatedUser where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authUser_")
instance ToJWT AuthenticatedUser instance ToJWT AuthenticatedUser
instance FromJWT AuthenticatedUser instance FromJWT AuthenticatedUser
...@@ -141,7 +142,8 @@ authCheck _env (BasicAuthData login password) = pure $ ...@@ -141,7 +142,8 @@ authCheck _env (BasicAuthData login password) = pure $
-- | Instances -- | Instances
$(deriveJSON (unPrefix "_authReq_") ''AuthRequest) $(deriveJSON (unPrefix "_authReq_") ''AuthRequest)
instance ToSchema AuthRequest -- TODO-SWAGGER unPrefix instance ToSchema AuthRequest where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authReq_")
instance Arbitrary AuthRequest where instance Arbitrary AuthRequest where
arbitrary = elements [ AuthRequest u p arbitrary = elements [ AuthRequest u p
...@@ -150,20 +152,23 @@ instance Arbitrary AuthRequest where ...@@ -150,20 +152,23 @@ instance Arbitrary AuthRequest where
] ]
$(deriveJSON (unPrefix "_authRes_") ''AuthResponse) $(deriveJSON (unPrefix "_authRes_") ''AuthResponse)
instance ToSchema AuthResponse -- TODO-SWAGGER unPrefix instance ToSchema AuthResponse where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authRes_")
instance Arbitrary AuthResponse where instance Arbitrary AuthResponse where
arbitrary = oneof [ AuthResponse Nothing . Just <$> arbitrary arbitrary = oneof [ AuthResponse Nothing . Just <$> arbitrary
, flip AuthResponse Nothing . Just <$> arbitrary ] , flip AuthResponse Nothing . Just <$> arbitrary ]
$(deriveJSON (unPrefix "_authInv_") ''AuthInvalid) $(deriveJSON (unPrefix "_authInv_") ''AuthInvalid)
instance ToSchema AuthInvalid -- TODO-SWAGGER unPrefix instance ToSchema AuthInvalid where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authInv_")
instance Arbitrary AuthInvalid where instance Arbitrary AuthInvalid where
arbitrary = elements [ AuthInvalid m arbitrary = elements [ AuthInvalid m
| m <- [ "Invalid user", "Invalid password"] | m <- [ "Invalid user", "Invalid password"]
] ]
$(deriveJSON (unPrefix "_authVal_") ''AuthValid) $(deriveJSON (unPrefix "_authVal_") ''AuthValid)
instance ToSchema AuthValid -- TODO-SWAGGER unPrefix instance ToSchema AuthValid where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authVal_")
instance Arbitrary AuthValid where instance Arbitrary AuthValid where
arbitrary = elements [ AuthValid to tr arbitrary = elements [ AuthValid to tr
| to <- ["token0", "token1"] | to <- ["token0", "token1"]
......
src/Gargantext/API/Corpus/New.hs
View file @ bb0bbdb0
...@@ -30,7 +30,7 @@ import Data.Aeson.TH (deriveJSON) ...@@ -30,7 +30,7 @@ import Data.Aeson.TH (deriveJSON)
import Data.Swagger import Data.Swagger
import Data.Text (Text) import Data.Text (Text)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Database.Flow (flowCorpusSearchInDatabase) import Gargantext.Database.Flow (flowCorpusSearchInDatabase)
import Gargantext.Database.Types.Node (CorpusId) import Gargantext.Database.Types.Node (CorpusId)
import Gargantext.Text.Terms (TermType(..)) import Gargantext.Text.Terms (TermType(..))
...@@ -60,9 +60,7 @@ instance Arbitrary Query where ...@@ -60,9 +60,7 @@ instance Arbitrary Query where
] ]
instance ToSchema Query where instance ToSchema Query where
declareNamedSchema = declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")
genericDeclareNamedSchema
defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 6 fieldLabel}
type Api = Summary "New Corpus endpoint" type Api = Summary "New Corpus endpoint"
:> ReqBody '[JSON] Query :> ReqBody '[JSON] Query
......
src/Gargantext/API/Count.hs
View file @ bb0bbdb0
...@@ -41,7 +41,7 @@ import Test.QuickCheck (elements) ...@@ -41,7 +41,7 @@ import Test.QuickCheck (elements)
-- import Control.Applicative ((<*>)) -- import Control.Applicative ((<*>))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
----------------------------------------------------------------------- -----------------------------------------------------------------------
-- TODO-ACCESS: CanCount -- TODO-ACCESS: CanCount
...@@ -93,7 +93,9 @@ instance Arbitrary Query where ...@@ -93,7 +93,9 @@ instance Arbitrary Query where
, n <- take 10 $ permutations scrapers , n <- take 10 $ permutations scrapers
] ]
instance ToSchema Query instance ToSchema Query where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")
----------------------------------------------------------------------- -----------------------------------------------------------------------
type Code = Integer type Code = Integer
type Error = Text type Error = Text
...@@ -144,7 +146,8 @@ data Count = Count { count_name :: Scraper ...@@ -144,7 +146,8 @@ data Count = Count { count_name :: Scraper
$(deriveJSON (unPrefix "count_") ''Count) $(deriveJSON (unPrefix "count_") ''Count)
instance ToSchema Count instance ToSchema Count where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "count_")
--instance Arbitrary Count where --instance Arbitrary Count where
-- arbitrary = Count <$> arbitrary <*> arbitrary <*> arbitrary -- arbitrary = Count <$> arbitrary <*> arbitrary <*> arbitrary
......
src/Gargantext/API/Metrics.hs
View file @ bb0bbdb0
...@@ -31,7 +31,7 @@ import Data.Time (UTCTime) ...@@ -31,7 +31,7 @@ import Data.Time (UTCTime)
import Data.Text (Text) import Data.Text (Text)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.Core.Types (ListType(..)) import Gargantext.Core.Types (ListType(..))
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Database.Utils import Gargantext.Database.Utils
import Gargantext.Core.Types (CorpusId, ListId, Limit) import Gargantext.Core.Types (CorpusId, ListId, Limit)
import Gargantext.Prelude import Gargantext.Prelude
...@@ -50,7 +50,8 @@ data Metrics = Metrics ...@@ -50,7 +50,8 @@ data Metrics = Metrics
{ metrics_data :: [Metric]} { metrics_data :: [Metric]}
deriving (Generic, Show) deriving (Generic, Show)
instance ToSchema Metrics instance ToSchema Metrics where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "metrics_")
instance Arbitrary Metrics instance Arbitrary Metrics
where where
arbitrary = Metrics <$> arbitrary arbitrary = Metrics <$> arbitrary
...@@ -62,7 +63,8 @@ data Metric = Metric ...@@ -62,7 +63,8 @@ data Metric = Metric
, m_cat :: !ListType , m_cat :: !ListType
} deriving (Generic, Show) } deriving (Generic, Show)
instance ToSchema Metric instance ToSchema Metric where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "m_")
instance Arbitrary Metric instance Arbitrary Metric
where where
arbitrary = Metric <$> arbitrary arbitrary = Metric <$> arbitrary
...@@ -78,7 +80,8 @@ deriveJSON (unPrefix "m_") ''Metric ...@@ -78,7 +80,8 @@ deriveJSON (unPrefix "m_") ''Metric
data ChartMetrics a = ChartMetrics { chartMetrics_data :: a } data ChartMetrics a = ChartMetrics { chartMetrics_data :: a }
deriving (Generic, Show) deriving (Generic, Show)
instance (ToSchema a) => ToSchema (ChartMetrics a) instance (ToSchema a) => ToSchema (ChartMetrics a) where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "chartMetrics_")
instance (Arbitrary a) => Arbitrary (ChartMetrics a) instance (Arbitrary a) => Arbitrary (ChartMetrics a)
where where
arbitrary = ChartMetrics <$> arbitrary arbitrary = ChartMetrics <$> arbitrary
...@@ -86,7 +89,8 @@ instance (Arbitrary a) => Arbitrary (ChartMetrics a) ...@@ -86,7 +89,8 @@ instance (Arbitrary a) => Arbitrary (ChartMetrics a)
deriveJSON (unPrefix "chartMetrics_") ''ChartMetrics deriveJSON (unPrefix "chartMetrics_") ''ChartMetrics
------------------------------------------------------------- -------------------------------------------------------------
instance ToSchema Histo instance ToSchema Histo where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "histo_")
instance Arbitrary Histo instance Arbitrary Histo
where where
arbitrary = elements [ Histo ["2012"] [1] arbitrary = elements [ Histo ["2012"] [1]
...@@ -95,11 +99,6 @@ instance Arbitrary Histo ...@@ -95,11 +99,6 @@ instance Arbitrary Histo
deriveJSON (unPrefix "histo_") ''Histo deriveJSON (unPrefix "histo_") ''Histo
instance ToSchema MyTree
instance Arbitrary MyTree
where
arbitrary = MyTree <$> arbitrary <*> arbitrary <*> arbitrary
------------------------------------------------------------- -------------------------------------------------------------
-- | Scatter metrics API -- | Scatter metrics API
......
src/Gargantext/API/Ngrams.hs
View file @ bb0bbdb0
...@@ -116,7 +116,7 @@ import Data.Swagger hiding (version, patch) ...@@ -116,7 +116,7 @@ import Data.Swagger hiding (version, patch)
import Data.Text (Text, isInfixOf, count) import Data.Text (Text, isInfixOf, count)
import Data.Validity import Data.Validity
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-- import Gargantext.Database.Schema.Ngrams (NgramsTypeId, ngramsTypeId, NgramsTableData(..)) -- import Gargantext.Database.Schema.Ngrams (NgramsTypeId, ngramsTypeId, NgramsTableData(..))
import Gargantext.Database.Config (userMaster) import Gargantext.Database.Config (userMaster)
import Gargantext.Database.Metrics.NgramsByNode (getOccByNgramsOnlyFast) import Gargantext.Database.Metrics.NgramsByNode (getOccByNgramsOnlyFast)
...@@ -255,7 +255,8 @@ mkNgramsElement ngrams list rp children = ...@@ -255,7 +255,8 @@ mkNgramsElement ngrams list rp children =
newNgramsElement :: Maybe ListType -> NgramsTerm -> NgramsElement newNgramsElement :: Maybe ListType -> NgramsTerm -> NgramsElement
newNgramsElement mayList ngrams = mkNgramsElement ngrams (fromMaybe GraphTerm mayList) Nothing mempty newNgramsElement mayList ngrams = mkNgramsElement ngrams (fromMaybe GraphTerm mayList) Nothing mempty
instance ToSchema NgramsElement instance ToSchema NgramsElement where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ne_")
instance Arbitrary NgramsElement where instance Arbitrary NgramsElement where
arbitrary = elements [newNgramsElement Nothing "sport"] arbitrary = elements [newNgramsElement Nothing "sport"]
...@@ -509,7 +510,8 @@ data NgramsPatch = ...@@ -509,7 +510,8 @@ data NgramsPatch =
deriveJSON (unPrefix "_") ''NgramsPatch deriveJSON (unPrefix "_") ''NgramsPatch
makeLenses ''NgramsPatch makeLenses ''NgramsPatch
instance ToSchema NgramsPatch instance ToSchema NgramsPatch where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_")
instance Arbitrary NgramsPatch where instance Arbitrary NgramsPatch where
arbitrary = NgramsPatch <$> arbitrary <*> (replace <$> arbitrary <*> arbitrary) arbitrary = NgramsPatch <$> arbitrary <*> (replace <$> arbitrary <*> arbitrary)
...@@ -644,7 +646,8 @@ data Versioned a = Versioned ...@@ -644,7 +646,8 @@ data Versioned a = Versioned
deriving (Generic, Show) deriving (Generic, Show)
deriveJSON (unPrefix "_v_") ''Versioned deriveJSON (unPrefix "_v_") ''Versioned
makeLenses ''Versioned makeLenses ''Versioned
instance ToSchema a => ToSchema (Versioned a) instance ToSchema a => ToSchema (Versioned a) where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_v_")
instance Arbitrary a => Arbitrary (Versioned a) where instance Arbitrary a => Arbitrary (Versioned a) where
arbitrary = Versioned 1 <$> arbitrary -- TODO 1 is constant so far arbitrary = Versioned 1 <$> arbitrary -- TODO 1 is constant so far
......
src/Gargantext/API/Ngrams/NTree.hs
View file @ bb0bbdb0
...@@ -23,16 +23,18 @@ import Data.Text (Text) ...@@ -23,16 +23,18 @@ import Data.Text (Text)
import Gargantext.Prelude import Gargantext.Prelude
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Data.Aeson.TH (deriveJSON) import Data.Aeson.TH (deriveJSON)
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Core.Types (ListType(..), NodeId) import Gargantext.Core.Types (ListType(..), NodeId)
import Gargantext.API.Ngrams import Gargantext.API.Ngrams
import Data.Tree import Data.Tree
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Data.Map (Map) import Data.Map (Map)
import Data.Set (Set) import Data.Set (Set)
import Data.Swagger
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.List as List import qualified Data.List as List
import Test.QuickCheck
type Children = Text type Children = Text
type Root = Text type Root = Text
...@@ -47,12 +49,17 @@ toMyTree (Node (l,v) xs) = MyTree l v (map toMyTree xs) ...@@ -47,12 +49,17 @@ toMyTree (Node (l,v) xs) = MyTree l v (map toMyTree xs)
deriveJSON (unPrefix "mt_") ''MyTree deriveJSON (unPrefix "mt_") ''MyTree
instance ToSchema MyTree where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "mt_")
instance Arbitrary MyTree
where
arbitrary = MyTree <$> arbitrary <*> arbitrary <*> arbitrary
toTree :: ListType -> Map Text (Set NodeId) -> Map Text NgramsRepoElement -> [MyTree] toTree :: ListType -> Map Text (Set NodeId) -> Map Text NgramsRepoElement -> [MyTree]
toTree lt vs m = map toMyTree $ unfoldForest buildNode roots toTree lt vs m = map toMyTree $ unfoldForest buildNode roots
where where
buildNode r = maybe ((r, value r),[]) (\x -> ((r, value r), mSetToList $ _nre_children x)) (Map.lookup r m) buildNode r = maybe ((r, value r),[]) (\x -> ((r, value r), mSetToList $ _nre_children x)) (Map.lookup r m)
value l = maybe 0 (fromIntegral . Set.size) $ Map.lookup l vs value l = maybe 0 (fromIntegral . Set.size) $ Map.lookup l vs
rootsCandidates = catMaybes rootsCandidates = catMaybes
...@@ -60,7 +67,7 @@ toTree lt vs m = map toMyTree $ unfoldForest buildNode roots ...@@ -60,7 +67,7 @@ toTree lt vs m = map toMyTree $ unfoldForest buildNode roots
$ map (\(c,c') -> case _nre_root c' of $ map (\(c,c') -> case _nre_root c' of
Nothing -> Just c Nothing -> Just c
_ -> _nre_root c' ) (Map.toList m) _ -> _nre_root c' ) (Map.toList m)
roots = map fst roots = map fst
$ filter (\(_,l) -> l == lt) $ filter (\(_,l) -> l == lt)
$ catMaybes $ catMaybes
......
src/Gargantext/API/Node.hs
View file @ bb0bbdb0
...@@ -207,6 +207,7 @@ nodeAPI p uId id = hoistServer (Proxy :: Proxy (NodeAPI a)) (withAccess uId id) ...@@ -207,6 +207,7 @@ nodeAPI p uId id = hoistServer (Proxy :: Proxy (NodeAPI a)) (withAccess uId id)
data RenameNode = RenameNode { r_name :: Text } data RenameNode = RenameNode { r_name :: Text }
deriving (Generic) deriving (Generic)
-- TODO unPrefix "r_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON RenameNode instance FromJSON RenameNode
instance ToJSON RenameNode instance ToJSON RenameNode
instance ToSchema RenameNode instance ToSchema RenameNode
...@@ -217,6 +218,7 @@ data PostNode = PostNode { pn_name :: Text ...@@ -217,6 +218,7 @@ data PostNode = PostNode { pn_name :: Text
, pn_typename :: NodeType} , pn_typename :: NodeType}
deriving (Generic) deriving (Generic)
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON PostNode instance FromJSON PostNode
instance ToJSON PostNode instance ToJSON PostNode
instance ToSchema PostNode instance ToSchema PostNode
...@@ -233,6 +235,7 @@ data NodesToCategory = NodesToCategory { ntc_nodesId :: [NodeId] ...@@ -233,6 +235,7 @@ data NodesToCategory = NodesToCategory { ntc_nodesId :: [NodeId]
} }
deriving (Generic) deriving (Generic)
-- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON NodesToCategory instance FromJSON NodesToCategory
instance ToJSON NodesToCategory instance ToJSON NodesToCategory
instance ToSchema NodesToCategory instance ToSchema NodesToCategory
......
src/Gargantext/API/Search.hs
View file @ bb0bbdb0
...@@ -35,7 +35,7 @@ import Test.QuickCheck (elements) ...@@ -35,7 +35,7 @@ import Test.QuickCheck (elements)
-- import Control.Applicative ((<*>)) -- import Control.Applicative ((<*>))
import Gargantext.API.Types (GargServer) import Gargantext.API.Types (GargServer)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Database.Types.Node import Gargantext.Database.Types.Node
import Gargantext.Database.TextSearch import Gargantext.Database.TextSearch
import Gargantext.Database.Facet import Gargantext.Database.Facet
...@@ -48,9 +48,7 @@ data SearchQuery = SearchQuery ...@@ -48,9 +48,7 @@ data SearchQuery = SearchQuery
$(deriveJSON (unPrefix "sq_") ''SearchQuery) $(deriveJSON (unPrefix "sq_") ''SearchQuery)
instance ToSchema SearchQuery where instance ToSchema SearchQuery where
declareNamedSchema = declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "sq_")
genericDeclareNamedSchema
defaultSchemaOptions {fieldLabelModifier = drop 3}
instance Arbitrary SearchQuery where instance Arbitrary SearchQuery where
arbitrary = elements [SearchQuery ["electrodes"]] arbitrary = elements [SearchQuery ["electrodes"]]
...@@ -64,9 +62,7 @@ instance Arbitrary SearchDocResults where ...@@ -64,9 +62,7 @@ instance Arbitrary SearchDocResults where
arbitrary = SearchDocResults <$> arbitrary arbitrary = SearchDocResults <$> arbitrary
instance ToSchema SearchDocResults where instance ToSchema SearchDocResults where
declareNamedSchema = declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "sdr_")
genericDeclareNamedSchema
defaultSchemaOptions {fieldLabelModifier = drop 4}
data SearchPairedResults = SearchPairedResults { spr_results :: [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]] } data SearchPairedResults = SearchPairedResults { spr_results :: [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]] }
deriving (Generic) deriving (Generic)
...@@ -76,9 +72,7 @@ instance Arbitrary SearchPairedResults where ...@@ -76,9 +72,7 @@ instance Arbitrary SearchPairedResults where
arbitrary = SearchPairedResults <$> arbitrary arbitrary = SearchPairedResults <$> arbitrary
instance ToSchema SearchPairedResults where instance ToSchema SearchPairedResults where
declareNamedSchema = declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "spr_")
genericDeclareNamedSchema
defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
----------------------------------------------------------------------- -----------------------------------------------------------------------
-- TODO-ACCESS: CanSearch? or is it part of CanGetNode -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
......
src/Gargantext/API/Table.hs
View file @ bb0bbdb0
...@@ -45,7 +45,7 @@ import Data.Text (Text()) ...@@ -45,7 +45,7 @@ import Data.Text (Text())
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.API.Ngrams (TabType(..)) import Gargantext.API.Ngrams (TabType(..))
import Gargantext.Core.Types (Offset, Limit) import Gargantext.Core.Types (Offset, Limit)
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..),runViewAuthorsDoc) import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..),runViewAuthorsDoc)
import Gargantext.Database.Learn (FavOrTrash(..), moreLike) import Gargantext.Database.Learn (FavOrTrash(..), moreLike)
import Gargantext.Database.TextSearch import Gargantext.Database.TextSearch
...@@ -73,9 +73,7 @@ data TableQuery = TableQuery ...@@ -73,9 +73,7 @@ data TableQuery = TableQuery
$(deriveJSON (unPrefix "tq_") ''TableQuery) $(deriveJSON (unPrefix "tq_") ''TableQuery)
instance ToSchema TableQuery where instance ToSchema TableQuery where
declareNamedSchema = declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "tq_")
genericDeclareNamedSchema
defaultSchemaOptions {fieldLabelModifier = drop 3}
instance Arbitrary TableQuery where instance Arbitrary TableQuery where
arbitrary = elements [TableQuery 0 10 DateAsc Docs "electrodes"] arbitrary = elements [TableQuery 0 10 DateAsc Docs "electrodes"]
......
src/Gargantext/API/Utils.hs
View file @ bb0bbdb0
...@@ -21,22 +21,6 @@ import Gargantext.Prelude ...@@ -21,22 +21,6 @@ import Gargantext.Prelude
import Data.Maybe (Maybe, fromMaybe) import Data.Maybe (Maybe, fromMaybe)
import Prelude (String) import Prelude (String)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Swagger
import Data.Text (Text)
swaggerOptions :: Text -> SchemaOptions
swaggerOptions pref = defaultSchemaOptions
{ Data.Swagger.fieldLabelModifier = modifier pref
, Data.Swagger.unwrapUnaryRecords = False
}
modifier :: Text -> String -> String
modifier pref field = T.unpack
$ T.stripPrefix pref (T.pack field) ?! "Expecting prefix " <> T.unpack pref
infixr 4 ?| infixr 4 ?|
......
src/Gargantext/Core/Types/Main.hs
View file @ bb0bbdb0
...@@ -22,8 +22,7 @@ module Gargantext.Core.Types.Main where ...@@ -22,8 +22,7 @@ module Gargantext.Core.Types.Main where
------------------------------------------------------------------------ ------------------------------------------------------------------------
import Prelude (Enum, Bounded, minBound, maxBound) import Prelude (Enum, Bounded, minBound, maxBound)
import Data.Aeson (FromJSON, ToJSON, toJSON) import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson as A
import Data.Aeson.TH (deriveJSON) import Data.Aeson.TH (deriveJSON)
import Data.Map (fromList, lookup) import Data.Map (fromList, lookup)
import Data.Either (Either(..)) import Data.Either (Either(..))
...@@ -33,7 +32,7 @@ import Data.Text (Text, unpack) ...@@ -33,7 +32,7 @@ import Data.Text (Text, unpack)
import Data.Swagger import Data.Swagger
import Gargantext.Database.Types.Node -- (NodeType(..), Node, Hyperdata(..)) import Gargantext.Database.Types.Node -- (NodeType(..), Node, Hyperdata(..))
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Prelude import Gargantext.Prelude
import GHC.Generics (Generic) import GHC.Generics (Generic)
...@@ -49,36 +48,10 @@ data NodeTree = NodeTree { _nt_name :: Text ...@@ -49,36 +48,10 @@ data NodeTree = NodeTree { _nt_name :: Text
} deriving (Show, Read, Generic) } deriving (Show, Read, Generic)
$(deriveJSON (unPrefix "_nt_") ''NodeTree) $(deriveJSON (unPrefix "_nt_") ''NodeTree)
instance ToSchema NodeTree where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_nt_")
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- Garg Network is a network of all Garg nodes
--gargNetwork = undefined
-- | Garg Node is Database Schema Typed as specification
-- gargNode gathers all the Nodes of all users on one Node
gargNode :: [Tree NodeTree]
gargNode = [userTree]
-- | User Tree simplified
userTree :: Tree NodeTree
userTree = TreeN (NodeTree "user name" NodeUser 1) [annuaireTree, projectTree]
-- | Project Tree
projectTree :: Tree NodeTree
projectTree = TreeN (NodeTree "Project CNRS/IMT" NodeFolder 2) [corpusTree 10 "A", corpusTree 20 "B"]
-- | Corpus Tree
annuaireTree :: Tree NodeTree
annuaireTree = (leafT $ NodeTree "Annuaire" NodeAnnuaire 41)
corpusTree :: NodeId -> Text -> Tree NodeTree
corpusTree nId t = TreeN (NodeTree ("Corpus " <> t) NodeCorpus nId) ( [ leafT $ NodeTree "Dashboard" NodeDashboard (nId +1)
, leafT $ NodeTree "Graph" NodeGraph (nId +2)
]
-- <> [ leafT $ NodeTree "My lists" Lists 5]
-- <> [ leafT (NodeTree "Metrics A" Metrics 6) ]
-- <> [ leafT (NodeTree "Class A" Classification 7)]
)
--data Classification = Favorites | MyClassifcation --data Classification = Favorites | MyClassifcation
...@@ -127,17 +100,14 @@ type IsTrash = Bool ...@@ -127,17 +100,14 @@ type IsTrash = Bool
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- All the Database is structred like a hierarchical Tree -- All the Database is structred like a hierarchical Tree
data Tree a = TreeN a [Tree a] data Tree a = TreeN { _tn_node :: a, _tn_children :: [Tree a] }
deriving (Show, Read, Eq, Generic, Ord) deriving (Show, Read, Eq, Generic, Ord)
instance ToJSON a => ToJSON (Tree a) where $(deriveJSON (unPrefix "_tn_") ''Tree)
toJSON (TreeN node nodes) =
object ["node" A..= toJSON node, "children" A..= toJSON nodes]
instance FromJSON a => FromJSON (Tree a) instance ToSchema a => ToSchema (Tree a) where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_tn_")
instance ToSchema NodeTree
instance ToSchema a => ToSchema (Tree a)
instance Arbitrary (Tree NodeTree) where instance Arbitrary (Tree NodeTree) where
arbitrary = elements [userTree, userTree] arbitrary = elements [userTree, userTree]
...@@ -146,3 +116,33 @@ instance Arbitrary (Tree NodeTree) where ...@@ -146,3 +116,33 @@ instance Arbitrary (Tree NodeTree) where
-- same as Data.Tree -- same as Data.Tree
leafT :: a -> Tree a leafT :: a -> Tree a
leafT x = TreeN x [] leafT x = TreeN x []
------------------------------------------------------------------------
-- Garg Network is a network of all Garg nodes
--gargNetwork = undefined
-- | Garg Node is Database Schema Typed as specification
-- gargNode gathers all the Nodes of all users on one Node
gargNode :: [Tree NodeTree]
gargNode = [userTree]
-- | User Tree simplified
userTree :: Tree NodeTree
userTree = TreeN (NodeTree "user name" NodeUser 1) [annuaireTree, projectTree]
-- | Project Tree
projectTree :: Tree NodeTree
projectTree = TreeN (NodeTree "Project CNRS/IMT" NodeFolder 2) [corpusTree 10 "A", corpusTree 20 "B"]
-- | Corpus Tree
annuaireTree :: Tree NodeTree
annuaireTree = (leafT $ NodeTree "Annuaire" NodeAnnuaire 41)
corpusTree :: NodeId -> Text -> Tree NodeTree
corpusTree nId t = TreeN (NodeTree ("Corpus " <> t) NodeCorpus nId) ( [ leafT $ NodeTree "Dashboard" NodeDashboard (nId +1)
, leafT $ NodeTree "Graph" NodeGraph (nId +2)
]
-- <> [ leafT $ NodeTree "My lists" Lists 5]
-- <> [ leafT (NodeTree "Metrics A" Metrics 6) ]
-- <> [ leafT (NodeTree "Class A" Classification 7)]
)
src/Gargantext/Core/Types/Phylo.hs
View file @ bb0bbdb0
...@@ -25,15 +25,18 @@ Phylomemy was first described in Chavalarias, D., Cointet, J.-P., 2013. Phylomem ...@@ -25,15 +25,18 @@ Phylomemy was first described in Chavalarias, D., Cointet, J.-P., 2013. Phylomem
module Gargantext.Core.Types.Phylo where module Gargantext.Core.Types.Phylo where
import Control.Lens (makeLenses)
import Data.Aeson.TH (deriveJSON) import Data.Aeson.TH (deriveJSON)
import Data.Maybe (Maybe) import Data.Maybe (Maybe)
import Data.Swagger
import Data.Text (Text) import Data.Text (Text)
import Data.Time.Clock.POSIX (POSIXTime) import Data.Time.Clock.POSIX (POSIXTime)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Phylo datatype descriptor of a phylomemy -- | Phylo datatype descriptor of a phylomemy
...@@ -94,8 +97,24 @@ type PhyloGroupId = (PhyloLevelId, Int) ...@@ -94,8 +97,24 @@ type PhyloGroupId = (PhyloLevelId, Int)
type Edge = (PhyloGroupId, Weight) type Edge = (PhyloGroupId, Weight)
type Weight = Double type Weight = Double
-- | Lenses
makeLenses ''Phylo
makeLenses ''PhyloPeriod
makeLenses ''PhyloLevel
makeLenses ''PhyloGroup
-- | JSON instances -- | JSON instances
$(deriveJSON (unPrefix "_phylo_" ) ''Phylo ) $(deriveJSON (unPrefix "_phylo_" ) ''Phylo )
$(deriveJSON (unPrefix "_phylo_Period" ) ''PhyloPeriod ) $(deriveJSON (unPrefix "_phylo_Period" ) ''PhyloPeriod )
$(deriveJSON (unPrefix "_phylo_Level" ) ''PhyloLevel ) $(deriveJSON (unPrefix "_phylo_Level" ) ''PhyloLevel )
$(deriveJSON (unPrefix "_phylo_Group" ) ''PhyloGroup ) $(deriveJSON (unPrefix "_phylo_Group" ) ''PhyloGroup )
-- | ToSchema instances
instance ToSchema Phylo where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_")
instance ToSchema PhyloPeriod where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_Period")
instance ToSchema PhyloLevel where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_Level")
instance ToSchema PhyloGroup where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_Group")
src/Gargantext/Core/Utils/Prefix.hs
View file @ bb0bbdb0
...@@ -22,6 +22,7 @@ import Data.Aeson.TH (Options, fieldLabelModifier, omitNothingFields) ...@@ -22,6 +22,7 @@ import Data.Aeson.TH (Options, fieldLabelModifier, omitNothingFields)
import Data.Aeson.Types (Parser) import Data.Aeson.Types (Parser)
import Data.Char (toLower) import Data.Char (toLower)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.Swagger.SchemaOptions (SchemaOptions, fromAesonOptions)
import Text.Read (Read(..),readMaybe) import Text.Read (Read(..),readMaybe)
...@@ -32,6 +33,9 @@ unPrefix prefix = defaultOptions ...@@ -32,6 +33,9 @@ unPrefix prefix = defaultOptions
, omitNothingFields = True , omitNothingFields = True
} }
unPrefixSwagger :: String -> SchemaOptions
unPrefixSwagger = fromAesonOptions . unPrefix
-- | Lower case leading character -- | Lower case leading character
unCapitalize :: String -> String unCapitalize :: String -> String
unCapitalize [] = [] unCapitalize [] = []
......
src/Gargantext/Database/Facet.hs
View file @ bb0bbdb0
...@@ -53,7 +53,7 @@ import Data.Time (UTCTime) ...@@ -53,7 +53,7 @@ import Data.Time (UTCTime)
import Data.Time.Segment (jour) import Data.Time.Segment (jour)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.Core.Types import Gargantext.Core.Types
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Database.Config (nodeTypeId) import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Database.Schema.Ngrams import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.Node
...@@ -111,9 +111,7 @@ $(deriveJSON (unPrefix "_p_") ''Pair) ...@@ -111,9 +111,7 @@ $(deriveJSON (unPrefix "_p_") ''Pair)
$(makeAdaptorAndInstance "pPair" ''Pair) $(makeAdaptorAndInstance "pPair" ''Pair)
instance (ToSchema i, ToSchema l) => ToSchema (Pair i l) where instance (ToSchema i, ToSchema l) => ToSchema (Pair i l) where
declareNamedSchema = declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_p_")
genericDeclareNamedSchema
defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 3 fieldLabel}
instance (Arbitrary i, Arbitrary l) => Arbitrary (Pair i l) where instance (Arbitrary i, Arbitrary l) => Arbitrary (Pair i l) where
arbitrary = Pair <$> arbitrary <*> arbitrary arbitrary = Pair <$> arbitrary <*> arbitrary
...@@ -128,9 +126,7 @@ $(deriveJSON (unPrefix "_fp_") ''FacetPaired) ...@@ -128,9 +126,7 @@ $(deriveJSON (unPrefix "_fp_") ''FacetPaired)
$(makeAdaptorAndInstance "pFacetPaired" ''FacetPaired) $(makeAdaptorAndInstance "pFacetPaired" ''FacetPaired)
instance (ToSchema id, ToSchema date, ToSchema hyperdata, ToSchema pairs, ToSchema score) => ToSchema (FacetPaired id date hyperdata score pairs) where instance (ToSchema id, ToSchema date, ToSchema hyperdata, ToSchema pairs, ToSchema score) => ToSchema (FacetPaired id date hyperdata score pairs) where
declareNamedSchema = declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fp_")
genericDeclareNamedSchema
defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
instance ( Arbitrary id instance ( Arbitrary id
, Arbitrary date , Arbitrary date
...@@ -154,7 +150,8 @@ type FacetPairedRead = FacetPaired (Column PGInt4 ) ...@@ -154,7 +150,8 @@ type FacetPairedRead = FacetPaired (Column PGInt4 )
$(deriveJSON (unPrefix "facetDoc_") ''Facet) $(deriveJSON (unPrefix "facetDoc_") ''Facet)
-- | Documentation instance -- | Documentation instance
instance ToSchema FacetDoc instance ToSchema FacetDoc where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "facetDoc_")
-- | Mock and Quickcheck instances -- | Mock and Quickcheck instances
instance Arbitrary FacetDoc where instance Arbitrary FacetDoc where
......
src/Gargantext/Database/Node/Contact.hs
View file @ bb0bbdb0
...@@ -22,12 +22,12 @@ module Gargantext.Database.Node.Contact ...@@ -22,12 +22,12 @@ module Gargantext.Database.Node.Contact
import Control.Lens (makeLenses) import Control.Lens (makeLenses)
import Data.Aeson.TH (deriveJSON) import Data.Aeson.TH (deriveJSON)
import Data.Swagger (ToSchema) import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
import Data.Text (Text) import Data.Text (Text)
import Data.Time (UTCTime) import Data.Time (UTCTime)
import Database.PostgreSQL.Simple.FromField (FromField, fromField) import Database.PostgreSQL.Simple.FromField (FromField, fromField)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Core.Types (Name) import Gargantext.Core.Types (Name)
import Gargantext.Database.Schema.Node (NodeWrite, node) import Gargantext.Database.Schema.Node (NodeWrite, node)
import Gargantext.Database.Types.Node (Node,Hyperdata,NodeType(..), UserId, AnnuaireId) import Gargantext.Database.Types.Node (Node,Hyperdata,NodeType(..), UserId, AnnuaireId)
...@@ -105,16 +105,22 @@ nodeContactW maybeName maybeContact aId = ...@@ -105,16 +105,22 @@ nodeContactW maybeName maybeContact aId =
contact = maybe arbitraryHyperdataContact identity maybeContact contact = maybe arbitraryHyperdataContact identity maybeContact
-- | Main instances of Contact -- | ToSchema instances
instance ToSchema HyperdataContact instance ToSchema HyperdataContact where
instance ToSchema ContactWho declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hc_")
instance ToSchema ContactWhere instance ToSchema ContactWho where
instance ToSchema ContactTouch declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
instance ToSchema ContactWhere where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
instance ToSchema ContactTouch where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ct_")
instance ToSchema ContactMetaData where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cm_")
-- | Arbitrary instances
instance Arbitrary HyperdataContact where instance Arbitrary HyperdataContact where
arbitrary = elements [HyperdataContact Nothing Nothing [] Nothing Nothing Nothing Nothing Nothing] arbitrary = elements [HyperdataContact Nothing Nothing [] Nothing Nothing Nothing Nothing Nothing]
-- | Specific Gargantext instance -- | Specific Gargantext instance
instance Hyperdata HyperdataContact instance Hyperdata HyperdataContact
......
src/Gargantext/Database/Types/Node.hs
View file @ bb0bbdb0
...@@ -58,7 +58,7 @@ import Test.QuickCheck.Instances.Time () ...@@ -58,7 +58,7 @@ import Test.QuickCheck.Instances.Time ()
import Test.QuickCheck.Instances.Text () import Test.QuickCheck.Instances.Text ()
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Viz.Phylo (Phylo) import Gargantext.Viz.Phylo (Phylo)
--import Gargantext.Database.Utils --import Gargantext.Database.Utils
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -268,7 +268,7 @@ instance Arbitrary Event where ...@@ -268,7 +268,7 @@ instance Arbitrary Event where
arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
instance ToSchema Event where instance ToSchema Event where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "event_")
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -290,7 +290,7 @@ instance Arbitrary Resource where ...@@ -290,7 +290,7 @@ instance Arbitrary Resource where
<*> arbitrary <*> arbitrary
instance ToSchema Resource where instance ToSchema Resource where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "resource_")
------------------------------------------------------------------------ ------------------------------------------------------------------------
data HyperdataUser = HyperdataUser { hyperdataUser_language :: Maybe Text data HyperdataUser = HyperdataUser { hyperdataUser_language :: Maybe Text
...@@ -527,17 +527,20 @@ docExample :: ByteString ...@@ -527,17 +527,20 @@ docExample :: ByteString
docExample = "{\"doi\":\"sdfds\",\"publication_day\":6,\"language_iso2\":\"en\",\"publication_minute\":0,\"publication_month\":7,\"language_iso3\":\"eng\",\"publication_second\":0,\"authors\":\"Nils Hovdenak, Kjell Haram\",\"publication_year\":2012,\"publication_date\":\"2012-07-06 00:00:00+00:00\",\"language_name\":\"English\",\"realdate_full_\":\"2012 01 12\",\"source\":\"European journal of obstetrics, gynecology, and reproductive biology\",\"abstract\":\"The literature was searched for publications on minerals and vitamins during pregnancy and the possible influence of supplements on pregnancy outcome.\",\"title\":\"Influence of mineral and vitamin supplements on pregnancy outcome.\",\"publication_hour\":0}" docExample = "{\"doi\":\"sdfds\",\"publication_day\":6,\"language_iso2\":\"en\",\"publication_minute\":0,\"publication_month\":7,\"language_iso3\":\"eng\",\"publication_second\":0,\"authors\":\"Nils Hovdenak, Kjell Haram\",\"publication_year\":2012,\"publication_date\":\"2012-07-06 00:00:00+00:00\",\"language_name\":\"English\",\"realdate_full_\":\"2012 01 12\",\"source\":\"European journal of obstetrics, gynecology, and reproductive biology\",\"abstract\":\"The literature was searched for publications on minerals and vitamins during pregnancy and the possible influence of supplements on pregnancy outcome.\",\"title\":\"Influence of mineral and vitamin supplements on pregnancy outcome.\",\"publication_hour\":0}"
instance ToSchema HyperdataCorpus where instance ToSchema HyperdataCorpus where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy declareNamedSchema proxy =
genericDeclareNamedSchema (unPrefixSwagger "hyperdataCorpus_") proxy
& mapped.schema.description ?~ "a corpus" & mapped.schema.description ?~ "a corpus"
& mapped.schema.example ?~ toJSON hyperdataCorpus & mapped.schema.example ?~ toJSON hyperdataCorpus
instance ToSchema HyperdataAnnuaire where instance ToSchema HyperdataAnnuaire where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy declareNamedSchema proxy =
genericDeclareNamedSchema (unPrefixSwagger "hyperdataAnnuaire_") proxy
& mapped.schema.description ?~ "an annuaire" & mapped.schema.description ?~ "an annuaire"
& mapped.schema.example ?~ toJSON hyperdataAnnuaire & mapped.schema.example ?~ toJSON hyperdataAnnuaire
instance ToSchema HyperdataDocument where instance ToSchema HyperdataDocument where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy declareNamedSchema proxy =
genericDeclareNamedSchema (unPrefixSwagger "hyperdataDocument_") proxy
& mapped.schema.description ?~ "a document" & mapped.schema.description ?~ "a document"
& mapped.schema.example ?~ toJSON hyperdataDocument & mapped.schema.example ?~ toJSON hyperdataDocument
...@@ -553,14 +556,16 @@ instance ToSchema hyperdata => ...@@ -553,14 +556,16 @@ instance ToSchema hyperdata =>
(Maybe UserId) (Maybe UserId)
ParentId NodeName ParentId NodeName
UTCTime hyperdata UTCTime hyperdata
) ) where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_node_")
instance ToSchema hyperdata => instance ToSchema hyperdata =>
ToSchema (NodePoly NodeId NodeTypeId ToSchema (NodePoly NodeId NodeTypeId
UserId UserId
(Maybe ParentId) NodeName (Maybe ParentId) NodeName
UTCTime hyperdata UTCTime hyperdata
) ) where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_node_")
instance ToSchema hyperdata => instance ToSchema hyperdata =>
...@@ -568,16 +573,19 @@ instance ToSchema hyperdata => ...@@ -568,16 +573,19 @@ instance ToSchema hyperdata =>
(Maybe UserId) (Maybe UserId)
ParentId NodeName ParentId NodeName
UTCTime hyperdata (Maybe TSVector) UTCTime hyperdata (Maybe TSVector)
) ) where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ns_")
instance ToSchema hyperdata => instance ToSchema hyperdata =>
ToSchema (NodePolySearch NodeId NodeTypeId ToSchema (NodePolySearch NodeId NodeTypeId
UserId UserId
(Maybe ParentId) NodeName (Maybe ParentId) NodeName
UTCTime hyperdata (Maybe TSVector) UTCTime hyperdata (Maybe TSVector)
) ) where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ns_")
instance ToSchema Status instance ToSchema Status where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "status_")
src/Gargantext/Viz/Graph.hs
View file @ bb0bbdb0
...@@ -24,7 +24,7 @@ import Data.Swagger ...@@ -24,7 +24,7 @@ import Data.Swagger
import Data.Text (Text, pack) import Data.Text (Text, pack)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import GHC.IO (FilePath) import GHC.IO (FilePath)
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Core.Types (ListId) import Gargantext.Core.Types (ListId)
import Gargantext.Database.Types.Node (NodeId) import Gargantext.Database.Types.Node (NodeId)
import Gargantext.Prelude import Gargantext.Prelude
...@@ -57,9 +57,7 @@ data Node = Node { node_size :: Int ...@@ -57,9 +57,7 @@ data Node = Node { node_size :: Int
deriving (Show, Generic) deriving (Show, Generic)
$(deriveJSON (unPrefix "node_") ''Node) $(deriveJSON (unPrefix "node_") ''Node)
instance ToSchema Node where instance ToSchema Node where
declareNamedSchema = declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "node_")
genericDeclareNamedSchema
defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 5 fieldLabel}
data Edge = Edge { edge_source :: Text data Edge = Edge { edge_source :: Text
...@@ -71,9 +69,7 @@ data Edge = Edge { edge_source :: Text ...@@ -71,9 +69,7 @@ data Edge = Edge { edge_source :: Text
deriving (Show, Generic) deriving (Show, Generic)
$(deriveJSON (unPrefix "edge_") ''Edge) $(deriveJSON (unPrefix "edge_") ''Edge)
instance ToSchema Edge where instance ToSchema Edge where
declareNamedSchema = declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "edge_")
genericDeclareNamedSchema
defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 5 fieldLabel}
--------------------------------------------------------------- ---------------------------------------------------------------
data LegendField = LegendField { _lf_id :: Int data LegendField = LegendField { _lf_id :: Int
...@@ -83,9 +79,7 @@ data LegendField = LegendField { _lf_id :: Int ...@@ -83,9 +79,7 @@ data LegendField = LegendField { _lf_id :: Int
$(deriveJSON (unPrefix "_lf_") ''LegendField) $(deriveJSON (unPrefix "_lf_") ''LegendField)
instance ToSchema LegendField where instance ToSchema LegendField where
declareNamedSchema = declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_lf_")
genericDeclareNamedSchema
defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
makeLenses ''LegendField makeLenses ''LegendField
-- --
...@@ -97,9 +91,7 @@ data GraphMetadata = GraphMetadata { _gm_title :: Text -- title of the grap ...@@ -97,9 +91,7 @@ data GraphMetadata = GraphMetadata { _gm_title :: Text -- title of the grap
deriving (Show, Generic) deriving (Show, Generic)
$(deriveJSON (unPrefix "_gm_") ''GraphMetadata) $(deriveJSON (unPrefix "_gm_") ''GraphMetadata)
instance ToSchema GraphMetadata where instance ToSchema GraphMetadata where
declareNamedSchema = declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_gm_")
genericDeclareNamedSchema
defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
makeLenses ''GraphMetadata makeLenses ''GraphMetadata
...@@ -112,10 +104,7 @@ $(deriveJSON (unPrefix "_graph_") ''Graph) ...@@ -112,10 +104,7 @@ $(deriveJSON (unPrefix "_graph_") ''Graph)
makeLenses ''Graph makeLenses ''Graph
instance ToSchema Graph where instance ToSchema Graph where
declareNamedSchema = declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_graph_")
genericDeclareNamedSchema
defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 7 fieldLabel}
-- | Intances for the mack -- | Intances for the mack
instance Arbitrary Graph where instance Arbitrary Graph where
......
src/Gargantext/Viz/Phylo.hs
View file @ bb0bbdb0
...@@ -37,10 +37,11 @@ import Data.Text (Text) ...@@ -37,10 +37,11 @@ import Data.Text (Text)
import Data.Set (Set) import Data.Set (Set)
import Data.Map (Map) import Data.Map (Map)
import Data.Vector (Vector) import Data.Vector (Vector)
import Data.Swagger
--import Data.Time.Clock.POSIX (POSIXTime) --import Data.Time.Clock.POSIX (POSIXTime)
import GHC.Generics (Generic) import GHC.Generics (Generic)
--import Gargantext.Database.Schema.Ngrams (NgramsId) --import Gargantext.Database.Schema.Ngrams (NgramsId)
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Text.Context (TermList) import Gargantext.Text.Context (TermList)
import Gargantext.Prelude import Gargantext.Prelude
...@@ -517,6 +518,57 @@ $(deriveJSON (unPrefix "_pn_" ) ''PhyloNode ) ...@@ -517,6 +518,57 @@ $(deriveJSON (unPrefix "_pn_" ) ''PhyloNode )
$(deriveJSON defaultOptions ''Filiation ) $(deriveJSON defaultOptions ''Filiation )
$(deriveJSON defaultOptions ''EdgeType ) $(deriveJSON defaultOptions ''EdgeType )
---------------------------
-- | Swagger instances | --
---------------------------
instance ToSchema Phylo where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_")
instance ToSchema PhyloFoundations where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_foundations")
instance ToSchema PhyloPeriod where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_period")
instance ToSchema PhyloLevel where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_level")
instance ToSchema PhyloGroup where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_group")
instance ToSchema PhyloFis where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phyloFis_")
instance ToSchema Software where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_software_")
instance ToSchema PhyloParam where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phyloParam_")
instance ToSchema Filter
instance ToSchema Metric
instance ToSchema Cluster
instance ToSchema Proximity where
declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
instance ToSchema FisParams where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fis_")
instance ToSchema HammingParams where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hamming_")
instance ToSchema LouvainParams where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_louvain_")
instance ToSchema RCParams where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_rc_")
instance ToSchema WLJParams where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wlj_")
instance ToSchema LBParams where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_lb_")
instance ToSchema SBParams where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_sb_")
instance ToSchema PhyloQueryBuild where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_q_")
instance ToSchema PhyloView where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_pv_")
instance ToSchema PhyloBranch where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_pb_")
instance ToSchema PhyloEdge where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_pe_")
instance ToSchema PhyloNode where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_pn_")
instance ToSchema Filiation
instance ToSchema EdgeType
---------------------------- ----------------------------
-- | TODO XML instances | -- -- | TODO XML instances | --
......
src/Gargantext/Viz/Phylo/API.hs
View file @ bb0bbdb0
...@@ -29,7 +29,6 @@ import qualified Data.ByteString as DB ...@@ -29,7 +29,6 @@ import qualified Data.ByteString as DB
import qualified Data.ByteString.Lazy as DBL import qualified Data.ByteString.Lazy as DBL
import Data.Swagger import Data.Swagger
import Gargantext.API.Types import Gargantext.API.Types
import Gargantext.API.Utils (swaggerOptions)
import Gargantext.Database.Types.Node (PhyloId, ListId, CorpusId) import Gargantext.Database.Types.Node (PhyloId, ListId, CorpusId)
import Gargantext.Database.Schema.Node (insertNodes, nodePhyloW, getNodePhylo) import Gargantext.Database.Schema.Node (insertNodes, nodePhyloW, getNodePhylo)
import Gargantext.Database.Types.Node -- (NodePhylo(..)) import Gargantext.Database.Types.Node -- (NodePhylo(..))
...@@ -153,33 +152,7 @@ instance Arbitrary Phylo ...@@ -153,33 +152,7 @@ instance Arbitrary Phylo
where where
arbitrary = elements [phylo] arbitrary = elements [phylo]
instance ToSchema Cluster
instance ToSchema EdgeType
instance ToSchema Filiation
instance ToSchema Filter
instance ToSchema FisParams
instance ToSchema HammingParams
instance ToSchema LouvainParams
instance ToSchema Metric
instance ToSchema Order instance ToSchema Order
instance ToSchema Phylo
instance ToSchema PhyloFis
instance ToSchema PhyloBranch
instance ToSchema PhyloEdge
instance ToSchema PhyloGroup
instance ToSchema PhyloLevel
instance ToSchema PhyloNode
instance ToSchema PhyloParam
instance ToSchema PhyloFoundations
instance ToSchema PhyloPeriod
instance ToSchema PhyloQueryBuild
instance ToSchema PhyloView
instance ToSchema RCParams
instance ToSchema LBParams
instance ToSchema SBParams
instance ToSchema Software
instance ToSchema WLJParams
instance ToParamSchema Order instance ToParamSchema Order
instance FromHttpApiData Order instance FromHttpApiData Order
...@@ -213,13 +186,6 @@ instance FromHttpApiData Sort ...@@ -213,13 +186,6 @@ instance FromHttpApiData Sort
parseUrlPiece = readTextData parseUrlPiece = readTextData
instance ToParamSchema Sort instance ToParamSchema Sort
instance ToSchema Proximity
where
declareNamedSchema = genericDeclareNamedSchemaUnrestricted
$ swaggerOptions ""
instance FromHttpApiData [Tagger] instance FromHttpApiData [Tagger]
where where
parseUrlPiece = readTextData parseUrlPiece = readTextData
......
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