NTree.purs 3.09 KB
Newer Older
1 2 3
module NTree where

import Data.Tuple (Tuple(..))
Abinaya Sudhir's avatar
Abinaya Sudhir committed
4
import Prelude hiding (div)
5
import React (ReactElement)
Abinaya Sudhir's avatar
Abinaya Sudhir committed
6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35
import React.DOM (a, div, i, li, text, ul)
import React.DOM.Props (Props, className, href, onClick)
import Thermite (PerformAction, Render, Spec, cotransform, simpleSpec)

type Name = String
type Open = Boolean
type URL  = String
type ID   = Int

data NTree a = NLeaf a | NNode ID Open Name (Array (NTree a))

type FTree = NTree (Tuple Name URL)

data Action = ToggleFolder ID

type State = FTree

initialState :: State
initialState = NLeaf (Tuple "" "")

performAction :: PerformAction _ State _ Action
performAction (ToggleFolder i) _ _ = void (cotransform (\td -> toggleNode i td))

toggleNode :: forall t10. Int -> NTree t10 -> NTree t10
toggleNode sid (NNode iid open name ary) =
  NNode iid nopen name $ map (toggleNode sid) ary
  where
    nopen = if sid == iid then not open else open
toggleNode sid a = a

36 37


Abinaya Sudhir's avatar
Abinaya Sudhir committed
38 39
------------------------------------------------------------------------
-- Realistic Tree for the UI
40

Abinaya Sudhir's avatar
Abinaya Sudhir committed
41 42 43 44
myCorpus :: Int -> String -> NTree (Tuple String String)
myCorpus n name = NNode n false name
    [ NLeaf (Tuple "Facets"    "#/docView")
    , NLeaf (Tuple "Graph"     "#/docView")
45
    , NLeaf (Tuple "Dashboard" "#/dashboard")
Abinaya Sudhir's avatar
Abinaya Sudhir committed
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
    ]

exampleTree :: NTree (Tuple String String)
exampleTree =
  NNode 1 true "My gargantext"
  [ myCorpus 2 "My publications"
  , myCorpus 3 "My community"
  , NNode 4 false "My researchs" [ myCorpus 5 "Subject A"
                                 , myCorpus 6 "Subject B"
                                 , myCorpus 7 "Subject C"
                                 ]
  ]

------------------------------------------------------------------------
-- TODO
-- alignment to the right
nodeOptionsCorp :: Boolean -> Array ReactElement
nodeOptionsCorp activated = case activated of
                         true  -> [ i [className "fab fa-whmcs" ] []]
                         false -> []

-- TODO
-- alignment to the right
-- on hover make other options available:
nodeOptionsView :: Boolean -> Array ReactElement
nodeOptionsView activated = case activated of
                         true -> [ i [className "fas fa-sync-alt" ] []
                                 , i [className "fas fa-upload"   ] []
                                 , i [className "fas fa-share-alt"] []
                                 ]
                         false -> []
77

Abinaya Sudhir's avatar
Abinaya Sudhir committed
78 79 80 81 82 83 84 85 86 87 88

treeview :: Spec _ State _ Action
treeview = simpleSpec performAction render
  where
    render :: Render State _ Action
    render dispatch _ state _ =
      [div [className "tree"] [toHtml dispatch state]]


toHtml :: _ -> FTree -> ReactElement
toHtml d (NLeaf (Tuple name link)) =
89 90
  li []
  [ a [ href link]
Abinaya Sudhir's avatar
Abinaya Sudhir committed
91 92 93
    ( [ text (name <> "    ")
      ] <> nodeOptionsView false
    )
94
  ]
Abinaya Sudhir's avatar
Abinaya Sudhir committed
95 96
toHtml d (NNode id open name ary) =
  ul [ ]
97
  [ li [] $
Abinaya Sudhir's avatar
Abinaya Sudhir committed
98 99 100 101 102 103 104
    ( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []]
      ,  text $ " " <> name <> "    "
      ] <> nodeOptionsCorp false <>
      if open then
        map (toHtml d) ary
        else []
    )
105
  ]
Abinaya Sudhir's avatar
Abinaya Sudhir committed
106 107 108

fldr :: Boolean -> Props
fldr open = if open then className "fas fa-folder-open" else className "fas fa-folder"