Skip to content

P
purescript-gargantext
Commit e275bde5 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

Merge branch 'dev-graph-screenshot' into dev

parents cc8a92c0 849e94c9
Expand all Show whitespace changes
Inline Side-by-side
Showing with 5059 additions and 353 deletions
.psc-package/local/.set/packages.json
View file @ e275bde5
This diff is collapsed.
nix/purs-packages.nix
View file @ e275bde5
This diff is collapsed.
packages-0.13.8-20200822.dhall 0 → 100644
View file @ e275bde5
This diff is collapsed.
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
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"
uploadArbitraryFile session id {mName, blob: UploadFileBlob blob} = do
contents <- readAsDataURL blob
uploadArbitraryDataURL session id mName contents
contents' <- readAsDataURL blob
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 nodeType (Just id) $ GT.asyncTaskTypePath GT.UploadFile
p = GR.NodeAPI GT.Node (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 :: GET.GraphId
, 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 :: GET.GraphId
, 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 :: GET.GraphId
, 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 -> GET.GraphId -> 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, printResponseFormatError, 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 $ printResponseFormatError err
throwError $ error $ printResponseFormatError 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 $ printResponseFormatError err
throwError $ error $ printResponseFormatError 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 $ printResponseFormatError err
throwError $ error $ printResponseFormatError 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, runEffectFn1, runEffectFn3, 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 = "add/file/async/"
asyncTaskTypePath UploadFile = "async/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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment