Frame.purs 3.93 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
module Gargantext.Components.Nodes.Frame where

import Data.Maybe (Maybe(..))
import Data.Tuple (fst)
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
--import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson, genericEnumDecodeJson, genericEnumEncodeJson)
import Data.Argonaut (decodeJson, (.:))

14 15 16 17 18
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get, sessionId)
19
import Gargantext.Types (NodeType(..))
20
import Gargantext.Utils.Argonaut (genericSumEncodeJson)
21
import Gargantext.Utils.Reactix as R2
22
import Gargantext.Utils.Reload as GUR
23 24

thisModule = "Gargantext.Components.Nodes.Frame"
25

26
data Hyperdata =
27
  Hyperdata { base     :: String
28 29 30 31 32 33 34 35 36 37 38 39 40 41
            , frame_id :: String
            }

derive instance eqHyperdata :: Eq Hyperdata

derive instance genericHyperdata :: Generic Hyperdata _

instance showHyperdata :: Show Hyperdata where
  show = genericShow

instance decodeJsonHyperdata :: Argonaut.DecodeJson Hyperdata where
-- TODO
--  decodeJson = genericSumDecodeJson
  decodeJson json = do
42 43
    obj      <- decodeJson json
    base     <- obj .: "base"
44 45 46 47 48 49 50 51 52
    frame_id <- obj .: "frame_id"
    pure $ Hyperdata {base, frame_id}


instance encodeJsonHyperdata :: Argonaut.EncodeJson Hyperdata where
  encodeJson = genericSumEncodeJson


type Props =
53 54 55
  ( nodeId   :: Int
  , session  :: Session
  , nodeType :: NodeType
56 57 58 59 60 61 62
  )

type KeyProps =
  ( key :: String
  | Props
  )

63
frameLayout :: Record Props -> R.Element
64 65
frameLayout props = R.createElement frameLayoutCpt props []

66
frameLayoutCpt :: R.Component Props
67
frameLayoutCpt = R.hooksComponentWithModule thisModule "frameLayout" cpt
68
  where
69
    cpt {nodeId, session, nodeType} _ = do
70 71
      let sid = sessionId session

72
      pure $ frameLayoutWithKey { key: show sid <> "-" <> show nodeId, nodeId, session, nodeType}
73 74 75 76 77

frameLayoutWithKey :: Record KeyProps -> R.Element
frameLayoutWithKey props = R.createElement frameLayoutWithKeyCpt props []

frameLayoutWithKeyCpt :: R.Component KeyProps
78
frameLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "frameLayoutWithKey" cpt
79
  where
80
    cpt { nodeId, session, nodeType} _ = do
81
      reload <- GUR.new
82

83
      useLoader {nodeId, reload: GUR.value reload, session} loadframeWithReload $
84
        \frame -> frameLayoutView {frame, nodeId, reload, session, nodeType}
85 86 87

type ViewProps =
  ( frame  :: NodePoly Hyperdata
88
  , reload  :: GUR.ReloadS
89 90 91 92 93 94 95
  | Props
  )


type Base = String
type FrameId = String

96
hframeUrl :: NodeType -> Base -> FrameId -> String
97
hframeUrl NodeFrameNotebook _    frame_id = frame_id  -- Temp fix : frame_id is currently the whole url created
98
hframeUrl _             base frame_id = base <> "/" <> frame_id <> "?view" -- "?both"
99 100 101 102 103

frameLayoutView :: Record ViewProps -> R.Element
frameLayoutView props = R.createElement frameLayoutViewCpt props []

frameLayoutViewCpt :: R.Component ViewProps
104
frameLayoutViewCpt = R.hooksComponentWithModule thisModule "frameLayoutView" cpt
105
  where
106
    cpt {frame: (NodePoly {hyperdata: Hyperdata {base, frame_id}}), nodeId, reload, session, nodeType} _ = do
107 108 109
      pure $ R2.frameset { className : "frame"
                         , rows: "100%,*" }
                   [ R2.frame { src: hframeUrl nodeType base frame_id
110 111 112 113 114 115 116 117 118 119 120 121 122 123 124
                              , width: "100%"
                              , height: "100%"
                              } []
                   ]


type LoadProps = 
  ( nodeId  :: Int
  , session :: Session
  )

loadframe' :: Record LoadProps -> Aff (NodePoly Hyperdata)
loadframe' {nodeId, session} = get session $ NodeAPI Node (Just nodeId) ""

-- Just to make reloading effective
125
loadframeWithReload :: {reload :: GUR.Reload  | LoadProps} -> Aff (NodePoly Hyperdata)
126 127
loadframeWithReload {nodeId, session} = loadframe' {nodeId, session}