Fix ToSchema instances

src/Gargantext/API/Auth.hs

@@ -40,7 +40,7 @@ import Data.Text.Lazy (toStrict)
 import Data.Text.Lazy.Encoding (decodeUtf8)
 import GHC.Generics (Generic)
 import Servant.Auth.Server
-import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.API.Settings
 import Gargantext.API.Types (HasJoseError(..), joseError)
 import Gargantext.Database.Root (getRoot)
@@ -115,11 +115,12 @@ auth (AuthRequest u p) = do
     Valid to trId   -> pure $ AuthResponse (Just $ AuthValid to trId) Nothing
 
 newtype AuthenticatedUser = AuthenticatedUser
-  { _au_id :: NodeId
+  { _authUser_id :: NodeId
   } deriving (Generic)
 
-$(deriveJSON (unPrefix "_au_") ''AuthenticatedUser)
-instance ToSchema AuthenticatedUser
+$(deriveJSON (unPrefix "_authUser_") ''AuthenticatedUser)
+instance ToSchema AuthenticatedUser where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authUser_")
 instance ToJWT AuthenticatedUser
 instance FromJWT AuthenticatedUser
 
@@ -141,7 +142,8 @@ authCheck _env (BasicAuthData login password) = pure $
 
 -- | Instances
 $(deriveJSON (unPrefix "_authReq_") ''AuthRequest)
-instance ToSchema AuthRequest -- TODO-SWAGGER unPrefix
+instance ToSchema AuthRequest where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authReq_")
 
 instance Arbitrary AuthRequest where
   arbitrary = elements [ AuthRequest u p
@@ -150,20 +152,23 @@ instance Arbitrary AuthRequest where
                        ]
 
 $(deriveJSON (unPrefix "_authRes_") ''AuthResponse)
-instance ToSchema AuthResponse -- TODO-SWAGGER unPrefix
+instance ToSchema AuthResponse where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authRes_")
 instance Arbitrary AuthResponse where
   arbitrary = oneof [ AuthResponse Nothing . Just      <$> arbitrary
                     , flip AuthResponse Nothing . Just <$> arbitrary ]
 
 $(deriveJSON (unPrefix "_authInv_") ''AuthInvalid)
-instance ToSchema AuthInvalid -- TODO-SWAGGER unPrefix
+instance ToSchema AuthInvalid where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authInv_")
 instance Arbitrary AuthInvalid where
   arbitrary = elements [ AuthInvalid m 
                        | m <- [ "Invalid user", "Invalid password"]
                        ]
 
 $(deriveJSON (unPrefix "_authVal_") ''AuthValid)
-instance ToSchema AuthValid -- TODO-SWAGGER unPrefix
+instance ToSchema AuthValid where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authVal_")
 instance Arbitrary AuthValid where
   arbitrary = elements [ AuthValid to tr
                        | to <- ["token0", "token1"]

src/Gargantext/API/Corpus/New.hs

@@ -30,7 +30,7 @@ import Data.Aeson.TH (deriveJSON)
 import Data.Swagger
 import Data.Text (Text)
 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.Types.Node (CorpusId)
 import Gargantext.Text.Terms (TermType(..))
@@ -60,9 +60,7 @@ instance Arbitrary Query where
                          ]
 
 instance ToSchema Query where
-  declareNamedSchema =
-    genericDeclareNamedSchema
-      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 6 fieldLabel}
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")
 
 type Api = Summary "New Corpus endpoint"
          :> ReqBody '[JSON] Query

src/Gargantext/API/Count.hs

@@ -41,7 +41,7 @@ import Test.QuickCheck (elements)
 -- import Control.Applicative ((<*>))
 
 import Gargantext.Prelude
-import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 
 -----------------------------------------------------------------------
 -- TODO-ACCESS: CanCount
@@ -93,7 +93,9 @@ instance Arbitrary Query where
                          , n <- take 10 $ permutations scrapers
                          ]
 
-instance ToSchema Query
+instance ToSchema Query where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")
+
 -----------------------------------------------------------------------
 type Code = Integer
 type Error  = Text
@@ -144,7 +146,8 @@ data Count = Count { count_name    :: Scraper
 
 $(deriveJSON (unPrefix "count_") ''Count)
 
-instance ToSchema Count
+instance ToSchema Count where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "count_")
 --instance Arbitrary Count where
 --    arbitrary = Count <$> arbitrary <*> arbitrary <*> arbitrary
 

src/Gargantext/API/Metrics.hs

@@ -31,7 +31,7 @@ import Data.Time (UTCTime)
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Gargantext.Core.Types (ListType(..))
-import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Utils
 import Gargantext.Core.Types (CorpusId, ListId, Limit)
 import Gargantext.Prelude
@@ -50,7 +50,8 @@ data Metrics = Metrics
   { metrics_data :: [Metric]}
   deriving (Generic, Show)
 
-instance ToSchema Metrics
+instance ToSchema Metrics where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "metrics_")
 instance Arbitrary Metrics
   where
     arbitrary = Metrics <$> arbitrary
@@ -62,7 +63,8 @@ data Metric = Metric
   , m_cat   :: !ListType
   } deriving (Generic, Show)
 
-instance ToSchema Metric
+instance ToSchema Metric where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "m_")
 instance Arbitrary Metric
   where
     arbitrary = Metric <$> arbitrary
@@ -78,7 +80,8 @@ deriveJSON (unPrefix "m_") ''Metric
 data ChartMetrics a = ChartMetrics { chartMetrics_data :: a }
   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)
   where
     arbitrary = ChartMetrics <$> arbitrary
@@ -86,7 +89,8 @@ instance (Arbitrary a) => Arbitrary (ChartMetrics a)
 deriveJSON (unPrefix "chartMetrics_") ''ChartMetrics
 
 -------------------------------------------------------------
-instance ToSchema Histo
+instance ToSchema Histo where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "histo_")
 instance Arbitrary Histo
   where
     arbitrary = elements [ Histo ["2012"] [1]
@@ -95,11 +99,6 @@ instance Arbitrary Histo
 deriveJSON (unPrefix "histo_") ''Histo
 
 
-instance ToSchema MyTree
-instance Arbitrary MyTree
-  where
-    arbitrary = MyTree <$> arbitrary <*> arbitrary <*> arbitrary
-
 
 -------------------------------------------------------------
 -- | Scatter metrics API

src/Gargantext/API/Ngrams.hs

@@ -116,7 +116,7 @@ import Data.Swagger hiding (version, patch)
 import Data.Text (Text, isInfixOf, count)
 import Data.Validity
 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.Config (userMaster)
 import Gargantext.Database.Metrics.NgramsByNode (getOccByNgramsOnlyFast)
@@ -255,7 +255,8 @@ mkNgramsElement ngrams list rp children =
 newNgramsElement :: Maybe ListType -> NgramsTerm -> NgramsElement
 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
   arbitrary = elements [newNgramsElement Nothing "sport"]
 
@@ -509,7 +510,8 @@ data NgramsPatch =
 deriveJSON (unPrefix "_") ''NgramsPatch
 makeLenses ''NgramsPatch
 
-instance ToSchema  NgramsPatch
+instance ToSchema  NgramsPatch where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_")
 
 instance Arbitrary NgramsPatch where
   arbitrary = NgramsPatch <$> arbitrary <*> (replace <$> arbitrary <*> arbitrary)
@@ -644,7 +646,8 @@ data Versioned a = Versioned
   deriving (Generic, Show)
 deriveJSON (unPrefix "_v_") ''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
   arbitrary = Versioned 1 <$> arbitrary -- TODO 1 is constant so far
 

src/Gargantext/API/Ngrams/NTree.hs

@@ -23,16 +23,18 @@ import Data.Text (Text)
 import Gargantext.Prelude
 import GHC.Generics (Generic)
 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.API.Ngrams
 import Data.Tree
 import Data.Maybe (catMaybes)
 import Data.Map (Map)
 import Data.Set (Set)
+import Data.Swagger
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 import qualified Data.List as List
+import Test.QuickCheck
 
 type Children = Text
 type Root = Text
@@ -47,12 +49,17 @@ toMyTree (Node (l,v) xs) = MyTree l v (map toMyTree xs)
 
 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 lt vs m = map toMyTree $ unfoldForest buildNode roots
   where
     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
 
     rootsCandidates = catMaybes
@@ -60,7 +67,7 @@ toTree lt vs m = map toMyTree $ unfoldForest buildNode roots
                     $ map (\(c,c') -> case _nre_root c' of
                                        Nothing -> Just c
                                        _ -> _nre_root c' ) (Map.toList m)
-    
+
     roots = map fst
           $ filter (\(_,l) -> l == lt)
           $ catMaybes

src/Gargantext/API/Node.hs

@@ -207,6 +207,7 @@ nodeAPI p uId id = hoistServer (Proxy :: Proxy (NodeAPI a)) (withAccess uId id)
 data RenameNode = RenameNode { r_name :: Text }
   deriving (Generic)
 
+-- TODO unPrefix "r_" FromJSON, ToJSON, ToSchema, adapt frontend.
 instance FromJSON  RenameNode
 instance ToJSON    RenameNode
 instance ToSchema  RenameNode
@@ -217,6 +218,7 @@ data PostNode = PostNode { pn_name :: Text
                          , pn_typename :: NodeType}
   deriving (Generic)
 
+-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
 instance FromJSON  PostNode
 instance ToJSON    PostNode
 instance ToSchema  PostNode
@@ -233,6 +235,7 @@ data NodesToCategory = NodesToCategory { ntc_nodesId :: [NodeId]
                                        }
   deriving (Generic)
 
+-- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
 instance FromJSON  NodesToCategory
 instance ToJSON    NodesToCategory
 instance ToSchema  NodesToCategory

src/Gargantext/API/Search.hs

@@ -35,7 +35,7 @@ import Test.QuickCheck (elements)
 -- import Control.Applicative ((<*>))
 import Gargantext.API.Types (GargServer)
 import Gargantext.Prelude
-import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Types.Node
 import Gargantext.Database.TextSearch
 import Gargantext.Database.Facet
@@ -48,9 +48,7 @@ data SearchQuery = SearchQuery
 $(deriveJSON (unPrefix "sq_") ''SearchQuery)
 
 instance ToSchema SearchQuery where
-  declareNamedSchema =
-    genericDeclareNamedSchema
-      defaultSchemaOptions {fieldLabelModifier = drop 3}
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "sq_")
 
 instance Arbitrary SearchQuery where
   arbitrary = elements [SearchQuery ["electrodes"]]
@@ -64,9 +62,7 @@ instance Arbitrary SearchDocResults where
   arbitrary = SearchDocResults <$> arbitrary
 
 instance ToSchema SearchDocResults where
-  declareNamedSchema =
-    genericDeclareNamedSchema
-      defaultSchemaOptions {fieldLabelModifier = drop 4}
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "sdr_")
 
 data SearchPairedResults = SearchPairedResults { spr_results :: [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]] }
   deriving (Generic)
@@ -76,9 +72,7 @@ instance Arbitrary SearchPairedResults where
   arbitrary = SearchPairedResults <$> arbitrary
 
 instance ToSchema SearchPairedResults where
-  declareNamedSchema =
-    genericDeclareNamedSchema
-      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "spr_")
 
 -----------------------------------------------------------------------
 -- TODO-ACCESS: CanSearch? or is it part of CanGetNode

src/Gargantext/API/Table.hs

@@ -45,7 +45,7 @@ import Data.Text (Text())
 import GHC.Generics (Generic)
 import Gargantext.API.Ngrams (TabType(..))
 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.Learn (FavOrTrash(..), moreLike)
 import Gargantext.Database.TextSearch
@@ -73,9 +73,7 @@ data TableQuery = TableQuery
 $(deriveJSON (unPrefix "tq_") ''TableQuery)
 
 instance ToSchema TableQuery where
-  declareNamedSchema =
-    genericDeclareNamedSchema
-      defaultSchemaOptions {fieldLabelModifier = drop 3}
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "tq_")
 
 instance Arbitrary TableQuery where
   arbitrary = elements [TableQuery 0 10 DateAsc Docs "electrodes"]

src/Gargantext/API/Utils.hs

@@ -21,22 +21,6 @@ import Gargantext.Prelude
 import Data.Maybe (Maybe, fromMaybe)
 import Prelude (String)
 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 ?|
 

src/Gargantext/Core/Types/Main.hs

@@ -22,8 +22,7 @@ module Gargantext.Core.Types.Main where
 ------------------------------------------------------------------------
 
 import Prelude (Enum, Bounded, minBound, maxBound)
-import Data.Aeson (FromJSON, ToJSON, toJSON)
-import Data.Aeson as A
+import Data.Aeson (FromJSON, ToJSON)
 import Data.Aeson.TH (deriveJSON)
 import Data.Map (fromList, lookup)
 import Data.Either (Either(..))
@@ -33,7 +32,7 @@ import Data.Text (Text, unpack)
 import Data.Swagger
 
 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 GHC.Generics (Generic)
@@ -49,36 +48,10 @@ data NodeTree = NodeTree { _nt_name :: Text
                          } deriving (Show, Read, Generic)
 
 $(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
@@ -127,17 +100,14 @@ type IsTrash  = Bool
 
 ------------------------------------------------------------------------
 -- 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)
 
-instance ToJSON a => ToJSON   (Tree a) where
-  toJSON (TreeN node nodes) =
-    object ["node" A..= toJSON node, "children" A..= toJSON nodes]
+$(deriveJSON (unPrefix "_tn_") ''Tree)
 
-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
   arbitrary = elements [userTree, userTree]
 
@@ -146,3 +116,33 @@ instance Arbitrary (Tree NodeTree) where
 -- same as Data.Tree
 leafT :: a -> Tree a
 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

@@ -25,15 +25,18 @@ Phylomemy was first described in Chavalarias, D., Cointet, J.-P., 2013. Phylomem
 
 module Gargantext.Core.Types.Phylo where
 
+import Control.Lens (makeLenses)
+
 import Data.Aeson.TH (deriveJSON)
 import Data.Maybe   (Maybe)
+import Data.Swagger
 import Data.Text    (Text)
 import Data.Time.Clock.POSIX  (POSIXTime)
 
 import GHC.Generics (Generic)
 
 import Gargantext.Prelude
-import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 
 ------------------------------------------------------------------------
 -- | Phylo datatype descriptor of a phylomemy
@@ -94,8 +97,24 @@ type PhyloGroupId = (PhyloLevelId, Int)
 type Edge         = (PhyloGroupId, Weight)
 type Weight       = Double
 
+-- | Lenses
+makeLenses ''Phylo
+makeLenses ''PhyloPeriod
+makeLenses ''PhyloLevel
+makeLenses ''PhyloGroup
+
 -- | JSON instances
 $(deriveJSON (unPrefix "_phylo_"       ) ''Phylo       )
 $(deriveJSON (unPrefix "_phylo_Period" ) ''PhyloPeriod )
 $(deriveJSON (unPrefix "_phylo_Level"  ) ''PhyloLevel  )
 $(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

@@ -22,6 +22,7 @@ import Data.Aeson.TH (Options, fieldLabelModifier, omitNothingFields)
 import Data.Aeson.Types (Parser)
 import Data.Char (toLower)
 import Data.Monoid ((<>))
+import Data.Swagger.SchemaOptions (SchemaOptions, fromAesonOptions)
 import Text.Read (Read(..),readMaybe)
 
 
@@ -32,6 +33,9 @@ unPrefix prefix = defaultOptions
   , omitNothingFields = True
   }
 
+unPrefixSwagger :: String -> SchemaOptions
+unPrefixSwagger = fromAesonOptions . unPrefix
+
 -- | Lower case leading character
 unCapitalize :: String -> String
 unCapitalize [] = []

src/Gargantext/Database/Facet.hs

@@ -53,7 +53,7 @@ import Data.Time (UTCTime)
 import Data.Time.Segment (jour)
 import GHC.Generics (Generic)
 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.Schema.Ngrams
 import Gargantext.Database.Schema.Node
@@ -111,9 +111,7 @@ $(deriveJSON (unPrefix "_p_") ''Pair)
 $(makeAdaptorAndInstance "pPair" ''Pair)
 
 instance (ToSchema i, ToSchema l) => ToSchema (Pair i l) where
-  declareNamedSchema =
-    genericDeclareNamedSchema
-      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 3 fieldLabel}
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_p_")
 instance (Arbitrary i, Arbitrary l) => Arbitrary (Pair i l) where
   arbitrary = Pair <$> arbitrary <*> arbitrary
 
@@ -128,9 +126,7 @@ $(deriveJSON (unPrefix "_fp_") ''FacetPaired)
 $(makeAdaptorAndInstance "pFacetPaired" ''FacetPaired)
 
 instance (ToSchema id, ToSchema date, ToSchema hyperdata, ToSchema pairs, ToSchema score) => ToSchema (FacetPaired id date hyperdata score pairs) where
-  declareNamedSchema =
-    genericDeclareNamedSchema
-      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fp_")
 
 instance ( Arbitrary id
          , Arbitrary date
@@ -154,7 +150,8 @@ type FacetPairedRead = FacetPaired (Column PGInt4       )
 $(deriveJSON (unPrefix "facetDoc_") ''Facet)
 
 -- | Documentation instance
-instance ToSchema FacetDoc
+instance ToSchema FacetDoc where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "facetDoc_")
 
 -- | Mock and Quickcheck instances
 instance Arbitrary FacetDoc where

src/Gargantext/Database/Node/Contact.hs

@@ -22,12 +22,12 @@ module Gargantext.Database.Node.Contact
 
 import Control.Lens (makeLenses)
 import Data.Aeson.TH (deriveJSON)
-import Data.Swagger (ToSchema)
+import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
 import Data.Text (Text)
 import Data.Time (UTCTime)
 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import GHC.Generics (Generic)
-import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Core.Types (Name)
 import Gargantext.Database.Schema.Node (NodeWrite, node)
 import Gargantext.Database.Types.Node (Node,Hyperdata,NodeType(..), UserId, AnnuaireId)
@@ -105,16 +105,22 @@ nodeContactW maybeName maybeContact aId =
       contact = maybe arbitraryHyperdataContact identity maybeContact
 
 
--- | Main instances of Contact
-instance ToSchema HyperdataContact
-instance ToSchema ContactWho
-instance ToSchema ContactWhere
-instance ToSchema ContactTouch
+-- | ToSchema instances
+instance ToSchema HyperdataContact where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hc_")
+instance ToSchema ContactWho where
+  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
   arbitrary = elements [HyperdataContact Nothing Nothing [] Nothing Nothing Nothing Nothing Nothing]
 
-
 -- | Specific Gargantext instance
 instance Hyperdata HyperdataContact
 

src/Gargantext/Database/Types/Node.hs

@@ -58,7 +58,7 @@ import           Test.QuickCheck.Instances.Time ()
 import           Test.QuickCheck.Instances.Text ()
 
 import           Gargantext.Prelude
-import           Gargantext.Core.Utils.Prefix (unPrefix)
+import           Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import           Gargantext.Viz.Phylo (Phylo)
 --import Gargantext.Database.Utils
 ------------------------------------------------------------------------
@@ -268,7 +268,7 @@ instance Arbitrary Event where
   arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
 
 instance ToSchema Event where
-  declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "event_")
 
 ------------------------------------------------------------------------
 
@@ -290,7 +290,7 @@ instance Arbitrary Resource where
                          <*> arbitrary
 
 instance ToSchema Resource where
-  declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "resource_")
 
 ------------------------------------------------------------------------
 data HyperdataUser = HyperdataUser { hyperdataUser_language       :: Maybe Text
@@ -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}"
 
 instance ToSchema HyperdataCorpus where
-  declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "hyperdataCorpus_") proxy
     & mapped.schema.description ?~ "a corpus"
     & mapped.schema.example ?~ toJSON hyperdataCorpus
 
 instance ToSchema HyperdataAnnuaire where
-  declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "hyperdataAnnuaire_") proxy
     & mapped.schema.description ?~ "an annuaire"
     & mapped.schema.example ?~ toJSON hyperdataAnnuaire
 
 instance ToSchema HyperdataDocument where
-  declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "hyperdataDocument_") proxy
     & mapped.schema.description ?~ "a document"
     & mapped.schema.example ?~ toJSON hyperdataDocument
 
@@ -553,14 +556,16 @@ instance ToSchema hyperdata =>
                             (Maybe UserId)
                             ParentId NodeName
                             UTCTime hyperdata
-                  )
+                  ) where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_node_")
 
 instance ToSchema hyperdata =>
          ToSchema (NodePoly NodeId NodeTypeId
                             UserId
                             (Maybe ParentId) NodeName
                             UTCTime hyperdata
-                  )
+                  ) where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_node_")
 
 
 instance ToSchema hyperdata =>
@@ -568,16 +573,19 @@ instance ToSchema hyperdata =>
                             (Maybe UserId)
                             ParentId NodeName
                             UTCTime hyperdata (Maybe TSVector)
-                  )
+                  ) where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ns_")
 
 instance ToSchema hyperdata =>
          ToSchema (NodePolySearch NodeId NodeTypeId
                             UserId
                             (Maybe ParentId) NodeName
                             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

@@ -24,7 +24,7 @@ import Data.Swagger
 import Data.Text (Text, pack)
 import GHC.Generics (Generic)
 import GHC.IO (FilePath)
-import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Core.Types (ListId)
 import Gargantext.Database.Types.Node (NodeId)
 import Gargantext.Prelude
@@ -57,9 +57,7 @@ data Node = Node { node_size  :: Int
   deriving (Show, Generic)
 $(deriveJSON (unPrefix "node_") ''Node)
 instance ToSchema Node where
-  declareNamedSchema =
-    genericDeclareNamedSchema
-      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 5 fieldLabel}
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "node_")
 
 
 data Edge = Edge { edge_source :: Text
@@ -71,9 +69,7 @@ data Edge = Edge { edge_source :: Text
   deriving (Show, Generic)
 $(deriveJSON (unPrefix "edge_") ''Edge)
 instance ToSchema Edge where
-  declareNamedSchema =
-    genericDeclareNamedSchema
-      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 5 fieldLabel}
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "edge_")
 
 ---------------------------------------------------------------
 data LegendField = LegendField { _lf_id :: Int
@@ -83,9 +79,7 @@ data LegendField = LegendField { _lf_id :: Int
 $(deriveJSON (unPrefix "_lf_") ''LegendField)
 
 instance ToSchema LegendField where
-  declareNamedSchema =
-    genericDeclareNamedSchema
-      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_lf_")
 
 makeLenses ''LegendField
 --
@@ -97,9 +91,7 @@ data GraphMetadata = GraphMetadata { _gm_title    :: Text   -- title of the grap
   deriving (Show, Generic)
 $(deriveJSON (unPrefix "_gm_") ''GraphMetadata)
 instance ToSchema GraphMetadata where
-  declareNamedSchema =
-    genericDeclareNamedSchema
-      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_gm_")
 makeLenses ''GraphMetadata
 
 
@@ -112,10 +104,7 @@ $(deriveJSON (unPrefix "_graph_") ''Graph)
 makeLenses ''Graph
 
 instance ToSchema Graph where
-  declareNamedSchema =
-    genericDeclareNamedSchema
-      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 7 fieldLabel}
-
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_graph_")
 
 -- | Intances for the mack
 instance Arbitrary Graph where

src/Gargantext/Viz/Phylo.hs

@@ -37,10 +37,11 @@ import Data.Text    (Text)
 import Data.Set     (Set)
 import Data.Map     (Map)
 import Data.Vector  (Vector)
+import Data.Swagger
 --import Data.Time.Clock.POSIX  (POSIXTime)
 import GHC.Generics (Generic)
 --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.Prelude
 
@@ -517,6 +518,57 @@ $(deriveJSON (unPrefix "_pn_" ) ''PhyloNode   )
 $(deriveJSON defaultOptions ''Filiation )
 $(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 | --

src/Gargantext/Viz/Phylo/API.hs

@@ -29,7 +29,6 @@ import qualified Data.ByteString as DB
 import qualified Data.ByteString.Lazy as DBL
 import Data.Swagger
 import Gargantext.API.Types
-import Gargantext.API.Utils (swaggerOptions)
 import Gargantext.Database.Types.Node (PhyloId, ListId, CorpusId)
 import Gargantext.Database.Schema.Node (insertNodes, nodePhyloW, getNodePhylo)
 import Gargantext.Database.Types.Node -- (NodePhylo(..))
@@ -153,33 +152,7 @@ instance Arbitrary Phylo
   where
     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 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 FromHttpApiData Order
@@ -213,13 +186,6 @@ instance FromHttpApiData Sort
     parseUrlPiece = readTextData
 instance ToParamSchema Sort
 
-
-instance ToSchema Proximity
-  where
-    declareNamedSchema = genericDeclareNamedSchemaUnrestricted
-                       $ swaggerOptions ""
-
-
 instance FromHttpApiData [Tagger]
   where
     parseUrlPiece = readTextData