Fix ToSchema instances to workaround swagger2#issue94

src/Gargantext/API/Ngrams.hs

@@ -116,7 +116,7 @@ import Formatting.Clock (timeSpecs)
 import GHC.Generics (Generic)
 import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset, HasInvalidError, assertValid)
 import Gargantext.Core.Types (TODO)
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 import Gargantext.Database.Action.Metrics.NgramsByNode (getOccByNgramsOnlyFast')
 import Gargantext.Database.Query.Table.Node.Select
 import Gargantext.Database.Query.Table.Ngrams hiding (NgramsType(..), ngrams, ngramsType, ngrams_terms)
@@ -200,7 +200,7 @@ instance (Ord a, FromJSON a) => FromJSON (MSet a) where
 
 instance (ToJSONKey a, ToSchema a) => ToSchema (MSet a) where
   -- TODO
-  declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
+  declareNamedSchema _ = wellNamedSchema "" (Proxy :: Proxy TODO)
 
 ------------------------------------------------------------------------
 type NgramsTerm = Text
@@ -492,7 +492,7 @@ instance (Ord a, Arbitrary a) => Arbitrary (PatchMSet a) where
 
 instance ToSchema a => ToSchema (PatchMSet a) where
   -- TODO
-  declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
+  declareNamedSchema _ = wellNamedSchema "" (Proxy :: Proxy TODO)
 
 type instance Patched (PatchMSet a) = MSet a
 
@@ -665,8 +665,8 @@ data Versioned a = Versioned
   deriving (Generic, Show, Eq)
 deriveJSON (unPrefix "_v_") ''Versioned
 makeLenses ''Versioned
-instance ToSchema a => ToSchema (Versioned a) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_v_")
+instance (Typeable a, ToSchema a) => ToSchema (Versioned a) where
+  declareNamedSchema = wellNamedSchema "_v_"
 instance Arbitrary a => Arbitrary (Versioned a) where
   arbitrary = Versioned 1 <$> arbitrary -- TODO 1 is constant so far
 

src/Gargantext/Core/Types.hs

@@ -34,13 +34,13 @@ import Data.Monoid
 import Data.Semigroup
 import Data.Set (Set, empty)
 import Data.Swagger (ToParamSchema)
-import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
+import Data.Swagger (ToSchema(..))
 import Data.Text (Text, unpack)
 import Data.Validity
 import GHC.Generics
 import Gargantext.Core.Types.Main
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Prefix (unPrefix, wellNamedSchema)
 import Gargantext.Prelude
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
@@ -150,8 +150,8 @@ data TableResult a = TableResult { tr_count :: Int
 
 $(deriveJSON (unPrefix "tr_") ''TableResult)
 
-instance ToSchema a => ToSchema (TableResult a) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "tr_")
+instance (Typeable a, ToSchema a) => ToSchema (TableResult a) where
+  declareNamedSchema = wellNamedSchema "tr_"
 
 instance Arbitrary a => Arbitrary (TableResult a) where
   arbitrary = TableResult <$> arbitrary <*> arbitrary

src/Gargantext/Core/Types/Main.hs

@@ -26,7 +26,7 @@ import Data.Monoid ((<>))
 import Data.Swagger
 import Data.Text (Text, unpack)
 import GHC.Generics (Generic)
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 import Gargantext.Database.Admin.Types.Node  -- (NodeType(..), Node, Hyperdata(..))
 import Gargantext.Prelude
 import Prelude (Enum, Bounded, minBound, maxBound)
@@ -98,8 +98,8 @@ data Tree a = TreeN { _tn_node :: a, _tn_children :: [Tree a] }
 
 $(deriveJSON (unPrefix "_tn_") ''Tree)
 
-instance ToSchema a => ToSchema (Tree a) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_tn_")
+instance (Typeable a, ToSchema a) => ToSchema (Tree a) where
+  declareNamedSchema = wellNamedSchema "_tn_"
 
 instance Arbitrary (Tree NodeTree) where
   arbitrary = elements [userTree, userTree]

src/Gargantext/Core/Utils/Prefix.hs

@@ -12,7 +12,10 @@ commentary with @some markup@.
 -}
 
 
