Merge remote-tracking branch 'origin/280-dev-xml-code-cleanup' into dev

bin/update-cabal-project

@@ -12,7 +12,7 @@ STORE_DIR="${1:-$DEFAULT_STORE}"
 # `sha256sum` result calculated on the `cabal.project` and `cabal.project.freeze`.
 # This ensures the files stay deterministic so that CI cache can kick in.
 expected_cabal_project_hash="3c1002c8ed7be226b2e189fdb7debef5b3c43d0f56e44df73d500954074c4568"
-expected_cabal_project_freeze_hash="2d3704d107bd8d08056ce4f0eb1f42202cb7f49a67c62a2445a6c70c7235f861"
+expected_cabal_project_freeze_hash="ee7ee880d93d58e52407e971033440291ddb20023a2e8090aa5b335ecbfbc649"
 
 cabal --store-dir=$STORE_DIR v2-update 'hackage.haskell.org,2023-06-24T21:28:46Z'
 

cabal.project.freeze

@@ -2177,7 +2177,6 @@ constraints: any.AC-Angle ==1.0,
              any.servant-swagger ==1.1.10,
              any.servant-swagger-ui ==0.3.5.4.5.0,
              any.servant-swagger-ui-core ==0.3.5,
-             any.servant-xml ==1.0.1.4,
              any.serverless-haskell ==0.12.6,
              any.serversession ==1.0.2,
              any.serversession-frontend-wai ==1.0,
@@ -2734,8 +2733,6 @@ constraints: any.AC-Angle ==1.0,
              any.xml-to-json ==2.0.1,
              any.xml-to-json-fast ==2.0.0,
              any.xml-types ==0.3.8,
-             any.xmlbf ==0.6.1,
-             any.xmlbf-xeno ==0.2,
              any.xmlgen ==0.6.2.2,
              any.xmonad ==0.15,
              any.xmonad-contrib ==0.16,

gargantext.cabal

@@ -390,7 +390,7 @@ library
       RankNTypes
       RecordWildCards
       StrictData
-  ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-signatures -Wunused-binds -Wunused-imports -Werror -freduction-depth=300 -fplugin=Clippy
+  ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-signatures -Wunused-binds -Wunused-imports -Werror -freduction-depth=300 -fplugin=Clippy -fprint-potential-instances
   if flag(test-crypto)
     cpp-options: -DTEST_CRYPTO
   build-depends:
@@ -536,7 +536,7 @@ library
     , servant-server ^>= 0.18.3
     , servant-swagger ^>= 1.1.10
     , servant-swagger-ui ^>= 0.3.5.3.5.0
-    , servant-xml ^>= 1.0.1.4
+    , servant-xml-conduit == 0.1.0.4
     , simple-reflect ^>= 0.3.3
     , singletons ^>= 2.7
     , split ^>= 0.2.3.4
@@ -571,9 +571,8 @@ library
     , websockets ^>= 0.12.7.3
     , wikiparsec ^>= 1.2.0
     , wreq ^>= 0.5.3.3
-    , xml-conduit ^>= 1.9.1.1
+    , xml-conduit ^>= 1.9.1.3
     , xml-types ^>= 0.3.8
-    , xmlbf ^>= 0.6.1
     , yaml ^>= 0.11.8.0
     , zip ^>= 1.7.2
     , zlib ^>= 0.6.2.3

src/Gargantext/Core/Viz/Graph/API.hs

@@ -48,7 +48,7 @@ import Gargantext.Prelude
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
 import Servant
 import Servant.Job.Async (AsyncJobsAPI)
-import Servant.XML
+import Servant.XML.Conduit (XML)
 
 ------------------------------------------------------------------------
 -- | There is no Delete specific API for Graph since it can be deleted

src/Gargantext/Core/Viz/Graph/GEXF.hs

@@ -7,6 +7,10 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
+See
+https://martin.hoppenheit.info/blog/2023/xml-stream-processing-with-haskell/
+for a tutorial of xml-conduit rendering.
+
 -}
 
 
@@ -18,63 +22,72 @@ Portability : POSIX
 module Gargantext.Core.Viz.Graph.GEXF
   where
 
