Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
122
Issues
122
List
Board
Labels
Milestones
Merge Requests
1
Merge Requests
1
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
purescript-gargantext
Commits
e275bde5
Commit
e275bde5
authored
Sep 03, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'dev-graph-screenshot' into dev
parents
cc8a92c0
849e94c9
Changes
24
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
24 changed files
with
5059 additions
and
353 deletions
+5059
-353
packages.json
.psc-package/local/.set/packages.json
+1332
-173
purs-packages.nix
nix/purs-packages.nix
+130
-103
packages-0.13.8-20200822.dhall
packages-0.13.8-20200822.dhall
+3450
-0
packages.dhall
packages.dhall
+5
-2
psc-package.json
psc-package.json
+3
-0
Tree.purs
src/Gargantext/Components/Forest/Tree.purs
+5
-5
Action.purs
src/Gargantext/Components/Forest/Tree/Node/Action.purs
+4
-4
Upload.purs
...Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
+12
-10
GraphExplorer.purs
src/Gargantext/Components/GraphExplorer.purs
+5
-7
Button.purs
src/Gargantext/Components/GraphExplorer/Button.purs
+33
-0
Controls.purs
src/Gargantext/Components/GraphExplorer/Controls.purs
+9
-3
Types.purs
src/Gargantext/Components/GraphExplorer/Types.purs
+2
-0
Core.purs
src/Gargantext/Components/NgramsTable/Core.purs
+2
-1
Types.purs
src/Gargantext/Components/Nodes/Corpus/Types.purs
+2
-1
REST.purs
src/Gargantext/Config/REST.purs
+19
-19
Sigma.js
src/Gargantext/Hooks/Sigmax/Sigma.js
+11
-0
Sigma.purs
src/Gargantext/Hooks/Sigmax/Sigma.purs
+5
-1
Sigmajs.purs
src/Gargantext/Hooks/Sigmax/Sigmajs.purs
+3
-2
Sessions.purs
src/Gargantext/Sessions.purs
+2
-1
Types.purs
src/Gargantext/Types.purs
+4
-3
Argonaut.purs
src/Gargantext/Utils/Argonaut.purs
+6
-5
CacheAPI.purs
src/Gargantext/Utils/CacheAPI.purs
+3
-3
DecodeMaybe.purs
src/Gargantext/Utils/DecodeMaybe.purs
+3
-2
Spec.purs
test/Gargantext/Utils/Spec.purs
+9
-8
No files found.
.psc-package/local/.set/packages.json
View file @
e275bde5
This diff is collapsed.
Click to expand it.
nix/purs-packages.nix
View file @
e275bde5
This diff is collapsed.
Click to expand it.
packages-0.13.8-20200822.dhall
0 → 100644
View file @
e275bde5
This diff is collapsed.
Click to expand it.
packages.dhall
View file @
e275bde5
let mkPackage =
https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.8-20200724/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57
https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.8-20200822/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57
--let upstream =
-- https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20200822/packages.dhall sha256:2230fc547841b54bca815eb0058414aa03ed7b675042f8b3dda644e1952824e5
let upstream =
https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20200724/packages.dhall sha256:2230fc547841b54bca815eb0058414aa03ed7b675042f8b3dda644e1952824e5
./packages-0.13.8-20200822.dhall
let overrides =
{ thermite =
...
...
psc-package.json
View file @
e275bde5
...
...
@@ -6,8 +6,10 @@
"aff-promise"
,
"affjax"
,
"argonaut"
,
"codec-argonaut"
,
"console"
,
"css"
,
"datetime"
,
"debug"
,
"dom-filereader"
,
"dom-simple"
,
...
...
@@ -23,6 +25,7 @@
"maybe"
,
"milkis"
,
"nonempty"
,
"now"
,
"numbers"
,
"prelude"
,
"psci-support"
,
...
...
src/Gargantext/Components/Forest/Tree.purs
View file @
e275bde5
...
...
@@ -350,12 +350,12 @@ performAction (UploadFile nodeType fileType mName blob) { session
liftEffect $ onTaskAdd task
liftEffect $ log2 "Uploaded, task:" task
performAction (UploadArbitraryFile
nodeType
mName blob) { session
, tasks: { onTaskAdd }
, tree: (NTree (LNode {id}) _)
} =
performAction (UploadArbitraryFile mName blob) { session
, tasks: { onTaskAdd }
, tree: (NTree (LNode {id}) _)
} =
do
task <- uploadArbitraryFile session
nodeType
id { blob, mName }
task <- uploadArbitraryFile session id { blob, mName }
liftEffect $ onTaskAdd task
liftEffect $ log2 "Uploaded, task:" task
...
...
src/Gargantext/Components/Forest/Tree/Node/Action.purs
View file @
e275bde5
...
...
@@ -25,7 +25,7 @@ data Action = AddNode String GT.NodeType
| UpdateNode UpdateNodeParams
| DoSearch GT.AsyncTaskWithType
| UploadFile GT.NodeType FileType (Maybe String) UploadFileBlob
| UploadArbitraryFile
GT.NodeType
(Maybe String) UploadFileBlob
| UploadArbitraryFile (Maybe String) UploadFileBlob
| DownloadNode
| RefreshTree
...
...
@@ -64,7 +64,7 @@ instance showShow :: Show Action where
show (SharePublic _ ) = "SharePublic"
show (DoSearch _ ) = "SearchQuery"
show (UploadFile _ _ _ _) = "UploadFile"
show (UploadArbitraryFile _ _
_
) = "UploadArbitraryFile"
show (UploadArbitraryFile _ _) = "UploadArbitraryFile"
show RefreshTree = "RefreshTree"
show DownloadNode = "Download"
show (MoveNode _ ) = "MoveNode"
...
...
@@ -83,7 +83,7 @@ icon (AddContact _) = glyphiconNodeAction Share
icon (SharePublic _ ) = glyphiconNodeAction (Publish { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (DoSearch _) = glyphiconNodeAction SearchBox
icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload
icon (UploadArbitraryFile _ _
_
) = glyphiconNodeAction Upload
icon (UploadArbitraryFile _ _ ) = glyphiconNodeAction Upload
icon RefreshTree = glyphiconNodeAction Refresh
icon DownloadNode = glyphiconNodeAction Download
icon (MoveNode _ ) = glyphiconNodeAction (Move { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
...
...
@@ -104,7 +104,7 @@ text (AddContact _ ) = "Add contact !"
text (SharePublic _ ) = "Publish !"
text (DoSearch _ ) = "Launch search !"
text (UploadFile _ _ _ _) = "Upload File !"
text (UploadArbitraryFile _ _
_
) = "Upload arbitrary file !"
text (UploadArbitraryFile _ _) = "Upload arbitrary file !"
text RefreshTree = "Refresh Tree !"
text DownloadNode = "Download !"
text (MoveNode _ ) = "Move !"
...
...
src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
View file @
e275bde5
...
...
@@ -166,7 +166,7 @@ uploadButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadButton" cpt
void $ launchAff do
case fileType of
Arbitrary ->
dispatch $ UploadArbitraryFile
nodeType
(Just name) blob
dispatch $ UploadArbitraryFile (Just name) blob
_ ->
dispatch $ UploadFile nodeType fileType (Just name) blob
liftEffect $ do
...
...
@@ -296,23 +296,25 @@ uploadFile session nodeType id fileType {mName, blob: UploadFileBlob blob} = do
uploadArbitraryFile :: Session
-> GT.NodeType
-> ID
-> {blob :: UploadFileBlob, mName :: Maybe String}
-> Aff GT.AsyncTaskWithType
uploadArbitraryFile session nodeType id {mName, blob: UploadFileBlob blob} = do
if nodeType == Corpus then
pure unit
else
throwError $ error $ "[uploadArbitraryFile] NodeType " <> (show nodeType) <> " not supported"
contents' <- readAsDataURL blob
uploadArbitraryFile session id {mName, blob: UploadFileBlob blob} = do
contents <- readAsDataURL blob
uploadArbitraryDataURL session id mName contents
uploadArbitraryDataURL :: Session
-> ID
-> Maybe String
-> String
-> Aff GT.AsyncTaskWithType
uploadArbitraryDataURL session id mName contents' = do
let re = unsafePartial $ fromRight $ DSR.regex "data:.*;base64," DSRF.noFlags
contents = DSR.replace re "" contents'
task <- postWwwUrlencoded session p (bodyParams contents)
pure $ GT.AsyncTaskWithType { task, typ: GT.Form }
where
p = GR.NodeAPI
nodeTyp
e (Just id) $ GT.asyncTaskTypePath GT.UploadFile
p = GR.NodeAPI
GT.Nod
e (Just id) $ GT.asyncTaskTypePath GT.UploadFile
bodyParams c = [ Tuple "_wfi_b64_data" (Just c)
, Tuple "_wfi_name" mName
...
...
src/Gargantext/Components/GraphExplorer.purs
View file @
e275bde5
...
...
@@ -37,11 +37,9 @@ import Gargantext.Types as Types
import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2
type GraphId = Int
type LayoutProps =
( frontends :: Frontends
, graphId :: GraphId
, graphId :: G
ET.G
raphId
, handed :: Types.Handed
, mCurrentRoute :: AppRoute
, session :: Session
...
...
@@ -101,7 +99,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
dataRef <- R.useRef graph
graphRef <- R.useRef null
graphVersionRef <- R.useRef (fst graphVersion)
controls <- Controls.useGraphControls graph
controls <- Controls.useGraphControls graph
graphId session
multiSelectEnabledRef <- R.useRef $ fst controls.multiSelectEnabled
R.useEffect' $ do
...
...
@@ -203,7 +201,7 @@ type TreeProps =
type MSidebarProps =
( frontends :: Frontends
, graph :: SigmaxT.SGraph
, graphId :: GraphId
, graphId :: G
ET.G
raphId
, graphVersion :: R.State Int
, removedNodeIds :: R.State SigmaxT.NodeIds
, showSidePanel :: R.State GET.SidePanelState
...
...
@@ -215,7 +213,7 @@ type MSidebarProps =
type GraphProps = (
controls :: Record Controls.Controls
, elRef :: R.Ref (Nullable Element)
, graphId :: GraphId
, graphId :: G
ET.G
raphId
, graph :: SigmaxT.SGraph
, multiSelectEnabledRef :: R.Ref Boolean
)
...
...
@@ -305,7 +303,7 @@ modeGraphType Types.Sources = "star"
modeGraphType Types.Terms = "def"
getNodes :: Session -> R.State Int -> GraphId -> Aff GET.GraphData
getNodes :: Session -> R.State Int -> G
ET.G
raphId -> Aff GET.GraphData
getNodes session (graphVersion /\ _) graphId = get session $ NodeAPI Types.Graph (Just graphId) ("?version=" <> show graphVersion)
...
...
src/Gargantext/Components/GraphExplorer/Button.purs
View file @
e275bde5
...
...
@@ -2,15 +2,26 @@ module Gargantext.Components.GraphExplorer.Button
( centerButton
, Props
, simpleButton
, cameraButton
) where
import Prelude
import Data.Enum (fromEnum)
import Data.Maybe (Maybe(..))
import Data.DateTime as DDT
import Data.DateTime.Instant as DDI
import Data.String as DS
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Now as EN
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadArbitraryDataURL)
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Sessions (Session)
type Props = (
onClick :: forall e. e -> Effect Unit
...
...
@@ -40,3 +51,25 @@ centerButton sigmaRef = simpleButton {
Sigma.goToAllCameras s {x: 0.0, y: 0.0, ratio: 1.0, angle: 0.0}
, text: "Center"
}
cameraButton :: Session -> Int -> R.Ref Sigmax.Sigma -> R.Element
cameraButton session id sigmaRef = simpleButton {
onClick: \_ -> do
let sigma = R.readRef sigmaRef
Sigmax.dependOnSigma sigma "[cameraButton] sigma: Nothing" $ \s -> do
screen <- Sigma.takeScreenshot s
now <- EN.now
let nowdt = DDI.toDateTime now
nowd = DDT.date nowdt
nowt = DDT.time nowdt
nowStr = DS.joinWith "-" [ show $ fromEnum $ DDT.year nowd
, show $ fromEnum $ DDT.month nowd
, show $ fromEnum $ DDT.day nowd
, show $ fromEnum $ DDT.hour nowt
, show $ fromEnum $ DDT.minute nowt
, show $ fromEnum $ DDT.second nowt ]
launchAff_ $ do
uploadArbitraryDataURL session id (Just $ nowStr <> "-" <> "screenshot.png") screen
, text: "Screenshot"
}
src/Gargantext/Components/GraphExplorer/Controls.purs
View file @
e275bde5
...
...
@@ -21,7 +21,7 @@ import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Components.Graph as Graph
import Gargantext.Components.GraphExplorer.Button (centerButton)
import Gargantext.Components.GraphExplorer.Button (centerButton
, cameraButton
)
import Gargantext.Components.GraphExplorer.RangeControl (edgeConfluenceControl, edgeWeightControl, nodeSizeControl)
import Gargantext.Components.GraphExplorer.Search (nodeSearchControl)
import Gargantext.Components.GraphExplorer.SlideButton (labelSizeButton, mouseSelectorSizeButton)
...
...
@@ -29,6 +29,7 @@ import Gargantext.Components.GraphExplorer.ToggleButton (multiSelectEnabledButto
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Sessions (Session)
import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2
...
...
@@ -37,11 +38,13 @@ type Controls =
, edgeWeight :: R.State Range.NumberRange
, forceAtlasState :: R.State SigmaxT.ForceAtlasState
, graph :: SigmaxT.SGraph
, graphId :: GET.GraphId
, graphStage :: R.State Graph.Stage
, multiSelectEnabled :: R.State Boolean
, nodeSize :: R.State Range.NumberRange
, removedNodeIds :: R.State SigmaxT.NodeIds
, selectedNodeIds :: R.State SigmaxT.NodeIds
, session :: Session
, showControls :: R.State Boolean
, showEdges :: R.State SigmaxT.ShowEdgesState
, showLouvain :: R.State Boolean
...
...
@@ -158,12 +161,13 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
, multiSelectEnabled: props.multiSelectEnabled
, selectedNodeIds: props.selectedNodeIds } ]
, RH.li {} [ mouseSelectorSizeButton props.sigmaRef localControls.mouseSelectorSize ]
, RH.li {} [ cameraButton props.session props.graphId props.sigmaRef ]
]
]
]
useGraphControls :: SigmaxT.SGraph -> R.Hooks (Record Controls)
useGraphControls graph = do
useGraphControls :: SigmaxT.SGraph ->
GET.GraphId -> Session ->
R.Hooks (Record Controls)
useGraphControls graph
graphId session
= do
edgeConfluence <- R.useState' $ Range.Closed { min: 0.0, max: 1.0 }
edgeWeight <- R.useState' $ Range.Closed {
min: 0.0
...
...
@@ -187,11 +191,13 @@ useGraphControls graph = do
, edgeWeight
, forceAtlasState
, graph
, graphId
, graphStage
, multiSelectEnabled
, nodeSize
, removedNodeIds
, selectedNodeIds
, session
, showControls
, showEdges
, showLouvain
...
...
src/Gargantext/Components/GraphExplorer/Types.purs
View file @
e275bde5
...
...
@@ -7,6 +7,8 @@ import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype)
import Partial.Unsafe (unsafePartial)
type GraphId = Int
newtype Node = Node
{ id_ :: String
, size :: Int
...
...
src/Gargantext/Components/NgramsTable/Core.purs
View file @
e275bde5
...
...
@@ -61,6 +61,7 @@ import Prelude
import Control.Monad.Cont.Trans (lift)
import Control.Monad.State (class MonadState, execState)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.:), (.:!), (.:?), (:=), (:=?), (~>), (~>?))
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.Array (head)
import Data.Array as A
import Data.Bifunctor (lmap)
...
...
@@ -409,7 +410,7 @@ instance decodeJsonReplace :: (DecodeJson a, Eq a) => DecodeJson (Replace a) whe
case Tuple mold mnew of
Tuple (Just old) (Just new) -> pure $ replace old new
Tuple Nothing Nothing -> pure Keep
_ -> Left "decodeJsonReplace"
_ -> Left
$ TypeMismatch
"decodeJsonReplace"
-- Representing a PatchSet as `Map a Boolean` would have the advantage
-- of enforcing rem and add to be disjoint.
...
...
src/Gargantext/Components/Nodes/Corpus/Types.purs
View file @
e275bde5
module Gargantext.Components.Nodes.Corpus.Types where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.List as List
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
...
...
@@ -124,7 +125,7 @@ instance decodeFTField :: DecodeJson (Field FieldType) where
tag <- data_ .: "tag"
text <- data_ .: "text"
pure $ Markdown {tag, text}
_ -> Left $ "Unsupported 'type' " <> type_
_ -> Left $
TypeMismatch $
"Unsupported 'type' " <> type_
pure $ Field {name, typ}
instance encodeFTField :: EncodeJson (Field FieldType) where
...
...
src/Gargantext/Config/REST.purs
View file @
e275bde5
module Gargantext.Config.REST where
import Affjax (defaultRequest, print
ResponseFormat
Error, request)
import Affjax (defaultRequest, printError, request)
import Affjax.RequestBody (RequestBody(..), formData, formURLEncoded)
import Affjax.RequestHeader as ARH
import Affjax.ResponseFormat as ResponseFormat
...
...
@@ -49,16 +49,16 @@ send m mtoken url reqbody = do
Just token -> liftEffect $ do
let cookie = "JWT-Cookie=" <> token <> "; Path=/;" --" HttpOnly; Secure; SameSite=Lax"
R2.setCookie cookie
case affResp
.body
of
case affResp of
Left err -> do
_ <- liftEffect $ log $ print
ResponseFormat
Error err
throwError $ error $ print
ResponseFormat
Error err
Right
json
-> do
_ <- liftEffect $ log $ printError err
throwError $ error $ printError err
Right
resp
-> do
--_ <- liftEffect $ log json.status
--_ <- liftEffect $ log json.headers
--_ <- liftEffect $ log json.body
case decodeJson
json
of
Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
case decodeJson
resp.body
of
Left err -> throwError $ error $ "decodeJson affResp.body: " <>
show
err
Right b -> pure b
noReqBody :: Maybe Unit
...
...
@@ -101,16 +101,16 @@ postWwwUrlencoded mtoken url bodyParams = do
) mtoken
, content = Just $ formURLEncoded urlEncodedBody
}
case affResp
.body
of
case affResp of
Left err -> do
_ <- liftEffect $ log $ print
ResponseFormat
Error err
throwError $ error $ print
ResponseFormat
Error err
Right
json
-> do
_ <- liftEffect $ log $ printError err
throwError $ error $ printError err
Right
resp
-> do
--_ <- liftEffect $ log json.status
--_ <- liftEffect $ log json.headers
--_ <- liftEffect $ log json.body
case decodeJson
json
of
Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
case decodeJson
resp.body
of
Left err -> throwError $ error $ "decodeJson affResp.body: " <>
show
err
Right b -> pure b
where
urlEncodedBody = FormURLEncoded.fromArray bodyParams
...
...
@@ -131,12 +131,12 @@ postMultipartFormData mtoken url body = do
) mtoken
, content = Just $ formData fd
}
case affResp
.body
of
case affResp of
Left err -> do
_ <- liftEffect $ log $ print
ResponseFormat
Error err
throwError $ error $ print
ResponseFormat
Error err
Right
json
-> do
case decodeJson
json
of
Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
_ <- liftEffect $ log $ printError err
throwError $ error $ printError err
Right
resp
-> do
case decodeJson
resp.body
of
Left err -> throwError $ error $ "decodeJson affResp.body: " <>
show
err
Right b -> pure b
src/Gargantext/Hooks/Sigmax/Sigma.js
View file @
e275bde5
...
...
@@ -190,7 +190,18 @@ function bindMouseSelectorPlugin(left, right, sig) {
}
function
bind
(
sigma
,
event
,
handler
)
{
sigma
.
bind
(
event
,
handler
);
}
function
takeScreenshot
(
sigma
)
{
let
c
=
sigma
.
renderers
[
0
].
container
;
let
edges
=
c
.
getElementsByClassName
(
'sigma-edges'
)[
0
];
let
scene
=
c
.
getElementsByClassName
(
'sigma-scene'
)[
0
];
let
sceneCtx
=
scene
.
getContext
(
'2d'
);
sceneCtx
.
globalAlpha
=
1
;
sceneCtx
.
drawImage
(
edges
,
0
,
0
);
return
scene
.
toDataURL
(
'image/png'
);
}
exports
.
_sigma
=
_sigma
;
exports
.
_addRenderer
=
addRenderer
;
exports
.
_bindMouseSelectorPlugin
=
bindMouseSelectorPlugin
;
exports
.
_bind
=
bind
;
exports
.
_takeScreenshot
=
takeScreenshot
;
src/Gargantext/Hooks/Sigmax/Sigma.purs
View file @
e275bde5
...
...
@@ -13,7 +13,7 @@ import Data.Traversable (traverse_)
import Effect (Effect)
import Effect.Exception as EEx
import Effect.Timer (setTimeout)
import Effect.Uncurried (EffectFn1, EffectFn3, EffectFn4, mkEffectFn1, runEffectFn3, runEffectFn4)
import Effect.Uncurried (EffectFn1, EffectFn3, EffectFn4, mkEffectFn1, runEffectFn
1, runEffectFn
3, runEffectFn4)
import FFI.Simple ((..), (...), (.=))
import Foreign.Object as Object
import Gargantext.Hooks.Sigmax.Types as Types
...
...
@@ -291,6 +291,9 @@ goTo props cam = pure $ cam ... "goTo" $ [props]
goToAllCameras :: Sigma -> Record CameraProps -> Effect Unit
goToAllCameras s props = traverse_ (goTo props) $ cameras s
takeScreenshot :: Sigma -> Effect String
takeScreenshot = runEffectFn1 _takeScreenshot
-- | FFI
foreign import _sigma ::
forall a b opts err.
...
...
@@ -312,3 +315,4 @@ foreign import _bindMouseSelectorPlugin
Sigma
(Either err Unit)
foreign import _bind :: forall e. EffectFn3 Sigma String (EffectFn1 e Unit) Unit
foreign import _takeScreenshot :: EffectFn1 Sigma String
src/Gargantext/Hooks/Sigmax/Sigmajs.purs
View file @
e275bde5
...
...
@@ -5,7 +5,8 @@ import Prelude
import Data.Nullable (Nullable)
import Effect (Effect)
import Effect.Uncurried (EffectFn1, runEffectFn1)
import React (ReactRef, SyntheticEventHandler)
import React (SyntheticEventHandler)
import React.Ref as RR
import Record.Unsafe (unsafeGet)
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Types (class Optional)
...
...
@@ -109,7 +110,7 @@ type SigmaProps =
, settings :: SigmaSettings
, style :: SigmaStyle
, graph :: SigmaGraphData
, ref ::
SyntheticEventHandler (Nullable ReactRef)
, ref ::
RR.RefHandler RR.ReactInstance
, onClickNode :: SigmaNodeEvent -> Unit
, onOverNode :: SigmaNodeEvent -> Unit
, onOutNode :: SigmaNodeEvent -> Effect Unit
...
...
src/Gargantext/Sessions.purs
View file @
e275bde5
...
...
@@ -4,6 +4,7 @@ module Gargantext.Sessions where
import DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:))
import Data.Argonaut.Core (Json, fromArray, jsonEmptyObject, stringify)
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.Argonaut.Parser (jsonParser)
import Data.Array as A
import Data.Either (Either(..))
...
...
@@ -94,7 +95,7 @@ instance decodeJsonSessions :: DecodeJson Sessions where
pure (Sessions {sessions:Seq.fromFoldable ss})
where
decodeSessions :: Json -> Either
String
(Array Session)
decodeSessions :: Json -> Either
JsonDecodeError
(Array Session)
decodeSessions json2 = decodeJson json2
>>= \obj -> obj .: "sessions"
>>= traverse decodeJson
...
...
src/Gargantext/Types.purs
View file @
e275bde5
module Gargantext.Types where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.Array as A
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
...
...
@@ -85,7 +86,7 @@ instance decodeJsonTermList :: DecodeJson TermList where
"MapTerm" -> pure MapTerm
"StopTerm" -> pure StopTerm
"CandidateTerm" -> pure CandidateTerm
_ -> Left
"Unexpected list name"
s -> Left $ AtKey s $ TypeMismatch
"Unexpected list name"
type ListTypeId = Int
...
...
@@ -604,11 +605,11 @@ instance decodeJsonAsyncTaskType :: DecodeJson AsyncTaskType where
"GraphT" -> pure GraphT
"Query" -> pure Query
"AddNode" -> pure AddNode
s -> Left
("Unknown string " <> s)
s -> Left
$ AtKey s $ TypeMismatch "Unknown string"
asyncTaskTypePath :: AsyncTaskType -> String
asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath UploadFile = "a
dd/file/async
/"
asyncTaskTypePath UploadFile = "a
sync/file/add
/"
asyncTaskTypePath Query = "query/"
asyncTaskTypePath GraphT = "async/"
asyncTaskTypePath AddNode = "async/nobody/"
...
...
src/Gargantext/Utils/Argonaut.purs
View file @
e275bde5
...
...
@@ -5,6 +5,7 @@ import Prelude
import Control.Alt ((<|>))
import Data.Argonaut (Json)
import Data.Argonaut as Argonaut
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.Either (Either(..))
import Data.Generic.Rep as GR
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
...
...
@@ -15,7 +16,7 @@ genericSumDecodeJson
. GR.Generic a rep
=> GenericSumDecodeJsonRep rep
=> Json
-> Either
String
a
-> Either
JsonDecodeError
a
genericSumDecodeJson f =
GR.to <$> genericSumDecodeJsonRep f
...
...
@@ -30,7 +31,7 @@ genericSumEncodeJson f =
genericSumEncodeJsonRep $ GR.from f
class GenericSumDecodeJsonRep rep where
genericSumDecodeJsonRep :: Json -> Either
String
rep
genericSumDecodeJsonRep :: Json -> Either
JsonDecodeError
rep
class GenericSumEncodeJsonRep rep where
genericSumEncodeJsonRep :: rep -> Json
...
...
@@ -97,13 +98,13 @@ genericEnumDecodeJson :: forall a rep
. GR.Generic a rep
=> GenericEnumDecodeJson rep
=> Json
-> Either
String
a
-> Either
JsonDecodeError
a
genericEnumDecodeJson f =
GR.to <$> genericEnumDecodeJsonRep f
-- | Generic Enum Sum Representations, with constructor names as strings
class GenericEnumDecodeJson rep where
genericEnumDecodeJsonRep :: Json -> Either
String
rep
genericEnumDecodeJsonRep :: Json -> Either
JsonDecodeError
rep
instance sumEnumDecodeJsonRep ::
( GenericEnumDecodeJson a
...
...
@@ -120,7 +121,7 @@ instance constructorEnumSumRep ::
s <- Argonaut.decodeJson f
if s == name
then pure $ GR.Constructor GR.NoArguments
else Left $
"Enum string " <> s <> "
did not match expected string " <> name
else Left $
Named s $ TypeMismatch $ "Enum
did not match expected string " <> name
where
name = reflectSymbol (SProxy :: SProxy name)
...
...
src/Gargantext/Utils/CacheAPI.purs
View file @
e275bde5
...
...
@@ -31,7 +31,7 @@ get cache session p = do
j <- M.json res
case decodeJson (F.unsafeFromForeign j) of
Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
Left err -> throwError $ error $ "decodeJson affResp.body: " <>
show
err
Right b -> pure b
foreign import data Cache :: Type
...
...
@@ -97,7 +97,7 @@ cachedJson cache req = do
j <- M.json res
case decodeJson (F.unsafeFromForeign j) of
Left err -> throwError $ error $ "[cachedJson] decodeJson affResp.body: " <> err
Left err -> throwError $ error $ "[cachedJson] decodeJson affResp.body: " <>
show
err
Right b -> pure b
delete :: Cache -> Request -> Aff Unit
...
...
@@ -116,7 +116,7 @@ pureJson req = do
res <- fetch req
j <- M.json res
case decodeJson (F.unsafeFromForeign j) of
Left err -> throwError $ error $ "[pureJson] decodeJson affResp.body: " <> err
Left err -> throwError $ error $ "[pureJson] decodeJson affResp.body: " <>
show
err
Right b -> pure b
...
...
src/Gargantext/Utils/DecodeMaybe.purs
View file @
e275bde5
...
...
@@ -3,6 +3,7 @@ module Gargantext.Utils.DecodeMaybe where
import Prelude
import Data.Argonaut (class DecodeJson, Json, getFieldOptional)
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.Either (Either)
import Data.Maybe (Maybe(..), fromMaybe)
import Foreign.Object (Object)
...
...
@@ -10,7 +11,7 @@ import Foreign.Object (Object)
foreign import isNull :: forall a. a -> Boolean
getFieldOptional' :: forall a. DecodeJson a =>
Object Json -> String -> Either
String
(Maybe a)
Object Json -> String -> Either
JsonDecodeError
(Maybe a)
getFieldOptional' o s = (case _ of
Just v -> if isNull v then Nothing else v
Nothing -> Nothing
...
...
@@ -19,7 +20,7 @@ getFieldOptional' o s = (case _ of
infix 7 getFieldOptional' as .?|
getFieldOptionalAsMempty :: forall a. DecodeJson a =>
Monoid a => Object Json -> String -> Either
String
a
Monoid a => Object Json -> String -> Either
JsonDecodeError
a
getFieldOptionalAsMempty o s =
fromMaybe mempty <$> (getFieldOptional' o s)
...
...
test/Gargantext/Utils/Spec.purs
View file @
e275bde5
...
...
@@ -3,6 +3,7 @@ module Gargantext.Utils.Spec where
import Prelude
import Data.Argonaut as Argonaut
import Data.Argonaut.Decode.Error (JsonDecodeError)
import Data.Either (Either(..), isLeft)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
...
...
@@ -65,14 +66,14 @@ spec =
GUM.log10 10.0 `shouldEqual` 1.0
it "genericSumDecodeJson works" do
let result1 = Argonaut.decodeJson =<< Argonaut.
jsonParser
"""{"Boat":{"hi":1}}"""
let result1 = Argonaut.decodeJson =<< Argonaut.
parseJson
"""{"Boat":{"hi":1}}"""
result1 `shouldEqual` Right (Boat { hi: 1 })
let result2 = Argonaut.decodeJson =<< Argonaut.
jsonParser
"""{"Gravy":"hi"}"""
let result2 = Argonaut.decodeJson =<< Argonaut.
parseJson
"""{"Gravy":"hi"}"""
result2 `shouldEqual` Right (Gravy "hi")
let result3 = Argonaut.decodeJson =<< Argonaut.
jsonParser
"""{"Boat":123}"""
isLeft (result3 :: Either
String
Fruit) `shouldEqual` true
let result3 = Argonaut.decodeJson =<< Argonaut.
parseJson
"""{"Boat":123}"""
isLeft (result3 :: Either
JsonDecodeError
Fruit) `shouldEqual` true
it "genericSumEncodeJson works and loops back with decode" do
let input1 = Boat { hi: 1 }
...
...
@@ -88,14 +89,14 @@ spec =
result2' `shouldEqual` Right input2
it "genericEnumDecodeJson works" do
let result1 = Argonaut.decodeJson =<< Argonaut.
jsonParser
"\"Member1\""
let result1 = Argonaut.decodeJson =<< Argonaut.
parseJson
"\"Member1\""
result1 `shouldEqual` Right Member1
let result2 = Argonaut.decodeJson =<< Argonaut.
jsonParser
"\"Member2\""
let result2 = Argonaut.decodeJson =<< Argonaut.
parseJson
"\"Member2\""
result2 `shouldEqual` Right Member2
let result3 = Argonaut.decodeJson =<< Argonaut.
jsonParser
"\"Failure\""
isLeft (result3 :: Either
String
EnumTest) `shouldEqual` true
let result3 = Argonaut.decodeJson =<< Argonaut.
parseJson
"\"Failure\""
isLeft (result3 :: Either
JsonDecodeError
EnumTest) `shouldEqual` true
it "genericSumEncodeJson works and loops back with decode" do
let input1 = Member1
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment