diff --git a/cabal.project.freeze b/cabal.project.freeze
index 121d46f4216c76fa8bb9e34702b659e7530d04b6..2403bf0b3957fcedc47368ac846454eee8eb31d9 100644
--- a/cabal.project.freeze
+++ b/cabal.project.freeze
@@ -1704,15 +1704,15 @@ constraints: any.AC-Angle ==1.0,
any.monoid-transformer ==0.0.4,
any.monoidal-containers ==0.6.4.0,
any.more-containers ==0.2.2.2,
- any.morpheus-graphql ==0.27.3,
- any.morpheus-graphql-app ==0.27.3,
- any.morpheus-graphql-client ==0.27.3,
- any.morpheus-graphql-code-gen ==0.27.3,
- any.morpheus-graphql-code-gen-utils ==0.27.3,
- any.morpheus-graphql-core ==0.27.3,
- any.morpheus-graphql-server ==0.27.3,
- any.morpheus-graphql-subscriptions ==0.27.3,
- any.morpheus-graphql-tests ==0.27.3,
+ any.morpheus-graphql ==0.24.3,
+ any.morpheus-graphql-app ==0.24.3,
+ any.morpheus-graphql-client ==0.24.3,
+ any.morpheus-graphql-code-gen ==0.24.3,
+ any.morpheus-graphql-code-gen-utils ==0.24.3,
+ any.morpheus-graphql-core ==0.24.3,
+ any.morpheus-graphql-server ==0.24.3,
+ any.morpheus-graphql-subscriptions ==0.24.3,
+ any.morpheus-graphql-tests ==0.24.3,
any.moss ==0.2.0.1,
any.mountpoints ==1.0.2,
any.mpi-hs ==0.7.2.0,
diff --git a/gargantext.cabal b/gargantext.cabal
index e3131b6c8d8add466436433689c0bb870c2855a1..8060c48a3b0a200b6e4f4cc9fc31ad72d3ebb105 100644
--- a/gargantext.cabal
+++ b/gargantext.cabal
@@ -45,6 +45,10 @@ flag test-crypto
default: False
manual: True
+flag disable-db-obfuscation-executable
+ default: False
+ manual: True
+
library
exposed-modules:
Gargantext
@@ -165,6 +169,7 @@ library
Gargantext.Utils.Jobs.Settings
Gargantext.Utils.Jobs.State
Gargantext.Utils.SpacyNLP
+ Gargantext.Utils.SpacyNLP.Types
Gargantext.Utils.Tuple
Gargantext.Utils.Zip
other-modules:
@@ -491,10 +496,11 @@ library
, matrix ^>= 0.3.6.1
, monad-control ^>= 1.0.3.1
, monad-logger ^>= 0.3.36
- , morpheus-graphql ^>= 0.17.0
- , morpheus-graphql-app ^>= 0.17.0
- , morpheus-graphql-core ^>= 0.17.0
- , morpheus-graphql-subscriptions ^>= 0.17.0
+ , morpheus-graphql >= 0.17.0 && < 0.25
+ , morpheus-graphql-app >= 0.17.0 && < 0.25
+ , morpheus-graphql-core >= 0.17.0 && < 0.25
+ , morpheus-graphql-server >= 0.17.0 && < 0.25
+ , morpheus-graphql-subscriptions >= 0.17.0 && < 0.25
, mtl ^>= 2.2.2
, natural-transformation ^>= 0.4
, network-uri ^>= 2.6.4.1
@@ -547,6 +553,7 @@ library
, servant-xml-conduit >= 0.1.0.4
, simple-reflect ^>= 0.3.3
, singletons ^>= 2.7
+ , singletons-th >= 3.1
, split ^>= 0.2.3.4
, stemmer ^>= 0.5.2
, stm ^>= 2.5.0.1
@@ -714,15 +721,18 @@ executable gargantext-db-obfuscation
RecordWildCards
StrictData
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2 -Wmissing-signatures
- build-depends:
- base
- , extra
- , gargantext
- , gargantext-prelude
- , optparse-simple
- , postgresql-simple ^>= 0.6.4
- , text
- default-language: Haskell2010
+ if flag(disable-db-obfuscation-executable)
+ buildable: False
+ else
+ build-depends:
+ base
+ , extra
+ , gargantext
+ , gargantext-prelude
+ , optparse-simple
+ , postgresql-simple ^>= 0.6.4
+ , text
+ default-language: Haskell2010
executable gargantext-import
main-is: Main.hs
diff --git a/src/Gargantext/API/Admin/Auth/Types.hs b/src/Gargantext/API/Admin/Auth/Types.hs
index 9350aa0e6effd011b90e313c425d4b9d667283c2..e4a98a6a5655657513fe6337c7de8327241df982 100644
--- a/src/Gargantext/API/Admin/Auth/Types.hs
+++ b/src/Gargantext/API/Admin/Auth/Types.hs
@@ -52,16 +52,11 @@ data AuthenticatedUser = AuthenticatedUser
, _auth_user_id :: UserId
} deriving (Generic)
-$(deriveJSON (JSON.defaultOptions { JSON.fieldLabelModifier = tail . dropWhile ((/=) '_') . tail }) ''AuthenticatedUser)
-
makeLenses ''AuthenticatedUser
instance ToSchema AuthenticatedUser where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authUser_")
-instance ToJWT AuthenticatedUser
-instance FromJWT AuthenticatedUser
-
data AuthenticationError
= LoginFailed NodeId UserId Jose.Error
| InvalidUsernameOrPassword
@@ -71,7 +66,6 @@ data AuthenticationError
type AuthContext = '[JWTSettings, CookieSettings] -- , BasicAuthCfg
-- | Instances
-$(deriveJSON (unPrefix "_authReq_") ''AuthRequest)
instance ToSchema AuthRequest where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authReq_")
@@ -81,7 +75,6 @@ instance Arbitrary AuthRequest where
, p <- arbitraryPassword
]
-$(deriveJSON (unPrefix "_authRes_") ''AuthResponse)
instance ToSchema AuthResponse where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authRes_")
instance Arbitrary AuthResponse where
@@ -101,20 +94,43 @@ type Password = Text
data ForgotPasswordRequest = ForgotPasswordRequest { _fpReq_email :: Email }
deriving (Generic )
-$(deriveJSON (unPrefix "_fpReq_") ''ForgotPasswordRequest)
instance ToSchema ForgotPasswordRequest where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fpReq_")
data ForgotPasswordResponse = ForgotPasswordResponse { _fpRes_status :: Text }
deriving (Generic )
-$(deriveJSON (unPrefix "_fpRes_") ''ForgotPasswordResponse)
instance ToSchema ForgotPasswordResponse where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fpRes_")
data ForgotPasswordGet = ForgotPasswordGet {_fpGet_password :: Password}
deriving (Generic )
-$(deriveJSON (unPrefix "_fpGet_") ''ForgotPasswordGet)
instance ToSchema ForgotPasswordGet where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fpGet_")
+--
+-- Lenses
+--
+
+makeLenses ''AuthValid
+>>>>>>> b7657056 (Fix compilation errors due to switch to GHC 9.4.7)
makeLenses ''AuthResponse
+
+--
+-- JSON instances
+--
+
+$(deriveJSON (JSON.defaultOptions { JSON.fieldLabelModifier = tail . dropWhile ((/=) '_') . tail }) ''AuthenticatedUser)
+$(deriveJSON (unPrefix "_authReq_") ''AuthRequest)
+$(deriveJSON (unPrefix "_authInv_") ''AuthInvalid)
+$(deriveJSON (unPrefix "_authVal_") ''AuthValid)
+$(deriveJSON (unPrefix "_authRes_") ''AuthResponse)
+$(deriveJSON (unPrefix "_fpReq_") ''ForgotPasswordRequest)
+$(deriveJSON (unPrefix "_fpRes_") ''ForgotPasswordResponse)
+$(deriveJSON (unPrefix "_fpGet_") ''ForgotPasswordGet)
+
+--
+-- JWT instances
+--
+
+instance ToJWT AuthenticatedUser
+instance FromJWT AuthenticatedUser
diff --git a/src/Gargantext/API/Admin/Settings.hs b/src/Gargantext/API/Admin/Settings.hs
index ef319f52b669de870a9dba9e8516c54f1ab13dc1..c78976154e8a2b8d1defdc4e867e3a87d8c06c4d 100644
--- a/src/Gargantext/API/Admin/Settings.hs
+++ b/src/Gargantext/API/Admin/Settings.hs
@@ -24,7 +24,8 @@ import Control.Lens
import Control.Monad.Logger (LogLevel(..))
import Control.Monad.Reader
import Data.ByteString.Lazy qualified as L
-import Data.Pool (Pool, createPool)
+import Data.Pool (Pool)
+import qualified Data.Pool as Pool
import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo)
import Gargantext.API.Admin.EnvTypes
import Gargantext.API.Admin.Types
@@ -217,7 +218,7 @@ newEnv logger port file = do
}
newPool :: ConnectInfo -> IO (Pool Connection)
-newPool param = createPool (connect param) close 1 (60*60) 8
+newPool param = Pool.newPool $ Pool.setNumStripes (Just 1) $ Pool.defaultPoolConfig (connect param) close (60*60) 8
{-
cleanEnv :: (HasConfig env, HasRepo env) => env -> IO ()
diff --git a/src/Gargantext/API/Count.hs b/src/Gargantext/API/Count.hs
index 7562c350c0cc69f5dab5646880907eb3d958e807..593ccc1f9a4fa305d7461e38ca8157d45400670f 100644
--- a/src/Gargantext/API/Count.hs
+++ b/src/Gargantext/API/Count.hs
@@ -104,18 +104,12 @@ messages = toMessage $ [ (400, ["Ill formed query "])
instance Arbitrary Message where
arbitrary = elements messages
-instance FromJSON Message
-instance ToJSON Message
-
instance ToSchema Message
-----------------------------------------------------------------------
data Counts = Counts { results :: [Either Message Count]
} deriving (Eq, Show, Generic)
-instance FromJSON Counts
-instance ToJSON Counts
-
instance Arbitrary Counts where
arbitrary = elements [Counts [ Right (Count Pubmed (Just 20 ))
, Right (Count IsTex (Just 150))
@@ -131,8 +125,6 @@ data Count = Count { count_name :: Scraper
}
deriving (Eq, Show, Generic)
-$(deriveJSON (unPrefix "count_") ''Count)
-
instance ToSchema Count where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "count_")
--instance Arbitrary Count where
@@ -141,3 +133,16 @@ instance ToSchema Count where
-----------------------------------------------------------------------
count :: Monad m => Query -> m Counts
count _ = undefined
+
+--
+-- JSON instances
+--
+
+instance FromJSON Message
+instance ToJSON Message
+
+$(deriveJSON (unPrefix "count_") ''Count)
+
+instance FromJSON Counts
+instance ToJSON Counts
+
diff --git a/src/Gargantext/API/Errors/Types.hs b/src/Gargantext/API/Errors/Types.hs
index 1334985dba97bb58ec0fa600084e46966dc01b14..afb99acc93ea288e752ab32f94f88f9c3ca9cb97 100644
--- a/src/Gargantext/API/Errors/Types.hs
+++ b/src/Gargantext/API/Errors/Types.hs
@@ -671,8 +671,8 @@ genFrontendErr be = do
EC_404__tree_empty_root
-> pure $ mkFrontendErr' txt $ FE_tree_empty_root
EC_500__tree_too_many_roots
- -> do nodes <- arbitrary
- pure $ mkFrontendErr' txt $ FE_tree_too_many_roots nodes
+ -> do nodes <- getNonEmpty <$> arbitrary
+ pure $ mkFrontendErr' txt $ FE_tree_too_many_roots (NE.fromList nodes)
-- job errors
EC_500__job_invalid_id_type
diff --git a/src/Gargantext/API/GraphQL.hs b/src/Gargantext/API/GraphQL.hs
index b423ccb99d16e017c844a63ecdcec839b4ab87c5..72645008383299a79753e182a3bec24e9c1b45de 100644
--- a/src/Gargantext/API/GraphQL.hs
+++ b/src/Gargantext/API/GraphQL.hs
@@ -22,7 +22,7 @@ import Data.ByteString.Lazy.Char8 ( ByteString )
import Data.Morpheus ( App, deriveApp )
import Data.Morpheus.Server ( httpPlayground )
import Data.Morpheus.Subscriptions ( Event (..), httpPubApp )
-import Data.Morpheus.Types ( GQLRequest, GQLResponse, GQLType, RootResolver(..), Undefined(..) )
+import Data.Morpheus.Types ( GQLRequest, GQLResponse, GQLType, RootResolver(..), Undefined, defaultRootResolver)
import Data.Proxy
import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
import Gargantext.API.Admin.Orchestrator.Types (JobLog)
@@ -111,7 +111,7 @@ rootResolver
-> AccessPolicyManager
-> RootResolver (GargM env BackendInternalError) e Query Mutation Undefined
rootResolver authenticatedUser policyManager =
- RootResolver
+ defaultRootResolver
{ queryResolver = Query { annuaire_contacts = GQLA.resolveAnnuaireContacts
, context_ngrams = GQLCTX.resolveContextNgrams
, contexts = GQLCTX.resolveNodeContext
@@ -133,7 +133,7 @@ rootResolver authenticatedUser policyManager =
, update_user_epo_api_token = GQLUser.updateUserEPOAPIToken
, delete_team_membership = GQLTeam.deleteTeamMembership
, update_node_context_category = GQLCTX.updateNodeContextCategory }
- , subscriptionResolver = Undefined }
+ }
-- | Main GraphQL "app".
app
diff --git a/src/Gargantext/API/GraphQL/Node.hs b/src/Gargantext/API/GraphQL/Node.hs
index af1892dbd18f118ce03a3ccf487024b859cae1da..6ac3a4c4a5d815b2cfefe293014986d980290872 100644
--- a/src/Gargantext/API/GraphQL/Node.hs
+++ b/src/Gargantext/API/GraphQL/Node.hs
@@ -15,7 +15,7 @@ Portability : POSIX
module Gargantext.API.GraphQL.Node where
import Data.Aeson
-import Data.HashMap.Strict qualified as HashMap
+import Data.Aeson.KeyMap qualified as KM
import Data.Morpheus.Types ( GQLType )
import Data.Text qualified as T
import Gargantext.API.Admin.Auth.Types
@@ -126,7 +126,7 @@ toCorpus N.Node { .. } = Corpus { id = NN.unNodeId _node_id
pubmedAPIKeyFromValue :: Value -> Maybe PUBMED.APIKey
pubmedAPIKeyFromValue (Object kv) =
- case HashMap.lookup "pubmed_api_key" kv of
+ case KM.lookup "pubmed_api_key" kv of
Nothing -> Nothing
Just v -> case fromJSON v of
Error _ -> Nothing
diff --git a/src/Gargantext/API/GraphQL/Utils.hs b/src/Gargantext/API/GraphQL/Utils.hs
index dee31a397a6fd0d87945e92d4c4ee440a89db12e..f7d4b7fea2f65ac5b1a03cbf6c28bba8ee530378 100644
--- a/src/Gargantext/API/GraphQL/Utils.hs
+++ b/src/Gargantext/API/GraphQL/Utils.hs
@@ -8,6 +8,8 @@ Stability : experimental
Portability : POSIX
-}
+{-# OPTIONS_GHC -Wno-deprecations #-} -- FIXME(adn) GraphQL will need updating.
+
module Gargantext.API.GraphQL.Utils where
import Control.Lens.Getter (view)
diff --git a/src/Gargantext/API/Ngrams.hs b/src/Gargantext/API/Ngrams.hs
index a61429c6946bb3cc32bd26ad6f6163a807baf555..7d8a3a1dabbfc9cf8b3c5290f318a2a8f82ab5a5 100644
--- a/src/Gargantext/API/Ngrams.hs
+++ b/src/Gargantext/API/Ngrams.hs
@@ -120,7 +120,7 @@ import Gargantext.Database.Query.Table.Node (getNode)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node.Select
import Gargantext.Database.Schema.Node (node_id, node_parent_id, node_user_id)
-import Gargantext.Prelude hiding (log, to, toLower, (%))
+import Gargantext.Prelude hiding (log, to, toLower, (%), isInfixOf)
import Gargantext.Prelude.Clock (hasTime, getTime)
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import GHC.Conc (readTVar, writeTVar)
diff --git a/src/Gargantext/API/Ngrams/Tools.hs b/src/Gargantext/API/Ngrams/Tools.hs
index 44f8a186750ba2f6b84a54585f5741c5d61c8f7d..495a6a793e584c81fd03f7b9d0cac5b45e8c2d0d 100644
--- a/src/Gargantext/API/Ngrams/Tools.hs
+++ b/src/Gargantext/API/Ngrams/Tools.hs
@@ -9,7 +9,8 @@ Portability : POSIX
-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
module Gargantext.API.Ngrams.Tools
where
diff --git a/src/Gargantext/API/Ngrams/Types.hs b/src/Gargantext/API/Ngrams/Types.hs
index fe7982aa36531ab55d46d2581f10fa348bd4271e..87cc9b77bead909dc4f4bc43ce1397fc025e6303 100644
--- a/src/Gargantext/API/Ngrams/Types.hs
+++ b/src/Gargantext/API/Ngrams/Types.hs
@@ -84,8 +84,6 @@ instance ToParamSchema TabType
instance ToJSON TabType
instance FromJSON TabType
instance ToSchema TabType
-instance Arbitrary TabType where
- arbitrary = elements [minBound .. maxBound]
instance FromJSONKey TabType where
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
instance ToJSONKey TabType where
@@ -161,14 +159,11 @@ deriveJSON (unPrefix "_nre_") ''NgramsRepoElement
makeLenses ''NgramsRepoElement
instance ToSchema NgramsRepoElement where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_nre_")
-instance Serialise NgramsRepoElement
instance FromField NgramsRepoElement where
fromField = fromJSONField
instance ToField NgramsRepoElement where
toField = toJSONField
-instance Serialise (MSet NgramsTerm)
-
data NgramsElement =
NgramsElement { _ne_ngrams :: NgramsTerm
, _ne_size :: Int
@@ -197,9 +192,6 @@ newNgramsElement mayList ngrams =
instance ToSchema NgramsElement where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ne_")
-instance Arbitrary NgramsElement where
- arbitrary = elements [newNgramsElement Nothing "sport"]
-
------------------------------------------------------------------------
newtype NgramsTable = NgramsTable [NgramsElement]
@@ -257,9 +249,6 @@ mockTable = NgramsTable
where
rp n = Just $ RootParent n n
-instance Arbitrary NgramsTable where
- arbitrary = pure mockTable
-
instance ToSchema NgramsTable
------------------------------------------------------------------------
@@ -283,10 +272,6 @@ instance ToParamSchema OrderBy
instance FromJSON OrderBy
instance ToJSON OrderBy
instance ToSchema OrderBy
-instance Arbitrary OrderBy
- where
- arbitrary = elements [minBound..maxBound]
-
-- | A query on a 'NgramsTable'.
data NgramsSearchQuery = NgramsSearchQuery
@@ -367,8 +352,6 @@ instance ToSchema a => ToSchema (PatchSet a)
type AddRem = Replace (Maybe ())
-instance Serialise AddRem
-
remPatch, addPatch :: AddRem
remPatch = replace (Just ()) Nothing
addPatch = replace Nothing (Just ())
@@ -388,9 +371,6 @@ unPatchMSet (PatchMSet a) = a
type ConflictResolutionPatchMSet a = a -> ConflictResolutionReplace (Maybe ())
type instance ConflictResolution (PatchMSet a) = ConflictResolutionPatchMSet a
-instance (Serialise a, Ord a) => Serialise (PatchMap a AddRem)
-instance (Serialise a, Ord a) => Serialise (PatchMSet a)
-
-- TODO this breaks module abstraction
makePrisms ''PM.PatchMap
@@ -419,19 +399,12 @@ instance (Ord a, ToJSON a) => ToJSON (PatchMSet a) where
instance (Ord a, FromJSON a) => FromJSON (PatchMSet a) where
parseJSON = fmap (_PatchMSetIso #) . parseJSON
-instance (Ord a, Arbitrary a) => Arbitrary (PatchMSet a) where
- arbitrary = (PatchMSet . PM.fromMap) <$> arbitrary
-
instance ToSchema a => ToSchema (PatchMSet a) where
-- TODO
declareNamedSchema _ = wellNamedSchema "" (Proxy :: Proxy TODO)
type instance Patched (PatchMSet a) = MSet a
-instance (Eq a, Arbitrary a) => Arbitrary (Replace a) where
- arbitrary = uncurry replace <$> arbitrary
- -- If they happen to be equal then the patch is Keep.
-
instance ToSchema a => ToSchema (Replace a) where
declareNamedSchema (_ :: Proxy (Replace a)) = do
-- TODO Keep constructor is not supported here.
@@ -475,19 +448,11 @@ instance ToSchema NgramsPatch where
, ("old", nreSch)
, ("new", nreSch)
]
-instance Arbitrary NgramsPatch where
- arbitrary = frequency [ (9, NgramsPatch <$> arbitrary <*> (replace <$> arbitrary <*> arbitrary))
- , (1, NgramsReplace <$> arbitrary <*> arbitrary)
- ]
-instance Serialise NgramsPatch
instance FromField NgramsPatch where
fromField = fromJSONField
instance ToField NgramsPatch where
toField = toJSONField
-instance Serialise (Replace ListType)
-
-instance Serialise ListType
type NgramsPatchIso =
MaybePatch NgramsRepoElement (PairPatch (PatchMSet NgramsTerm) (Replace ListType))
@@ -555,9 +520,6 @@ newtype NgramsTablePatch = NgramsTablePatch (PatchMap NgramsTerm NgramsPatch)
mkNgramsTablePatch :: Map NgramsTerm NgramsPatch -> NgramsTablePatch
mkNgramsTablePatch = NgramsTablePatch . PM.fromMap
-instance Serialise NgramsTablePatch
-instance Serialise (PatchMap NgramsTerm NgramsPatch)
-
instance FromField NgramsTablePatch
where
fromField = fromJSONField
@@ -690,9 +652,6 @@ instance Action NgramsTablePatch (Maybe NgramsTableMap) where
fmap (execState (reParentNgramsTablePatch p)) .
act (p ^. _NgramsTablePatch)
-instance Arbitrary NgramsTablePatch where
- arbitrary = NgramsTablePatch <$> PM.fromMap <$> arbitrary
-
-- Should it be less than an Lens' to preserve PatchMap's abstraction.
-- ntp_ngrams_patches :: Lens' NgramsTablePatch (Map NgramsTerm NgramsPatch)
-- ntp_ngrams_patches = _NgramsTablePatch . undefined
@@ -709,8 +668,6 @@ deriveJSON (unPrefix "_v_") ''Versioned
makeLenses ''Versioned
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
------------------------------------------------------------------------
type Count = Int
@@ -724,8 +681,6 @@ deriveJSON (unPrefix "_vc_") ''VersionedWithCount
makeLenses ''VersionedWithCount
instance (Typeable a, ToSchema a) => ToSchema (VersionedWithCount a) where
declareNamedSchema = wellNamedSchema "_vc_"
-instance Arbitrary a => Arbitrary (VersionedWithCount a) where
- arbitrary = VersionedWithCount 1 1 <$> arbitrary -- TODO 1 is constant so far
toVersionedWithCount :: Count -> Versioned a -> VersionedWithCount a
toVersionedWithCount count (Versioned version data_) = VersionedWithCount version count data_
@@ -749,8 +704,6 @@ instance (ToJSON s, ToJSON p) => ToJSON (Repo s p) where
toJSON = genericToJSON $ unPrefix "_r_"
toEncoding = genericToEncoding $ unPrefix "_r_"
-instance (Serialise s, Serialise p) => Serialise (Repo s p)
-
makeLenses ''Repo
initRepo :: Monoid s => Repo s p
@@ -771,11 +724,6 @@ type RepoCmdM env err m =
-- Instances
-instance Arbitrary NgramsRepoElement where
- arbitrary = elements $ map ngramsElementToRepo ns
- where
- NgramsTable ns = mockTable
-
instance FromHttpApiData (Map TableNgrams.NgramsType (Versioned NgramsTableMap))
where
parseUrlPiece x = maybeToEither x (decode $ cs x)
@@ -814,3 +762,51 @@ instance ToSchema UpdateTableNgramsCharts where
------------------------------------------------------------------------
type NgramsList = (Map TableNgrams.NgramsType (Versioned NgramsTableMap))
+
+--
+-- Serialise instances
+--
+
+instance Serialise ListType
+instance Serialise NgramsRepoElement
+instance Serialise NgramsTablePatch
+instance Serialise (PatchMap NgramsTerm NgramsPatch)
+instance Serialise (MSet NgramsTerm)
+instance Serialise AddRem
+instance Serialise NgramsPatch
+instance Serialise (Replace ListType)
+instance (Serialise a, Ord a) => Serialise (PatchMap a AddRem)
+instance (Serialise a, Ord a) => Serialise (PatchMSet a)
+instance (Serialise s, Serialise p) => Serialise (Repo s p)
+
+--
+-- Arbitrary instances
+--
+instance Arbitrary TabType where
+ arbitrary = elements [minBound .. maxBound]
+instance Arbitrary NgramsElement where
+ arbitrary = elements [newNgramsElement Nothing "sport"]
+instance Arbitrary NgramsTable where
+ arbitrary = pure mockTable
+instance Arbitrary OrderBy
+ where
+ arbitrary = elements [minBound..maxBound]
+instance (Ord a, Arbitrary a) => Arbitrary (PatchMSet a) where
+ arbitrary = (PatchMSet . PM.fromMap) <$> arbitrary
+instance (Eq a, Arbitrary a) => Arbitrary (Replace a) where
+ arbitrary = uncurry replace <$> arbitrary
+ -- If they happen to be equal then the patch is Keep.
+instance Arbitrary NgramsPatch where
+ arbitrary = frequency [ (9, NgramsPatch <$> arbitrary <*> (replace <$> arbitrary <*> arbitrary))
+ , (1, NgramsReplace <$> arbitrary <*> arbitrary)
+ ]
+instance Arbitrary NgramsTablePatch where
+ arbitrary = NgramsTablePatch <$> PM.fromMap <$> arbitrary
+instance Arbitrary a => Arbitrary (Versioned a) where
+ arbitrary = Versioned 1 <$> arbitrary -- TODO 1 is constant so far
+instance Arbitrary a => Arbitrary (VersionedWithCount a) where
+ arbitrary = VersionedWithCount 1 1 <$> arbitrary -- TODO 1 is constant so far
+instance Arbitrary NgramsRepoElement where
+ arbitrary = elements $ map ngramsElementToRepo ns
+ where
+ NgramsTable ns = mockTable
diff --git a/src/Gargantext/API/Node.hs b/src/Gargantext/API/Node.hs
index 4a8f7a39517609e124eda25b1e1f155be9b208e4..91ddee157344e9ec7a48f0623f400afa2f875ede 100644
--- a/src/Gargantext/API/Node.hs
+++ b/src/Gargantext/API/Node.hs
@@ -189,62 +189,6 @@ nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uI
nodeNodeAPI' :: GargServer (NodeNodeAPI a)
nodeNodeAPI' = getNodeWith nId p
-------------------------------------------------------------------------
--- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
-nodeAPI :: forall proxy a.
- ( HyperdataC a, Show a
- ) => proxy a
- -> AuthenticatedUser
- -> NodeId
- -> ServerT (NodeAPI a) (GargM Env BackendInternalError)
-nodeAPI p authenticatedUser targetNode =
- withAccess (Proxy :: Proxy (NodeAPI a)) Proxy authenticatedUser (PathNode targetNode) nodeAPI'
- where
-
- userRootId = RootId $ authenticatedUser ^. auth_node_id
-
- nodeAPI' :: ServerT (NodeAPI a) (GargM Env BackendInternalError)
- nodeAPI' = withPolicy authenticatedUser (nodeChecks targetNode) (getNodeWith targetNode p)
- :<|> rename targetNode
- :<|> postNode authenticatedUser targetNode
- :<|> postNodeAsyncAPI authenticatedUser targetNode
- :<|> FrameCalcUpload.api authenticatedUser targetNode
- :<|> putNode targetNode
- :<|> Update.api targetNode
- :<|> Action.deleteNode userRootId targetNode
- :<|> getChildren targetNode p
-
- -- TODO gather it
- :<|> tableApi targetNode
- :<|> apiNgramsTableCorpus targetNode
-
- :<|> catApi targetNode
- :<|> scoreApi targetNode
- :<|> Search.api targetNode
- :<|> Share.api userRootId targetNode
- -- Pairing Tools
- :<|> pairWith targetNode
- :<|> pairs targetNode
- :<|> getPair targetNode
-
- -- VIZ
- :<|> scatterApi targetNode
- :<|> chartApi targetNode
- :<|> pieApi targetNode
- :<|> treeApi targetNode
- :<|> phyloAPI targetNode
- :<|> moveNode userRootId targetNode
- -- :<|> nodeAddAPI id'
- -- :<|> postUpload id'
- :<|> Share.unPublish targetNode
-
- :<|> fileApi targetNode
- :<|> fileAsyncApi authenticatedUser targetNode
-
- :<|> DFWN.api authenticatedUser targetNode
- :<|> DocumentUpload.api targetNode
-
-
------------------------------------------------------------------------
data RenameNode = RenameNode { r_name :: Text }
deriving (Generic)
@@ -374,5 +318,59 @@ instance ToSchema RenameNode
instance Arbitrary RenameNode where
arbitrary = elements [RenameNode "test"]
+------------------------------------------------------------------------
+-- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
+nodeAPI :: forall proxy a.
+ ( HyperdataC a, Show a, MimeUnrender JSON a
+ ) => proxy a
+ -> AuthenticatedUser
+ -> NodeId
+ -> ServerT (NodeAPI a) (GargM Env BackendInternalError)
+nodeAPI p authenticatedUser targetNode =
+ withAccess (Proxy :: Proxy (NodeAPI a)) Proxy authenticatedUser (PathNode targetNode) nodeAPI'
+ where
+
+ userRootId = RootId $ authenticatedUser ^. auth_node_id
+
+ nodeAPI' :: ServerT (NodeAPI a) (GargM Env BackendInternalError)
+ nodeAPI' = withPolicy authenticatedUser (nodeChecks targetNode) (getNodeWith targetNode p)
+ :<|> rename targetNode
+ :<|> postNode authenticatedUser targetNode
+ :<|> postNodeAsyncAPI authenticatedUser targetNode
+ :<|> FrameCalcUpload.api authenticatedUser targetNode
+ :<|> putNode targetNode
+ :<|> Update.api targetNode
+ :<|> Action.deleteNode userRootId targetNode
+ :<|> getChildren targetNode p
+
+ -- TODO gather it
+ :<|> tableApi targetNode
+ :<|> apiNgramsTableCorpus targetNode
+
+ :<|> catApi targetNode
+ :<|> scoreApi targetNode
+ :<|> Search.api targetNode
+ :<|> Share.api userRootId targetNode
+ -- Pairing Tools
+ :<|> pairWith targetNode
+ :<|> pairs targetNode
+ :<|> getPair targetNode
+
+ -- VIZ
+ :<|> scatterApi targetNode
+ :<|> chartApi targetNode
+ :<|> pieApi targetNode
+ :<|> treeApi targetNode
+ :<|> phyloAPI targetNode
+ :<|> moveNode userRootId targetNode
+ -- :<|> nodeAddAPI id'
+ -- :<|> postUpload id'
+ :<|> Share.unPublish targetNode
+
+ :<|> fileApi targetNode
+ :<|> fileAsyncApi authenticatedUser targetNode
+
+ :<|> DFWN.api authenticatedUser targetNode
+ :<|> DocumentUpload.api targetNode
+
--------------------------------------------------------------
diff --git a/src/Gargantext/API/Node/Document/Export/Types.hs b/src/Gargantext/API/Node/Document/Export/Types.hs
index e475845efb06fe71a8974c3376bef0a9323dccaa..cf0dda3c0271ce309641d7c992a3cf849f1544fb 100644
--- a/src/Gargantext/API/Node/Document/Export/Types.hs
+++ b/src/Gargantext/API/Node/Document/Export/Types.hs
@@ -94,6 +94,6 @@ type API = Summary "Document Export"
:<|> "csv"
:> Get '[PlainText] (Headers '[Servant.Header "Content-Disposition" Text] Text)) -- [Document])
-$(deriveJSON (unPrefix "_de_") ''DocumentExport)
-$(deriveJSON (unPrefix "_d_") ''Document)
$(deriveJSON (unPrefix "_ng_") ''Ngrams)
+$(deriveJSON (unPrefix "_d_") ''Document)
+$(deriveJSON (unPrefix "_de_") ''DocumentExport)
diff --git a/src/Gargantext/Core/NodeStory.hs b/src/Gargantext/Core/NodeStory.hs
index 2cff67bdecdc227920861b8df8653a8a6fc96910..4b5628a0f387df15b2bfd1fa4d1319e995a28e8f 100644
--- a/src/Gargantext/Core/NodeStory.hs
+++ b/src/Gargantext/Core/NodeStory.hs
@@ -701,7 +701,7 @@ clearHistory (NodeStory ns) = NodeStory $ ns & (traverse . a_history) .~ emptyHi
currentVersion :: (HasNodeStory env err m) => ListId -> m Version
currentVersion listId = do
pool <- view connPool
- nls <- withResource pool $ \c -> liftBase $ getNodeStory c listId
+ nls <- liftBase $ withResource pool $ \c -> liftBase $ getNodeStory c listId
pure $ nls ^. unNodeStory . at listId . _Just . a_version
@@ -711,7 +711,7 @@ currentVersion listId = do
fixNodeStoryVersions :: (HasNodeStory env err m) => m ()
fixNodeStoryVersions = do
pool <- view connPool
- _ <- withResource pool $ \c -> liftBase $ PGS.withTransaction c $ do
+ _ <- liftBase $ withResource pool $ \c -> liftBase $ PGS.withTransaction c $ do
nIds <- runPGSQuery c [sql| SELECT id FROM nodes WHERE ? |] (PGS.Only True) :: IO [PGS.Only Int64]
-- printDebug "[fixNodeStoryVersions] nIds" nIds
mapM_ (\(PGS.Only nId) -> do
diff --git a/src/Gargantext/Core/Text/Corpus/Parsers/Date.hs b/src/Gargantext/Core/Text/Corpus/Parsers/Date.hs
index c804a5e046e2c37a8357cb6a68d3567ebb25be9d..f99aa69123f657aa3104fd6864383492cf8510ad 100644
--- a/src/Gargantext/Core/Text/Corpus/Parsers/Date.hs
+++ b/src/Gargantext/Core/Text/Corpus/Parsers/Date.hs
@@ -24,7 +24,7 @@ module Gargantext.Core.Text.Corpus.Parsers.Date
import Data.Aeson (toJSON, Value)
import Data.Aeson qualified as Json
-import Data.HashMap.Strict as HM hiding (map)
+import Data.Aeson.KeyMap as KM hiding (map)
import Data.HashSet qualified as HashSet
import Data.List qualified as List
import Data.Text (unpack, splitOn, replace)
@@ -184,7 +184,7 @@ getTimeValue rt = case head rt of
extractValue :: Maybe Value -> Maybe Text
extractValue (Just (Json.Object object)) =
- case HM.lookup "value" object of
+ case KM.lookup "value" object of
Just (Json.String date) -> Just date
_ -> Nothing
extractValue _ = Nothing
diff --git a/src/Gargantext/Core/Text/Terms/Eleve.hs b/src/Gargantext/Core/Text/Terms/Eleve.hs
index 0ed11598f3a4e5744c28e36140129fc71c2e170c..c7dc3f39f0f1f1bc17db14b832567f98129fc477 100644
--- a/src/Gargantext/Core/Text/Terms/Eleve.hs
+++ b/src/Gargantext/Core/Text/Terms/Eleve.hs
@@ -34,10 +34,11 @@ Notes for current implementation:
{-# OPTIONS_GHC -fno-warn-deprecations #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
module Gargantext.Core.Text.Terms.Eleve where
diff --git a/src/Gargantext/Core/Text/Terms/Mono/Token/En.hs b/src/Gargantext/Core/Text/Terms/Mono/Token/En.hs
index 4b9deb28480f6d69b076f611b0c5a631f3ec86fc..78faecad4876caa84494538966eee7933b0a7be6 100644
--- a/src/Gargantext/Core/Text/Terms/Mono/Token/En.hs
+++ b/src/Gargantext/Core/Text/Terms/Mono/Token/En.hs
@@ -143,11 +143,11 @@ whitespace :: Tokenizer
whitespace xs = E [Right w | w <- T.words xs ]
instance Monad (EitherList a) where
- return x = E [Right x]
+ return = pure
E xs >>= f = E $ concatMap (either (return . Left) (unE . f)) xs
instance Applicative (EitherList a) where
- pure = pure
+ pure x = E [Right x]
f <*> x = f `ap` x
instance Functor (EitherList a) where
diff --git a/src/Gargantext/Core/Types/Phylo.hs b/src/Gargantext/Core/Types/Phylo.hs
index a349fd26b8498515196434ffd2034c5cb87fb8f4..daaaeeda86ca10f40889249e2095925ba32050ad 100644
--- a/src/Gargantext/Core/Types/Phylo.hs
+++ b/src/Gargantext/Core/Types/Phylo.hs
@@ -216,43 +216,6 @@ data ObjectData =
| Layer !GvId !GraphDataData !LayerData
deriving (Show, Eq, Generic)
-instance ToJSON ObjectData where
- toJSON = \case
- GroupToNode gvid commonData nodeTypeData
- -> mkObject gvid (Left commonData) nodeTypeData
- BranchToNode gvid commonData nodeTypeData
- -> mkObject gvid (Left commonData) nodeTypeData
- PeriodToNode gvid commonData nodeTypeData
- -> mkObject gvid (Left commonData) nodeTypeData
- Layer gvid graphData nodeTypeData
- -> mkObject gvid (Right graphData) nodeTypeData
-
-instance FromJSON ObjectData where
- parseJSON = withObject "ObjectData" $ \o -> do
- _gvid <- o .: "_gvid"
- -- try to parse the graph data first. If we succeed, then we are dealing with
- -- the 'Layer', otherwise we the rest, but for the rest we can avoid re-parsing
- -- the 'NodeCommonData' every time.
- case parseMaybe @_ @GraphDataData parseJSON (Object o) of
- Nothing
- -> do commonData <- parseJSON (Object o)
- ((GroupToNode <$> pure _gvid <*> pure commonData <*> parseJSON (Object o)) <|>
- (BranchToNode <$> pure _gvid <*> pure commonData <*> parseJSON (Object o)) <|>
- (PeriodToNode <$> pure _gvid <*> pure commonData <*> parseJSON (Object o)))
- Just gd
- -> Layer <$> pure _gvid <*> pure gd <*> parseJSON (Object o)
-
-
-mkObject :: ToJSON a => GvId -> Either NodeCommonData GraphDataData -> a -> Value
-mkObject gvid commonData objectTypeData =
- let commonDataJSON = either toJSON toJSON commonData
- objectTypeDataJSON = toJSON objectTypeData
- header = object $ [ "_gvid" .= toJSON gvid ]
- in case (commonDataJSON, objectTypeDataJSON, header) of
- (Object hdr, Object cdJSON, Object etDataJSON)
- -> Object $ hdr <> cdJSON <> etDataJSON
- _ -> panicTrace "[Gargantext.Core.Types.Phylo.mkObject] impossible: commonData, header or objectTypeDataJSON didn't convert back to JSON Object."
-
data GroupToNodeData
= GroupToNodeData
{ _gtn_bId :: Text
@@ -474,17 +437,23 @@ data BranchToGroupData
, _btg_style :: Maybe Text
} deriving (Show, Eq, Generic)
--- | 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 )
+instance ToJSON GvId where
+ toJSON GvId{..} = toJSON _GvId
+instance FromJSON GvId where
+ parseJSON v = GvId <$> parseJSON v
+
+-- /NOTE/ We need to define /after/ the JSON istance for 'GvId' due to GHC stage limitation.
+mkObject :: ToJSON a => GvId -> Either NodeCommonData GraphDataData -> a -> Value
+mkObject gvid commonData objectTypeData =
+ let commonDataJSON = either toJSON toJSON commonData
+ objectTypeDataJSON = toJSON objectTypeData
+ header = object $ [ "_gvid" .= toJSON gvid ]
+ in case (commonDataJSON, objectTypeDataJSON, header) of
+ (Object hdr, Object cdJSON, Object etDataJSON)
+ -> Object $ hdr <> cdJSON <> etDataJSON
+ _ -> panicTrace "[Gargantext.Core.Types.Phylo.mkObject] impossible: commonData, header or objectTypeDataJSON didn't convert back to JSON Object."
+
instance ToJSON GraphData where
toJSON = mkGraphData
@@ -512,11 +481,6 @@ instance FromJSON GraphData where
_gd_data <- parseJSON (Object o)
pure GraphData{..}
-instance ToJSON GvId where
- toJSON GvId{..} = toJSON _GvId
-instance FromJSON GvId where
- parseJSON v = GvId <$> parseJSON v
-
instance ToJSON EdgeData where
toJSON = \case
GroupToAncestor gvid commonData edgeTypeData
@@ -608,6 +572,38 @@ instance FromJSON BranchToGroupData where
_btg_style <- o .:? "style"
pure BranchToGroupData{..}
+instance ToJSON ObjectData where
+ toJSON = \case
+ GroupToNode gvid commonData nodeTypeData
+ -> mkObject gvid (Left commonData) nodeTypeData
+ BranchToNode gvid commonData nodeTypeData
+ -> mkObject gvid (Left commonData) nodeTypeData
+ PeriodToNode gvid commonData nodeTypeData
+ -> mkObject gvid (Left commonData) nodeTypeData
+ Layer gvid graphData nodeTypeData
+ -> mkObject gvid (Right graphData) nodeTypeData
+
+instance FromJSON ObjectData where
+ parseJSON = withObject "ObjectData" $ \o -> do
+ _gvid <- o .: "_gvid"
+ -- try to parse the graph data first. If we succeed, then we are dealing with
+ -- the 'Layer', otherwise we the rest, but for the rest we can avoid re-parsing
+ -- the 'NodeCommonData' every time.
+ case parseMaybe @_ @GraphDataData parseJSON (Object o) of
+ Nothing
+ -> do commonData <- parseJSON (Object o)
+ ((GroupToNode <$> pure _gvid <*> pure commonData <*> parseJSON (Object o)) <|>
+ (BranchToNode <$> pure _gvid <*> pure commonData <*> parseJSON (Object o)) <|>
+ (PeriodToNode <$> pure _gvid <*> pure commonData <*> parseJSON (Object o)))
+ Just gd
+ -> Layer <$> pure _gvid <*> pure gd <*> parseJSON (Object o)
+
+
+
+$(deriveJSON (unPrefix "_phylo_Group" ) ''PhyloGroup )
+$(deriveJSON (unPrefix "_phylo_Level" ) ''PhyloLevel )
+$(deriveJSON (unPrefix "_phylo_Period" ) ''PhyloPeriod )
+$(deriveJSON (unPrefix "_phylo_" ) ''Phylo )
-- | ToSchema instances
instance ToSchema Phylo where
@@ -637,7 +633,9 @@ instance ToSchema GraphDataData where
instance ToSchema GraphData where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_gd_")
--- | Arbitrary instances
+--
+-- Arbitrary instances
+--
instance Arbitrary LayerData where
arbitrary = LayerData <$> arbitrary
instance Arbitrary NodeCommonData where
@@ -723,3 +721,13 @@ instance Arbitrary GraphDataData where
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+
+--
+-- Lenses
+--
+
+makeLenses ''Phylo
+makeLenses ''PhyloPeriod
+makeLenses ''PhyloLevel
+makeLenses ''PhyloGroup
+
diff --git a/src/Gargantext/Core/Viz/LegacyPhylo.hs b/src/Gargantext/Core/Viz/LegacyPhylo.hs
index f6eab991d99685b426c27f9f0c73e9f1d2b33e74..a4ff22e20638e94cc43dce0498bb03e510297d42 100644
--- a/src/Gargantext/Core/Viz/LegacyPhylo.hs
+++ b/src/Gargantext/Core/Viz/LegacyPhylo.hs
@@ -475,38 +475,38 @@ makeLenses ''PhyloEdge
------------------------
-$(deriveJSON (unPrefix "_phylo_" ) ''Phylo )
+$(deriveJSON (unPrefix "_phylo_group" ) ''PhyloGroup )
+$(deriveJSON (unPrefix "_phylo_level" ) ''PhyloLevel )
$(deriveJSON (unPrefix "_phylo_foundations" ) ''PhyloFoundations )
$(deriveJSON (unPrefix "_phylo_period" ) ''PhyloPeriod )
-$(deriveJSON (unPrefix "_phylo_level" ) ''PhyloLevel )
-$(deriveJSON (unPrefix "_phylo_group" ) ''PhyloGroup )
$(deriveJSON (unPrefix "_phyloFis_" ) ''PhyloFis )
--
-$(deriveJSON (unPrefix "_software_" ) ''Software )
-$(deriveJSON (unPrefix "_phyloParam_" ) ''PhyloParam )
+$(deriveJSON (unPrefix "_lb_" ) ''LBParams )
+$(deriveJSON (unPrefix "_sb_" ) ''SBParams )
+--
+$(deriveJSON (unPrefix "_fis_" ) ''FisParams )
+$(deriveJSON (unPrefix "_hamming_" ) ''HammingParams )
+$(deriveJSON (unPrefix "_wlj_" ) ''WLJParams )
--
$(deriveJSON defaultOptions ''Filter )
$(deriveJSON defaultOptions ''Metric )
-$(deriveJSON defaultOptions ''Cluster )
$(deriveJSON defaultOptions ''Proximity )
---
-$(deriveJSON (unPrefix "_fis_" ) ''FisParams )
-$(deriveJSON (unPrefix "_hamming_" ) ''HammingParams )
$(deriveJSON (unPrefix "_louvain_" ) ''LouvainParams )
$(deriveJSON (unPrefix "_rc_" ) ''RCParams )
-$(deriveJSON (unPrefix "_wlj_" ) ''WLJParams )
+$(deriveJSON defaultOptions ''Cluster )
+$(deriveJSON (unPrefix "_q_" ) ''PhyloQueryBuild )
--
-$(deriveJSON (unPrefix "_lb_" ) ''LBParams )
-$(deriveJSON (unPrefix "_sb_" ) ''SBParams )
+$(deriveJSON (unPrefix "_software_" ) ''Software )
+$(deriveJSON (unPrefix "_phyloParam_" ) ''PhyloParam )
+$(deriveJSON (unPrefix "_phylo_" ) ''Phylo )
--
-$(deriveJSON (unPrefix "_q_" ) ''PhyloQueryBuild )
-$(deriveJSON (unPrefix "_pv_" ) ''PhyloView )
$(deriveJSON (unPrefix "_pb_" ) ''PhyloBranch )
-$(deriveJSON (unPrefix "_pe_" ) ''PhyloEdge )
-$(deriveJSON (unPrefix "_pn_" ) ''PhyloNode )
-
$(deriveJSON defaultOptions ''Filiation )
+$(deriveJSON (unPrefix "_pn_" ) ''PhyloNode )
$(deriveJSON defaultOptions ''EdgeType )
+$(deriveJSON (unPrefix "_pe_" ) ''PhyloEdge )
+$(deriveJSON (unPrefix "_pv_" ) ''PhyloView )
+
---------------------------
-- | Swagger instances | --
diff --git a/src/Gargantext/Core/Viz/Phylo.hs b/src/Gargantext/Core/Viz/Phylo.hs
index a20838dc81e2271be29d7b0ddec99610bb101a01..501243e64ad2b0416c744e894fac979973c4721c 100644
--- a/src/Gargantext/Core/Viz/Phylo.hs
+++ b/src/Gargantext/Core/Viz/Phylo.hs
@@ -625,9 +625,6 @@ makeLenses ''PhyloBranch
-- | JSON instances | --
------------------------
-instance FromJSON Phylo
-instance ToJSON Phylo
-
instance FromJSON PhyloSources
instance ToJSON PhyloSources
@@ -651,6 +648,9 @@ instance ToJSON PhyloGroup
$(deriveJSON (unPrefix "_foundations_" ) ''PhyloFoundations)
+instance FromJSON Phylo
+instance ToJSON Phylo
+
-- NFData instances
instance NFData CorpusParser
@@ -677,3 +677,4 @@ instance NFData Order
instance NFData Sort
instance NFData Tagger
instance NFData PhyloLabel
+
diff --git a/src/Gargantext/Core/Viz/Phylo/API/Tools.hs b/src/Gargantext/Core/Viz/Phylo/API/Tools.hs
index dd6c5e38f082918e962e3c19fd1042350467c1c5..e8e36aa4e8b3edbf999c260acf5029987fccf140 100644
--- a/src/Gargantext/Core/Viz/Phylo/API/Tools.hs
+++ b/src/Gargantext/Core/Viz/Phylo/API/Tools.hs
@@ -114,7 +114,7 @@ corpusIdtoDocuments timeUnit corpusId = do
docs <- selectDocNodes corpusId
lId <- defaultList corpusId
termList <- getTermList lId MapTerm NgramsTerms
- corpus_node <- getNodeWith corpusId (Proxy @ HyperdataCorpus)
+ corpus_node <- getNodeWith corpusId (Proxy @HyperdataCorpus)
let corpusLang = view (node_hyperdata . to _hc_lang) corpus_node
let patterns = case termList of
diff --git a/src/Gargantext/Core/Viz/Phylo/Legacy/LegacyMain.hs b/src/Gargantext/Core/Viz/Phylo/Legacy/LegacyMain.hs
index 8beb075dec1921e4d21a8864ffd9cf47a0da55ea..1644a853dea8b114c0f954091da514a0dd4363d9 100644
--- a/src/Gargantext/Core/Viz/Phylo/Legacy/LegacyMain.hs
+++ b/src/Gargantext/Core/Viz/Phylo/Legacy/LegacyMain.hs
@@ -46,7 +46,7 @@ flowPhylo :: (HasNodeStory env err m, HasDBid NodeType)
-> m Phylo
flowPhylo cId = do
- corpus_node <- getNodeWith cId (Proxy @ HyperdataCorpus)
+ corpus_node <- getNodeWith cId (Proxy @HyperdataCorpus)
let lang = withDefaultLanguage $ view (node_hyperdata . to _hc_lang) corpus_node
list' <- defaultList cId
termList <- HashMap.toList <$> getTermsWith (Text.words . unNgramsTerm) [list'] NgramsTerms (Set.singleton MapTerm)
diff --git a/src/Gargantext/Database/Action/Flow.hs b/src/Gargantext/Database/Action/Flow.hs
index 52c5d37ceefd1319fd78bdb17e21fe0abb3b0e75..ac61a1655227f68982646444cbd374e999a7571c 100644
--- a/src/Gargantext/Database/Action/Flow.hs
+++ b/src/Gargantext/Database/Action/Flow.hs
@@ -659,7 +659,7 @@ reIndexWith :: ( HasNodeStory env err m )
-> m ()
reIndexWith cId lId nt lts = do
-- printDebug "(cId,lId,nt,lts)" (cId, lId, nt, lts)
- corpus_node <- getNodeWith cId (Proxy @ HyperdataCorpus)
+ corpus_node <- getNodeWith cId (Proxy @HyperdataCorpus)
let corpusLang = withDefaultLanguage $ view (node_hyperdata . to _hc_lang) corpus_node
-- Getting [NgramsTerm]
diff --git a/src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs b/src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs
index 941b1251c097c4e52ddf96a2ec01e50a59647c0b..89155ba88613a558d8c7f9fb879125a6eedc5612 100644
--- a/src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs
+++ b/src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs
@@ -193,6 +193,20 @@ instance Arbitrary HyperdataContact where
-- | Specific Gargantext instance
instance Hyperdata HyperdataContact
+-- | All lenses
+makeLenses ''ContactWho
+makeLenses ''ContactWhere
+makeLenses ''ContactTouch
+makeLenses ''ContactMetaData
+makeLenses ''HyperdataContact
+
+-- | All Json instances
+$(deriveJSON (unPrefix "_ct_") ''ContactTouch)
+$(deriveJSON (unPrefix "_cw_") ''ContactWho)
+$(deriveJSON (unPrefix "_cw_") ''ContactWhere)
+$(deriveJSON (unPrefix "_cm_") ''ContactMetaData)
+$(deriveJSON (unPrefix "_hc_") ''HyperdataContact)
+
-- | Database (Posgresql-simple instance)
instance FromField HyperdataContact where
fromField = fromField'
@@ -207,16 +221,3 @@ instance DefaultFromField (Nullable SqlJsonb) HyperdataContact where
--- | All lenses
-makeLenses ''ContactWho
-makeLenses ''ContactWhere
-makeLenses ''ContactTouch
-makeLenses ''ContactMetaData
-makeLenses ''HyperdataContact
-
--- | All Json instances
-$(deriveJSON (unPrefix "_cw_") ''ContactWho)
-$(deriveJSON (unPrefix "_cw_") ''ContactWhere)
-$(deriveJSON (unPrefix "_ct_") ''ContactTouch)
-$(deriveJSON (unPrefix "_cm_") ''ContactMetaData)
-$(deriveJSON (unPrefix "_hc_") ''HyperdataContact)
diff --git a/src/Gargantext/Database/Admin/Types/Hyperdata/Document.hs b/src/Gargantext/Database/Admin/Types/Hyperdata/Document.hs
index f955e8f9186854a8f6bfcbfd95ff1d6ade5958f2..52d21120993a75f8de849fadb7a99747db6be5a3 100644
--- a/src/Gargantext/Database/Admin/Types/Hyperdata/Document.hs
+++ b/src/Gargantext/Database/Admin/Types/Hyperdata/Document.hs
@@ -73,8 +73,6 @@ defaultHyperdataDocument = case decode docExample of
data StatusV3 = StatusV3 { statusV3_error :: !(Maybe Text)
, statusV3_action :: !(Maybe Text)
} deriving (Show, Generic)
-$(deriveJSON (unPrefix "statusV3_") ''StatusV3)
-
------------------------------------------------------------------------
data HyperdataDocumentV3 = HyperdataDocumentV3 { _hdv3_publication_day :: !(Maybe Int)
@@ -140,12 +138,25 @@ arbitraryHyperdataDocuments =
instance Hyperdata HyperdataDocument
instance Hyperdata HyperdataDocumentV3
------------------------------------------------------------------------
-$(makeLenses ''HyperdataDocument)
-makePrisms ''HyperdataDocument
+-- $(deriveJSON (unPrefix "_hd_") ''HyperdataDocument)
+instance ToSchema HyperdataDocument where
+ declareNamedSchema proxy =
+ genericDeclareNamedSchema (unPrefixSwagger "_hd_") proxy
+ & mapped.schema.description ?~ "Document Hyperdata"
+ & mapped.schema.example ?~ toJSON defaultHyperdataDocument
-$(makeLenses ''HyperdataDocumentV3)
+{-
+-- | For now HyperdataDocumentV3 is not exposed with the API
+instance ToSchema HyperdataDocumentV3 where
+ declareNamedSchema proxy =
+ genericDeclareNamedSchema (unPrefixSwagger "hyperdataDocumentV3_") proxy
+ & mapped.schema.description ?~ "Document Hyperdata for Garg V3"
+ & mapped.schema.example ?~ toJSON defaultHyperdataDocumentV3
+-}
--- $(deriveJSON (unPrefix "_hd_") ''HyperdataDocument)
+--
+-- JSON instances
+--
instance FromJSON HyperdataDocument
where
@@ -167,24 +178,13 @@ instance ToJSON HyperdataDocument
+$(deriveJSON (unPrefix "statusV3_") ''StatusV3)
$(deriveJSON (unPrefix "_hdv3_") ''HyperdataDocumentV3)
-instance ToSchema HyperdataDocument where
- declareNamedSchema proxy =
- genericDeclareNamedSchema (unPrefixSwagger "_hd_") proxy
- & mapped.schema.description ?~ "Document Hyperdata"
- & mapped.schema.example ?~ toJSON defaultHyperdataDocument
+--
+-- FromField/ToField instances
+--
-{-
--- | For now HyperdataDocumentV3 is not exposed with the API
-instance ToSchema HyperdataDocumentV3 where
- declareNamedSchema proxy =
- genericDeclareNamedSchema (unPrefixSwagger "hyperdataDocumentV3_") proxy
- & mapped.schema.description ?~ "Document Hyperdata for Garg V3"
- & mapped.schema.example ?~ toJSON defaultHyperdataDocumentV3
--}
-
-------------------------------------------------------------------------
instance FromField HyperdataDocument
where
fromField = fromField'
@@ -193,14 +193,12 @@ instance FromField HyperdataDocumentV3
where
fromField = fromField'
--------
instance ToField HyperdataDocument where
toField = toJSONField
instance ToField HyperdataDocumentV3 where
toField = toJSONField
-------------------------------------------------------------------------
instance DefaultFromField SqlJsonb HyperdataDocument
where
defaultFromField = fromPGSFromField
@@ -208,4 +206,10 @@ instance DefaultFromField SqlJsonb HyperdataDocument
instance DefaultFromField SqlJsonb HyperdataDocumentV3
where
defaultFromField = fromPGSFromField
-------------------------------------------------------------------------
+
+--
+-- Lenses
+--
+$(makeLenses ''HyperdataDocument)
+makePrisms ''HyperdataDocument
+$(makeLenses ''HyperdataDocumentV3)
diff --git a/src/Gargantext/Database/Admin/Types/Hyperdata/User.hs b/src/Gargantext/Database/Admin/Types/Hyperdata/User.hs
index b034a8db59c286377089cd75a2697f2554e73aa8..75ea3d8bd54ba95f4a1dfc3863f87addf3c5c662 100644
--- a/src/Gargantext/Database/Admin/Types/Hyperdata/User.hs
+++ b/src/Gargantext/Database/Admin/Types/Hyperdata/User.hs
@@ -98,9 +98,9 @@ makeLenses ''HyperdataPrivate
makeLenses ''HyperdataPublic
-- | All Json instances
-$(deriveJSON (unPrefix "_hu_") ''HyperdataUser)
$(deriveJSON (unPrefix "_hpr_") ''HyperdataPrivate)
$(deriveJSON (unPrefix "_hpu_") ''HyperdataPublic)
+$(deriveJSON (unPrefix "_hu_") ''HyperdataUser)
-- | Arbitrary instances
instance Arbitrary HyperdataUser where
diff --git a/src/Gargantext/Database/Admin/Types/Metrics.hs b/src/Gargantext/Database/Admin/Types/Metrics.hs
index d89a950ade2956f686061beed61345244084a736..3888a6573a10a5fc69b1ba9ac8ff9ce456fa55a2 100644
--- a/src/Gargantext/Database/Admin/Types/Metrics.hs
+++ b/src/Gargantext/Database/Admin/Types/Metrics.hs
@@ -41,8 +41,8 @@ instance Arbitrary Metric
<*> arbitrary
<*> arbitrary
-deriveJSON (unPrefix "metrics_") ''Metrics
deriveJSON (unPrefix "m_") ''Metric
+deriveJSON (unPrefix "metrics_") ''Metrics
newtype ChartMetrics a = ChartMetrics { chartMetrics_data :: a }
diff --git a/src/Gargantext/Database/Prelude.hs b/src/Gargantext/Database/Prelude.hs
index b5a751774c7f2a2e886f984157974a1f25ccb879..5a1cf7b85526d8cf2925c9c890fcc7f32b06a5c1 100644
--- a/src/Gargantext/Database/Prelude.hs
+++ b/src/Gargantext/Database/Prelude.hs
@@ -119,7 +119,7 @@ fromInt64ToInt = fromIntegral
mkCmd :: (Connection -> IO a) -> DBCmd err a
mkCmd k = do
pool <- view connPool
- withResource pool (liftBase . k)
+ liftBase $ withResource pool (liftBase . k)
runCmd :: (HasConnectionPool env)
=> env
diff --git a/src/Gargantext/Database/Query/Facet.hs b/src/Gargantext/Database/Query/Facet.hs
index 4c1f656bb78dd60d097cc451b2773aa41724856d..a6dc8716a56a2ec3864c5c8f0d3a3cfb87d34fe0 100644
--- a/src/Gargantext/Database/Query/Facet.hs
+++ b/src/Gargantext/Database/Query/Facet.hs
@@ -15,6 +15,7 @@ Portability : POSIX
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
------------------------------------------------------------------------
module Gargantext.Database.Query.Facet
( runViewAuthorsDoc
diff --git a/src/Gargantext/Database/Schema/User.hs b/src/Gargantext/Database/Schema/User.hs
index 8d971e235e583b936d57b8f3037933b7efd7b3d7..c653b639fb0b4238030644966e00c37dbdbb8929 100644
--- a/src/Gargantext/Database/Schema/User.hs
+++ b/src/Gargantext/Database/Schema/User.hs
@@ -121,11 +121,11 @@ userTable = Table "auth_user"
}
)
+$(deriveJSON (unPrefix "userLight_") ''UserLight)
+$(deriveJSON (unPrefix "user_") ''UserPoly)
+
instance FromField UserLight where
fromField = fromField'
instance FromField UserDB where
fromField = fromField'
-
-$(deriveJSON (unPrefix "userLight_") ''UserLight)
-$(deriveJSON (unPrefix "user_") ''UserPoly)
diff --git a/src/Gargantext/Utils/Jobs.hs b/src/Gargantext/Utils/Jobs.hs
index f3e2c97ec1acf9f1222abee460604e2b9231f53a..06167e8c94a51c3243227ecb5262421255e0aec9 100644
--- a/src/Gargantext/Utils/Jobs.hs
+++ b/src/Gargantext/Utils/Jobs.hs
@@ -10,6 +10,7 @@ Portability : POSIX
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
module Gargantext.Utils.Jobs (
-- * Serving the JOBS API
serveJobsAPI
diff --git a/src/Gargantext/Utils/SpacyNLP.hs b/src/Gargantext/Utils/SpacyNLP.hs
index df3a197b6e56c16969ad2d4506efb18a2b41ba46..2696a9da27afe8e577bd213a12caaedd7d78c303 100644
--- a/src/Gargantext/Utils/SpacyNLP.hs
+++ b/src/Gargantext/Utils/SpacyNLP.hs
@@ -15,71 +15,24 @@ Server to be used: https://gitlab.iscpif.fr/gargantext/spacy-server
{-# LANGUAGE TemplateHaskell #-}
-module Gargantext.Utils.SpacyNLP where
+module Gargantext.Utils.SpacyNLP (
+ module Gargantext.Utils.SpacyNLP.Types
+ , spacyRequest
+ , spacyTagsToToken
+ , spacyDataToPosSentences
+ , nlp
+ ) where
-import Control.Lens
import Data.Aeson (encode)
-import Data.Aeson.TH (deriveJSON)
import Data.Text hiding (map, group, filter, concat, zip)
import Gargantext.Core (Lang(..))
import Gargantext.Core.Text.Terms.Multi.PosTagging.Types
-import Gargantext.Core.Types (POS(..), NER(..))
-import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Prelude
import Network.HTTP.Simple (parseRequest, httpJSON, setRequestBodyLBS, getResponseBody, Response)
import Network.URI (URI(..))
+import Gargantext.Utils.SpacyNLP.Types
-data SpacyData = SpacyData { _spacy_data :: ![SpacyText]}
- deriving (Show)
-
-data SpacyText = SpacyText { _spacy_text :: !Text
- , _spacy_tags :: ![SpacyTags]
- } deriving (Show)
-data SpacyTags =
- SpacyTags { _spacyTags_text :: !Text
- , _spacyTags_text_with_ws :: !Text
- , _spacyTags_whitespace :: !Text
- , _spacyTags_head :: !Text
- , _spacyTags_head_index :: !Int
- , _spacyTags_left_edge :: !Text
- , _spacyTags_right_edge :: !Text
- , _spacyTags_index :: Int
- , _spacyTags_ent_type :: !NER
- , _spacyTags_ent_iob :: !Text
- , _spacyTags_lemma :: !Text
- , _spacyTags_normalized :: !Text
- , _spacyTags_shape :: !Text
- , _spacyTags_prefix :: !Text
- , _spacyTags_suffix :: !Text
- , _spacyTags_is_alpha :: Bool
- , _spacyTags_is_ascii :: Bool
- , _spacyTags_is_digit :: Bool
- , _spacyTags_is_title :: Bool
- , _spacyTags_is_punct :: Bool
- , _spacyTags_is_left_punct :: Bool
- , _spacyTags_is_right_punct :: Bool
- , _spacyTags_is_space :: Bool
- , _spacyTags_is_bracket :: Bool
- , _spacyTags_is_quote :: Bool
- , _spacyTags_is_currency :: Bool
- , _spacyTags_like_url :: Bool
- , _spacyTags_like_num :: Bool
- , _spacyTags_like_email :: Bool
- , _spacyTags_is_oov :: Bool
- , _spacyTags_is_stop :: Bool
- , _spacyTags_pos :: POS
- , _spacyTags_tag :: POS
- , _spacyTags_dep :: !Text
- , _spacyTags_lang :: !Text
- , _spacyTags_prob :: !Int
- , _spacyTags_char_offset :: !Int
- } deriving (Show)
-
-
-data SpacyRequest = SpacyRequest { _spacyRequest_text :: !Text }
- deriving (Show)
-
spacyRequest :: URI -> Text -> IO SpacyData
spacyRequest uri txt = do
req <- parseRequest $ "POST " <> show (uri { uriPath = "/pos" })
@@ -87,30 +40,18 @@ spacyRequest uri txt = do
result <- httpJSON request :: IO (Response SpacyData)
pure $ getResponseBody result
-
--- Instances
-deriveJSON (unPrefix "_spacy_") ''SpacyData
-deriveJSON (unPrefix "_spacy_") ''SpacyText
-deriveJSON (unPrefix "_spacyTags_") ''SpacyTags
-deriveJSON (unPrefix "_spacyRequest_") ''SpacyRequest
-
-makeLenses ''SpacyData
-makeLenses ''SpacyText
-makeLenses ''SpacyTags
-makeLenses ''SpacyRequest
-
----------------------------------------------------------------
spacyTagsToToken :: SpacyTags -> Token
-spacyTagsToToken st = Token (st ^. spacyTags_index)
- (st ^. spacyTags_normalized)
- (st ^. spacyTags_text)
- (st ^. spacyTags_lemma)
- (st ^. spacyTags_head_index)
- (st ^. spacyTags_char_offset)
- (Just $ st ^. spacyTags_pos)
- (Just $ st ^. spacyTags_ent_type)
- (Just $ st ^. spacyTags_prefix)
- (Just $ st ^. spacyTags_suffix)
+spacyTagsToToken st = Token (_spacyTags_index st)
+ (_spacyTags_normalized st)
+ (_spacyTags_text st)
+ (_spacyTags_lemma st)
+ (_spacyTags_head_index st)
+ (_spacyTags_char_offset st)
+ (Just $ _spacyTags_pos st)
+ (Just $ _spacyTags_ent_type st)
+ (Just $ _spacyTags_prefix st)
+ (Just $ _spacyTags_suffix st)
spacyDataToPosSentences :: SpacyData -> PosSentences
spacyDataToPosSentences (SpacyData ds) = PosSentences
diff --git a/src/Gargantext/Utils/SpacyNLP/Types.hs b/src/Gargantext/Utils/SpacyNLP/Types.hs
new file mode 100644
index 0000000000000000000000000000000000000000..a43cd69aca53ea3f3eaeefff0e35a0bbb0062610
--- /dev/null
+++ b/src/Gargantext/Utils/SpacyNLP/Types.hs
@@ -0,0 +1,95 @@
+{-|
+Module : Gargantext.Utils.SpacyNLP.Types
+Description : John Snow NLP API connexion
+Copyright : (c) CNRS, 2017
+License : AGPL + CECILL v3
+Maintainer : team@gargantext.org
+Stability : experimental
+Portability : POSIX
+
+Spacy ecosystem: https://github.com/explosion/spaCy
+
+Server to be used: https://gitlab.iscpif.fr/gargantext/spacy-server
+
+-}
+
+{-# LANGUAGE TemplateHaskell #-}
+
+module Gargantext.Utils.SpacyNLP.Types where
+
+import Control.Lens
+import Data.Aeson.TH (deriveJSON)
+import Data.Text hiding (map, group, filter, concat, zip)
+import Gargantext.Core.Types (POS(..), NER(..))
+import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Prelude
+
+
+data SpacyData = SpacyData { _spacy_data :: ![SpacyText]}
+ deriving (Show)
+
+data SpacyText = SpacyText { _spacy_text :: !Text
+ , _spacy_tags :: ![SpacyTags]
+ } deriving (Show)
+data SpacyTags =
+ SpacyTags { _spacyTags_text :: !Text
+ , _spacyTags_text_with_ws :: !Text
+ , _spacyTags_whitespace :: !Text
+ , _spacyTags_head :: !Text
+ , _spacyTags_head_index :: !Int
+ , _spacyTags_left_edge :: !Text
+ , _spacyTags_right_edge :: !Text
+ , _spacyTags_index :: Int
+ , _spacyTags_ent_type :: !NER
+ , _spacyTags_ent_iob :: !Text
+ , _spacyTags_lemma :: !Text
+ , _spacyTags_normalized :: !Text
+ , _spacyTags_shape :: !Text
+ , _spacyTags_prefix :: !Text
+ , _spacyTags_suffix :: !Text
+ , _spacyTags_is_alpha :: Bool
+ , _spacyTags_is_ascii :: Bool
+ , _spacyTags_is_digit :: Bool
+ , _spacyTags_is_title :: Bool
+ , _spacyTags_is_punct :: Bool
+ , _spacyTags_is_left_punct :: Bool
+ , _spacyTags_is_right_punct :: Bool
+ , _spacyTags_is_space :: Bool
+ , _spacyTags_is_bracket :: Bool
+ , _spacyTags_is_quote :: Bool
+ , _spacyTags_is_currency :: Bool
+ , _spacyTags_like_url :: Bool
+ , _spacyTags_like_num :: Bool
+ , _spacyTags_like_email :: Bool
+ , _spacyTags_is_oov :: Bool
+ , _spacyTags_is_stop :: Bool
+ , _spacyTags_pos :: POS
+ , _spacyTags_tag :: POS
+ , _spacyTags_dep :: !Text
+ , _spacyTags_lang :: !Text
+ , _spacyTags_prob :: !Int
+ , _spacyTags_char_offset :: !Int
+ } deriving (Show)
+
+
+data SpacyRequest = SpacyRequest { _spacyRequest_text :: !Text }
+ deriving (Show)
+
+--
+-- JSON instances
+--
+
+deriveJSON (unPrefix "_spacyTags_") ''SpacyTags
+deriveJSON (unPrefix "_spacy_") ''SpacyText
+deriveJSON (unPrefix "_spacy_") ''SpacyData
+deriveJSON (unPrefix "_spacyRequest_") ''SpacyRequest
+
+--
+-- Lenses
+--
+
+makeLenses ''SpacyData
+makeLenses ''SpacyText
+makeLenses ''SpacyTags
+makeLenses ''SpacyRequest
+
diff --git a/stack.yaml b/stack.yaml
index 941f09ef2d8b23d96101854d5b55f330ddaeb99d..06036cef64d28568f06f8926980a53f751768ef0 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -148,6 +148,11 @@ extra-deps:
- tmp-postgres-1.34.1.0
- vector-0.12.3.0@sha256:0ae2c1ba86f0077910be242ec6802cc3d7725fe7b2bea6987201aa3737b239b5,7953
- wai-3.2.4
+- morpheus-graphql-0.24.3
+- morpheus-graphql-app-0.24.3
+- morpheus-graphql-core-0.24.3
+- morpheus-graphql-server-0.24.3
+- morpheus-graphql-subscriptions-0.24.3
# For the graph clustering
ghc-options: