>>> continue

src/Gargantext/Components/Nodes/Corpus/Phylo.purs

@@ -4,24 +4,20 @@ module Gargantext.Components.Nodes.Corpus.Phylo
 
 import Gargantext.Prelude
 
-import Affjax (Error)
 import Affjax as AX
 import Affjax.ResponseFormat as ResponseFormat
 import DOM.Simple.Console (log2)
 import Data.Either (Either(..))
 import Data.HTTP.Method (Method(..))
-import Data.List.Types (NonEmptyList)
 import Data.Maybe (Maybe(..))
-import Effect.Aff (Aff, launchAff_, throwError)
+import Effect.Aff (Aff, launchAff_)
 import Effect.Class (liftEffect)
-import Foreign (ForeignError)
-import Gargantext.Components.PhyloExplorer.Types (PhyloDataSet)
+import Gargantext.Components.PhyloExplorer.Types (PhyloDataset)
 import Gargantext.Sessions (Session)
 import Gargantext.Types (NodeID)
 import Gargantext.Utils.Reactix as R2
 import Reactix as R
 import Reactix.DOM.HTML as H
-import Simple.JSON (class ReadForeign)
 import Simple.JSON as JSON
 import Toestand as T
 
@@ -39,36 +35,39 @@ phyloLayoutCpt :: R.Component Props
 phyloLayoutCpt = here.component "phyloLayout" cpt where
   cpt _ _ = do
 
-    isFetchedBox <- T.useBox false
+    fetchedDataBox <- T.useBox (Nothing :: Maybe PhyloDataset)
+    fetchedData <- T.useLive T.unequal fetchedDataBox
 
-    isFetched <- T.useLive T.unequal isFetchedBox
+    R.useEffectOnce' $ launchAff_ do
+      result <- fetchPhyloJSON
+      liftEffect $ case result of
+        Left err -> log2 "error" err
+        Right res -> T.write_ (Just res) fetchedDataBox
 
-    R.useEffect' $ launchAff_ $ fetchPhyloJSON
+    pure $ case fetchedData of
+      Nothing -> mempty
+      Just fdata ->
 
+        H.div
+        { className:"phyloCorpus" }
+        [ H.text $ show fdata ]
 
-    pure $
+          -- ,
+          --   infoCorpusR
+          -- ,
+          --   infoPhyloR
+          -- ,
+          --   timelineR
+          -- ,
+          --   isolineR
+          -- ,
+          --   wordcloudR
+          -- ,
+          --   phyloR
 
-      H.div
-      { className: "page-phylo" }
-      [
-        H.h1 {} [ H.text "hello" ]
-      -- ,
-      --   infoCorpusR
-      -- ,
-      --   infoPhyloR
-      -- ,
-      --   timelineR
-      -- ,
-      --   isolineR
-      -- ,
-      --   wordcloudR
-      -- ,
-      --   phyloR
-      ]
 
-
--- fetchPhyloJSON :: forall res. Aff (Either Error res)
-fetchPhyloJSON :: ReadForeign PhyloDataSet => Aff Unit
+fetchPhyloJSON :: Aff (Either String PhyloDataset)
+-- fetchPhyloJSON :: ReadForeign PhyloDataset => Aff Unit
 fetchPhyloJSON =
   let
     request = AX.defaultRequest
@@ -80,7 +79,7 @@ fetchPhyloJSON =
   in do
     result <- request # AX.request
     liftEffect $ case result of
-      Left err -> log2 "error" $ AX.printError err
+      Left err -> pure $ Left $ AX.printError err
       Right response -> case JSON.readJSON response.body of
-        Left err -> log2 "error" $ show err
-        Right (res :: PhyloDataSet) -> log2 "success" $ show res
+        Left err -> pure $ Left $ show err
+        Right (res :: PhyloDataset) -> pure $ Right res

src/Gargantext/Components/PhyloExplorer/Types.purs

 module Gargantext.Components.PhyloExplorer.Types where
 
 import Gargantext.Prelude
-import Prelude
 
-import Data.Eq.Generic (genericEq)
 import Data.Generic.Rep (class Generic)
-import Data.Maybe (Maybe(..))
-import Data.Newtype (class Newtype)
-import Data.Nullable (Nullable)
+import Data.Generic.Rep as GR
 import Data.Show.Generic (genericShow)
+import Gargantext.Utils.SimpleJSON (untaggedSumRep)
 import Simple.JSON as JSON
-import Simple.JSON.Generics (enumSumRep)
-import Simple.JSON.Generics as JSONG
 
--- // Generics
 
+type GraphData =
+  ( bb                :: String
+  , color             :: String
+  , fontsize          :: String
+  , label             :: String
+  , labelloc          :: String
+  , lheight           :: String
+  , lp                :: String
+  , lwidth            :: String
+  , name              :: String
+  , nodesep           :: String
+  , overlap           :: String
+  , phyloBranches     :: String
+  , phyloDocs         :: String
+  , phyloFoundations  :: String
+  , phyloGroups       :: String
+  , phyloPeriods      :: String
+  , phyloSources      :: String
+  , phyloTerms        :: String
+  , phyloTimeScale    :: String
+  , rank              :: String
+  , ranksep           :: String
+  , ratio             :: String
+  , splines           :: String
+  , style             :: String
+  )
 
 --------------------------------------------------
 
--- type PhyloJSON =
---   { name              :: String
---   , phyloDocs         :: String
---   , phyloFoundations  :: String
---   , phyloPeriods      :: String
---   , phyloTerms        :: String
---   , phyloGroups       :: String
---   , phyloBranches     :: String
---   , objects           :: Array PhyloObject
---   , edges             :: Array PhyloEdge
---   }
-
-newtype PhyloDataSet = PhyloDataSet
-  { name :: String
-  , edges :: Array PhyloEdge
+newtype PhyloDataset = PhyloDataset
+  { _subgraph_cnt     :: Int
+  , directed          :: Boolean
+  , edges             :: Array Edge
+  , objects           :: Array Object
+  , strict            :: Boolean
+  | GraphData
   }
 
+derive instance Generic PhyloDataset _
+derive instance Eq PhyloDataset
+instance Show PhyloDataset where show = genericShow
+derive newtype instance JSON.ReadForeign PhyloDataset
 
-derive instance Generic PhyloDataSet _
-derive instance Newtype PhyloDataSet _
-instance Show PhyloDataSet where show = genericShow
-derive newtype instance JSON.ReadForeign PhyloDataSet
 --------------------------------------------------
 
--- data PhyloObject =
---     PhyloBranch
---     { _gvid       :: Int
---     , bId         :: String
---     , branch_x    :: String
---     , branch_y    :: String
---     , label       :: String
---     , nodeType    :: String
---     , pos         :: String
---     }
---   | PhyloGroup
---     { _gvid       :: Int
---     , bId         :: String
---     , foundation  :: String
---     , from        :: String
---     , lbl         :: String
---     , nodeType    :: String
---     , pos         :: String
---     , role        :: String
---     , support     :: String
---     , to          :: String
---     , weight      :: String
---     }
---   | PhyloPeriod
---     { _gvid       :: Int
---     , nodeType    :: String
---     }
---   | DefaultObject
---     { _gvid       :: Int
---     }
-
--- derive instance Generic PhyloObject _
--- instance Eq PhyloObject where eq = genericEq
-
--- instance showPhyloObject :: Show PhyloObject where
---   show (PhyloBranch         { nodeType }) = nodeType
---   show (PhyloGroup          { nodeType }) = nodeType
---   show (PhyloPeriod         { nodeType }) = nodeType
---   show (DefaultObject       { _gvid })    = "DefaultNode"
+type NodeData =
+  ( height            :: String
+  , label             :: String
+  , name              :: String
+  , nodeType          :: String
+  , pos               :: String
+  , shape             :: String
+  , width             :: String
+  )
+
+data Object
+  = Layer
+    { _gvid           :: Int
+    , nodes           :: Array Int
+    | GraphData
+    }
+  | BranchToNode
+    { _gvid           :: Int
+    , age             :: String
+    , bId             :: String
+    , birth           :: String
+    , branchId        :: String
+    , branch_x        :: String
+    , branch_y        :: String
+    , fillcolor       :: String
+    , fontname        :: String
+    , fontsize        :: String
+    , size            :: String
+    , style           :: String
+    | NodeData
+    }
+  | GroupToNode
+    { _gvid           :: Int
+    , bId             :: String
+    , branchId        :: String
+    , fontname        :: String
+    , foundation      :: String
+    , frequence       :: String
+    , from            :: String
+    , lbl             :: String
+    , penwidth        :: String
+    , role            :: String
+    , seaLvl          :: String
+    , source          :: String
+    , strFrom         :: String
+    , strTo           :: String
+    , support         :: String
+    , to              :: String
+    , weight          :: String
+    | NodeData
+    }
+  | PeriodToNode
+    { _gvid           :: Int
+    , fontsize        :: String
+    , from            :: String
+    , strFrom         :: String
+    , strTo           :: String
+    , to              :: String
+    | NodeData
+    }
+
+derive instance Generic Object _
+derive instance Eq Object
+instance Show Object where show = genericShow
+instance JSON.ReadForeign Object where
+  readImpl f = GR.to <$> untaggedSumRep f
 
---------------------------------------------------
 
-data EdgeType = Link | BranchLink | AncestorLink | DefaultEdge
-
-derive instance Generic EdgeType _
-instance Eq EdgeType where eq = genericEq
-instance Show EdgeType where show = genericShow
--- @TODO use `enumSumRep` -> input value with lowercased first char
-instance JSON.ReadForeign EdgeType where
-  readImpl v = JSON.readImpl v >>= pure <<< case _ of
-      Just "link"         -> Link
-      Just "branchLink"   -> BranchLink
-      Just "ancestorLink" -> AncestorLink
-      _                   -> DefaultEdge
-
-newtype PhyloEdge = PhyloEdge
-  { _gvid    :: Int
-  , color :: String
-  , edgeType :: EdgeType
-  , head :: Int
-  , pos :: String
-  , tail :: Int
-  , width :: String
-
-  , arrowhead :: Maybe String
-  , constraint :: Maybe String
-  , lbl :: Maybe String
-  , penwidth :: Maybe String
-  }
+--------------------------------------------------
 
-derive instance Generic PhyloEdge _
-derive instance Newtype PhyloEdge _
-instance Show PhyloEdge where show = genericShow
-derive newtype instance JSON.ReadForeign PhyloEdge
-
-
-
--- arrowhead: "rdot"
--- color: "black"
--- edgeType: "branchLink"
--- head: 309
--- pos: "e,63066,5862.7 62942,34687 62953,34667 62967,34640 62975,34615 63059,34351 63066,34275 63066,33998 63066,33998 63066,33998 63066,7485.5 63066,6917.8 63066,6256.7 63066,5870.9"
--- tail: 86
--- width: "3"
--- _gvid: 49
-
--- color: "black"
--- head: 90
--- pos: "e,64286,35436 64286,35508 64286,35489 64286,35466 64286,35446"
--- tail: 87
--- width: "5"
--- _gvid: 50
-
--- color: "black"
--- constraint: "true"
--- edgeType: "link"
--- head: 101
--- lbl: "1.0"
--- penwidth: "4"
--- pos: "e,22565,33307 22565,33379 22565,33358 22565,33338 22565,33317"
--- tail: 89
--- width: "3"
--- _gvid: 52
+type EdgeData =
+  ( color           :: String
+  , head            :: Int
+  , pos             :: String
+  , tail            :: Int
+  , width           :: String
+  )
+
+data Edge
+  = GroupToGroup
+    { _gvid         :: Int
+    , constraint    :: String
+    , edgeType      :: String
+    , lbl           :: String
+    , penwidth      :: String
+    | EdgeData
+    }
+  | BranchToGroup
+    { _gvid         :: Int
+    , arrowhead     :: String
+    , edgeType      :: String
+    | EdgeData
+    }
+  | BranchToBranch
+    { _gvid         :: Int
+    , arrowhead     :: String
+    , style         :: String
+    | EdgeData
+    }
+  | GroupToAncestor
+    { _gvid         :: Int
+    , arrowhead     :: String
+    , lbl           :: String
+    , penwidth      :: String
+    , style         :: String
+    | EdgeData
+    }
+  | PeriodToPeriod
+    { _gvid         :: Int
+    | EdgeData
+    }
+
+derive instance Generic Edge _
+derive instance Eq Edge
+instance Show Edge where show = genericShow
+instance JSON.ReadForeign Edge where
+  readImpl f = GR.to <$> untaggedSumRep f

src/Gargantext/Utils/SimpleJSON.purs

@@ -39,7 +39,7 @@ instance ( GenericTaggedSumRep a
          ) => GenericTaggedSumRep (GR.Constructor name a) where
   genericTaggedSumRep f = do
     -- r :: { "type" :: String } <- JSON.read' f
-    -- if r."type" == name 
+    -- if r."type" == name
     --   then withExcept (map $ ErrorAtProperty name) $ GR.Constructor <$> genericTaggedSumRep r
     --   else fail $ ForeignError $ "Wrong type tag " <> r."type" <> " where " <> name <> " was expected."
     r :: FO.Object Foreign <- JSON.read' f
@@ -60,5 +60,28 @@ instance ( JSON.ReadForeign a
 
 
 
+-----------------------------------------------------------
 
+-- | Applying Generics-Rep to decoding untagged JSON values
+-- |
+-- | https://purescript-simple-json.readthedocs.io/en/latest/generics-rep.html
+class UntaggedSumRep rep where
+  untaggedSumRep :: Foreign -> Foreign.F rep
 
+instance untaggedSumRepSum ::
+  ( UntaggedSumRep a
+  , UntaggedSumRep b
+  ) => UntaggedSumRep (GR.Sum a b) where
+  untaggedSumRep f
+      = GR.Inl <$> untaggedSumRep f
+    <|> GR.Inr <$> untaggedSumRep f
+
+instance untaggedSumRepConstructor ::
+  ( UntaggedSumRep a
+  ) => UntaggedSumRep (GR.Constructor name a) where
+  untaggedSumRep f = GR.Constructor <$> untaggedSumRep f
+
+instance untaggedSumRepArgument ::
+  ( JSON.ReadForeign a
+  ) => UntaggedSumRep (GR.Argument a) where
+  untaggedSumRep f = GR.Argument <$> JSON.readImpl f