Commit 229f9ba3 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[simple-json] fixes to sessions and other endpoints

parent 81e21c97
This diff is collapsed.
......@@ -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
......@@ -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
......
module Gargantext.Components.App (app) where
import Data.Set as Set
import Reactix as R
import Toestand as T
......
This diff is collapsed.
......@@ -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
......@@ -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
......
......@@ -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
cpt { boxes: boxes@{ handed
, route
, showTree } } _ = do
route' <- T.useLive T.unequal boxes.route
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,7 +112,7 @@ 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
cpt { boxes: { backend
, forestOpen
, handed
, reloadForest
......@@ -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,7 +215,7 @@ 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
cpt { boxes: { graphVersion
, reloadForest
, route
, sidePanelGraph
......@@ -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,7 +439,7 @@ user :: R2.Component SessionNodeProps
user = R.createElement userCpt
userCpt :: R.Component SessionNodeProps
userCpt = here.component "user" cpt where
cpt props@{ boxes: boxes@{ reloadForest
cpt props@{ boxes: { reloadForest
, reloadRoot
, sidePanelState
, sidePanelTexts
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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 }
......
......@@ -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
......
exports._makeRequest = function() {
return function(url) {
exports._makeRequest = function(url) {
return function(options) {
return new Request(url, options);
}
}
}
......
......@@ -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