-import Data.HashMap.Lazy qualified as HashMap
+import Conduit
+import Data.Conduit.Combinators qualified as CC
+import Data.XML.Types qualified as XML
 import Gargantext.Core.Viz.Graph.Types qualified as G
 import Gargantext.Prelude
-import Gargantext.Prelude qualified as P
 import Prelude qualified
-import Xmlbf qualified as Xmlbf
+import Servant (MimeRender(..), MimeUnrender(..))
+import Servant.XML.Conduit (XML)
+import Text.XML.Stream.Render qualified as XML
+
 
 -- Converts to GEXF format
 -- See https://gephi.org/gexf/format/
-instance Xmlbf.ToXml G.Graph where
-  toXml (G.Graph { _graph_nodes = graphNodes
-                 , _graph_edges = graphEdges }) = root graphNodes graphEdges
-    where
-      root :: [G.Node] -> [G.Edge] -> [Xmlbf.Node]
-      root gn ge =
-        Xmlbf.element "gexf" params $ meta <> (graph gn ge)
-        where
-          params = HashMap.fromList [ ("xmlns", "http://www.gexf.net/1.3")
-                                    , ("xmlns:viz", "http://gexf.net/1.3/viz")
-                                    , ("xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance")
-                                    , ("xsi:schemaLocation", "http://gexf.net/1.3 http://gexf.net/1.3/gexf.xsd")
-                                    , ("version", "1.3") ]
-      meta = Xmlbf.element "meta" params $ creator <> desc
-        where
-          params = HashMap.fromList [ ("lastmodifieddate", "2020-03-13") ]
-      creator = Xmlbf.element "creator" HashMap.empty $ Xmlbf.text "Gargantext.org"
-      desc = Xmlbf.element "description" HashMap.empty $ Xmlbf.text "Gargantext gexf file"
-      graph :: [G.Node] -> [G.Edge] -> [Xmlbf.Node]
-      graph gn ge = Xmlbf.element "graph" params $ (nodes gn) <> (edges ge)
-        where
-          params = HashMap.fromList [ ("mode", "static")
-                                    , ("defaultedgetype", "directed") ]
-      nodes :: [G.Node] -> [Xmlbf.Node]
-      nodes gn = Xmlbf.element "nodes" HashMap.empty $ P.concatMap node' gn
-
-      node' :: G.Node -> [Xmlbf.Node]
-      node' (G.Node { node_id = nId, node_label = l, node_size = w}) =
-        Xmlbf.element "node" params (Xmlbf.element "viz:size" sizeParams [])
-        where
-          params = HashMap.fromList [ ("id", nId)
-                                    , ("label", l) ]
-          sizeParams = HashMap.fromList [ ("value", show w) ]
-      edges :: [G.Edge] -> [Xmlbf.Node]
-      edges gn = Xmlbf.element "edges" HashMap.empty $ P.concatMap edge gn
-      edge :: G.Edge -> [Xmlbf.Node]
-      edge (G.Edge { edge_id = eId
-                   , edge_source = es
-                   , edge_target = et
-                   , edge_weight = ew }) =
-        Xmlbf.element "edge" params []
+graphToXML :: Monad m => G.Graph -> ConduitT i XML.Event m ()
+graphToXML (G.Graph { .. }) = root _graph_nodes _graph_edges
+  where
+    -- root :: [G.Node] -> [G.Edge] -> ConduitT i XML.Event m ()
+    root gn ge =
+      XML.tag "gexf" params $ meta <> (graph gn ge)
         where
-          params = HashMap.fromList [ ("id", eId)
-                                    , ("source", es)
-                                    , ("target", et)
-                                    , ("weight", show ew)]
+          params =    XML.attr "xmlns" "http://www.gexf.net/1.3"
+                   <> XML.attr "version" "1.3"
+
+    meta = XML.tag "meta" params $ creator <> desc
+      where
+        params = XML.attr "lastmodifieddate" "2020-03-13"
+        creator = XML.tag "creator" mempty $ XML.content "Gargantext.org"
+        desc = XML.tag "description" mempty $ XML.content "Gargantext gexf file"
+
+    graph :: (Monad m) => [G.Node] -> [G.Edge] -> ConduitT i XML.Event m ()
+    graph gn ge = XML.tag "graph" params $ (nodes gn) <> (edges ge)
+      where
+        params = XML.attr "mode" "static"
+              <> XML.attr "defaultedgetype" "directed"
+
+    nodes :: (Monad m) => [G.Node] -> ConduitT i XML.Event m ()
+    nodes gn = XML.tag "nodes" mempty (yieldMany gn .| awaitForever node')
+    node' :: (Monad m) => G.Node -> ConduitT i XML.Event m ()
+    node' (G.Node { .. }) = XML.tag "node" params (XML.tag "viz:size" sizeParams $ XML.content "")
+      where
+        params = XML.attr "id" node_id
+              <> XML.attr "label" node_label
+        sizeParams = XML.attr "value" (show node_size)
+
+    edges :: (Monad m) => [G.Edge] -> ConduitT i XML.Event m ()
+    edges ge = XML.tag "edges" mempty (yieldMany ge .| awaitForever edge')
+    edge' :: (Monad m) => G.Edge -> ConduitT i XML.Event m ()
+    edge' (G.Edge { .. }) = XML.tag "edge" params $ XML.content ""
+      where
+        params = XML.attr "id" edge_id
+              <> XML.attr "source" edge_source
+              <> XML.attr "target" edge_target
+              <> XML.attr "weight" (show edge_weight)
+
+
+instance MimeRender XML G.Graph where
+  mimeRender _ g = runConduitPure (source .| CC.sinkLazyBuilder)
+    where
+      namespaces = [ ("viz", "http://gexf.net/1.3/viz")
+                   , ("xsi", "http://www.w3.org/2001/XMLSchema-instance")
+                   , ("schemaLocation", "http://gexf.net/1.3") ]
+      source = graphToXML g .| XML.renderBuilder (XML.def { XML.rsNamespaces = namespaces })
+      --encoded = source .| mapC TE.encodeUtf8
+
 
 -- just to be able to derive a client for the entire gargantext API,
 -- we however want to avoid sollicitating this instance
-instance Xmlbf.FromXml G.Graph where
-  fromXml = Prelude.error "FromXml Graph: not defined, just a placeholder"
+instance MimeUnrender XML G.Graph where
+  mimeUnrender _ _ = Prelude.error "MimeUnrender Graph: not defined, just a placeholder"

stack.yaml

@@ -134,15 +134,12 @@ extra-deps:
 - servant-ekg-0.3.1@sha256:19bd9dc3943983da8e79d6f607614c68faea4054fb889d508c8a2b67b6bdd448,2203
 - servant-flatten-0.2@sha256:276896f7c5cdec5b8f8493f6205fded0cc602d050b58fdb09a6d7c85c3bb0837,1234
 - servant-mock-0.8.7@sha256:64cb3e52bbd51ab6cb25e3f412a99ea712c6c26f1efd117f01a8d1664df49c67,2306
-- servant-xml-1.0.1.4@sha256:6c9f2986ac42e72fe24b794c660763a1966a18d696b34cd4f4ed15165edd4aa0,851
 - stemmer-0.5.2@sha256:823aec56249ec2619f60a2c0d1384b732894dbbbe642856d337ebfe9629a0efd,4082
 - taggy-0.2.1@sha256:7bc55ddba178971dc6052163597f0445a0a2b5b0ca0e84ce651d53d722e3c265,4662
 - taggy-lens-0.1.2@sha256:091ca81d02bd3d7fb493dce0148e1a38f25eb178a1ebd751043a23239e5e3265,3009
 - tasty-hspec-1.2.0.3
 - tmp-postgres-1.34.1.0
 - vector-0.12.3.0@sha256:0ae2c1ba86f0077910be242ec6802cc3d7725fe7b2bea6987201aa3737b239b5,7953
-- xmlbf-0.6.1@sha256:57867fcb39e0514d17b3328ff5de8d241a18482fc89bb742d9ed820a6a2a5187,1540
-- xmlbf-xeno-0.2@sha256:39f70fced6052524c290cf595f114661c721452e65fc3e0953a44e7682a6a6b0,950
 
 # For the graph clustering
 ghc-options: