Frame.purs 7.95 KB
Newer Older
1 2
module Gargantext.Components.Nodes.Frame where

Karen Konou's avatar
Karen Konou committed
3 4
import Gargantext.Prelude

5
import DOM.Simple as DOM
6
import Data.Array as A
7
import Data.Either (Either(..))
8
import Data.Eq.Generic (genericEq)
9
import Data.Generic.Rep (class Generic)
10
import Data.Maybe (Maybe(..))
11
import Data.Newtype (class Newtype)
12
import Data.Nullable (Nullable, null, toMaybe)
13
import Data.Show.Generic (genericShow)
14
import Data.Tuple (Tuple(..))
15
import Effect.Aff (launchAff_)
16
import Effect.Class (liftEffect)
17
import Gargantext.Components.FolderView as FV
18
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..))
19
import Gargantext.Components.GraphQL.Endpoints (getNodeParent, triggerEthercalcCSVDownload)
Karen Konou's avatar
Karen Konou committed
20
import Gargantext.Components.Node (NodePoly(..))
21
import Gargantext.Config.REST (RESTError, AffRESTError, logRESTError)
22 23
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(NodeAPI))
24
import Gargantext.Routes as GR
25
import Gargantext.Sessions (Session, get, postWwwUrlencoded, sessionId)
26
import Gargantext.Types (NodeType(..))
27 28
import Gargantext.Types as GT
import Gargantext.Utils.EtherCalc as EC
29
import Gargantext.Utils.JitsiMeet as JM
30
import Gargantext.Utils.Reactix as R2
31
import Gargantext.Utils.Toestand as T2
32 33 34 35 36
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Web.URL as WURL
37

James Laver's avatar
James Laver committed
38 39
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Frame"
40

41
newtype Hyperdata = Hyperdata { base :: String, frame_id :: String }
42
derive instance Generic Hyperdata _
43 44 45 46 47
derive instance Newtype Hyperdata _
instance Eq Hyperdata where eq = genericEq
instance Show Hyperdata where show = genericShow
derive newtype instance JSON.ReadForeign Hyperdata
derive newtype instance JSON.WriteForeign Hyperdata
48 49

type Props =
50 51
  ( nodeId   :: Int
  , nodeType :: NodeType
52
  , session  :: Session
53 54 55
  )

type KeyProps =
James Laver's avatar
James Laver committed
56
  ( key      :: String
57
  | Props
58 59
  )

James Laver's avatar
James Laver committed
60
frameLayout :: R2.Leaf Props
61
frameLayout props = R.createElement frameLayoutCpt props []
62
frameLayoutCpt :: R.Component Props
James Laver's avatar
James Laver committed
63
frameLayoutCpt = here.component "frameLayout" cpt where
64 65 66 67
  cpt { nodeId, nodeType, session } _ = do
    pure $ frameLayoutWithKey { key, nodeId, nodeType, session }
      where
        key = show (sessionId session) <> "-" <> show nodeId
68

James Laver's avatar
James Laver committed
69
frameLayoutWithKey :: R2.Leaf KeyProps
70 71
frameLayoutWithKey props = R.createElement frameLayoutWithKeyCpt props []
frameLayoutWithKeyCpt :: R.Component KeyProps
James Laver's avatar
James Laver committed
72 73
frameLayoutWithKeyCpt = here.component "frameLayoutWithKey" cpt where
  cpt { nodeId, session, nodeType} _ = do
74 75
    reload <- T.useBox T2.newReload
    reload' <- T.useLive T.unequal reload
76 77 78 79 80
    useLoader { errorHandler
              , loader: loadframeWithReload
              , path: {nodeId, reload: reload', session}
              , render: \frame -> frameLayoutView {frame, nodeId, reload, session, nodeType} }
    where
81
      errorHandler = logRESTError here "[frameLayoutWithKey]"
82 83

type ViewProps =
84 85
  ( frame    :: NodePoly Hyperdata
  , reload   :: T2.ReloadS
James Laver's avatar
James Laver committed
86 87
  , nodeId   :: Int
  , nodeType :: NodeType
88
  , session  :: Session
89 90 91
  )

type Base = String
James Laver's avatar
James Laver committed
92

93 94
type FrameId = String

95
hframeUrl :: NodeType -> Base -> FrameId -> String
James Laver's avatar
James Laver committed
96
hframeUrl NodeFrameNotebook _ frame_id = frame_id  -- Temp fix : frame_id is currently the whole url created
97 98
hframeUrl NodeFrameCalc  base frame_id = base <> "/" <> frame_id
hframeUrl NodeFrameVisio base frame_id = base <> "/" <> frame_id
James Laver's avatar
James Laver committed
99
hframeUrl _ base frame_id = base <> "/" <> frame_id <> "?view" -- "?both"
100

101 102
frameLayoutView :: R2.Leaf ViewProps
frameLayoutView props  = R.createElement frameLayoutViewCpt props []
103
frameLayoutViewCpt :: R.Component ViewProps
James Laver's avatar
James Laver committed
104
frameLayoutViewCpt = here.component "frameLayoutView" cpt
105
  where
106 107
    cpt { frame: NodePoly { hyperdata: h@(Hyperdata { base, frame_id }) }
        , nodeId
108
        , nodeType
109 110
        , reload
        , session } _ = do
111 112 113 114 115 116
      case nodeType of
        NodeFrameVisio ->
          case WURL.fromAbsolute base of
            Nothing  -> pure $ H.div {} [ H.text $ "Wrong base url: " <> base ]
            Just url -> pure $ nodeFrameVisio { frame_id, reload, url }
        _              ->
117 118
          pure $ H.div{}
            [ FV.backButton {} []
119
            , importIntoListButton { hyperdata: h, nodeId, session } []
120 121
            , H.div { className : "frame"
                    , rows: "100%,*" }
122
              [ -- H.script { src: "https://visio.gargantext.org/external_api.js"} [],
123
                H.iframe { src: hframeUrl nodeType base frame_id
124 125 126
                         , width: "100%"
                         , height: "100%"
                         } []
127 128 129
              ]
            ]

130 131
type ImportIntoListButtonProps =
  ( hyperdata :: Hyperdata
132 133
  , nodeId    :: Int
  , session   :: Session )
134 135 136 137 138 139

importIntoListButton :: R2.Component ImportIntoListButtonProps
importIntoListButton = R.createElement importIntoListButtonCpt
importIntoListButtonCpt :: R.Component ImportIntoListButtonProps
importIntoListButtonCpt = here.component "importIntoListButton" cpt where
  cpt { hyperdata: Hyperdata { base, frame_id }
140 141
      , nodeId
      , session } _ = do
142 143 144 145 146 147 148
    pure $ H.div { className: "btn btn-default"
                 , on: { click: onClick } }
      [ H.text $ "Import into list" ]
      where
        onClick _ = do
          let url = base <> "/" <> frame_id
              --task = GT.AsyncTaskWithType { task, typ: GT.ListCSVUpload }
149
          launchAff_ $ do
150
            -- Get corpus_id
151 152 153 154
            corpusNodes <- getNodeParent session nodeId Corpus
            case A.uncons corpusNodes of
              Nothing -> liftEffect $ here.log2 "[importIntoListButton] corpusNodes empty" corpusNodes
              Just { head: corpusNode } -> do
155
                -- Use that corpus id
156
                _ <- triggerEthercalcCSVDownload session corpusNode.id nodeId
157 158 159 160 161 162 163 164 165 166 167
                -- eCsv <- EC.downloadCSV base frame_id
                -- case eCsv of
                --   Left err -> liftEffect $ here.log2 "[importIntoListButton] error with csv" err
                --   Right csv -> do
                --     let uploadPath = GR.NodeAPI NodeList (Just corpusNode.id) $ GT.asyncTaskTypePath GT.ListCSVUpload
                --     eTask :: Either RESTError GT.AsyncTaskWithType <- postWwwUrlencoded
                --                                                       session
                --                                                       uploadPath
                --                                                       [ Tuple "_wf_data" (Just csv.body)
                --                                                       , Tuple "_wf_filetype" (Just $ show CSV)
                --                                                       , Tuple "_wf_name" (Just frame_id) ]
168
                pure unit
169

170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186
type NodeFrameVisioProps =
  ( frame_id  :: String
  , reload    :: T2.ReloadS
  , url       :: WURL.URL
  )

nodeFrameVisio :: R2.Leaf NodeFrameVisioProps
nodeFrameVisio props = R.createElement nodeFrameVisioCpt props []
nodeFrameVisioCpt :: R.Component NodeFrameVisioProps
nodeFrameVisioCpt = here.component "nodeFrameVisio" cpt
  where
    cpt { frame_id
        , url } _  = do
      ref <- R.useRef (null :: Nullable DOM.Element)

      R.useEffect' $ do
        here.log2 "[nodeFrameVisio] ref" $ R.readRef ref
187 188 189 190 191 192
        here.log2 "[nodeFrameVisio] JM.api" JM._api
        case toMaybe (R.readRef ref) of
          Nothing -> pure unit
          Just r  -> do
            api <- JM.jitsiMeetAPI (WURL.host url) { parentNode: r, roomName: frame_id }
            here.log2 "[nodeFrameVisio] api" api
193

194
      pure $ H.div { ref } [ H.text $ WURL.host url ]
195

196 197
type LoadProps   = ( nodeId  :: Int
                   , session :: Session )
James Laver's avatar
James Laver committed
198

199 200 201
type ReloadProps = ( nodeId  :: Int
                   , reload :: T2.Reload
                   , session :: Session )
202

203
loadframe' :: Record LoadProps -> AffRESTError (NodePoly Hyperdata)
James Laver's avatar
James Laver committed
204
loadframe' { nodeId, session } = get session $ NodeAPI Node (Just nodeId) ""
205 206

-- Just to make reloading effective
207
loadframeWithReload :: Record ReloadProps -> AffRESTError (NodePoly Hyperdata)
James Laver's avatar
James Laver committed
208
loadframeWithReload { nodeId, session } = loadframe' { nodeId, session }