-module Gargantext.Core.Utils.Prefix where
+module Gargantext.Core.Utils.Prefix
+  ( module Gargantext.Core.Utils.Prefix
+  , wellNamedSchema
+  ) where
 
 import Prelude
 
@@ -22,6 +25,7 @@ import Data.Aeson.Types (Parser)
 import Data.Char (toLower)
 import Data.Monoid ((<>))
 import Data.Swagger.SchemaOptions (SchemaOptions, fromAesonOptions)
+import Servant.Job.Utils (wellNamedSchema)
 import Text.Read (Read(..),readMaybe)
 
 

src/Gargantext/Database/Admin/Types/Hyperdata.hs

@@ -29,7 +29,7 @@ import Test.QuickCheck.Arbitrary
 import Gargantext.API.Ngrams.NTree (MyTree)
 import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metrics)
 import Gargantext.Database.Prelude (fromField')
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 import Gargantext.Viz.Phylo (Phylo(..))
 import Gargantext.Viz.Types (Histo(..))
 
@@ -179,9 +179,9 @@ $(makeLenses ''HyperdataField)
 defaultHyperdataField :: HyperdataField CorpusField
 defaultHyperdataField = HyperdataField Markdown "name" defaultCorpusField
 
-instance (ToSchema a) => ToSchema (HyperdataField a) where
+instance (Typeable a, ToSchema a) => ToSchema (HyperdataField a) where
   declareNamedSchema =
-    genericDeclareNamedSchema (unPrefixSwagger "_hf_")
+    wellNamedSchema "_hf_"
     -- & mapped.schema.description ?~ "HyperdataField"
     -- & mapped.schema.example ?~ toJSON defaultHyperdataField
 

src/Gargantext/Database/Admin/Types/Metrics.hs

@@ -11,7 +11,7 @@ import Protolude
 import Test.QuickCheck.Arbitrary
 
 import Gargantext.Core.Types (ListType(..))
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 
 ----------------------------------------------------------------------------
 
@@ -48,8 +48,8 @@ deriveJSON (unPrefix "m_") ''Metric
 data ChartMetrics a = ChartMetrics { chartMetrics_data :: a }
   deriving (Generic, Show)
 
-instance (ToSchema a) => ToSchema (ChartMetrics a) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "chartMetrics_")
+instance (Typeable a, ToSchema a) => ToSchema (ChartMetrics a) where
+  declareNamedSchema = wellNamedSchema "chartMetrics_"
 instance (Arbitrary a) => Arbitrary (ChartMetrics a)
   where
     arbitrary = ChartMetrics <$> arbitrary

src/Gargantext/Database/Admin/Types/Node.hs

@@ -29,6 +29,7 @@ import Data.Eq (Eq)
 import Data.Swagger
 import Data.Text (Text, unpack)
 import Data.Time (UTCTime)
+import Data.Typeable (Typeable)
 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import Database.PostgreSQL.Simple.ToField (ToField, toField)
 import GHC.Generics (Generic)
