filtered & begin d3/graph

src/App.purs

@@ -11,7 +11,7 @@ import Data.Nullable (toMaybe)
 import Effect (Effect)
 import FFI.Simple ((...), delay, args2)
 import Phylo.Graph (phyloR, timelineR, wordcloudR)
-import Phylo.Infos (infoCorpusR)
+import Phylo.Infos (infoCorpusR,infoPhyloR)
 import Phylo.Isoline (isolineR)
 import Reactix as R
 import Reactix.DOM.HTML as H
@@ -23,5 +23,5 @@ app = R.createElement appCpt
 appCpt :: R.Component()
 appCpt = R.hooksComponent "app" cpt where
   cpt _ _ = do
-    pure $ H.div {className:"mèmiscape"} [infoCorpusR, timelineR,isolineR, wordcloudR, phyloR]
+    pure $ H.div {className:"mèmiscape"} [infoCorpusR,infoPhyloR, timelineR,isolineR, wordcloudR, phyloR]
 

src/Phylo/Components/Infos.purs

@@ -20,32 +20,33 @@ import Reactix as R
 import Reactix.DOM.HTML as H
 import Toestand as T
 
--- type InfoPhylo = 
---   ( nbTerms      :: Int
---   , nbGroups     :: Int
---   , nbBranches   :: Int
---    )
 type Props = ()
 
 infoCorpusR :: R.Element
 infoCorpusR = infoCorpus {}
 
--- infoPhyloR :: R.Element
--- infoPhyloR = infoPhylo {nbTerms      : 0
---                        ,nbGroups     : 0
---                        ,nbBranches   : 0}
--- 
--- infoPhylo :: Record InfoPhylo -> R.Element
--- infoPhylo props = R.createElement infoPhyloCpt props []
--- 
--- infoPhyloCpt :: R.Component InfoPhylo
--- infoPhyloCpt = R.hooksComponent "infoPhylo" cpt where
---   cpt {  } _children = do
---     pure $ H.div {className:"phyloInfos"} [H.text "Here lies Phylo-info",
---     H.div {className:"phyloInfos-info"}[H.text "0"]]
+infoPhyloR :: R.Element
+infoPhyloR = infoPhylo {}
 
-infoCorpus :: Record Props -> R.Element 
-infoCorpus props = R.createElement infoCorpusCpt props []
+--infoPhyloCpt :: R.Component Props
+--infoPhyloCpt = R.hooksComponent "infoPhylo" cpt where
+--  cpt {  } _children = do
+--    pure $ H.div {className:"phyloInfos"} [H.text "Here lies Phylo-info",
+--    H.div {className:"phyloInfos-info"}[H.text "0"]]
+
+infoPhyloCpt :: R.Component Props
+infoPhyloCpt = R.hooksComponent "infoCorpus" cpt where
+  cpt {  } _children = do
+    fetched <- T.useBox Nothing
+
+    R.useEffect' $ do
+      launchAff_ $ do        
+        mr <- PTE.fetchPhyloJSON
+        liftEffect $ do
+          case mr of
+            Nothing -> log "Nothing"
+            Just r -> T.write_ (Just r) fetched
+    pure $ infoPhyloLoaded { fetched } []
 
 --infoCorpusCpt :: R.Component InfoCorpus
 --infoCorpusCpt = R.hooksComponent "infoCorpus" cpt where
@@ -53,6 +54,12 @@ infoCorpus props = R.createElement infoCorpusCpt props []
 --    pure $ H.div {className:"phyloCorpus"} [H.text "Here lies Corpus-info",
 --    H.div {className:"phyloCorpus-info"}[H.text $ "Corpus Info here"]
 
+infoCorpus :: Record Props -> R.Element 
+infoCorpus props = R.createElement infoCorpusCpt props []
+
+infoPhylo :: Record Props -> R.Element
+infoPhylo props = R.createElement infoPhyloCpt props []
+
 type InfoCorpusLoaded =
   ( fetched :: T.Box (Maybe PTE.PhyloJSON) )
 
@@ -73,6 +80,9 @@ infoCorpusCpt = R.hooksComponent "infoCorpus" cpt where
 infoCorpusLoaded :: Record InfoCorpusLoaded -> Array R.Element -> R.Element
 infoCorpusLoaded = R.createElement infoCorpusLoadedCpt
 
+infoPhyloLoaded :: Record InfoCorpusLoaded -> Array R.Element -> R.Element
+infoPhyloLoaded = R.createElement infoPhyloLoadedCpt
+
 infoCorpusLoadedCpt :: R.Component InfoCorpusLoaded
 infoCorpusLoadedCpt = R.hooksComponent "infoCorpusLoaded" cpt where
   cpt { fetched } _ = do
@@ -82,10 +92,22 @@ infoCorpusLoadedCpt = R.hooksComponent "infoCorpusLoaded" cpt where
       Nothing -> pure $ H.div {}[]
       Just mr -> pure $ H.div {className:"phyloCorpus"} 
         [H.text "Corpus",
-         H.div {className:"phyloCorpus-info"}[H.span {}[H.text $ mr.phyloDocs <> " docs"],
+         H.div {className:"phyloInfos-info"}[H.span {}[H.text $ mr.phyloDocs <> " docs"],
                                               H.span {}[H.text $ mr.phyloFoundations <> " foundations"],
                                               H.span {}[H.text $ mr.phyloPeriods <> " periods"]]]
 
+infoPhyloLoadedCpt :: R.Component InfoCorpusLoaded
+infoPhyloLoadedCpt = R.hooksComponent "infoCorpusLoaded" cpt where
+  cpt { fetched } _ = do
+    fetched' <- T.useLive T.unequal fetched
+
+    case fetched' of
+      Nothing -> pure $ H.div {}[]
+      Just mr -> pure $ H.div {className:"phyloInfos"} 
+        [H.text "Phylo",
+         H.div {className:"phyloCorpus-info"}[H.span {}[H.text $ mr.phyloTerms <> " Termes"],
+                                              H.span {}[H.text $ mr.phyloBranches <> " Branches"],
+                                              H.span {}[H.text $ mr.phyloGroups <> " Groupes"]]]
 --getPhyloName = 
 --  launchAff_ $ do
 --    mr <- PTE.fetchPhyloJSON

src/Phylo/TypesExamples.purs

@@ -14,6 +14,7 @@ import Data.Maybe (Maybe(..), fromMaybe, maybe)
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff, launchAff_)
 import Effect.Class (liftEffect)
+import Effect.Class.Console (logShow)
 import Simple.JSON as JSON
 
 type PhyloJSON = 
@@ -61,13 +62,17 @@ type PhyloJSON =
 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 (Default     {_gvid}) = "DefaultNode"
+
 data PhyloObject = PhyloBranch  
                 { _gvid :: Int
-                , bId :: String
                 , nodeType :: String
                 } | PhyloGroup   
                 { _gvid :: Int
-                , bId :: String
                 , nodeType :: String
                 } | PhyloPeriod  
                 { _gvid :: Int
@@ -77,25 +82,33 @@ data PhyloObject = PhyloBranch
                   _gvid :: Int
                 }
 
-isolate :: PhyloObject -> String -> PhyloObject
-isolate obj s = case s of
-  "branch" ->
+--instance JSON.ReadForeign PhyloObject where
+--  readImpl f = do
+--    { _gvid, nodeType: mNodeType } :: { _gvid :: Int, nodeType :: Maybe String } <- JSON.readImpl f
+--    case mNodeType of
+--      Nothing -> pure $ Default { _gvid }
+--      Just nodeType -> do
+--        { bId: mBId } :: { bId :: Maybe String } <- JSON.readImpl f
+--        case mBId of
+--          Nothing -> pure $ Default { _gvid }
+--          Just bId ->
+--            case nodeType of
+--              "branch" -> pure $ PhyloBranch { _gvid, bId, nodeType }
+--              "group" -> pure $ PhyloGroup { _gvid, bId, nodeType }
+--              "period" -> pure $ PhyloPeriod { _gvid, nodeType }
+--              _ -> pure $ Default { _gvid }
 
 instance JSON.ReadForeign PhyloObject where
   readImpl f = do
-    { _gvid, nodeType: mNodeType } :: { _gvid :: Int, nodeType :: Maybe String } <- JSON.readImpl f
+    { _gvid, nodeType: mNodeType} :: { _gvid :: Int, nodeType :: Maybe String } <- JSON.readImpl f
     case mNodeType of
       Nothing -> pure $ Default { _gvid }
-      Just nodeType -> do
-        { bId: mBId } :: { bId :: Maybe String } <- JSON.readImpl f
-        case mBId of
-          Nothing -> pure $ Default { _gvid }
-          Just bId ->
-            case nodeType of
-              "branch" -> pure $ PhyloBranch { _gvid, bId, nodeType }
-              "group" -> pure $ PhyloGroup { _gvid, bId, nodeType }
-              "period" -> pure $ PhyloPeriod { _gvid, nodeType }
-              _ -> pure $ Default { _gvid }
+      Just nodeType ->
+        case nodeType of
+          "branch" -> pure $ PhyloBranch { _gvid, nodeType }
+          "group" -> pure $ PhyloGroup { _gvid, nodeType }
+          "period" -> pure $ PhyloPeriod { _gvid, nodeType }
+          _ -> pure $ Default { _gvid }
 
 derive instance Generic PhyloEdge _
 instance Eq PhyloEdge where eq = genericEq 
@@ -139,27 +152,27 @@ instance JSON.ReadForeign PhyloEdge where
                                     , edgeType }
               _ -> pure $ DefaultLink { _gvid }
 
