module Gargantext.Components.PhyloExplorer.Resources ( PubSubEvent(..) , drawPhylo , selectSource , findSourceById , autocompleteSearch, autocompleteSearchMulti , autocompleteSubmit , setGlobalDependencies, setGlobalD3Reference , resetView , changeDisplayView , exportViz , doubleClick , subscribe, unsubscribe, publish ) where import Gargantext.Prelude import DOM.Simple (Element, Window) import Data.Array as Array import Data.Foldable (for_) import Data.FoldableWithIndex (forWithIndex_) import Data.Generic.Rep (class Generic) import Data.Int (fromString) import Data.Maybe (Maybe(..), isJust, maybe) import Data.String as String import Effect (Effect) import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn4, EffectFn7, runEffectFn1, runEffectFn2, runEffectFn4, runEffectFn7) import FFI.Simple ((..), (.=), (.?)) import Gargantext.Components.PhyloExplorer.Types (AncestorLink, Branch, BranchLink, DisplayView(..), Group(..), Link, Period, PhyloData(..), Source(..), Term(..)) import Gargantext.Utils (getter) import Gargantext.Utils.Reactix ((~~)) import Gargantext.Utils.Reactix as R2 import Graphics.D3.Base (D3, D3Eff) import Graphics.D3.Selection as D3S import Graphics.D3.Util (ffi) import Toestand as T foreign import _drawPhylo :: EffectFn7 (Array Branch) (Array Period) (Array Group) (Array Link) (Array AncestorLink) (Array BranchLink) (Array Number) (Unit) drawPhylo :: Array Branch -> Array Period -> Array Group -> Array Link -> Array AncestorLink -> Array BranchLink -> Array Number -> Effect Unit drawPhylo = runEffectFn7 _drawPhylo foreign import _drawWordCloud :: forall a. EffectFn1 (Array a) Unit drawWordCloud :: forall a. Array a -> Effect Unit drawWordCloud = runEffectFn1 _drawWordCloud foreign import _termClick :: EffectFn4 String String Int String Unit termClick :: String -> String -> Int -> String -> Effect Unit termClick = runEffectFn4 _termClick foreign import _resetView :: Effect Unit resetView :: Effect Unit resetView = _resetView foreign import _showLabel :: Effect Unit showLabel :: Effect Unit showLabel = _showLabel foreign import _showHeading :: Effect Unit showHeading :: Effect Unit showHeading = _showHeading foreign import _showLanding :: Effect Unit showLanding :: Effect Unit showLanding = _showLanding foreign import _exportViz :: Effect Unit exportViz :: Effect Unit exportViz = _exportViz foreign import _doubleClick :: Effect Unit doubleClick :: Effect Unit doubleClick = _doubleClick foreign import _highlightGroups :: EffectFn1 (Array Element) Unit highlightGroups :: Array Element -> Effect Unit highlightGroups = runEffectFn1 _highlightGroups foreign import _initPath :: Effect Unit initPath :: Effect Unit initPath = _initPath ----------------------------------------------------------- foreign import _subscribe :: forall opt. EffectFn2 String (opt -> Effect Unit) Unit subscribe :: forall opt. String -> (opt -> Effect Unit) -> Effect Unit subscribe = runEffectFn2 _subscribe foreign import _unsubscribe :: EffectFn2 String String Unit unsubscribe :: String -> String -> Effect Unit unsubscribe = runEffectFn2 _unsubscribe foreign import _publish :: forall opt. EffectFn2 String opt Unit publish :: forall opt. String -> opt -> Effect Unit publish = runEffectFn2 _publish ----------------------------------------------------------- foreign import _extractedTermsEvent :: String foreign import _extractedCountEvent :: String foreign import _selectedTermEvent :: String foreign import _selectedBranchEvent :: String foreign import _selectedSourceEvent :: String foreign import _displayViewEvent :: String data PubSubEvent = ExtractedTermsEvent | ExtractedCountEvent | SelectedTermEvent | SelectedBranchEvent | SelectedSourceEvent | DisplayViewEvent derive instance Generic PubSubEvent _ derive instance Eq PubSubEvent instance Show PubSubEvent where show = case _ of ExtractedTermsEvent -> _extractedTermsEvent ExtractedCountEvent -> _extractedCountEvent SelectedTermEvent -> _selectedTermEvent SelectedBranchEvent -> _selectedBranchEvent SelectedSourceEvent -> _selectedSourceEvent DisplayViewEvent -> _displayViewEvent ----------------------------------------------------------- -- @XXX: "Graphics.D3.Selection" lack of "filter" function -- https://github.com/d3/d3-selection#selection_filter selectionFilter :: forall d. String -> D3S.Selection d -> D3Eff (D3S.Selection D3S.Void) selectionFilter = ffi ["query", "selection", ""] "selection.filter(query)" -- @XXX: "Graphics.D3.Selection" lack of "nodes" function -- https://github.com/d3/d3-selection#selection_nodes selectionNodes :: forall d. D3S.Selection d -> D3Eff (Array Element) selectionNodes = ffi ["selection", ""] "selection.nodes()" -- @XXX: "Graphics.D3.Selection" lack of "node" function -- https://github.com/d3/d3-selection#selection_node -- selectionNode :: forall d. D3S.Selection d -> D3Eff (Nullable Element) -- selectionNode = ffi ["selection", ""] "selection.node()" ----------------------------------------------------------- setGlobalDependencies :: Window -> PhyloData -> Effect Unit setGlobalDependencies w (PhyloData o) = do _ <- pure $ (w .= "freq") {} _ <- pure $ (w .= "nbBranches") o.nbBranches _ <- pure $ (w .= "nbDocs") o.nbDocs _ <- pure $ (w .= "nbFoundations") o.nbFoundations _ <- pure $ (w .= "nbGroups") o.nbGroups _ <- pure $ (w .= "nbPeriods") o.nbPeriods _ <- pure $ (w .= "nbTerms") o.nbTerms _ <- pure $ (w .= "sources") o.sources _ <- pure $ (w .= "terms") [] _ <- pure $ (w .= "timeScale") o.timeScale _ <- pure $ (w .= "weighted") o.weighted _ <- pure $ (w .= "branchFocus") [] (freq :: Array Int) <- pure $ w .. "freq" (terms :: Array Term) <- pure $ w .. "terms" for_ o.groups \(Group g) -> do let f = g.foundation l = g.label forWithIndex_ f \idx val -> let idx' = show idx val' = show val in -- For each entries in group.foundation array, -- increment consequently the global window.keys array case (freq .? val') of Nothing -> pure $ (freq .= val') 0 Just v -> pure $ (freq .= val') (v +1) *> -- For each entries in group.foundation array, -- if the global window.terms does not have it in property, -- append an item to the global window.terms case (terms .? val') of Just _ -> pure unit Nothing -> void <<< pure $ (terms .= val') $ Term { label: l .. idx' , fdt : val' } -- Use FFI native `Array.flat` method (not mutating its caller in this -- context) void do new <- pure $ (terms ~~ "flat") [] pure $ (w .= "terms") new -- @XXX: prevent PureScript from not injecting D3 setGlobalD3Reference :: Window -> D3 -> Effect Unit setGlobalD3Reference window d3 = void $ pure $ (window .= "d3") d3 ----------------------------------------------------------- selectSource :: Window -> Maybe Source -> Effect Unit selectSource window source = let hasHighlight = maybe false identity (window .? "highlighted") hasLdView = maybe false identity (window .? "ldView") in do groups <- D3S.rootSelectAll ".group-inner" if hasHighlight then selectionFilter ".source-focus" groups >>= selectionNodes >>= flip for_ (flip R2.addClass [ "group-unfocus" ]) else pure unit -- unselected all the groups _ <- selectionNodes groups >>= flip for_ (flip R2.removeClass [ "source-focus" ]) if hasLdView then selectionNodes groups >>= flip for_ (fill "#f5eee6") else selectionNodes groups >>= flip for_ (fill "#fff") _ <- D3S.rootSelectAll ".peak" >>= D3S.classed "peak-focus-source" false -- select the relevant ones case source of Nothing -> do drawWordCloud [] Just (Source { id }) -> do arr <- selectionFilter (".source-" <> show id) groups >>= selectionNodes drawWordCloud arr initPath for_ arr $ focusBranch window highlightGroups arr for_ arr markSourceFocus where fill :: String -> Element -> Effect Unit fill hex el = do style <- pure $ (el .. "style") pure $ (style .= "fill") hex markSourceFocus :: Element -> Effect Unit markSourceFocus el = do R2.removeClass el [ "group-unfocus" ] R2.addClass el [ "source-focus" ] bid <- pure $ (el ~~ "getAttribute") [ "bId" ] void $ D3S.rootSelect ("#peak-" <> bid) >>= D3S.classed "peak-focus-source" true focusBranch :: Window -> Element -> Effect Unit focusBranch w el = do (branchFocus :: Array Int) <- pure $ w .. "branchFocus" bid <- pure $ (el ~~ "getAttribute") [ "bId" ] case fromString bid of Nothing -> pure unit Just i -> pure $ (branchFocus ~~ "push") [ i ] findSourceById :: Array Source -> Int -> Maybe Source findSourceById list value = Array.find (fn) list where fn (Source { id }) = eq value id autocompleteSearch :: Array Term -> String -> Effect (Maybe Term) autocompleteSearch terms query = let hasMinLen = String.length >>> (_ > 0) in pure if hasMinLen query then findTermByPrefix terms query else Nothing autocompleteSearchMulti :: Array Term -> String -> Effect (Array Term) autocompleteSearchMulti terms query = let hasMinLen = String.length >>> (_ > 0) in pure if hasMinLen query then findTermsByPrefix terms query else [] autocompleteSubmit :: T.Box DisplayView -> Maybe Term -> Effect Unit autocompleteSubmit displayView = case _ of Nothing -> pure unit Just (Term { label, fdt }) -> do showLabel T.write_ LabelMode displayView termClick label fdt 0 "search" findTermsByPrefix :: Array Term -> String -> Array Term findTermsByPrefix terms prefix = let needle = String.toLower prefix fn s = getter _.label >>> String.toLower >>> String.stripPrefix (String.Pattern s) >>> isJust in Array.filter (fn needle) terms findTermByPrefix :: Array Term -> String -> Maybe Term findTermByPrefix terms prefix = Array.head $ findTermsByPrefix terms prefix changeDisplayView :: DisplayView -> Effect Unit changeDisplayView = case _ of LabelMode -> showLabel HeadingMode -> showHeading LandingMode -> showLanding