@@ -43,7 +44,7 @@ import Test.QuickCheck.Instances.Time ()
 import Text.Read (read)
 import Text.Show (Show())
 
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 import Gargantext.Database.Prelude (fromField')
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude
@@ -60,37 +61,37 @@ type NodeSearch json   = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId
 
 ------------------------------------------------------------------------
 
-instance ToSchema hyperdata =>
+instance (Typeable hyperdata, ToSchema hyperdata) =>
          ToSchema (NodePoly NodeId NodeTypeId
                             (Maybe UserId)
                             ParentId NodeName
                             UTCTime hyperdata
                   ) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_node_")
+  declareNamedSchema = wellNamedSchema "_node_"
 
-instance ToSchema hyperdata =>
+instance (Typeable hyperdata, ToSchema hyperdata) =>
          ToSchema (NodePoly NodeId NodeTypeId
                             UserId
                             (Maybe ParentId) NodeName
                             UTCTime hyperdata
                   ) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_node_")
+  declareNamedSchema = wellNamedSchema "_node_"
 
-instance ToSchema hyperdata =>
+instance (Typeable hyperdata, ToSchema hyperdata) =>
          ToSchema (NodePolySearch NodeId NodeTypeId
                             (Maybe UserId)
                             ParentId NodeName
                             UTCTime hyperdata (Maybe TSVector)
                   ) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ns_")
+  declareNamedSchema = wellNamedSchema "_ns_"
 
-instance ToSchema hyperdata =>
+instance (Typeable hyperdata, ToSchema hyperdata) =>
          ToSchema (NodePolySearch NodeId NodeTypeId
                             UserId
                             (Maybe ParentId) NodeName
                             UTCTime hyperdata (Maybe TSVector)
                   ) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ns_")
+  declareNamedSchema = wellNamedSchema "_ns_"
 
 instance (Arbitrary hyperdata
          ,Arbitrary nodeId

src/Gargantext/Database/Query/Facet.hs

@@ -44,6 +44,7 @@ import Data.Swagger
 import Data.Text (Text)
 import Data.Time (UTCTime)
 import Data.Time.Segment (jour)
+import Data.Typeable (Typeable)
 import GHC.Generics (Generic)
 import Opaleye
 import Prelude hiding (null, id, map, sum, not, read)
@@ -53,7 +54,7 @@ import Test.QuickCheck.Arbitrary
 import qualified Opaleye.Internal.Unpackspec()
 
 import Gargantext.Core.Types
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Query.Filter
@@ -105,8 +106,8 @@ data Pair i l = Pair {_p_id    :: i
 $(deriveJSON (unPrefix "_p_") ''Pair)
 $(makeAdaptorAndInstance "pPair" ''Pair)
 
-instance (ToSchema i, ToSchema l) => ToSchema (Pair i l) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_p_")
+instance (Typeable i, Typeable l, ToSchema i, ToSchema l) => ToSchema (Pair i l) where
+  declareNamedSchema = wellNamedSchema "_p_"
 instance (Arbitrary i, Arbitrary l) => Arbitrary (Pair i l) where
   arbitrary = Pair <$> arbitrary <*> arbitrary
 
@@ -125,8 +126,13 @@ instance ( ToSchema id
          , ToSchema hyperdata
          , ToSchema score
          , ToSchema pair
+         , Typeable id
+         , Typeable date
+         , Typeable hyperdata
+         , Typeable score
+         , Typeable pair
          ) => ToSchema (FacetPaired id date hyperdata score pair) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fp_")
+  declareNamedSchema = wellNamedSchema "_fp_"
 
 instance ( Arbitrary id
          , Arbitrary date

src/Gargantext/Prelude.hs

@@ -26,6 +26,7 @@ module Gargantext.Prelude
   , sortWith
   , module Prelude
   , MonadBase(..)
+  , Typeable
   )
   where
 
@@ -36,6 +37,7 @@ import GHC.Real (round)
 import Data.Map (Map, lookup)
 import Data.Maybe (isJust, fromJust, maybe)
 import Data.Text (Text)
+import Data.Typeable (Typeable)
 import Protolude ( Bool(True, False), Int, Int64, Double, Integer
                  , Fractional, Num, Maybe(Just,Nothing)
                  , Enum, Bounded, Float

stack.yaml

@@ -47,7 +47,7 @@ extra-deps:
   #- git: https://github.com/delanoe/servant-job.git
   #commit: 7a7b7100e6d132adb4c11b25b2128e6309690ac0
 - git: https://github.com/np/servant-job.git
-  commit: 5b994e20e90e344b67368b8c6ae3bd917322a35e
+  commit: 6487744c322baaa9229fdabd321a878a5b363c61
 - git: https://gitlab.iscpif.fr/gargantext/clustering-louvain.git
   commit: 7d74f96dfea8e51fbab1793cc0429b2fe741f73d
 - git: https://github.com/np/patches-map