[graphql] fix droping field prefixes

src/Gargantext/API/Admin/Orchestrator/Types.hs

@@ -18,12 +18,11 @@ module Gargantext.API.Admin.Orchestrator.Types
   where
 
 import Data.Aeson (genericParseJSON, genericToJSON)
-import Data.Morpheus.Types ( GQLType, VisitType(visitFieldNames) )
+import Data.Morpheus.Types ( GQLType(..), DropNamespace(..), typeDirective )
 import Data.Swagger (ToSchema, URL, declareNamedSchema, defaultSchemaOptions, genericDeclareNamedSchemaUnrestricted)
 -- import Gargantext.API.GraphQL.UnPrefix qualified as GQLU
 import Gargantext.Core.Types (TODO(..))
 import Gargantext.Core.Utils.Aeson (jsonOptions)
-import Gargantext.Core.Utils.Prefix (dropPrefixT)
 import Gargantext.Prelude
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
@@ -75,9 +74,8 @@ instance ToJSON ScraperEvent where
 instance FromJSON ScraperEvent where
   parseJSON = genericParseJSON $ jsonOptions "_scev_"
 instance ToSchema ScraperEvent  -- TODO _scev_ prefix
-instance GQLType ScraperEvent
-instance VisitType ScraperEvent where
-  visitFieldNames _ = dropPrefixT "_scev_"
+instance GQLType ScraperEvent where
+  directives _ = typeDirective DropNamespace { dropNamespace = "_scev_" }
 
 
 data JobLog = JobLog
@@ -104,7 +102,5 @@ instance ToJSON JobLog where
 instance FromJSON JobLog where
   parseJSON = genericParseJSON $ jsonOptions "_scst_"
 instance ToSchema JobLog -- TODO _scst_ prefix
-instance GQLType JobLog
---   typeOptions _ = GQLU.unPrefix "_scst_"
-instance VisitType JobLog where
-  visitFieldNames _ = dropPrefixT "_scst_"
+instance GQLType JobLog where
+  directives _ = typeDirective DropNamespace { dropNamespace = "_scst_" }

src/Gargantext/Core/Utils/Prefix.hs

@@ -20,9 +20,7 @@ import Data.Aeson (Value, defaultOptions, parseJSON)
 import Data.Aeson.TH (Options, fieldLabelModifier, omitNothingFields, sumEncoding, SumEncoding(UntaggedValue))
 import Data.Aeson.Types (Parser)
 import Data.Char (toLower)
-import Data.Maybe (fromMaybe)
 import Data.Swagger.SchemaOptions (SchemaOptions, fromAesonOptions)
-import Data.Text qualified as T
 import Prelude
 import Text.Read (readMaybe)
 
@@ -65,6 +63,3 @@ parseJSONFromString v = do
   case readMaybe (numString :: String) of
     Nothing -> fail $ "Invalid number for TransactionID: " ++ show v -- TODO error message too specific
     Just n -> pure n
-
-dropPrefixT :: T.Text -> T.Text -> T.Text
-dropPrefixT prefix input = fromMaybe input (T.stripPrefix prefix input)

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

@@ -19,10 +19,9 @@ Portability : POSIX
 module Gargantext.Database.Admin.Types.Hyperdata.Contact
   where
 
-import Data.Morpheus.Types (GQLType, VisitType(visitFieldNames))
+import Data.Morpheus.Types (GQLType(..), DropNamespace(..), typeDirective)
 import Data.Time.Segment (jour)
 import Gargantext.Core.Text (HasText(..))
-import Gargantext.Core.Utils.Prefix (dropPrefixT)
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude
 import Gargantext.Prelude
 import Gargantext.Utils.UTCTime ( NUTCTime(..) )
@@ -37,9 +36,8 @@ data HyperdataContact =
                    , _hc_lastValidation  :: Maybe Text -- TODO UTCTime
   } deriving (Eq, Show, Generic)
 
-instance GQLType HyperdataContact
-instance VisitType HyperdataContact where
-  visitFieldNames _ = dropPrefixT "_hc_"
+instance GQLType HyperdataContact where
+  directives _ = typeDirective DropNamespace { dropNamespace = "_hc_" }
 
 instance HasText HyperdataContact
   where
@@ -94,9 +92,8 @@ data ContactWho =
              , _cw_description :: Maybe Text
   } deriving (Eq, Show, Generic)
 
-instance GQLType ContactWho
-instance VisitType ContactWho where
-  visitFieldNames _ = dropPrefixT "_cw_"
+instance GQLType ContactWho where
+  directives _ = typeDirective DropNamespace { dropNamespace = "_cw_" }
 
 type FirstName = Text
 type LastName  = Text
@@ -129,9 +126,8 @@ data ContactWhere =
                , _cw_exit         :: Maybe NUTCTime
   } deriving (Eq, Show, Generic)
 
-instance GQLType ContactWhere
-instance VisitType ContactWhere where
-  visitFieldNames _ = dropPrefixT "_cw_"
+instance GQLType ContactWhere where
+  directives _ = typeDirective DropNamespace { dropNamespace = "_cw_" }
 
 defaultContactWhere :: ContactWhere
 defaultContactWhere =
@@ -152,9 +148,8 @@ data ContactTouch =
                   , _ct_url       :: Maybe Text
   } deriving (Eq, Show, Generic)
 
-instance GQLType ContactTouch
-instance VisitType ContactTouch where
-  visitFieldNames _ = dropPrefixT "_ct_"
+instance GQLType ContactTouch where
+  directives _ = typeDirective DropNamespace { dropNamespace = "_ct_" }
 
 defaultContactTouch :: ContactTouch
 defaultContactTouch =

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

@@ -18,14 +18,13 @@ Portability : POSIX
 module Gargantext.Database.Admin.Types.Hyperdata.User
   where
 
-import Data.Morpheus.Types (GQLType, VisitType(visitFieldNames))
+import Data.Morpheus.Types (GQLType(..), DropNamespace(..), typeDirective)
 import Gargantext.Core (Lang(..))
-import Gargantext.Core.Utils.Prefix (dropPrefixT)
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude
 import Gargantext.Database.Admin.Types.Hyperdata.Contact
 import Gargantext.Database.Admin.Types.Node (DocumentId)
 import Gargantext.Prelude
-import qualified PUBMED.Types as PUBMED
+import PUBMED.Types qualified as PUBMED
 
 -- import Gargantext.Database.Schema.Node -- (Node(..))
 
@@ -38,20 +37,17 @@ data HyperdataUser =
                    , _hu_epo_api_token  :: !(Maybe Text)
                    } deriving (Eq, Show, Generic)
 
-instance GQLType HyperdataUser
-instance VisitType HyperdataUser where
-  visitFieldNames _ = dropPrefixT "_hu_"
+instance GQLType HyperdataUser where
+  directives _ = typeDirective DropNamespace { dropNamespace = "_hu_" }
 
 data HyperdataPrivate =
      HyperdataPrivate { _hpr_password :: !Text
                       , _hpr_lang     :: !Lang
                       }
-     deriving (Eq, Show, Generic, GQLType)
+     deriving (Eq, Show, Generic)
 
--- instance GQLType HyperdataPrivate where
---   typeOptions _ = GAGU.unPrefix "_hpr_"
-instance VisitType HyperdataPrivate where
-  visitFieldNames _ = dropPrefixT "_hpr_"
+instance GQLType HyperdataPrivate where
+  directives _ = typeDirective DropNamespace { dropNamespace = "_hpr_" }
 
 
 data HyperdataPublic =
@@ -60,9 +56,8 @@ data HyperdataPublic =
                      }
      deriving (Eq, Show, Generic)
 
-instance GQLType HyperdataPublic
-instance VisitType HyperdataPublic where
-  visitFieldNames _ = dropPrefixT "_hpu_"
+instance GQLType HyperdataPublic where
+  directives _ = typeDirective DropNamespace { dropNamespace = "_hpu_" }
 
 -- | Default
 defaultHyperdataUser :: HyperdataUser

src/Gargantext/Database/Schema/User.hs

@@ -19,12 +19,12 @@ Functions to deal with users, database side.
 
 module Gargantext.Database.Schema.User where
 
-import Data.Morpheus.Types (GQLType, VisitType(visitFieldNames))
+import Data.Morpheus.Types (GQLType(..), DropNamespace(..), typeDirective)
 import Data.Time (UTCTime)
 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 -- import Gargantext.API.GraphQL.UnPrefix qualified as GAGU
 import Gargantext.Core.Types.Individu (GargPassword, toGargPassword)
-import Gargantext.Core.Utils.Prefix (unPrefix, dropPrefixT)
+import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Database.Prelude (fromField')
 import Gargantext.Prelude
 
@@ -44,9 +44,8 @@ data UserLight = UserLight { userLight_id                   :: !UserId
                            , userLight_password             :: !GargPassword
                            , userLight_forgot_password_uuid :: !(Maybe Text)
                            } deriving (Show, Generic)
-instance GQLType UserLight
-instance VisitType UserLight where
-  visitFieldNames _ = dropPrefixT "userLight_"
+instance GQLType UserLight where
+  directives _ = typeDirective DropNamespace { dropNamespace = "userLight_" }
 
 toUserLight :: UserDB -> UserLight
 toUserLight (UserDB { user_id