-newtype PhyloData = PhyloData
-  { name                :: String
-  , phyloDocs           :: Int
-  , phyloFoundations    :: Int
-  , phyloPeriods        :: Int
-  , phyloTerms          :: Int
-  , phyloGroups         :: Int
-  , phyloBranches       :: Int
-  , phyloOBranches      :: Array PhyloObject
-  , phyloOGroups        :: Array PhyloObject
-  , phyloOPeriods       :: Array PhyloObject
-  , phyloOLinks         :: Array PhyloEdge
-  , phyloOAncestorLinks :: Array PhyloEdge
-  , phyloOBrancheLinks  :: Array PhyloEdge
-  }
-
-
-type PhyloConfig =
-  {
-
-  }
+--newtype PhyloData = PhyloData
+--  { name                :: String
+--  , phyloDocs           :: Int
+--  , phyloFoundations    :: Int
+--  , phyloPeriods        :: Int
+--  , phyloTerms          :: Int
+--  , phyloGroups         :: Int
+--  , phyloBranches       :: Int
+--  , phyloOBranches      :: Array PhyloObject
+--  , phyloOGroups        :: Array PhyloObject
+--  , phyloOPeriods       :: Array PhyloObject
+--  , phyloOLinks         :: Array PhyloEdge
+--  , phyloOAncestorLinks :: Array PhyloEdge
+--  , phyloOBrancheLinks  :: Array PhyloEdge
+--  }
+--
+--
+--type PhyloConfig =
+--  {
+--
+--  }
 -- getBranch :: 
 -- type PhyloObjects =
 --   { _gvid    :: Int
@@ -220,13 +233,38 @@ fetchPhyloJSON = do
           pure Nothing
         Right (r :: PhyloJSON) -> do
           log $ "name of phylo is : " <> show r.name
+          log $ getBranches r.objects
+          log $ getGroups r.objects
+          log $ getPeriods r.objects
           pure $ Just r
 
--- phylo :: PhyloJSON -> PhyloJSON
+isBranch :: PhyloObject -> Boolean
+isBranch (PhyloBranch _) = true
+isBranch _ = false
+
+getBranches :: Array PhyloObject -> Array PhyloObject
+getBranches x = filter isBranch x
+
+isGroup :: PhyloObject -> Boolean
+isGroup (PhyloGroup _) = true
+isGroup _ = false
+
+getGroups :: Array PhyloObject -> Array PhyloObject
+getGroups x = filter isGroup x
+
+isPeriod :: PhyloObject -> Boolean
+isPeriod (PhyloPeriod _) = true
+isPeriod _ = false
+
+getPeriods :: Array PhyloObject -> Array PhyloObject
+getPeriods x = filter isPeriod x
+
+isBranch' :: String -> Boolean
+isBranch' "branch" = true
+isBranch' _ = false
 
-doStuff = do
-  mPhy <- fetchPhyloJSON
-  pure $ maybe mPhy
+getBranches' :: Array PhyloObject -> Array PhyloObject
+getBranches' x = filter (isBranch) x
 
 -- fetchmyJSON = do
 --   result <- AX.request (AX.defaultRequest { url = "http://localhost:5501/data/myJSON.json", method = Left GET, -- responseFormat = ResponseFormat.string })

src/sass/_phylo.sass

@@ -22,15 +22,15 @@ $white: #ffffff
   color: $black
 
 .phyloCorpus
-  grid-row: 1 / 2
-  grid-column: 1 / 4
+  grid-row: 1 / 4
+  grid-column: 1 / 2
   display: flex
   align-items: center
   justify-content: center
   background-color: $testcolor3
 
 .phyloInfos
-  grid-row: 1
+  grid-row: 1 / 4
   grid-column: 3 / 4
   font-size: 14px
   display: flex
@@ -46,7 +46,7 @@ $white: #ffffff
   background-color: $testcolor4
 
 .phyloInfos-info
-  grid-row: 2 / 4
+  grid-row: 1 / 4
   grid-column: 6 / 8
   font-size: 14px
   display: flex