Skip to content

P
purescript-gargantext
Commit 229f9ba3 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[simple-json] fixes to sessions and other endpoints

parent 81e21c97
Hide whitespace changes
Inline Side-by-side
Showing with 73950 additions and 292 deletions
dist/index.js
View file @ 229f9ba3
This source diff could not be displayed because it is too large. You can view the blob instead.
packages.dhall
View file @ 229f9ba3
......@@ -101,7 +101,7 @@ let additions =
, repo = "https://github.com/purescript-contrib/purescript-precise"
, version = "v4.0.0"
}
, reactix =
{- , reactix =
{ dependencies =
[ "aff"
, "dom-simple"
......@@ -114,7 +114,7 @@ let additions =
]
, repo = "https://github.com/irresponsible/purescript-reactix"
, version = "v0.4.11"
}
} -}
, simple-json-generics =
{ dependencies =
[ "simple-json" ]
......@@ -172,4 +172,8 @@ let additions =
}
}
in upstream // overrides // additions
let localPackages = {
reactix = ../../purescript-reactix/spago.dhall as Location
}
in upstream // overrides // additions // localPackages
shell.nix
View file @ 229f9ba3
......@@ -19,7 +19,23 @@ let
#build-purs
echo "Bundling"
#yarn pulp browserify --skip-compile -t dist/bundle.js --src-path output
yarn spago bundle-app --to dist/bundle.js
yarn spago build
browserify
'';
build-watch = pkgs.writeShellScriptBin "build-watch" ''
#!/usr/bin/env bash
set -e
echo "Build watch"
yarn spago build -w --then browserify
'';
browserify = pkgs.writeShellScriptBin "browserify" ''
#!/usr/bin/env bash
set -e
yarn pulp browserify --skip-compile -t dist/bundle.js --src-path output
'';
repl = pkgs.writeShellScriptBin "repl" ''
......@@ -45,7 +61,9 @@ pkgs.mkShell {
easy-ps.purs-0_14_2
easy-ps.psc-package
easy-ps.dhall-json-simple
browserify
build-purs
build-watch
build
repl
pkgs.spago
......
src/Gargantext/Components/App.purs
View file @ 229f9ba3
module Gargantext.Components.App (app) where
import Data.Set as Set
import Reactix as R
import Toestand as T
......
src/Gargantext/Components/Forest/Tree.purs
View file @ 229f9ba3
......@@ -193,32 +193,11 @@ childLoaderCpt = here.component "childLoader" cpt where
type PerformActionProps =
( setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit)) | PACommon )
closePopover :: forall t187 t191 t194 t195.
MonadEffect t191 => Foldable t195 => { setPopoverRef :: Ref (t195 (Boolean -> Effect t194))
| t187
}
-> t191 Unit
closePopover { setPopoverRef } =
liftEffect $ traverse_ (\set -> set false) (R.readRef setPopoverRef)
refreshTree :: forall t203 t208 t213 t214 t215.
MonadEffect t203 => Reloadable t208 => Foldable t214 => { reloadTree :: t208
, setPopoverRef :: Ref (t214 (Boolean -> Effect t213))
| t215
}
-> t203 Unit
refreshTree p = liftEffect $ T2.reload p.reloadTree *> closePopover p
deleteNode' :: forall t254 t261 t262 t263 t265.
Read t254 OpenNodes => Write t254 OpenNodes => Reloadable t261 => Foldable t263 => NodeType
-> { forestOpen :: t254
, reloadTree :: t261
, session :: Session
, setPopoverRef :: Ref (t263 (Boolean -> Effect t262))
, tree :: NTree LNode
| t265
}
-> Aff Unit
deleteNode' nt p@{ tree: (NTree (LNode {id, parent_id}) _) } = do
case nt of
GT.NodePublic GT.FolderPublic -> void $ deleteNode p.session nt id
......@@ -227,164 +206,60 @@ deleteNode' nt p@{ tree: (NTree (LNode {id, parent_id}) _) } = do
liftEffect $ T.modify_ (openNodesDelete (mkNodeId p.session id)) p.forestOpen
refreshTree p
doSearch :: forall t167 t176.
MonadEffect t176 => AsyncTaskWithType
-> { tasks :: Box Storage
, tree :: NTree LNode
| t167
}
-> t176 Unit
doSearch task p@{ tasks, tree: NTree (LNode {id}) _ } = liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] DoSearch task:" task
updateNode :: forall t119.
UpdateNodeParams
-> { session :: Session
, tasks :: Box Storage
, tree :: NTree LNode
| t119
}
-> Aff Unit
updateNode params p@{ tasks, tree: (NTree (LNode {id}) _) } = do
task <- updateRequest params p.session id
liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] UpdateNode task:" task
renameNode :: forall t390 t391 t392 t394.
Reloadable t390 => Foldable t392 => String
-> { reloadTree :: t390
, session :: Session
, setPopoverRef :: Ref (t392 (Boolean -> Effect t391))
, tree :: NTree LNode
| t394
}
-> Aff Unit
renameNode name p@{ tree: (NTree (LNode {id}) _) } = do
void $ rename p.session id $ RenameValue { text: name }
refreshTree p
shareTeam :: forall t147.
String
-> { session :: Session
, tree :: NTree LNode
| t147
}
-> Aff Unit
shareTeam username p@{ tree: (NTree (LNode {id}) _)} =
void $ Share.shareReq p.session id $ Share.ShareTeamParams {username}
sharePublic :: forall t427 t431 t432 t433 t435 t438.
Read t427 OpenNodes => Write t427 OpenNodes => Reloadable t431 => Foldable t433 => Foldable t438 => t438 SubTreeOut
-> { forestOpen :: t427
, reloadTree :: t431
, session :: Session
, setPopoverRef :: Ref (t433 (Boolean -> Effect t432))
| t435
}
-> Aff Unit
sharePublic params p@{ forestOpen } = traverse_ f params where
f (SubTreeOut { in: inId, out }) = do
void $ Share.shareReq p.session inId $ Share.SharePublicParams { node_id: out }
liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session out)) forestOpen
refreshTree p
addContact :: forall t638.
AddContactParams
-> { session :: Session
, tree :: NTree LNode
| t638
}
-> Aff Unit
addContact params p@{ tree: (NTree (LNode {id}) _) } =
void $ Contact.contactReq p.session id params
addNode' :: forall t612 t616 t617 t618 t620.
Read t612 OpenNodes => Write t612 OpenNodes => Reloadable t616 => Foldable t618 => String
-> NodeType
-> { forestOpen :: t612
, reloadTree :: t616
, session :: Session
, setPopoverRef :: Ref (t618 (Boolean -> Effect t617))
, tree :: NTree LNode
| t620
}
-> Aff Unit
addNode' name nodeType p@{ forestOpen, tree: (NTree (LNode { id }) _) } = do
task <- addNode p.session id $ AddNodeValue {name, nodeType}
liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session id)) forestOpen
refreshTree p
uploadFile' :: forall t66.
NodeType
-> FileType
-> Maybe String
-> UploadFileBlob
-> { session :: Session
, tasks :: Box Storage
, tree :: NTree LNode
| t66
}
-> Aff Unit
uploadFile' nodeType fileType mName blob p@{ tasks, tree: (NTree (LNode { id }) _) } = do
task <- uploadFile p.session nodeType id fileType {mName, blob}
liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] UploadFile, uploaded, task:" task
uploadArbitraryFile' :: forall t93.
Maybe String
-> UploadFileBlob
-> { session :: Session
, tasks :: Box Storage
, tree :: NTree LNode
| t93
}
-> Aff Unit
uploadArbitraryFile' mName blob p@{ tasks, tree: (NTree (LNode { id }) _) } = do
task <- uploadArbitraryFile p.session id { blob, mName }
liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
moveNode :: forall t354 t357 t358 t359 t361 t364.
Read t354 OpenNodes => Write t354 OpenNodes => Reloadable t357 => Foldable t359 => Foldable t364 => t364 SubTreeOut
-> { forestOpen :: t354
, reloadTree :: t357
, session :: Session
, setPopoverRef :: Ref (t359 (Boolean -> Effect t358))
| t361
}
-> Aff Unit
moveNode params p@{ forestOpen, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
void $ moveNodeReq p.session in' out
liftEffect $ T.modify_ (openNodesInsert (mkNodeId session out)) forestOpen
refreshTree p
mergeNode :: forall t315 t316 t317 t319 t322.
Reloadable t315 => Foldable t317 => Foldable t322 => t322 SubTreeOut
-> { reloadTree :: t315
, session :: Session
, setPopoverRef :: Ref (t317 (Boolean -> Effect t316))
| t319
}
-> Aff Unit
mergeNode params p = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
void $ mergeNodeReq p.session in' out
refreshTree p
linkNode :: forall t287 t288 t289 t291 t294.
Reloadable t287 => Foldable t289 => Foldable t294 => Maybe NodeType
-> t294 SubTreeOut
-> { reloadTree :: t287
, session :: Session
, setPopoverRef :: Ref (t289 (Boolean -> Effect t288))
| t291
}
-> Aff Unit
linkNode nodeType params p = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
void $ linkNodeReq p.session nodeType in' out
......
src/Gargantext/Components/Node.purs
View file @ 229f9ba3
......@@ -3,6 +3,7 @@ module Gargantext.Components.Node
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe)
import Data.Newtype (class Newtype)
import Simple.JSON as JSON
......@@ -34,7 +35,7 @@ instance JSON.ReadForeign a => JSON.ReadForeign (NodePoly a) where
, date: inst.date
, hyperdata: inst.hyperdata }
newtype HyperdataList = HyperdataList { preferences :: String }
newtype HyperdataList = HyperdataList { preferences :: Maybe String }
derive instance Generic HyperdataList _
derive instance Newtype HyperdataList _
derive newtype instance JSON.ReadForeign HyperdataList
src/Gargantext/Components/Nodes/Texts.purs
View file @ 229f9ba3
......@@ -7,7 +7,6 @@ import Data.Tuple.Nested ((/\))
import Effect.Aff (launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
import Gargantext.Prelude
......
src/Gargantext/Components/Router.purs
View file @ 229f9ba3
......@@ -58,7 +58,7 @@ router :: R2.Leaf Props
router props = R.createElement routerCpt props []
routerCpt :: R.Component Props
routerCpt = here.component "router" cpt where
cpt props@{ boxes: boxes@{ handed } } _ = do
cpt { boxes: boxes@{ handed } } _ = do
handed' <- T.useLive T.unequal handed
let handedClassName = case handed' of
......@@ -90,13 +90,13 @@ topBar :: R2.Leaf Props
topBar p = R.createElement topBarCpt p []
topBarCpt :: R.Component Props
topBarCpt = here.component "topBar" cpt where
cpt props@{ boxes: boxes@{ handed
, route
, showTree } } _ = do
route' <- T.useLive T.unequal boxes.route
cpt { boxes: boxes@{ handed
, route
, showTree } } _ = do
route' <- T.useLive T.unequal route
let children = case route' of
GR.PGraphExplorer s g -> [ GETB.topBar { boxes } ]
GR.PGraphExplorer _s _g -> [ GETB.topBar { boxes } ]
_ -> []
pure $ TopBar.topBar { handed, showTree } children
......@@ -112,17 +112,17 @@ forest :: R2.Leaf Props
forest p = R.createElement forestCpt p []
forestCpt :: R.Component Props
forestCpt = here.component "forest" cpt where
cpt props@{ boxes: boxes@{ backend
, forestOpen
, handed
, reloadForest
, reloadMainPage
, reloadRoot
, route
, sessions
, showLogin
, showTree
, tasks } } _ = do
cpt { boxes: { backend
, forestOpen
, handed
, reloadForest
, reloadMainPage
, reloadRoot
, route
, sessions
, showLogin
, showTree
, tasks } } _ = do
pure $ Forest.forestLayout { backend
, forestOpen
, frontends: defaultFrontends
......@@ -140,13 +140,8 @@ sidePanel :: R2.Leaf Props
sidePanel p = R.createElement sidePanelCpt p []
sidePanelCpt :: R.Component Props
sidePanelCpt = here.component "sidePanel" cpt where
cpt props@{ boxes: boxes@{ graphVersion
, reloadForest
, session
, sidePanelGraph
, sidePanelState
, sidePanelLists
, sidePanelTexts } } _ = do
cpt props@{ boxes: { session
, sidePanelState } } _ = do
session' <- T.useLive T.unequal session
sidePanelState' <- T.useLive T.unequal sidePanelState
......@@ -220,14 +215,14 @@ openedSidePanel :: R2.Component (WithSession Props)
openedSidePanel = R.createElement openedSidePanelCpt
openedSidePanelCpt :: R.Component (WithSession Props)
openedSidePanelCpt = here.component "openedSidePanel" cpt where
cpt props@{ boxes: boxes@{ graphVersion
, reloadForest
, route
, sidePanelGraph
, sidePanelState
, sidePanelLists
, sidePanelTexts }
, session} _ = do
cpt { boxes: { graphVersion
, reloadForest
, route
, sidePanelGraph
, sidePanelState
, sidePanelLists
, sidePanelTexts }
, session} _ = do
{ mGraph, mMetaData, removedNodeIds, selectedNodeIds, sideTab } <- GEST.focusedSidePanel sidePanelGraph
mGraph' <- T.useLive T.unequal mGraph
mGraphMetaData' <- T.useLive T.unequal mMetaData
......@@ -236,12 +231,12 @@ openedSidePanelCpt = here.component "openedSidePanel" cpt where
let wrapper = H.div { className: "side-panel" }
case route' of
GR.Lists s n -> do
GR.Lists _s _n -> do
pure $ wrapper
[ Lists.sidePanel { session
, sidePanel: sidePanelLists
, sidePanelState } [] ]
GR.PGraphExplorer s g -> do
GR.PGraphExplorer _s g -> do
case (mGraph' /\ mGraphMetaData') of
(Nothing /\ _) -> pure $ wrapper []
(_ /\ Nothing) -> pure $ wrapper []
......@@ -258,7 +253,7 @@ openedSidePanelCpt = here.component "openedSidePanel" cpt where
, session
, sideTab
} [] ]
GR.Texts s n -> do
GR.Texts _s _n -> do
pure $ wrapper
[ Texts.sidePanel { session
, sidePanel: sidePanelTexts
......@@ -269,7 +264,7 @@ annuaire :: R2.Component SessionNodeProps
annuaire = R.createElement annuaireCpt
annuaireCpt :: R.Component SessionNodeProps
annuaireCpt = here.component "annuaire" cpt where
cpt props@{ boxes, nodeId } _ = do
cpt props@{ nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
annuaireLayout { frontends: defaultFrontends
......@@ -296,7 +291,7 @@ corpusDocument = R.createElement corpusDocumentCpt
corpusDocumentCpt :: R.Component CorpusDocumentProps
corpusDocumentCpt = here.component "corpusDocument" cpt
where
cpt props@{ boxes, corpusId: corpusId', listId, nodeId } _ = do
cpt props@{ corpusId: corpusId', listId, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
documentMainLayout { mCorpusId: Just corpusId'
......@@ -309,7 +304,7 @@ dashboard = R.createElement dashboardCpt
dashboardCpt :: R.Component SessionNodeProps
dashboardCpt = here.component "dashboard" cpt
where
cpt props@{ boxes, nodeId } _ = do
cpt props@{ nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
dashboardLayout { nodeId, session } [] } sessionProps) []
......@@ -320,7 +315,7 @@ document :: R2.Component DocumentProps
document = R.createElement documentCpt
documentCpt :: R.Component DocumentProps
documentCpt = here.component "document" cpt where
cpt props@{ boxes, listId, nodeId } _ = do
cpt props@{ listId, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
documentMainLayout { listId
......@@ -344,7 +339,7 @@ phyloExplorer = R.createElement phyloExplorerCpt
phyloExplorerCpt :: R.Component SessionNodeProps
phyloExplorerCpt = here.component "phylo" cpt
where
cpt props@{ boxes, nodeId } _ = do
cpt props@{ nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
phyloLayout { nodeId, session } [] } sessionProps) []
......@@ -355,22 +350,16 @@ home :: R2.Component Props
home = R.createElement homeCpt
homeCpt :: R.Component Props
homeCpt = here.component "home" cpt where
cpt props@{ boxes: boxes@{ backend, sessions, showLogin, tasks, reloadForest} } _ = do
cpt { boxes: { backend, sessions, showLogin, tasks, reloadForest} } _ = do
pure $ homeLayout { backend, lang: LL_EN, sessions, showLogin, tasks, reloadForest }
lists :: R2.Component SessionNodeProps
lists = R.createElement listsCpt
listsCpt :: R.Component SessionNodeProps
listsCpt = here.component "lists" cpt where
cpt props@{ boxes: { backend
, forestOpen
, handed
, reloadForest
cpt props@{ boxes: { reloadForest
, reloadMainPage
, reloadRoot
, route
, sessions
, showLogin
, sidePanelState
, sidePanelLists
, tasks }
......@@ -399,7 +388,7 @@ routeFile = R.createElement routeFileCpt
routeFileCpt :: R.Component SessionNodeProps
routeFileCpt = here.component "routeFile" cpt where
cpt props@{ boxes, nodeId } _ = do
cpt props@{ nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
fileLayout { nodeId, session } } sessionProps) []
......@@ -413,7 +402,7 @@ routeFrame :: R2.Component RouteFrameProps
routeFrame = R.createElement routeFrameCpt
routeFrameCpt :: R.Component RouteFrameProps
routeFrameCpt = here.component "routeFrame" cpt where
cpt props@{ boxes, nodeId, nodeType } _ = do
cpt props@{ nodeId, nodeType } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
frameLayout { nodeId, nodeType, session } } sessionProps) []
......@@ -425,24 +414,18 @@ teamCpt = here.component "team" cpt where
cpt props@{ boxes, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
corpusLayout { nodeId, session, tasks: boxes.tasks, reloadForest: boxes.reloadForest } } sessionProps) []
corpusLayout { nodeId
, session
, tasks: boxes.tasks
, reloadForest: boxes.reloadForest } } sessionProps) []
texts :: R2.Component SessionNodeProps
texts = R.createElement textsCpt
textsCpt :: R.Component SessionNodeProps
textsCpt = here.component "texts" cpt
where
cpt props@{ boxes: { backend
, forestOpen
, handed
, reloadForest
, reloadRoot
, route
, sessions
, showLogin
, sidePanelState
, sidePanelTexts
, tasks }
cpt props@{ boxes: { sidePanelState
, sidePanelTexts }
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
......@@ -456,11 +439,11 @@ user :: R2.Component SessionNodeProps
user = R.createElement userCpt
userCpt :: R.Component SessionNodeProps
userCpt = here.component "user" cpt where
cpt props@{ boxes: boxes@{ reloadForest
, reloadRoot
, sidePanelState
, sidePanelTexts
, tasks }
cpt props@{ boxes: { reloadForest
, reloadRoot
, sidePanelState
, sidePanelTexts
, tasks }
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
......@@ -487,7 +470,7 @@ contactCpt = here.component "contact" cpt where
, tasks }
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
let forestedProps = RE.pick props :: Record Props
-- let forestedProps = RE.pick props :: Record Props
pure $ authed (Record.merge { content: \session ->
contactLayout { annuaireId
, frontends: defaultFrontends
......
src/Gargantext/Ends.purs
View file @ 229f9ba3
......@@ -3,12 +3,7 @@ module Gargantext.Ends
-- ( )
where
import Prelude
( class Eq, class Show, bind, pure, show
, ($), (/=), (<<<), (<>), (==) )
import Data.Argonaut
( class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject
, (:=), (~>), (.:) )
import Prelude (class Eq, class Show, show, ($), (/=), (<<<), (<>), (==))
import Data.Foldable (foldMap)
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
......@@ -18,7 +13,6 @@ import Simple.JSON as JSON
import Gargantext.Routes as R
import Gargantext.Types (ApiVersion, ChartType(..), Limit, NodePath, NodeType(..), Offset, TabType(..), TermSize(..), nodePath, nodeTypePath, showTabType', TermList(MapTerm))
import Prelude (class Eq, class Show, identity, show, ($), (<>), bind, pure, (<<<), (==), (/=))
-- | A means of generating a url to visit, a destination
class ToUrl conf p where
......@@ -38,6 +32,9 @@ derive instance Generic Backend _
derive instance Newtype Backend _
derive newtype instance JSON.ReadForeign Backend
derive newtype instance JSON.WriteForeign Backend
instance Eq Backend where eq = genericEq
instance Show Backend where show (Backend {name}) = name
instance ToUrl Backend String where toUrl = backendUrl
backend :: ApiVersion -> String -> String -> String -> Backend
backend version prePath baseUrl name = Backend { name, version, prePath, baseUrl }
......@@ -46,15 +43,6 @@ backend version prePath baseUrl name = Backend { name, version, prePath, baseUrl
backendUrl :: Backend -> String -> String
backendUrl (Backend b) path = b.baseUrl <> b.prePath <> show b.version <> "/" <> path
instance Eq Backend where
eq = genericEq
instance Show Backend where
show (Backend {name}) = name
instance ToUrl Backend String where
toUrl = backendUrl
-- | Encapsulates the data needed to construct a url to a frontend
-- | server (either for the app or static content)
newtype Frontend = Frontend
......@@ -63,12 +51,11 @@ newtype Frontend = Frontend
, prePath :: String }
derive instance Generic Frontend _
instance Eq Frontend where
eq = genericEq
instance ToUrl Frontend NodePath where
toUrl front np = frontendUrl front (nodePath np)
instance Eq Frontend where eq = genericEq
instance ToUrl Frontend NodePath where toUrl front np = frontendUrl front (nodePath np)
instance Show Frontend where show (Frontend {name}) = name
instance ToUrl Frontend String where toUrl = frontendUrl
instance ToUrl Frontend R.AppRoute where toUrl f r = frontendUrl f (R.appPath r)
-- | Creates a frontend
frontend :: String -> String -> String -> Frontend
......@@ -78,25 +65,12 @@ frontend baseUrl prePath name = Frontend { name, baseUrl, prePath }
frontendUrl :: Frontend -> String -> String
frontendUrl (Frontend f) path = f.baseUrl <> f.prePath <> path
instance Show Frontend where
show (Frontend {name}) = name
instance ToUrl Frontend String where
toUrl = frontendUrl
instance ToUrl Frontend R.AppRoute where
toUrl f r = frontendUrl f (R.appPath r)
-- | The currently selected App and Static configurations
newtype Frontends = Frontends { app :: Frontend, static :: Frontend }
derive instance Eq Frontends
instance ToUrl Frontends R.AppRoute where
toUrl f r = appUrl f (R.appPath r)
instance ToUrl Frontends NodePath where
toUrl (Frontends {app}) np = frontendUrl app (nodePath np)
instance ToUrl Frontends R.AppRoute where toUrl f r = appUrl f (R.appPath r)
instance ToUrl Frontends NodePath where toUrl (Frontends {app}) np = frontendUrl app (nodePath np)
-- | Creates an app url from a Frontends and the path as a string
appUrl :: Frontends -> String -> String
......
src/Gargantext/Sessions.purs
View file @ 229f9ba3
......@@ -8,28 +8,28 @@ module Gargantext.Sessions
, getCacheState, setCacheState
) where
import Gargantext.Prelude
import DOM.Simple.Console (log2)
import Data.Either (Either(..), hush)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe)
import Effect (Effect)
import Effect.Aff (Aff)
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
import Web.Storage.Storage (getItem, removeItem, setItem)
import Gargantext.Prelude
import Gargantext.Components.Login.Types (AuthData(..), AuthInvalid(..), AuthRequest(..), AuthResponse(..))
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Config.REST as REST
import Gargantext.Ends (class ToUrl, Backend, toUrl)
import Gargantext.Sessions.Types (Session(..), Sessions(..), OpenNodes, NodeId, mkNodeId, sessionUrl, sessionId, empty, null, unSessions, lookup, cons, tryCons, update, remove, tryRemove)
import Gargantext.Utils.Reactix (getls, stringify)
import Prim.Row (class Lacks, class Nub)
import Reactix as R
import Record as Record
import Record.Extra as REX
import Simple.JSON as JSON
import Toestand as T
import Web.HTML.Event.EventTypes (offline)
import Web.Storage.Storage (getItem, removeItem, setItem)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Sessions"
type WithSession c =
( session :: Session
......@@ -86,7 +86,7 @@ setCacheState (Session session@{ caches }) nodeId cacheState =
-- | if decoding fails
loadSessions :: Effect Sessions
loadSessions = do
storage <- getls
storage <- R2.getls
mItem :: Maybe String <- getItem localStorageKey storage
case mItem of
Nothing -> pure empty
......@@ -95,7 +95,7 @@ loadSessions = do
case hush r of
Nothing -> pure empty
Just p -> pure p
-- loadSessions = getls >>= getItem localStorageKey >>= handleMaybe
-- loadSessions = R2.getls >>= getItem localStorageKey >>= handleMaybe
-- where
-- -- a localstorage lookup can find nothing
-- handleMaybe (Just val) = handleEither (JSON.readJSON val)
......@@ -105,14 +105,10 @@ loadSessions = do
-- handleEither (Left err) = err *> pure empty
-- handleEither (Right ss) = pure ss
mapLeft :: forall l m r. (l -> m) -> Either l r -> Either m r
mapLeft f (Left l) = Left (f l)
mapLeft _ (Right r) = Right r
saveSessions :: Sessions -> Effect Sessions
saveSessions sessions = effect *> pure sessions where
rem = getls >>= removeItem localStorageKey
set v = getls >>= setItem localStorageKey v
rem = R2.getls >>= removeItem localStorageKey
set v = R2.getls >>= setItem localStorageKey v
effect
| null sessions = rem
| otherwise = set (JSON.writeJSON sessions)
......
src/Gargantext/Sessions/Types.purs
View file @ 229f9ba3
......@@ -18,6 +18,7 @@ import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Set (Set)
import Data.Set as Set
import Data.Show.Generic (genericShow)
import Data.Tuple (Tuple)
import Foreign.Object as Object
import Reactix as R
......@@ -60,21 +61,11 @@ instance JSON.WriteForeign Session where
JSON.writeImpl { backend, caches: caches', token, treeId, username }
where
caches' = JSON.writeImpl $ Object.fromFoldable (GUT.mapFst show <$> Map.toUnfoldable caches :: Array (Tuple String NT.CacheState))
instance Eq Session where
eq = genericEq
instance Show Session where
show (Session {backend, username}) = username <> "@" <> show backend
instance ToUrl Session SessionRoute where
toUrl (Session {backend}) r = backendUrl backend (sessionPath r)
instance ToUrl Session NodePath where
toUrl (Session {backend}) np = backendUrl backend (nodePath np)
instance ToUrl Session String where
toUrl = sessionUrl
instance Eq Session where eq = genericEq
instance Show Session where show (Session {backend, username}) = username <> "@" <> show backend
instance ToUrl Session SessionRoute where toUrl (Session {backend}) r = backendUrl backend (sessionPath r)
instance ToUrl Session NodePath where toUrl (Session {backend}) np = backendUrl backend (nodePath np)
instance ToUrl Session String where toUrl = sessionUrl
sessionUrl :: Session -> String -> String
sessionUrl (Session {backend}) = backendUrl backend
......@@ -93,9 +84,8 @@ instance JSON.ReadForeign Sessions where
pure $ Sessions { sessions }
instance JSON.WriteForeign Sessions where
writeImpl (Sessions { sessions }) = GJSON.writeSequence sessions
instance Eq Sessions where
eq = genericEq
instance Eq Sessions where eq = genericEq
instance Show Sessions where show = genericShow
empty :: Sessions
empty = Sessions { sessions: Seq.empty }
......
src/Gargantext/Types.purs
View file @ 229f9ba3
......@@ -425,17 +425,20 @@ instance JSON.WriteForeign OrderBy where writeImpl = JSON.writeImpl <<< show
data ApiVersion = V0 | V10 | V11
derive instance Generic ApiVersion _
instance JSON.ReadForeign ApiVersion where readImpl = JSONG.enumSumRep
instance JSON.ReadForeign ApiVersion where
readImpl f = do
s <- JSON.readImpl f
case s of
"v0" -> pure V0
"v1.0" -> pure V10
"v1.1" -> pure V11
x -> F.fail $ F.ErrorAtProperty x $ F.ForeignError "unknown API value"
instance JSON.WriteForeign ApiVersion where
writeImpl V0 = F.unsafeToForeign $ JSON.writeImpl "v0"
writeImpl V10 = F.unsafeToForeign $ JSON.writeImpl "v1.0"
writeImpl V11 = F.unsafeToForeign $ JSON.writeImpl "v1.1"
writeImpl v = F.unsafeToForeign $ JSON.writeImpl $ show v
instance Show ApiVersion where
show V0 = "v0"
show V10 = "v1.0"
show V11 = "v1.1"
instance Eq ApiVersion where
eq V10 V10 = true
eq V11 V11 = true
......
src/Gargantext/Utils/CacheAPI.js
View file @ 229f9ba3
exports._makeRequest = function() {
return function(url) {
return function(options) {
return new Request(url, options);
}
exports._makeRequest = function(url) {
return function(options) {
return new Request(url, options);
}
}
......
src/Gargantext/Utils/JSON.purs
View file @ 229f9ba3
......@@ -6,7 +6,7 @@ import Control.Monad.Except (withExcept)
import Data.Int as Int
import Data.List as List
import Data.Map as Map
import Data.Maybe (fromJust, Maybe(..))
import Data.Maybe (Maybe(..))
import Data.Sequence as Seq
import Data.Traversable (sequence)
import Data.TraversableWithIndex (traverseWithIndex)
......@@ -14,10 +14,8 @@ import Data.Tuple (Tuple(..))
import Foreign (F, Foreign, ForeignError(..), readArray, unsafeToForeign)
import Foreign as F
import Foreign.Object as Object
import Simple.JSON (writeImpl)
import Simple.JSON as JSON
import Gargantext.Utils.Tuple as GUT
readSequence :: forall a. JSON.ReadForeign a => Foreign -> F (Seq.Seq a)
readSequence f = do
......@@ -28,7 +26,7 @@ readSequence f = do
readAtIdx i f' = withExcept (map (ErrorAtIndex i)) (JSON.readImpl f')
writeSequence :: forall a. JSON.WriteForeign a => Seq.Seq a -> Foreign
writeSequence xs = unsafeToForeign $ JSON.writeImpl <$> xs
writeSequence xs = unsafeToForeign $ JSON.writeImpl $ (Seq.toUnfoldable xs :: Array a)
readList :: forall a. JSON.ReadForeign a => Foreign -> F (List.List a)
readList f = do
......
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