[graphql] implement unprefix for graphql serialization of models

src/Gargantext/API/GraphQL.hs

@@ -18,8 +18,6 @@ import Data.Maybe (fromMaybe)
 import Data.Morpheus
   ( App
   , deriveApp )
-import Data.Morpheus.App.Internal.Resolving
-  ( failure )
 import Data.Morpheus.Server
   ( httpPlayground
   )

src/Gargantext/API/GraphQL/Utils.hs

 module Gargantext.API.GraphQL.Utils where
 
-import Data.Morpheus.Types (GQLTypeOptions, fieldLabelModifier)
+import Data.Morpheus.Types (GQLTypeOptions(..))
 import qualified Data.Text as T
 import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
 import Gargantext.Prelude
 
 unPrefix :: T.Text -> GQLTypeOptions -> GQLTypeOptions
-unPrefix prefix gqlto = fieldLabelModifier gqlto nflm
+unPrefix prefix (GQLTypeOptions { fieldLabelModifier, .. }) = GQLTypeOptions { fieldLabelModifier = nflm, .. }
   where
-    nflm label = unCapitalize $ dropPrefix (T.unpack prefix) label
+    nflm label = unCapitalize $ dropPrefix (T.unpack prefix) $ fieldLabelModifier label

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

@@ -26,6 +26,7 @@ module Gargantext.Database.Admin.Types.Hyperdata.Contact
 
 import Data.Morpheus.Types (GQLType(..))
 import Data.Time.Segment (jour)
+import qualified Gargantext.API.GraphQL.Utils as GAGU
 import Gargantext.Core.Text (HasText(..))
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude
 import Gargantext.Prelude
@@ -42,7 +43,10 @@ data HyperdataContact =
                       , _hc_uniqIdBdd       :: Maybe Text
                       , _hc_uniqId          :: Maybe Text
 
-  } deriving (Eq, Show, Generic, GQLType)
+  } deriving (Eq, Show, Generic)
+
+instance GQLType HyperdataContact where
+  typeOptions _ = GAGU.unPrefix "_hc_"
 
 instance HasText HyperdataContact
   where
@@ -89,7 +93,10 @@ data ContactWho =
                 , _cw_lastName    :: Maybe Text
                 , _cw_keywords :: [Text]
                 , _cw_freetags :: [Text]
-  } deriving (Eq, Show, Generic, GQLType)
+  } deriving (Eq, Show, Generic)
+
+instance GQLType ContactWho where
+  typeOptions _ = GAGU.unPrefix "_cw_"
 
 type FirstName = Text
 type LastName  = Text
@@ -118,7 +125,10 @@ data ContactWhere =
 
                   , _cw_entry        :: Maybe NUTCTime
                   , _cw_exit         :: Maybe NUTCTime
-  } deriving (Eq, Show, Generic, GQLType)
+  } deriving (Eq, Show, Generic)
+
+instance GQLType ContactWhere where
+  typeOptions _ = GAGU.unPrefix "_cw_"
 
 defaultContactWhere :: ContactWhere
 defaultContactWhere = ContactWhere ["Organization X"]
@@ -135,7 +145,10 @@ data ContactTouch =
      ContactTouch { _ct_mail      :: Maybe Text
                   , _ct_phone     :: Maybe Text
                   , _ct_url       :: Maybe Text
-  } deriving (Eq, Show, Generic, GQLType)
+  } deriving (Eq, Show, Generic)
+
+instance GQLType ContactTouch where
+  typeOptions _ = GAGU.unPrefix "_ct_"
 
 defaultContactTouch :: ContactTouch
 defaultContactTouch = ContactTouch (Just "email@data.com")

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

@@ -24,7 +24,7 @@ Portability : POSIX
 module Gargantext.Database.Admin.Types.Hyperdata.User
   where
 
-import Data.Morpheus.Types (GQLType(typeOptions), defaultTypeOptions)
+import Data.Morpheus.Types (GQLType(typeOptions))
 import qualified Gargantext.API.GraphQL.Utils as GAGU
 import Gargantext.Core (Lang(..))
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude
@@ -41,19 +41,26 @@ data HyperdataUser =
                    } deriving (Eq, Show, Generic)
 
 instance GQLType HyperdataUser where
-  typeOptions _ = GAGU.unPrefix "_hu_" defaultTypeOptions
+  typeOptions _ = GAGU.unPrefix "_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_"
+
 
 data HyperdataPublic =
      HyperdataPublic { _hpu_pseudo       :: !Text
                      , _hpu_publications :: ![DocumentId]
                      }
-     deriving (Eq, Show, Generic, GQLType)
+     deriving (Eq, Show, Generic)
+
+instance GQLType HyperdataPublic where
+  typeOptions _ = GAGU.unPrefix "_hpu_"
 
 -- | Default
 defaultHyperdataUser :: HyperdataUser

src/Gargantext/Database/Schema/User.hs

@@ -20,15 +20,16 @@ Functions to deal with users, database side.
 
 module Gargantext.Database.Schema.User where
 
-import Data.Morpheus.Types (GQLType)
+import Data.Morpheus.Types (GQLType(typeOptions))
 import Data.Text (Text)
 import Data.Time (UTCTime)
+import qualified Gargantext.API.GraphQL.Utils as GAGU
+import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Database.Prelude (fromField')
 import Gargantext.Prelude
 import GHC.Generics (Generic)
 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import Data.Aeson.TH (deriveJSON)
-import Gargantext.Database.Prelude (fromField')
-import Gargantext.Core.Utils.Prefix (unPrefix)
 
 -- FIXME PLZ : the import below leads to an error, why ?
 -- import Gargantext.Database.Schema.Prelude hiding (makeLensesWith, abbreviatedFields, makeAdaptorAndInstance)
@@ -43,7 +44,10 @@ data UserLight = UserLight { userLight_id       :: !Int
                            , userLight_username :: !Text
                            , userLight_email    :: !Text
                            , userLight_password :: !Text
-                           } deriving (Show, Generic, GQLType)
+                           } deriving (Show, Generic)
+
+instance GQLType UserLight where
+  typeOptions _ = GAGU.unPrefix "userLight_"
 
 toUserLight :: UserDB -> UserLight
 toUserLight (UserDB id p _ _ u _ _ e _ _ _ ) = UserLight id u e p

stack.yaml

@@ -86,8 +86,8 @@ extra-deps:
   commit: 83ada76e78ac10d9559af8ed6bd4064ec81308e4
 - accelerate-arithmetic-1.0.0.1@sha256:555639232aa5cad411e89247b27871d09352b987a754230a288c690b6de6d888,2096
 
-- git: https://github.com/morpheusgraphql/morpheus-graphql.git
-  commit: 339ee745049febbf2e7fd6fabf1e01afab19d0a9
+- git: https://github.com/CGenie/morpheus-graphql.git
+  commit: 899b7bf21274739beae84b27812f76e2a5e67e29
   subdirs:
   - .
   - morpheus-graphql-app