Commit b2e1f439 authored by Sudhir Kumar's avatar Sudhir Kumar

working tree

parent 3dee4b8d
...@@ -4,9 +4,11 @@ import Prelude hiding (div) ...@@ -4,9 +4,11 @@ import Prelude hiding (div)
import Affjax (defaultRequest, printResponseFormatError, request) import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.ResponseFormat as ResponseFormat import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, decodeJson, (.?)) import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.HTTP.Method (Method(..)) import Data.HTTP.Method (Method(..))
import Data.Newtype (class Newtype)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
...@@ -14,7 +16,7 @@ import Effect.Console (log) ...@@ -14,7 +16,7 @@ import Effect.Console (log)
import React (ReactElement) import React (ReactElement)
import React.DOM (a, div, i, li, text, ul) import React.DOM (a, div, i, li, text, ul)
import React.DOM.Props (Props, className, href, onClick) import React.DOM.Props (Props, className, href, onClick)
import Thermite (PerformAction, Render, Spec, cotransform, simpleSpec) import Thermite (PerformAction, Render, Spec, cotransform, modifyState, simpleSpec)
type Name = String type Name = String
type Open = Boolean type Open = Boolean
...@@ -25,7 +27,7 @@ data NTree a = NTree a (Array (NTree a)) ...@@ -25,7 +27,7 @@ data NTree a = NTree a (Array (NTree a))
type FTree = NTree LNode type FTree = NTree LNode
data Action = ToggleFolder ID data Action = ToggleFolder ID --| Initialize
type State = FTree type State = FTree
...@@ -36,6 +38,13 @@ performAction :: PerformAction State {} Action ...@@ -36,6 +38,13 @@ performAction :: PerformAction State {} Action
performAction (ToggleFolder i) _ _ = void $ performAction (ToggleFolder i) _ _ = void $
cotransform (\td -> toggleNode i td) cotransform (\td -> toggleNode i td)
-- performAction Initialize _ _ = void $ do
-- s <- lift $ loadDefaultNode
-- case s of
-- Left err -> modifyState identity
-- Right d -> modifyState (\state -> d)
toggleNode :: Int -> NTree LNode -> NTree LNode toggleNode :: Int -> NTree LNode -> NTree LNode
toggleNode sid (NTree (LNode {id, name, nodeType, open}) ary) = toggleNode sid (NTree (LNode {id, name, nodeType, open}) ary) =
NTree (LNode {id,name, nodeType, open : nopen}) $ map (toggleNode sid) ary NTree (LNode {id,name, nodeType, open : nopen}) $ map (toggleNode sid) ary
...@@ -124,7 +133,7 @@ fldr open = if open then className "fas fa-folder-open" else className "fas fa-f ...@@ -124,7 +133,7 @@ fldr open = if open then className "fas fa-folder-open" else className "fas fa-f
newtype LNode = LNode {id :: Int, name :: String, nodeType :: String, open :: Boolean} newtype LNode = LNode {id :: Int, name :: String, nodeType :: String, open :: Boolean}
-- derive instance newtypeLNode :: Newtype LNode _ derive instance newtypeLNode :: Newtype LNode _
instance decodeJsonLNode :: DecodeJson LNode where instance decodeJsonLNode :: DecodeJson LNode where
decodeJson json = do decodeJson json = do
...@@ -134,10 +143,19 @@ instance decodeJsonLNode :: DecodeJson LNode where ...@@ -134,10 +143,19 @@ instance decodeJsonLNode :: DecodeJson LNode where
nodeType <- obj .? "type" nodeType <- obj .? "type"
pure $ LNode {id : id_, name, nodeType, open : true} pure $ LNode {id : id_, name, nodeType, open : true}
loadDefaultNode :: Aff (Either String (Array LNode)) instance decodeJsonFTree :: DecodeJson (NTree LNode) where
decodeJson json = do
obj <- decodeJson json
node <- obj .? "node"
nodes <- obj .? "children"
node' <- decodeJson node
nodes' <- decodeJson nodes
pure $ NTree node' nodes'
loadDefaultNode :: Aff (Either String (NTree LNode))
loadDefaultNode = do loadDefaultNode = do
res <- request $ defaultRequest res <- request $ defaultRequest
{ url = "http://localhost:8008/user" { url = "http://localhost:8008/tree/1"
, responseFormat = ResponseFormat.json , responseFormat = ResponseFormat.json
, method = Left GET , method = Left GET
, headers = [] , headers = []
......
...@@ -3,7 +3,6 @@ module Gargantext.Pages.Layout.Actions where ...@@ -3,7 +3,6 @@ module Gargantext.Pages.Layout.Actions where
import Prelude hiding (div) import Prelude hiding (div)
import Control.Monad.Cont.Trans (lift) import Control.Monad.Cont.Trans (lift)
import Data.Array (length)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Lens (Prism', prism) import Data.Lens (Prism', prism)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
...@@ -80,16 +79,18 @@ performAction Initialize _ state = void do ...@@ -80,16 +79,18 @@ performAction Initialize _ state = void do
Left err -> do Left err -> do
modifyState identity modifyState identity
Right d -> do Right d -> do
_ <- modifyState $ _ { initialized = true, ntreeState = d}
page <- lift $ DV.loadPage page <- lift $ DV.loadPage
case page of case page of
Left err -> do Left err -> do
modifyState identity modifyState identity
Right docs -> do Right docs -> do
modifyState $ _ { initialized = true modifyState $ _ { initialized = true
, ntreeState = if length d > 0 , ntreeState = d
then Tree.exampleTree -- if length d > 0
--then fnTransform $ unsafePartial $ fromJust $ head d -- then Tree.exampleTree
else Tree.initialState -- --then fnTransform $ unsafePartial $ fromJust $ head d
-- else Tree.initialState
, docViewState = docs , docViewState = docs
} }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment