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
0
Issues
0
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
Przemyslaw Kaminski
purescript-gargantext
Commits
81e21c97
Commit
81e21c97
authored
Jul 01, 2021
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[simple-json] code compiles now
parent
0f9d2064
Changes
35
Hide whitespace changes
Inline
Side-by-side
Showing
35 changed files
with
972 additions
and
1347 deletions
+972
-1347
packages.dhall
packages.dhall
+2
-2
shell.nix
shell.nix
+1
-0
spago.dhall
spago.dhall
+39
-7
AsyncTasks.purs
src/Gargantext/AsyncTasks.purs
+10
-7
App.purs
src/Gargantext/Components/App.purs
+2
-0
Data.purs
src/Gargantext/Components/App/Data.purs
+5
-2
Series.purs
src/Gargantext/Components/Charts/Options/Series.purs
+20
-21
DocsTable.purs
src/Gargantext/Components/DocsTable.purs
+11
-13
FacetsTable.purs
src/Gargantext/Components/FacetsTable.purs
+5
-5
Tree.purs
src/Gargantext/Components/Forest/Tree.purs
+132
-7
Types.purs
...text/Components/Forest/Tree/Node/Tools/SubTree/Types.purs
+4
-9
Types.purs
src/Gargantext/Components/GraphExplorer/Types.purs
+85
-177
NgramsTable.purs
src/Gargantext/Components/NgramsTable.purs
+2
-2
Core.purs
src/Gargantext/Components/NgramsTable/Core.purs
+128
-202
Loader.purs
src/Gargantext/Components/NgramsTable/Loader.purs
+3
-3
Node.purs
src/Gargantext/Components/Node.purs
+26
-37
Annuaire.purs
src/Gargantext/Components/Nodes/Annuaire.purs
+21
-35
Types.purs
...antext/Components/Nodes/Annuaire/User/Contacts/Types.purs
+89
-215
Corpus.purs
src/Gargantext/Components/Nodes/Corpus.purs
+42
-38
Common.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Common.purs
+3
-3
Histo.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Histo.purs
+9
-22
Metrics.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Metrics.purs
+9
-25
Pie.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Pie.purs
+9
-22
Tree.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Tree.purs
+9
-13
Dashboard.purs
src/Gargantext/Components/Nodes/Corpus/Dashboard.purs
+13
-20
Document.purs
src/Gargantext/Components/Nodes/Corpus/Document.purs
+0
-5
Types.purs
src/Gargantext/Components/Nodes/Corpus/Document/Types.purs
+22
-111
Frame.purs
src/Gargantext/Components/Nodes/Frame.purs
+14
-21
Types.purs
src/Gargantext/Components/Nodes/Types.purs
+24
-22
Search.purs
src/Gargantext/Components/Search.purs
+106
-144
Loader.purs
src/Gargantext/Hooks/Loader.purs
+9
-17
Types.purs
src/Gargantext/Sessions/Types.purs
+36
-5
Types.purs
src/Gargantext/Types.purs
+60
-121
CacheAPI.purs
src/Gargantext/Utils/CacheAPI.purs
+10
-10
JSON.purs
src/Gargantext/Utils/JSON.purs
+12
-4
No files found.
packages.dhall
View file @
81e21c97
...
@@ -93,8 +93,8 @@ let additions =
...
@@ -93,8 +93,8 @@ let additions =
}
}
, markdown-smolder =
, markdown-smolder =
{ dependencies = [ "markdown", "smolder" ]
{ dependencies = [ "markdown", "smolder" ]
, repo = "https://github.com/
poorscript
/purescript-markdown-smolder"
, repo = "https://github.com/
hgiasac
/purescript-markdown-smolder"
, version = "
2021-06-22
"
, version = "
v2.2.0
"
}
}
, precise =
, precise =
{ dependencies = [ "prelude" ]
{ dependencies = [ "prelude" ]
...
...
shell.nix
View file @
81e21c97
...
@@ -48,6 +48,7 @@ pkgs.mkShell {
...
@@ -48,6 +48,7 @@ pkgs.mkShell {
build-purs
build-purs
build
build
repl
repl
pkgs
.
spago
pkgs
.
yarn
pkgs
.
yarn
test-ps
test-ps
];
];
...
...
spago.dhall
View file @
81e21c97
...
@@ -12,35 +12,59 @@ to generate this file without the comments in this block.
...
@@ -12,35 +12,59 @@ to generate this file without the comments in this block.
-}
-}
{ name = "gargantext"
{ name = "gargantext"
, dependencies =
, dependencies =
[ "aff-promise"
[ "aff"
, "aff-promise"
, "affjax"
, "affjax"
, "argonaut"
, "argonaut"
, "argonaut-codecs"
, "argonaut-core"
, "arrays"
, "bifunctors"
, "colors"
, "console"
, "console"
, "control"
, "css"
, "css"
, "datetime"
, "datetime"
, "debug"
, "dom-filereader"
, "dom-filereader"
, "dom-simple"
, "dom-simple"
, "effect"
, "effect"
, "foreign-generic"
, "either"
, "enums"
, "exceptions"
, "ffi-simple"
, "foldable-traversable"
, "foreign"
, "foreign-object"
, "foreign-object"
, "form-urlencoded"
, "formula"
, "formula"
, "functions"
, "globals"
, "globals"
, "http-methods"
, "integers"
, "integers"
, "js-timers"
, "js-timers"
, "lists"
, "markdown"
, "markdown-smolder"
, "markdown-smolder"
, "math"
, "math"
, "maybe"
, "maybe"
, "media-types"
, "milkis"
, "milkis"
, "newtype"
, "nonempty"
, "nonempty"
, "now"
, "now"
, "nullable"
, "numbers"
, "numbers"
, "ordered-collections"
, "orders"
, "parallel"
, "partial"
, "prelude"
, "prelude"
, "profunctor-lenses"
, "psci-support"
, "psci-support"
, "random"
, "random"
, "react"
, "react"
, "reactix"
, "reactix"
, "re
a
d"
, "re
cor
d"
, "record-extra"
, "record-extra"
, "routing"
, "routing"
, "sequences"
, "sequences"
...
@@ -48,18 +72,26 @@ to generate this file without the comments in this block.
...
@@ -48,18 +72,26 @@ to generate this file without the comments in this block.
, "simple-json-generics"
, "simple-json-generics"
, "simplecrypto"
, "simplecrypto"
, "smolder"
, "smolder"
, "spec"
, "spec-discovery"
, "spec-discovery"
, "spec-quickcheck"
, "spec-quickcheck"
, "string-parsers"
, "strings"
, "strings"
, "stringutils"
, "stringutils"
, "these"
, "toestand"
, "toestand"
, "transformers"
, "tuples"
, "tuples-native"
, "tuples-native"
, "typisch"
, "typelevel"
, "typelevel-prelude"
, "uint"
, "uint"
, "unfoldable"
, "unsafe-coerce"
, "uri"
, "uri"
, "
versions
"
, "
web-file
"
, "web-html"
, "web-html"
, "web-storage"
, "web-xhr"
]
]
, packages = ./packages.dhall
, packages = ./packages.dhall
, sources = [ "src/**/*.purs", "test/**/*.purs" ]
, sources = [ "src/**/*.purs", "test/**/*.purs" ]
...
...
src/Gargantext/AsyncTasks.purs
View file @
81e21c97
...
@@ -24,12 +24,15 @@ localStorageKey = "garg-async-tasks"
...
@@ -24,12 +24,15 @@ localStorageKey = "garg-async-tasks"
type TaskList = Array GT.AsyncTaskWithType
type TaskList = Array GT.AsyncTaskWithType
type Storage = Map.Map GT.NodeID TaskList
newtype Storage = Storage (Map.Map GT.NodeID TaskList)
instance JSON.ReadForeign Storage where readImpl = GUJ.readMap
instance JSON.ReadForeign Storage where
readImpl f = do
m <- GUJ.readMapInt f
pure $ Storage m
empty :: Storage
empty :: Storage
empty = Map.empty
empty =
Storage $
Map.empty
getAsyncTasks :: Effect Storage
getAsyncTasks :: Effect Storage
getAsyncTasks = R2.getls >>= WSS.getItem localStorageKey >>= handleMaybe
getAsyncTasks = R2.getls >>= WSS.getItem localStorageKey >>= handleMaybe
...
@@ -44,10 +47,10 @@ getAsyncTasks = R2.getls >>= WSS.getItem localStorageKey >>= handleMaybe
...
@@ -44,10 +47,10 @@ getAsyncTasks = R2.getls >>= WSS.getItem localStorageKey >>= handleMaybe
parse s = GU.mapLeft (log2 "Error parsing serialised sessions:") (JSON.readJSON s)
parse s = GU.mapLeft (log2 "Error parsing serialised sessions:") (JSON.readJSON s)
getTasks :: GT.NodeID -> Storage -> TaskList
getTasks :: GT.NodeID -> Storage -> TaskList
getTasks nodeId
storage
= fromMaybe [] $ Map.lookup nodeId storage
getTasks nodeId
(Storage storage)
= fromMaybe [] $ Map.lookup nodeId storage
setTasks :: GT.NodeID -> TaskList -> Storage -> Storage
setTasks :: GT.NodeID -> TaskList -> Storage -> Storage
setTasks id tasks
s =
Map.insert id tasks s
setTasks id tasks
(Storage s) = Storage $
Map.insert id tasks s
focus :: GT.NodeID -> T.Box Storage -> R.Hooks (T.Box TaskList)
focus :: GT.NodeID -> T.Box Storage -> R.Hooks (T.Box TaskList)
focus id tasks = T.useFocused (getTasks id) (setTasks id) tasks
focus id tasks = T.useFocused (getTasks id) (setTasks id) tasks
...
@@ -65,7 +68,7 @@ type ReductorProps = (
...
@@ -65,7 +68,7 @@ type ReductorProps = (
insert :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
insert :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
insert id task storage = T.modify_ newStorage storage
insert id task storage = T.modify_ newStorage storage
where
where
newStorage
s =
Map.alter (maybe (Just [task]) (\ts -> Just $ A.cons task ts)) id s
newStorage
(Storage s) = Storage $
Map.alter (maybe (Just [task]) (\ts -> Just $ A.cons task ts)) id s
finish :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
finish :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
finish id task storage = remove id task storage
finish id task storage = remove id task storage
...
@@ -73,7 +76,7 @@ finish id task storage = remove id task storage
...
@@ -73,7 +76,7 @@ finish id task storage = remove id task storage
remove :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
remove :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
remove id task storage = T.modify_ newStorage storage
remove id task storage = T.modify_ newStorage storage
where
where
newStorage
s =
Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts task)) id s
newStorage
(Storage s) = Storage $
Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts task)) id s
-- When a task is finished: which tasks cause forest or app reload
-- When a task is finished: which tasks cause forest or app reload
...
...
src/Gargantext/Components/App.purs
View file @
81e21c97
module Gargantext.Components.App (app) where
module Gargantext.Components.App (app) where
import Data.Set as Set
import Reactix as R
import Reactix as R
import Toestand as T
import Toestand as T
...
...
src/Gargantext/Components/App/Data.purs
View file @
81e21c97
...
@@ -4,6 +4,8 @@ import Data.Set as Set
...
@@ -4,6 +4,8 @@ import Data.Set as Set
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..))
import Toestand as T
import Toestand as T
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST
import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST
import Gargantext.Components.Nodes.Lists.Types as ListsT
import Gargantext.Components.Nodes.Lists.Types as ListsT
...
@@ -11,7 +13,8 @@ import Gargantext.Components.Nodes.Texts.Types as TextsT
...
@@ -11,7 +13,8 @@ import Gargantext.Components.Nodes.Texts.Types as TextsT
import Gargantext.Ends (Backend)
import Gargantext.Ends (Backend)
import Gargantext.Routes (AppRoute(Home))
import Gargantext.Routes (AppRoute(Home))
import Gargantext.Sessions as Sessions
import Gargantext.Sessions as Sessions
import Gargantext.Sessions (OpenNodes, Session, Sessions)
import Gargantext.Sessions (Session, Sessions)
import Gargantext.Sessions.Types (OpenNodes(..))
import Gargantext.Types (Handed(RightHanded), SidePanelState(..))
import Gargantext.Types (Handed(RightHanded), SidePanelState(..))
import Gargantext.Utils.Toestand as T2
import Gargantext.Utils.Toestand as T2
...
@@ -39,7 +42,7 @@ type App =
...
@@ -39,7 +42,7 @@ type App =
emptyApp :: App
emptyApp :: App
emptyApp =
emptyApp =
{ backend : Nothing
{ backend : Nothing
, forestOpen : Set.empty
, forestOpen :
OpenNodes $
Set.empty
, graphVersion : T2.newReload
, graphVersion : T2.newReload
, handed : RightHanded
, handed : RightHanded
, reloadForest : T2.newReload
, reloadForest : T2.newReload
...
...
src/Gargantext/Components/Charts/Options/Series.purs
View file @
81e21c97
module Gargantext.Components.Charts.Options.Series where
module Gargantext.Components.Charts.Options.Series where
import Prelude (class Eq, class Show, bind, map, pure, show, ($), (+), (<<<), (<>), eq)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Array (foldl)
import Data.Array (foldl)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), maybe)
import Data.Maybe (Maybe(..), maybe)
import Data.Newtype (class Newtype)
import Data.Symbol (SProxy(..))
import Record as Record
import Record.Unsafe (unsafeSet)
import Record.Unsafe (unsafeSet)
import Simple.JSON as JSON
import Unsafe.Coerce (unsafeCoerce)
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
import Gargantext.Types (class Optional)
import Gargantext.Types (class Optional)
import Gargantext.Components.Charts.Options.Font (ItemStyle, Tooltip)
import Gargantext.Components.Charts.Options.Font (ItemStyle, Tooltip)
import Gargantext.Components.Charts.Options.Data (DataD1, DataD2)
import Gargantext.Components.Charts.Options.Data (DataD1, DataD2)
...
@@ -186,28 +188,20 @@ toJsTree maybeSurname (TreeNode x) =
...
@@ -186,28 +188,20 @@ toJsTree maybeSurname (TreeNode x) =
where
where
name = maybe "" (\x' -> x' <> ">") maybeSurname <> x.name
name = maybe "" (\x' -> x' <> ">") maybeSurname <> x.name
data
TreeNode = TreeNode {
newtype
TreeNode = TreeNode {
children :: Array TreeNode
children :: Array TreeNode
, name :: String
, name :: String
, value :: Int
, value :: Int
}
}
derive instance Generic TreeNode _
derive instance Generic TreeNode _
instance Eq TreeNode where
derive instance Newtype TreeNode _
eq (TreeNode n1) (TreeNode n2) = eq n1 n2
derive instance Eq TreeNode
instance DecodeJson TreeNode where
instance JSON.ReadForeign TreeNode where
decodeJson json = do
readImpl f = do
obj <- decodeJson json
inst <- JSON.readImpl f
children <- obj .: "children"
pure $ TreeNode $ Record.rename labelP nameP inst
name <- obj .: "label"
instance JSON.WriteForeign TreeNode where
value <- obj .: "value"
writeImpl (TreeNode t) = JSON.writeImpl $ Record.rename nameP labelP t
pure $ TreeNode { children, name, value }
instance EncodeJson TreeNode where
encodeJson (TreeNode { children, name, value }) =
"children" := encodeJson children
~> "label" := encodeJson name
~> "value" := encodeJson value
~> jsonEmptyObject
treeNode :: String -> Int -> Array TreeNode -> TreeNode
treeNode :: String -> Int -> Array TreeNode -> TreeNode
treeNode n v ts = TreeNode {name : n, value:v, children:ts}
treeNode n v ts = TreeNode {name : n, value:v, children:ts}
...
@@ -216,7 +210,12 @@ treeLeaf :: String -> Int -> TreeNode
...
@@ -216,7 +210,12 @@ treeLeaf :: String -> Int -> TreeNode
treeLeaf n v = TreeNode { name : n, value : v, children : []}
treeLeaf n v = TreeNode { name : n, value : v, children : []}
nameP = SProxy :: SProxy "name"
labelP = SProxy :: SProxy "label"
-- | TODO
-- | TODO
-- https://ecomfe.github.io/echarts-examples/public/data/asset/data/life-expectancy-table.json
-- https://ecomfe.github.io/echarts-examples/public/data/asset/data/life-expectancy-table.json
-- https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter3D-dataset&gl=1
-- https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter3D-dataset&gl=1
src/Gargantext/Components/DocsTable.purs
View file @
81e21c97
-- TODO: this module should be replaced by FacetsTable
-- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.DocsTable where
module Gargantext.Components.DocsTable where
import Gargantext.Prelude
( class Ord, Unit, bind, const, discard, identity, mempty
, otherwise, pure, show, unit, ($), (/=), (<$>), (<<<), (<>), (==) )
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Array as A
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Lens ((^.))
import Data.Lens ((^.))
import Data.Lens.At (at)
import Data.Lens.At (at)
import Data.Lens.Record (prop)
import Data.Lens.Record (prop)
import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
import Data.Map as Map
import Data.Newtype (class Newtype)
import Data.Ord.Down (Down(..))
import Data.Ord.Down (Down(..))
import Data.Set (Set)
import Data.Set (Set)
import Data.Set as Set
import Data.Set as Set
...
@@ -23,8 +22,11 @@ import Effect.Aff (Aff, launchAff_)
...
@@ -23,8 +22,11 @@ import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Category (rating)
import Gargantext.Components.Category (rating)
import Gargantext.Components.Category.Types (Star(..))
import Gargantext.Components.Category.Types (Star(..))
import Gargantext.Components.DocsTable.Types
import Gargantext.Components.DocsTable.Types
...
@@ -290,7 +292,7 @@ pageLayoutCpt = here.component "pageLayout" cpt where
...
@@ -290,7 +292,7 @@ pageLayoutCpt = here.component "pageLayout" cpt where
, renderer: paint
, renderer: paint
}
}
NT.CacheOff -> do
NT.CacheOff -> do
localCategories <- T.useBox (
m
empty :: LocalUserScore)
localCategories <- T.useBox (
Map.
empty :: LocalUserScore)
paramsS <- T.useBox params
paramsS <- T.useBox params
paramsS' <- T.useLive T.unequal paramsS
paramsS' <- T.useLive T.unequal paramsS
let loader p = do
let loader p = do
...
@@ -338,7 +340,7 @@ pagePaintCpt = here.component "pagePaintCpt" cpt
...
@@ -338,7 +340,7 @@ pagePaintCpt = here.component "pagePaintCpt" cpt
cpt { documents, layout, params } _ = do
cpt { documents, layout, params } _ = do
params' <- T.useLive T.unequal params
params' <- T.useLive T.unequal params
localCategories <- T.useBox (
m
empty :: LocalUserScore)
localCategories <- T.useBox (
Map.
empty :: LocalUserScore)
pure $ pagePaintRaw { documents: A.fromFoldable (filteredRows params')
pure $ pagePaintRaw { documents: A.fromFoldable (filteredRows params')
, layout
, layout
, localCategories
, localCategories
...
@@ -505,13 +507,9 @@ newtype SearchQuery = SearchQuery {
...
@@ -505,13 +507,9 @@ newtype SearchQuery = SearchQuery {
parent_id :: Int
parent_id :: Int
, query :: Array String
, query :: Array String
}
}
derive instance Generic SearchQuery _
derive instance Newtype SearchQuery _
instance EncodeJson SearchQuery where
derive newtype instance JSON.ReadForeign SearchQuery
encodeJson (SearchQuery {query, parent_id})
= "query" := query
~> "parent_id" := parent_id
~> jsonEmptyObject
documentsRoute :: Int -> SessionRoute
documentsRoute :: Int -> SessionRoute
...
...
src/Gargantext/Components/FacetsTable.purs
View file @
81e21c97
...
@@ -3,11 +3,11 @@
...
@@ -3,11 +3,11 @@
-- has not been ported to this module yet.
-- has not been ported to this module yet.
module Gargantext.Components.FacetsTable where
module Gargantext.Components.FacetsTable where
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Eq.Generic (genericEq)
import Data.Show.Generic (genericShow)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype (class Newtype)
import Data.Sequence (Seq)
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Sequence as Seq
import Data.Set (Set)
import Data.Set (Set)
...
@@ -18,6 +18,7 @@ import Effect (Effect)
...
@@ -18,6 +18,7 @@ import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Aff (Aff, launchAff_)
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Toestand as T
import Gargantext.Prelude
import Gargantext.Prelude
...
@@ -412,10 +413,9 @@ publicationDate (DocumentsView {publication_year, publication_month, publication
...
@@ -412,10 +413,9 @@ publicationDate (DocumentsView {publication_year, publication_month, publication
---------------------------------------------------------
---------------------------------------------------------
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
derive instance Generic DeleteDocumentQuery _
instance EncodeJson DeleteDocumentQuery where
derive instance Newtype DeleteDocumentQuery _
encodeJson (DeleteDocumentQuery {documents}) =
derive newtype instance JSON.WriteForeign DeleteDocumentQuery
"documents" := documents ~> jsonEmptyObject
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments session nodeId =
deleteDocuments session nodeId =
...
...
src/Gargantext/Components/Forest/Tree.purs
View file @
81e21c97
...
@@ -4,7 +4,6 @@ import Gargantext.Prelude
...
@@ -4,7 +4,6 @@ import Gargantext.Prelude
import Data.Array as A
import Data.Array as A
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Data.Traversable (traverse_, traverse)
import Data.Traversable (traverse_, traverse)
import DOM.Simple.Console (log, log2)
import DOM.Simple.Console (log, log2)
import Effect (Effect)
import Effect (Effect)
...
@@ -35,7 +34,8 @@ import Gargantext.Ends (Frontends)
...
@@ -35,7 +34,8 @@ import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (AppRoute)
import Gargantext.Routes (AppRoute)
import Gargantext.Routes as GR
import Gargantext.Routes as GR
import Gargantext.Sessions (OpenNodes, Session, mkNodeId, get)
import Gargantext.Sessions (OpenNodes, Session, get, mkNodeId)
import Gargantext.Sessions.Types (useOpenNodesMemberBox, openNodesInsert, openNodesDelete)
import Gargantext.Types (Handed, ID, isPublic, publicize, switchHanded)
import Gargantext.Types (Handed, ID, isPublic, publicize, switchHanded)
import Gargantext.Types as GT
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reactix as R2
...
@@ -99,7 +99,7 @@ treeCpt :: R.Component TreeProps
...
@@ -99,7 +99,7 @@ treeCpt :: R.Component TreeProps
treeCpt = here.component "tree" cpt where
treeCpt = here.component "tree" cpt where
cpt p@{ reload, session, tree: NTree (LNode { id, name, nodeType }) children } _ = do
cpt p@{ reload, session, tree: NTree (LNode { id, name, nodeType }) children } _ = do
setPopoverRef <- R.useRef Nothing
setPopoverRef <- R.useRef Nothing
folderOpen <-
T2.use
MemberBox nodeId p.forestOpen
folderOpen <-
useOpenNodes
MemberBox nodeId p.forestOpen
pure $ H.ul { className: ulClass }
pure $ H.ul { className: ulClass }
[ H.li { className: childrenClass children' }
[ H.li { className: childrenClass children' }
[ nodeSpan (nsprops { folderOpen, name, id, nodeType, setPopoverRef, isLeaf })
[ nodeSpan (nsprops { folderOpen, name, id, nodeType, setPopoverRef, isLeaf })
...
@@ -193,73 +193,198 @@ childLoaderCpt = here.component "childLoader" cpt where
...
@@ -193,73 +193,198 @@ childLoaderCpt = here.component "childLoader" cpt where
type PerformActionProps =
type PerformActionProps =
( setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit)) | PACommon )
( 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 } =
closePopover { setPopoverRef } =
liftEffect $ traverse_ (\set -> set false) (R.readRef 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
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
deleteNode' nt p@{ tree: (NTree (LNode {id, parent_id}) _) } = do
case nt of
case nt of
GT.NodePublic GT.FolderPublic -> void $ deleteNode p.session nt id
GT.NodePublic GT.FolderPublic -> void $ deleteNode p.session nt id
GT.NodePublic _ -> void $ unpublishNode p.session parent_id id
GT.NodePublic _ -> void $ unpublishNode p.session parent_id id
_ -> void $ deleteNode p.session nt id
_ -> void $ deleteNode p.session nt id
liftEffect $ T.modify_ (
Set.d
elete (mkNodeId p.session id)) p.forestOpen
liftEffect $ T.modify_ (
openNodesD
elete (mkNodeId p.session id)) p.forestOpen
refreshTree p
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
doSearch task p@{ tasks, tree: NTree (LNode {id}) _ } = liftEffect $ do
GAT.insert id task tasks
GAT.insert id task tasks
log2 "[performAction] DoSearch task:" task
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
updateNode params p@{ tasks, tree: (NTree (LNode {id}) _) } = do
task <- updateRequest params p.session id
task <- updateRequest params p.session id
liftEffect $ do
liftEffect $ do
GAT.insert id task tasks
GAT.insert id task tasks
log2 "[performAction] UpdateNode task:" task
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
renameNode name p@{ tree: (NTree (LNode {id}) _) } = do
void $ rename p.session id $ RenameValue { text: name }
void $ rename p.session id $ RenameValue { text: name }
refreshTree p
refreshTree p
shareTeam :: forall t147.
String
-> { session :: Session
, tree :: NTree LNode
| t147
}
-> Aff Unit
shareTeam username p@{ tree: (NTree (LNode {id}) _)} =
shareTeam username p@{ tree: (NTree (LNode {id}) _)} =
void $ Share.shareReq p.session id $ Share.ShareTeamParams {username}
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
sharePublic params p@{ forestOpen } = traverse_ f params where
f (SubTreeOut { in: inId, out }) = do
f (SubTreeOut { in: inId, out }) = do
void $ Share.shareReq p.session inId $ Share.SharePublicParams { node_id: out }
void $ Share.shareReq p.session inId $ Share.SharePublicParams { node_id: out }
liftEffect $ T.modify_ (
Set.i
nsert (mkNodeId p.session out)) forestOpen
liftEffect $ T.modify_ (
openNodesI
nsert (mkNodeId p.session out)) forestOpen
refreshTree p
refreshTree p
addContact :: forall t638.
AddContactParams
-> { session :: Session
, tree :: NTree LNode
| t638
}
-> Aff Unit
addContact params p@{ tree: (NTree (LNode {id}) _) } =
addContact params p@{ tree: (NTree (LNode {id}) _) } =
void $ Contact.contactReq p.session id params
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
addNode' name nodeType p@{ forestOpen, tree: (NTree (LNode { id }) _) } = do
task <- addNode p.session id $ AddNodeValue {name, nodeType}
task <- addNode p.session id $ AddNodeValue {name, nodeType}
liftEffect $ T.modify_ (
Set.i
nsert (mkNodeId p.session id)) forestOpen
liftEffect $ T.modify_ (
openNodesI
nsert (mkNodeId p.session id)) forestOpen
refreshTree p
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
uploadFile' nodeType fileType mName blob p@{ tasks, tree: (NTree (LNode { id }) _) } = do
task <- uploadFile p.session nodeType id fileType {mName, blob}
task <- uploadFile p.session nodeType id fileType {mName, blob}
liftEffect $ do
liftEffect $ do
GAT.insert id task tasks
GAT.insert id task tasks
log2 "[performAction] UploadFile, uploaded, task:" task
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
uploadArbitraryFile' mName blob p@{ tasks, tree: (NTree (LNode { id }) _) } = do
task <- uploadArbitraryFile p.session id { blob, mName }
task <- uploadArbitraryFile p.session id { blob, mName }
liftEffect $ do
liftEffect $ do
GAT.insert id task tasks
GAT.insert id task tasks
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
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
moveNode params p@{ forestOpen, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
f (SubTreeOut { in: in', out }) = do
void $ moveNodeReq p.session in' out
void $ moveNodeReq p.session in' out
liftEffect $ T.modify_ (
Set.i
nsert (mkNodeId session out)) forestOpen
liftEffect $ T.modify_ (
openNodesI
nsert (mkNodeId session out)) forestOpen
refreshTree p
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
mergeNode params p = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
f (SubTreeOut { in: in', out }) = do
void $ mergeNodeReq p.session in' out
void $ mergeNodeReq p.session in' out
refreshTree p
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
linkNode nodeType params p = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
f (SubTreeOut { in: in', out }) = do
void $ linkNodeReq p.session nodeType in' out
void $ linkNodeReq p.session nodeType in' out
...
...
src/Gargantext/Components/Forest/Tree/Node/Tools/SubTree/Types.purs
View file @
81e21c97
...
@@ -5,16 +5,13 @@ import Data.Eq.Generic (genericEq)
...
@@ -5,16 +5,13 @@ import Data.Eq.Generic (genericEq)
import Data.Show.Generic (genericShow)
import Data.Show.Generic (genericShow)
import Gargantext.Prelude (class Eq, class Show)
import Gargantext.Prelude (class Eq, class Show)
import Gargantext.Types as GT
import Gargantext.Types as GT
import Reactix as R
data SubTreeOut = SubTreeOut { in :: GT.ID
data SubTreeOut = SubTreeOut { in :: GT.ID
, out :: GT.ID
, out :: GT.ID
}
}
derive instance Generic SubTreeOut _
derive instance Generic SubTreeOut _
instance Eq SubTreeOut where
instance Eq SubTreeOut where eq = genericEq
eq = genericEq
instance Show SubTreeOut where show = genericShow
instance Show SubTreeOut where
show = genericShow
------------------------------------------------------------------------
------------------------------------------------------------------------
data SubTreeParams = SubTreeParams { showtypes :: Array GT.NodeType
data SubTreeParams = SubTreeParams { showtypes :: Array GT.NodeType
...
@@ -22,10 +19,8 @@ data SubTreeParams = SubTreeParams { showtypes :: Array GT.NodeType
...
@@ -22,10 +19,8 @@ data SubTreeParams = SubTreeParams { showtypes :: Array GT.NodeType
}
}
derive instance Generic SubTreeParams _
derive instance Generic SubTreeParams _
instance Eq SubTreeParams where
instance Eq SubTreeParams where eq = genericEq
eq = genericEq
instance Show SubTreeParams where show = genericShow
instance Show SubTreeParams where
show = genericShow
------------------------------------------------------------------------
------------------------------------------------------------------------
src/Gargantext/Components/GraphExplorer/Types.purs
View file @
81e21c97
module Gargantext.Components.GraphExplorer.Types where
module Gargantext.Components.GraphExplorer.Types where
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (.:), (.:?), jsonEmptyObject, (~>), (:=))
import Data.Array ((!!), length)
import Data.Array ((!!), length)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..), fromJust)
import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype)
import Data.Newtype (class Newtype)
import Data.Ord
import Data.Ord
import Data.Ord.Generic (genericCompare)
import Data.Symbol (SProxy(..))
import Partial.Unsafe (unsafePartial)
import Partial.Unsafe (unsafePartial)
import Record as Record
import Simple.JSON as JSON
import Gargantext.Prelude
import Gargantext.Prelude
...
@@ -23,19 +26,41 @@ newtype Node = Node {
...
@@ -23,19 +26,41 @@ newtype Node = Node {
, y :: Number
, y :: Number
}
}
x_coordP = SProxy :: SProxy "x_coord"
xP = SProxy :: SProxy "x"
y_coordP = SProxy :: SProxy "y_coord"
yP = SProxy :: SProxy "y"
clustDefaultP = SProxy :: SProxy "clustDefault"
clust_defaultP = SProxy :: SProxy "clust_default"
cameraP = SProxy :: SProxy "camera"
mCameraP = SProxy :: SProxy "mCamera"
idP = SProxy :: SProxy "id"
id_P = SProxy :: SProxy "id_"
derive instance Generic Node _
derive instance Generic Node _
derive instance Newtype Node _
derive instance Newtype Node _
instance Eq Node where
instance Eq Node where eq = genericEq
eq = genericEq
instance Ord Node where compare (Node n1) (Node n2) = compare n1.id_ n2.id_
instance Ord Node where
instance JSON.ReadForeign Node where
compare (Node n1) (Node n2) = compare n1.id_ n2.id_
readImpl f = do
inst <- JSON.readImpl f
pure $ Node $ Record.rename x_coordP xP $ Record.rename y_coordP yP inst
instance JSON.WriteForeign Node where
writeImpl (Node nd) = JSON.writeImpl $ Record.rename xP x_coordP $ Record.rename yP y_coordP nd
newtype Cluster = Cluster { clustDefault :: Int }
newtype Cluster = Cluster { clustDefault :: Int }
derive instance Generic Cluster _
derive instance Generic Cluster _
derive instance Newtype Cluster _
derive instance Newtype Cluster _
instance Eq Cluster where
instance Eq Cluster where eq = genericEq
eq = genericEq
instance JSON.ReadForeign Cluster where
readImpl f = do
inst <- JSON.readImpl f
pure $ Cluster $ Record.rename clust_defaultP clustDefaultP inst
instance JSON.WriteForeign Cluster where
writeImpl (Cluster cl) = JSON.writeImpl $ Record.rename clustDefaultP clust_defaultP cl
newtype Edge = Edge {
newtype Edge = Edge {
confluence :: Number
confluence :: Number
...
@@ -47,10 +72,14 @@ newtype Edge = Edge {
...
@@ -47,10 +72,14 @@ newtype Edge = Edge {
derive instance Generic Edge _
derive instance Generic Edge _
derive instance Newtype Edge _
derive instance Newtype Edge _
instance Eq Edge where
instance Eq Edge where eq = genericEq
eq = genericEq
instance Ord Edge where compare (Edge e1) (Edge e2) = compare e1.id_ e2.id_
instance Ord Edge where
instance JSON.ReadForeign Edge where
compare (Edge e1) (Edge e2) = compare e1.id_ e2.id_
readImpl f = do
inst <- JSON.readImpl f
pure $ Edge $ Record.rename idP id_P inst
instance JSON.WriteForeign Edge where
writeImpl (Edge ed) = JSON.writeImpl $ Record.rename id_P idP ed
-- | A 'fully closed interval' in CS parlance
-- | A 'fully closed interval' in CS parlance
type InclusiveRange t = { min :: t, max :: t }
type InclusiveRange t = { min :: t, max :: t }
...
@@ -66,8 +95,7 @@ newtype GraphSideCorpus = GraphSideCorpus
...
@@ -66,8 +95,7 @@ newtype GraphSideCorpus = GraphSideCorpus
, listId :: ListId
, listId :: ListId
}
}
derive instance Generic GraphSideCorpus _
derive instance Generic GraphSideCorpus _
instance Eq GraphSideCorpus where
instance Eq GraphSideCorpus where eq = genericEq
eq = genericEq
newtype GraphData = GraphData
newtype GraphData = GraphData
{ nodes :: Array Node
{ nodes :: Array Node
...
@@ -77,9 +105,24 @@ newtype GraphData = GraphData
...
@@ -77,9 +105,24 @@ newtype GraphData = GraphData
}
}
derive instance Newtype GraphData _
derive instance Newtype GraphData _
derive instance Generic GraphData _
derive instance Generic GraphData _
instance Eq GraphData where
instance Eq GraphData where eq = genericEq
eq = genericEq
instance JSON.ReadForeign GraphData where
readImpl f = do
inst :: { nodes :: Array Node
, edges :: Array Edge
, metadata :: Maybe MetaData
, corpusId :: Array CorpusId
, listId :: ListId } <- JSON.readImpl f
let side x = GraphSideCorpus { corpusId: x, corpusLabel: "Publications", listId : inst.listId}
let sides = side <$> inst.corpusId
pure $ GraphData { nodes: inst.nodes
, edges: inst.edges
, sides
, metaData: inst.metadata }
instance JSON.WriteForeign GraphData where
writeImpl (GraphData gd) = JSON.writeImpl { nodes: gd.nodes
, edges: gd.edges
, metadata: gd.metaData }
newtype MetaData = MetaData
newtype MetaData = MetaData
{ corpusId :: Array Int
{ corpusId :: Array Int
...
@@ -92,20 +135,22 @@ newtype MetaData = MetaData
...
@@ -92,20 +135,22 @@ newtype MetaData = MetaData
, title :: String
, title :: String
}
}
derive instance Generic MetaData _
derive instance Generic MetaData _
instance Eq MetaData where
derive instance Newtype MetaData _
eq = genericEq
instance Eq MetaData where eq = genericEq
derive newtype instance JSON.ReadForeign MetaData
derive newtype instance JSON.WriteForeign MetaData
getLegend :: GraphData -> Maybe (Array Legend)
getLegend :: GraphData -> Maybe (Array Legend)
getLegend (GraphData {metaData}) = (\(MetaData m) -> m.legend) <$> metaData
getLegend (GraphData {metaData}) = (\(MetaData m) -> m.legend) <$> metaData
newtype SelectedNode = SelectedNode {id :: String, label :: String}
newtype SelectedNode = SelectedNode {id :: String, label :: String}
derive instance
Eq SelectedNode
derive instance
Generic SelectedNode _
derive instance Newtype SelectedNode _
derive instance Newtype SelectedNode _
derive instance Ord SelectedNode
instance Eq SelectedNode where eq = genericEq
instance Ord SelectedNode where compare = genericCompare
instance Show SelectedNode where
instance Show SelectedNode where show (SelectedNode node) = node.label
show (SelectedNode node) = node.label
type State = (
type State = (
-- corpusId :: R.State Int
-- corpusId :: R.State Int
...
@@ -137,135 +182,15 @@ initialGraphData = GraphData {
...
@@ -137,135 +182,15 @@ initialGraphData = GraphData {
}
}
}
}
instance DecodeJson GraphData where
decodeJson json = do
obj <- decodeJson json
nodes <- obj .: "nodes"
edges <- obj .: "edges"
-- TODO: sides
metadata <- obj .: "metadata"
corpusIds <- metadata .: "corpusId"
list <- metadata .: "list"
listId' <- list .: "listId"
metaData <- obj .: "metadata"
let side x = GraphSideCorpus { corpusId: x, corpusLabel: "Publications", listId : listId'}
let sides = side <$> corpusIds
pure $ GraphData { nodes, edges, sides, metaData }
instance EncodeJson GraphData where
encodeJson (GraphData gd) =
"nodes" := gd.nodes
~> "edges" := gd.edges
~> "metadata" := gd.metaData
~> jsonEmptyObject
instance DecodeJson Node where
decodeJson json = do
obj <- decodeJson json
id_ <- obj .: "id"
type_ <- obj .: "type"
label <- obj .: "label"
size <- obj .: "size"
attributes <- obj .: "attributes"
x <- obj .: "x_coord"
y <- obj .: "y_coord"
pure $ Node { id_, type_, size, label, attributes, x, y }
instance EncodeJson Node where
encodeJson (Node nd) =
"id" := nd.id_
~> "attributes" := nd.attributes
~> "label" := nd.label
~> "size" := nd.size
~> "type" := nd.type_
~> "x_coord" := nd.x
~> "y_coord" := nd.y
~> jsonEmptyObject
instance DecodeJson MetaData where
decodeJson json = do
obj <- decodeJson json
legend <- obj .: "legend"
corpusId <- obj .: "corpusId"
list <- obj .: "list"
listId <- list .: "listId"
metric <- obj .: "metric"
startForceAtlas <- obj .: "startForceAtlas"
title <- obj .: "title"
version <- list .: "version"
pure $ MetaData {
corpusId
, legend
, list: {listId, version}
, metric
, startForceAtlas
, title
}
instance EncodeJson MetaData where
encodeJson (MetaData md) =
"corpusId" := md.corpusId
~> "legend" := md.legend
~> "list" := md.list
~> "metric" := md.metric
~> "startForceAtlas" := md.startForceAtlas
~> "title" := md.title
~> jsonEmptyObject
instance DecodeJson Legend where
decodeJson json = do
obj <- decodeJson json
id_ <- obj .: "id"
color <- obj .: "color"
label <- obj .: "label"
pure $ Legend { id_, color, label }
instance EncodeJson Legend where
encodeJson (Legend lg) =
"id" := lg.id_
~> "color" := lg.color
~> "label" := lg.label
~> jsonEmptyObject
instance DecodeJson Cluster where
decodeJson json = do
obj <- decodeJson json
clustDefault <- obj .: "clust_default"
pure $ Cluster { clustDefault }
instance EncodeJson Cluster where
encodeJson (Cluster cl) =
"clust_default" := cl.clustDefault
~> jsonEmptyObject
instance DecodeJson Edge where
decodeJson json = do
obj <- decodeJson json
id_ <- obj .: "id"
source <- obj .: "source"
target <- obj .: "target"
weight <- obj .: "weight"
confluence <- obj .: "confluence"
pure $ Edge { id_, source, target, weight, confluence }
instance EncodeJson Edge where
encodeJson (Edge ed) =
"id" := ed.id_
~> "confluence" := ed.confluence
~> "source" := ed.source
~> "target" := ed.target
~> "weight" := ed.weight
~> jsonEmptyObject
newtype Legend = Legend {id_ ::Int , color :: String, label :: String}
newtype Legend = Legend {id_ ::Int , color :: String, label :: String}
instance Eq Legend where
derive instance Generic Legend _
eq (Legend l1) (Legend l2) = eq l1.id_ l2.id_
derive instance Newtype Legend _
instance Eq Legend where eq (Legend l1) (Legend l2) = eq l1.id_ l2.id_
instance Ord Legend where compare (Legend l1) (Legend l2) = compare l1.id_ l2.id_
derive newtype instance JSON.ReadForeign Legend
derive newtype instance JSON.WriteForeign Legend
instance Ord Legend where
compare (Legend l1) (Legend l2) = compare l1.id_ l2.id_
getLegendData :: GraphData -> Array Legend
getLegendData :: GraphData -> Array Legend
getLegendData (GraphData {metaData: Just (MetaData {legend})}) = legend
getLegendData (GraphData {metaData: Just (MetaData {legend})}) = legend
...
@@ -296,38 +221,21 @@ newtype Camera =
...
@@ -296,38 +221,21 @@ newtype Camera =
, y :: Number
, y :: Number
}
}
derive instance Generic Camera _
derive instance Generic Camera _
instance Eq Camera where
derive instance Newtype Camera _
eq = genericEq
instance Eq Camera where eq = genericEq
instance DecodeJson Camera where
derive newtype instance JSON.ReadForeign Camera
decodeJson json = do
derive newtype instance JSON.WriteForeign Camera
obj <- decodeJson json
ratio <- obj .: "ratio"
x <- obj .: "x"
y <- obj .: "y"
pure $ Camera { ratio, x, y }
instance EncodeJson Camera where
encodeJson (Camera c) =
"ratio" := c.ratio
~> "x" := c.x
~> "y" := c.y
~> jsonEmptyObject
newtype HyperdataGraph = HyperdataGraph {
newtype HyperdataGraph = HyperdataGraph {
graph :: GraphData
graph :: GraphData
, mCamera :: Maybe Camera
, mCamera :: Maybe Camera
}
}
derive instance Generic HyperdataGraph _
derive instance Generic HyperdataGraph _
instance Eq HyperdataGraph where
derive instance Newtype HyperdataGraph _
eq = genericEq
instance Eq HyperdataGraph where eq = genericEq
instance DecodeJson HyperdataGraph where
instance JSON.ReadForeign HyperdataGraph where
decodeJson json = do
readImpl f = do
obj <- decodeJson json
inst <- JSON.readImpl f
graph <- obj .: "graph"
pure $ HyperdataGraph $ Record.rename cameraP mCameraP inst
mCamera <- obj .:? "camera"
instance JSON.WriteForeign HyperdataGraph where
pure $ HyperdataGraph { graph, mCamera }
writeImpl (HyperdataGraph c) = JSON.writeImpl $ Record.rename mCameraP cameraP c
instance EncodeJson HyperdataGraph where
encodeJson (HyperdataGraph c) =
"camera" := c.mCamera
~> "graph" := c.graph
~> jsonEmptyObject
src/Gargantext/Components/NgramsTable.purs
View file @
81e21c97
...
@@ -74,7 +74,7 @@ type State =
...
@@ -74,7 +74,7 @@ type State =
initialState :: VersionedNgramsTable -> State
initialState :: VersionedNgramsTable -> State
initialState (Versioned {version}) = {
initialState (Versioned {version}) = {
ngramsChildren:
m
empty
ngramsChildren:
Map.
empty
, ngramsLocalPatch: mempty
, ngramsLocalPatch: mempty
, ngramsParent: Nothing
, ngramsParent: Nothing
, ngramsSelection: mempty
, ngramsSelection: mempty
...
@@ -444,7 +444,7 @@ mkDispatch { filteredRows
...
@@ -444,7 +444,7 @@ mkDispatch { filteredRows
allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows
allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows
setParentResetChildren :: Maybe NgramsTerm -> State -> State
setParentResetChildren :: Maybe NgramsTerm -> State -> State
setParentResetChildren p = _ { ngramsParent = p, ngramsChildren =
m
empty }
setParentResetChildren p = _ { ngramsParent = p, ngramsChildren =
Map.
empty }
performAction :: Action -> Effect Unit
performAction :: Action -> Effect Unit
performAction (SetParentResetChildren p) =
performAction (SetParentResetChildren p) =
...
...
src/Gargantext/Components/NgramsTable/Core.purs
View file @
81e21c97
...
@@ -3,6 +3,7 @@ module Gargantext.Components.NgramsTable.Core
...
@@ -3,6 +3,7 @@ module Gargantext.Components.NgramsTable.Core
, CoreParams
, CoreParams
, NgramsElement(..)
, NgramsElement(..)
, _NgramsElement
, _NgramsElement
, NgramsRepoElementT
, NgramsRepoElement(..)
, NgramsRepoElement(..)
, _NgramsRepoElement
, _NgramsRepoElement
, ngramsRepoElementToNgramsElement
, ngramsRepoElementToNgramsElement
...
@@ -79,8 +80,6 @@ module Gargantext.Components.NgramsTable.Core
...
@@ -79,8 +80,6 @@ module Gargantext.Components.NgramsTable.Core
where
where
import Control.Monad.State (class MonadState, execState)
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 (head)
import Data.Array as A
import Data.Array as A
import Data.Bifunctor (lmap)
import Data.Bifunctor (lmap)
...
@@ -104,6 +103,7 @@ import Data.List as L
...
@@ -104,6 +103,7 @@ import Data.List as L
import Data.Map (Map)
import Data.Map (Map)
import Data.Map as Map
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', isJust)
import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', isJust)
import Data.Monoid (class Monoid)
import Data.Monoid.Additive (Additive(..))
import Data.Monoid.Additive (Additive(..))
import Data.Newtype (class Newtype)
import Data.Newtype (class Newtype)
import Data.Set (Set)
import Data.Set (Set)
...
@@ -124,12 +124,15 @@ import Effect.Aff (Aff, launchAff_)
...
@@ -124,12 +124,15 @@ import Effect.Aff (Aff, launchAff_)
import Effect (Effect)
import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Class (liftEffect)
import Effect.Exception.Unsafe (unsafeThrow)
import Effect.Exception.Unsafe (unsafeThrow)
import Foreign as F
import Foreign.Object as FO
import Foreign.Object as FO
import FFI.Simple.Functions (delay)
import FFI.Simple.Functions (delay)
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as H
import Record as Record
import Partial (crashWith)
import Partial (crashWith)
import Partial.Unsafe (unsafePartial)
import Partial.Unsafe (unsafePartial)
import Simple.JSON as JSON
import Toestand as T
import Toestand as T
import Gargantext.Prelude
import Gargantext.Prelude
...
@@ -158,19 +161,10 @@ newtype Versioned a = Versioned
...
@@ -158,19 +161,10 @@ newtype Versioned a = Versioned
, data :: a
, data :: a
}
}
derive instance Generic (Versioned a) _
derive instance Generic (Versioned a) _
instance Eq a => Eq (Versioned a) where
derive instance Newtype (Versioned a) _
eq = genericEq
instance Eq a => Eq (Versioned a) where eq = genericEq
instance EncodeJson a => EncodeJson (Versioned a) where
derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (Versioned a)
encodeJson (Versioned {version, data: data_})
derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (Versioned a)
= "version" := version
~> "data" := data_
~> jsonEmptyObject
instance DecodeJson a => DecodeJson (Versioned a) where
decodeJson json = do
obj <- decodeJson json
version <- obj .: "version"
data_ <- obj .: "data"
pure $ Versioned {version, data: data_}
------------------------------------------------------------------------
------------------------------------------------------------------------
type Count = Int
type Count = Int
...
@@ -180,22 +174,10 @@ newtype VersionedWithCount a = VersionedWithCount
...
@@ -180,22 +174,10 @@ newtype VersionedWithCount a = VersionedWithCount
, data :: a
, data :: a
}
}
derive instance Generic (VersionedWithCount a) _
derive instance Generic (VersionedWithCount a) _
instance Eq a => Eq (VersionedWithCount a) where
derive instance Newtype (VersionedWithCount a) _
eq = genericEq
instance Eq a => Eq (VersionedWithCount a) where eq = genericEq
instance EncodeJson a => EncodeJson (VersionedWithCount a) where
derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (VersionedWithCount a)
encodeJson (VersionedWithCount {count, version, data: data_})
derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (VersionedWithCount a)
= "version" := version
~> "count" := count
~> "data" := data_
~> jsonEmptyObject
instance DecodeJson a => DecodeJson (VersionedWithCount a) where
decodeJson json = do
obj <- decodeJson json
count <- obj .: "count"
data_ <- obj .: "data"
version <- obj .: "version"
pure $ VersionedWithCount {count, version, data: data_}
toVersioned :: forall a. VersionedWithCount a -> Tuple Count (Versioned a)
toVersioned :: forall a. VersionedWithCount a -> Tuple Count (Versioned a)
toVersioned (VersionedWithCount { count, data: d, version }) = Tuple count $ Versioned { data: d, version }
toVersioned (VersionedWithCount { count, data: d, version }) = Tuple count $ Versioned { data: d, version }
...
@@ -206,6 +188,20 @@ type NgramsTablePatch = { ngramsPatches :: NgramsPatches }
...
@@ -206,6 +188,20 @@ type NgramsTablePatch = { ngramsPatches :: NgramsPatches }
newtype PatchMap k p = PatchMap (Map k p)
newtype PatchMap k p = PatchMap (Map k p)
derive instance Generic (PatchMap k p) _
derive instance Newtype (PatchMap k p) _
derive instance (Eq k, Eq p) => Eq (PatchMap k p)
-- TODO generalize
instance JSON.WriteForeign p => JSON.WriteForeign (PatchMap NgramsTerm p) where
writeImpl (PatchMap m) =
JSON.writeImpl $ FO.fromFoldable $ map (lmap ngramsTermText) (Map.toUnfoldable m :: Array _)
instance (JSON.ReadForeign p, Monoid p) => JSON.ReadForeign (PatchMap NgramsTerm p) where
readImpl f = do
inst <- JSON.readImpl f
pure $ PatchMap $ foldlWithIndex (\k m v -> Map.insert (NormNgramsTerm k) v m) Map.empty (inst :: FO.Object p)
-- TODO we assume that the ngrams are already normalized ^^^^^^^^^^^^^
type NgramsPatches = PatchMap NgramsTerm NgramsPatch
type NgramsPatches = PatchMap NgramsTerm NgramsPatch
data NgramsPatch
data NgramsPatch
...
@@ -217,25 +213,46 @@ data NgramsPatch
...
@@ -217,25 +213,46 @@ data NgramsPatch
{ patch_children :: PatchSet NgramsTerm
{ patch_children :: PatchSet NgramsTerm
, patch_list :: Replace TermList
, patch_list :: Replace TermList
}
}
derive instance Generic NgramsPatch _
derive instance Eq NgramsPatch
instance Monoid NgramsPatch where
mempty = NgramsPatch { patch_children: mempty, patch_list: mempty }
instance Semigroup NgramsPatch where
append (NgramsReplace p) (NgramsReplace q)
| p.patch_old /= q.patch_new = unsafeThrow "append/NgramsPatch: old != new"
| otherwise = ngramsReplace q.patch_old p.patch_new
append (NgramsPatch p) (NgramsPatch q) = NgramsPatch
{ patch_children: p.patch_children <> q.patch_children
, patch_list: p.patch_list <> q.patch_list
}
append (NgramsPatch p) (NgramsReplace q) = ngramsReplace q.patch_old (q.patch_new # _Just <<< _Newtype %~ applyNgramsPatch' p)
append (NgramsReplace p) (NgramsPatch q) = ngramsReplace (p.patch_old # _Just <<< _Newtype %~ applyNgramsPatch' (invert q)) p.patch_new
instance JSON.WriteForeign NgramsPatch where
writeImpl (NgramsReplace { patch_old, patch_new }) = JSON.writeImpl { patch_old, patch_new }
writeImpl (NgramsPatch { patch_children, patch_list }) = JSON.writeImpl { patch_children, patch_list }
instance JSON.ReadForeign NgramsPatch where
readImpl f = do
inst :: { patch_old :: Maybe NgramsRepoElement
, patch_new :: Maybe NgramsRepoElement
, patch_children :: PatchSet NgramsTerm
, patch_list :: Replace TermList } <- JSON.readImpl f
-- TODO handle empty fields
-- TODO handle patch_new
if isJust inst.patch_new || isJust inst.patch_old then
pure $ NgramsReplace { patch_old: inst.patch_old, patch_new: inst.patch_new }
else do
pure $ NgramsPatch { patch_list: inst.patch_list, patch_children: inst.patch_children }
------------------------------------------------------------------------
------------------------------------------------------------------------
newtype NgramsTerm = NormNgramsTerm String
newtype NgramsTerm = NormNgramsTerm String
derive instance Generic NgramsTerm _
derive instance Generic NgramsTerm _
instance Eq NgramsTerm where
derive instance Newtype NgramsTerm _
eq = genericEq
instance Eq NgramsTerm where eq = genericEq
instance Ord NgramsTerm where
instance Ord NgramsTerm where compare = genericCompare
compare = genericCompare
instance Show NgramsTerm where show = genericShow
instance Show NgramsTerm where
derive newtype instance JSON.ReadForeign NgramsTerm
show = genericShow
derive newtype instance JSON.WriteForeign NgramsTerm
derive newtype instance Monoid NgramsTerm
instance EncodeJson NgramsTerm where
encodeJson (NormNgramsTerm s) = encodeJson s
-- TODO we assume that the ngrams are already normalized.
instance DecodeJson NgramsTerm where
decodeJson = map NormNgramsTerm <<< decodeJson
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -331,8 +348,7 @@ _ngrams_scores = prop (SProxy :: SProxy "ngrams_scores")
...
@@ -331,8 +348,7 @@ _ngrams_scores = prop (SProxy :: SProxy "ngrams_scores")
derive instance Newtype NgramsElement _
derive instance Newtype NgramsElement _
derive instance Generic NgramsElement _
derive instance Generic NgramsElement _
instance Show NgramsElement where
instance Show NgramsElement where show = genericShow
show = genericShow
_NgramsElement :: Iso' NgramsElement {
_NgramsElement :: Iso' NgramsElement {
children :: Set NgramsTerm
children :: Set NgramsTerm
...
@@ -345,65 +361,40 @@ _NgramsElement :: Iso' NgramsElement {
...
@@ -345,65 +361,40 @@ _NgramsElement :: Iso' NgramsElement {
}
}
_NgramsElement = _Newtype
_NgramsElement = _Newtype
instance DecodeJson NgramsElement where
instance JSON.ReadForeign NgramsElement where
decodeJson json = do
readImpl f = do
obj <- decodeJson json
inst :: { children :: Array NgramsTerm
ngrams <- obj .: "ngrams"
, size :: Int
size <- obj .: "size"
, list :: TermList
list <- obj .: "list"
, ngrams :: NgramsTerm
occurrences <- obj .: "occurrences"
, occurrences :: Int
parent <- obj .:? "parent"
, parent :: Maybe NgramsTerm
root <- obj .:? "root"
, root :: Maybe NgramsTerm }<- JSON.readImpl f
children' <- obj .: "children"
pure $ NgramsElement $ inst { children = Set.fromFoldable inst.children }
let children = Set.fromFoldable (children' :: Array NgramsTerm)
instance JSON.WriteForeign NgramsElement where
pure $ NgramsElement {ngrams, size, list, occurrences, parent, root, children}
writeImpl (NgramsElement ne) =
JSON.writeImpl $ ne { children = Set.toUnfoldable ne.children :: Array _ }
instance EncodeJson NgramsElement where
encodeJson (NgramsElement { children, list, ngrams, occurrences, parent, root }) =
type NgramsRepoElementT =
"children" := children
( size :: Int
~> "list" := list
~> "ngrams" := ngrams
~> "occurrences" := occurrences
~> "parent" :=? parent
~>? "root" :=? root
~>? jsonEmptyObject
newtype NgramsRepoElement = NgramsRepoElement
{ size :: Int
, list :: TermList
, list :: TermList
, root :: Maybe NgramsTerm
, root :: Maybe NgramsTerm
, parent :: Maybe NgramsTerm
, parent :: Maybe NgramsTerm
, children :: Set NgramsTerm
)
-- , occurrences :: Int -- TODO
newtype NgramsRepoElement = NgramsRepoElement
}
{ children :: Set NgramsTerm
| NgramsRepoElementT }
derive instance Eq NgramsRepoElement
instance DecodeJson NgramsRepoElement where
decodeJson json = do
obj <- decodeJson json
size <- obj .: "size"
list <- obj .: "list"
parent <- obj .:? "parent"
root <- obj .:? "root"
children' <- obj .: "children"
let children = Set.fromFoldable (children' :: Array NgramsTerm)
pure $ NgramsRepoElement {size, list, parent, root, children}
instance EncodeJson NgramsRepoElement where
encodeJson (NgramsRepoElement { size, list, root, parent, children {-occurrences-} })
= "size" := size
~> "list" := list
~> "root" :=? root
~>? "parent" :=? parent
~>? "children" := children
-- ~> "occurrences" := occurrences
~> jsonEmptyObject
derive instance Newtype NgramsRepoElement _
derive instance Generic NgramsRepoElement _
derive instance Generic NgramsRepoElement _
instance Show NgramsRepoElement where
derive instance Newtype NgramsRepoElement _
show = genericShow
derive instance Eq NgramsRepoElement
instance JSON.ReadForeign NgramsRepoElement where
readImpl f = do
inst :: { children :: Array NgramsTerm | NgramsRepoElementT } <- JSON.readImpl f
pure $ NgramsRepoElement $ inst { children = Set.fromFoldable inst.children }
instance JSON.WriteForeign NgramsRepoElement where
writeImpl (NgramsRepoElement nre) =
JSON.writeImpl $ nre { children = Set.toUnfoldable nre.children :: Array _ }
instance Show NgramsRepoElement where show = genericShow
_NgramsRepoElement :: Iso' NgramsRepoElement {
_NgramsRepoElement :: Iso' NgramsRepoElement {
children :: Set NgramsTerm
children :: Set NgramsTerm
...
@@ -447,10 +438,8 @@ newtype NgramsTable = NgramsTable
...
@@ -447,10 +438,8 @@ newtype NgramsTable = NgramsTable
derive instance Newtype NgramsTable _
derive instance Newtype NgramsTable _
derive instance Generic NgramsTable _
derive instance Generic NgramsTable _
instance Eq NgramsTable where
instance Eq NgramsTable where eq = genericEq
eq = genericEq
instance Show NgramsTable where show = genericShow
instance Show NgramsTable where
show = genericShow
_NgramsTable :: Iso' NgramsTable
_NgramsTable :: Iso' NgramsTable
{ ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement
{ ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement
...
@@ -464,12 +453,12 @@ instance Index NgramsTable NgramsTerm NgramsRepoElement where
...
@@ -464,12 +453,12 @@ instance Index NgramsTable NgramsTerm NgramsRepoElement where
instance At NgramsTable NgramsTerm NgramsRepoElement where
instance At NgramsTable NgramsTerm NgramsRepoElement where
at k = _NgramsTable <<< _ngrams_repo_elements <<< at k
at k = _NgramsTable <<< _ngrams_repo_elements <<< at k
instance
DecodeJso
n NgramsTable where
instance
JSON.ReadForeig
n NgramsTable where
decodeJson json
= do
readImpl ff
= do
elements <- decodeJson json
inst <- JSON.readImpl ff
pure $ NgramsTable
pure $ NgramsTable
{ ngrams_repo_elements: Map.fromFoldable $ f <$> (
elements
:: Array NgramsElement)
{ ngrams_repo_elements: Map.fromFoldable $ f <$> (
inst
:: Array NgramsElement)
, ngrams_scores: Map.fromFoldable $ g <$>
elements
, ngrams_scores: Map.fromFoldable $ g <$>
inst
}
}
where
where
f (NgramsElement {ngrams, size, list, root, parent, children}) =
f (NgramsElement {ngrams, size, list, root, parent, children}) =
...
@@ -580,6 +569,8 @@ data Replace a
...
@@ -580,6 +569,8 @@ data Replace a
= Keep
= Keep
| Replace { old :: a, new :: a }
| Replace { old :: a, new :: a }
derive instance Generic (Replace a) _
replace :: forall a. Eq a => a -> a -> Replace a
replace :: forall a. Eq a => a -> a -> Replace a
replace old new
replace old new
| old == new = Keep
| old == new = Keep
...
@@ -593,8 +584,7 @@ instance Eq a => Semigroup (Replace a) where
...
@@ -593,8 +584,7 @@ instance Eq a => Semigroup (Replace a) where
append (Replace { old }) (Replace { new }) | old /= new = unsafeThrow "old != new"
append (Replace { old }) (Replace { new }) | old /= new = unsafeThrow "old != new"
append (Replace { new }) (Replace { old }) = replace old new
append (Replace { new }) (Replace { old }) = replace old new
instance Eq a => Monoid (Replace a) where
instance Eq a => Monoid (Replace a) where mempty = Keep
mempty = Keep
applyReplace :: forall a. Eq a => Replace a -> a -> a
applyReplace :: forall a. Eq a => Replace a -> a -> a
applyReplace Keep a = a
applyReplace Keep a = a
...
@@ -602,25 +592,16 @@ applyReplace (Replace { old, new }) a
...
@@ -602,25 +592,16 @@ applyReplace (Replace { old, new }) a
| a == old = new
| a == old = new
| otherwise = a
| otherwise = a
instance EncodeJson a => EncodeJson (Replace a) where
instance JSON.WriteForeign a => JSON.WriteForeign (Replace a) where
encodeJson Keep
writeImpl Keep = JSON.writeImpl { tag: "Keep" }
= "tag" := "Keep"
writeImpl (Replace {old, new}) = JSON.writeImpl { old, new, tag: "Replace" }
~> jsonEmptyObject
instance (JSON.ReadForeign a, Eq a) => JSON.ReadForeign (Replace a) where
encodeJson (Replace {old, new})
readImpl f = do
= "old" := old
impl :: { old :: Maybe a, new :: Maybe a } <- JSON.readImpl f
~> "new" := new
case Tuple impl.old impl.new of
~> "tag" := "Replace"
~> jsonEmptyObject
instance (DecodeJson a, Eq a) => DecodeJson (Replace a) where
decodeJson json = do
obj <- decodeJson json
mold <- obj .:! "old"
mnew <- obj .:! "new"
case Tuple mold mnew of
Tuple (Just old) (Just new) -> pure $ replace old new
Tuple (Just old) (Just new) -> pure $ replace old new
Tuple Nothing Nothing -> pure Keep
Tuple Nothing Nothing -> pure Keep
_ ->
Left $ TypeMismatch
"decodeJsonReplace"
_ ->
F.fail $ F.ForeignError
"decodeJsonReplace"
-- Representing a PatchSet as `Map a Boolean` would have the advantage
-- Representing a PatchSet as `Map a Boolean` would have the advantage
-- of enforcing rem and add to be disjoint.
-- of enforcing rem and add to be disjoint.
...
@@ -629,6 +610,9 @@ newtype PatchSet a = PatchSet
...
@@ -629,6 +610,9 @@ newtype PatchSet a = PatchSet
, add :: Set a
, add :: Set a
}
}
derive instance Generic (PatchSet a) _
derive instance Newtype (PatchSet a) _
instance Ord a => Semigroup (PatchSet a) where
instance Ord a => Semigroup (PatchSet a) where
append (PatchSet p) (PatchSet q) = PatchSet
append (PatchSet p) (PatchSet q) = PatchSet
{ rem: q.rem <> p.rem
{ rem: q.rem <> p.rem
...
@@ -638,19 +622,16 @@ instance Ord a => Semigroup (PatchSet a) where
...
@@ -638,19 +622,16 @@ instance Ord a => Semigroup (PatchSet a) where
instance Ord a => Monoid (PatchSet a) where
instance Ord a => Monoid (PatchSet a) where
mempty = PatchSet { rem: Set.empty, add: Set.empty }
mempty = PatchSet { rem: Set.empty, add: Set.empty }
instance EncodeJson a => EncodeJson (PatchSet a) where
instance JSON.WriteForeign a => JSON.WriteForeign (PatchSet a) where
encodeJson (PatchSet {rem, add})
writeImpl (PatchSet {rem, add}) = JSON.writeImpl { rem: (Set.toUnfoldable rem :: Array a)
-- TODO only include non empty fields
, add: (Set.toUnfoldable add :: Array a) }
= "rem" := (Set.toUnfoldable rem :: Array a)
~> "add" := (Set.toUnfoldable add :: Array a)
~> jsonEmptyObject
instance (Ord a,
DecodeJson a) => DecodeJso
n (PatchSet a) where
instance (Ord a,
JSON.ReadForeign a) => JSON.ReadForeig
n (PatchSet a) where
decodeJson json
= do
readImpl f
= do
-- TODO handle empty fields
-- TODO handle empty fields
obj <- decodeJson json
inst :: { rem :: Array a, add :: Array a } <- JSON.readImpl f
rem <- mkSet <$> (obj .: "rem")
let rem = mkSet inst.rem
add <- mkSet <$> (obj .: "add")
add = mkSet inst.add
pure $ PatchSet { rem, add }
pure $ PatchSet { rem, add }
where
where
mkSet :: forall b. Ord b => Array b -> Set b
mkSet :: forall b. Ord b => Array b -> Set b
...
@@ -668,55 +649,14 @@ patchSetFromMap m = PatchSet { rem: Map.keys (Map.filter not m)
...
@@ -668,55 +649,14 @@ patchSetFromMap m = PatchSet { rem: Map.keys (Map.filter not m)
ngramsReplace :: Maybe NgramsRepoElement -> Maybe NgramsRepoElement -> NgramsPatch
ngramsReplace :: Maybe NgramsRepoElement -> Maybe NgramsRepoElement -> NgramsPatch
ngramsReplace patch_old patch_new = NgramsReplace {patch_old, patch_new}
ngramsReplace patch_old patch_new = NgramsReplace {patch_old, patch_new}
derive instance Eq NgramsPatch
derive instance Eq (PatchSet NgramsTerm)
derive instance Eq (PatchSet NgramsTerm)
instance Semigroup NgramsPatch where
append (NgramsReplace p) (NgramsReplace q)
| p.patch_old /= q.patch_new = unsafeThrow "append/NgramsPatch: old != new"
| otherwise = ngramsReplace q.patch_old p.patch_new
append (NgramsPatch p) (NgramsPatch q) = NgramsPatch
{ patch_children: p.patch_children <> q.patch_children
, patch_list: p.patch_list <> q.patch_list
}
append (NgramsPatch p) (NgramsReplace q) = ngramsReplace q.patch_old (q.patch_new # _Just <<< _Newtype %~ applyNgramsPatch' p)
append (NgramsReplace p) (NgramsPatch q) = ngramsReplace (p.patch_old # _Just <<< _Newtype %~ applyNgramsPatch' (invert q)) p.patch_new
-- TODO
-- TODO
invert :: forall a. a -> a
invert :: forall a. a -> a
invert _ = unsafeThrow "invert: TODO"
invert _ = unsafeThrow "invert: TODO"
instance Monoid NgramsPatch where
mempty = NgramsPatch { patch_children: mempty, patch_list: mempty }
instance EncodeJson NgramsPatch where
encodeJson (NgramsReplace { patch_old, patch_new })
= "patch_old" := patch_old
~> "patch_new" := patch_new
~> jsonEmptyObject
encodeJson (NgramsPatch { patch_children, patch_list })
-- TODO only include non empty fields
= "patch_children" := patch_children
~> "patch_list" := patch_list
~> jsonEmptyObject
instance DecodeJson NgramsPatch where
decodeJson json = do
obj <- decodeJson json
-- TODO handle empty fields
-- TODO handle patch_new
patch_new <- obj .:? "patch_new"
patch_old <- obj .:? "patch_old"
if isJust patch_new || isJust patch_old then
pure $ NgramsReplace { patch_old, patch_new }
else do
patch_list <- obj .: "patch_list"
patch_children <- obj .: "patch_children"
pure $ NgramsPatch { patch_list, patch_children }
applyNgramsPatch' :: forall row.
applyNgramsPatch' :: forall row.
{ patch_children :: PatchSet NgramsTerm
{ patch_children :: PatchSet NgramsTerm
, patch_list :: Replace TermList
, patch_list :: Replace TermList
...
@@ -744,9 +684,6 @@ instance (Ord k, Eq p, Monoid p) => Semigroup (PatchMap k p) where
...
@@ -744,9 +684,6 @@ instance (Ord k, Eq p, Monoid p) => Semigroup (PatchMap k p) where
instance (Ord k, Eq p, Monoid p) => Monoid (PatchMap k p) where
instance (Ord k, Eq p, Monoid p) => Monoid (PatchMap k p) where
mempty = PatchMap Map.empty
mempty = PatchMap Map.empty
derive instance Newtype (PatchMap k p) _
derive instance (Eq k, Eq p) => Eq (PatchMap k p)
_PatchMap :: forall k p. Iso' (PatchMap k p) (Map k p)
_PatchMap :: forall k p. Iso' (PatchMap k p) (Map k p)
_PatchMap = _Newtype
_PatchMap = _Newtype
...
@@ -783,17 +720,6 @@ traversePatchMapWithIndex :: forall f a b k.
...
@@ -783,17 +720,6 @@ traversePatchMapWithIndex :: forall f a b k.
(k -> a -> f b) -> PatchMap k a -> f (PatchMap k b)
(k -> a -> f b) -> PatchMap k a -> f (PatchMap k b)
traversePatchMapWithIndex f (PatchMap m) = fromMap <$> traverseWithIndex f m
traversePatchMapWithIndex f (PatchMap m) = fromMap <$> traverseWithIndex f m
-- TODO generalize
instance EncodeJson p => EncodeJson (PatchMap NgramsTerm p) where
encodeJson (PatchMap m) =
encodeJson $ FO.fromFoldable $ map (lmap ngramsTermText) (Map.toUnfoldable m :: Array _)
instance DecodeJson p => DecodeJson (PatchMap NgramsTerm p) where
decodeJson json = do
obj <- decodeJson json
pure $ PatchMap $ foldlWithIndex (\k m v -> Map.insert (NormNgramsTerm k) v m) mempty (obj :: FO.Object p)
-- TODO we assume that the ngrams are already normalized ^^^^^^^^^^^^^
singletonPatchMap :: forall k p. k -> p -> PatchMap k p
singletonPatchMap :: forall k p. k -> p -> PatchMap k p
singletonPatchMap k p = PatchMap (Map.singleton k p)
singletonPatchMap k p = PatchMap (Map.singleton k p)
...
@@ -825,11 +751,11 @@ newtype AsyncNgramsChartsUpdate = AsyncNgramsChartsUpdate {
...
@@ -825,11 +751,11 @@ newtype AsyncNgramsChartsUpdate = AsyncNgramsChartsUpdate {
listId :: Maybe ListId
listId :: Maybe ListId
, tabType :: TabType
, tabType :: TabType
}
}
instance EncodeJson AsyncNgramsChartsUpdate where
derive instance Generic AsyncNgramsChartsUpdate _
encodeJson (AsyncNgramsChartsUpdate { listId, tabType }) = do
derive instance Newtype AsyncNgramsChartsUpdate _
"list_id" := listId
instance JSON.WriteForeign AsyncNgramsChartsUpdate where
~> "tab_type" := tabType
writeImpl (AsyncNgramsChartsUpdate { listId, tabType }) =
~> jsonEmptyObject
JSON.writeImpl { list_id: listId, tab_type: tabType }
type NewElems = Map NgramsTerm TermList
type NewElems = Map NgramsTerm TermList
...
...
src/Gargantext/Components/NgramsTable/Loader.purs
View file @
81e21c97
module Gargantext.Components.NgramsTable.Loader where
module Gargantext.Components.NgramsTable.Loader where
import Data.Argonaut (class DecodeJson)
import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Tuple (fst)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Data.Tuple.Nested ((/\))
...
@@ -8,6 +7,7 @@ import Effect.Aff (Aff, launchAff_, throwError)
...
@@ -8,6 +7,7 @@ import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Effect.Exception (error)
import Reactix as R
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
import Toestand as T
import Gargantext.Prelude
import Gargantext.Prelude
...
@@ -34,7 +34,7 @@ type LoaderWithCacheAPIProps path res ret = (
...
@@ -34,7 +34,7 @@ type LoaderWithCacheAPIProps path res ret = (
)
)
useLoaderWithCacheAPI :: forall path res ret. Eq path =>
DecodeJso
n res => Eq ret =>
useLoaderWithCacheAPI :: forall path res ret. Eq path =>
JSON.ReadForeig
n res => Eq ret =>
Record (LoaderWithCacheAPIProps path res ret)
Record (LoaderWithCacheAPIProps path res ret)
-> R.Hooks R.Element
-> R.Hooks R.Element
useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer } = do
useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer } = do
...
@@ -56,7 +56,7 @@ type LoaderWithCacheAPIEffectProps path res ret = (
...
@@ -56,7 +56,7 @@ type LoaderWithCacheAPIEffectProps path res ret = (
, state :: T.Box (Maybe ret)
, state :: T.Box (Maybe ret)
)
)
useCachedAPILoaderEffect :: forall path res ret. Eq path =>
DecodeJso
n res => Eq ret =>
useCachedAPILoaderEffect :: forall path res ret. Eq path =>
JSON.ReadForeig
n res => Eq ret =>
Record (LoaderWithCacheAPIEffectProps path res ret)
Record (LoaderWithCacheAPIEffectProps path res ret)
-> R.Hooks Unit
-> R.Hooks Unit
useCachedAPILoaderEffect { cacheEndpoint
useCachedAPILoaderEffect { cacheEndpoint
...
...
src/Gargantext/Components/Node.purs
View file @
81e21c97
module Gargantext.Components.Node
module Gargantext.Components.Node
where
where
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?), (.!=))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Eq.Generic (genericEq)
import Data.Newtype (class Newtype)
import Simple.JSON as JSON
import Gargantext.Prelude
import Gargantext.Prelude
type NodePolyCommon a =
( id :: Int
, typename :: Int
, name :: String
, date :: String
, hyperdata :: a )
newtype NodePoly a =
newtype NodePoly a =
NodePoly { id :: Int
NodePoly { userId :: Int
, typename :: Int
, userId :: Int
, parentId :: Int
, parentId :: Int
, name :: String
| NodePolyCommon a
, date :: String
, hyperdata :: a
}
}
derive instance Generic (NodePoly a) _
derive instance Generic (NodePoly a) _
instance Eq a => Eq (NodePoly a) where
derive instance Newtype (NodePoly a) _
eq = genericEq
instance Eq a => Eq (NodePoly a) where eq = genericEq
instance (DecodeJson a)
instance JSON.ReadForeign a => JSON.ReadForeign (NodePoly a) where
=> DecodeJson (NodePoly a) where
readImpl f = do
decodeJson json = do
inst :: { user_id :: Int, parent_id :: Int | NodePolyCommon a } <- JSON.readImpl f
obj <- decodeJson json
pure $ NodePoly { id: inst.id
id <- obj .: "id"
, typename: inst.typename
typename <- obj .: "typename"
, userId: inst.user_id
userId <- obj .: "user_id"
, parentId: inst.parent_id
parentId <- obj .: "parent_id"
, name: inst.name
name <- obj .: "name"
, date: inst.date
date <- obj .: "date"
, hyperdata: inst.hyperdata }
hyperdata <- obj .: "hyperdata"
hyperdata' <- decodeJson hyperdata
pure $ NodePoly { id
, date
, hyperdata: hyperdata'
, name
, parentId
, typename
, userId
}
newtype HyperdataList = HyperdataList { preferences :: String }
newtype HyperdataList = HyperdataList { preferences :: String }
derive instance Generic HyperdataList _
instance DecodeJson HyperdataList where
derive instance Newtype HyperdataList _
decodeJson json = do
derive newtype instance JSON.ReadForeign HyperdataList
obj <- decodeJson json
pref <- obj .:? "preferences" .!= ""
pure $ HyperdataList { preferences : pref }
src/Gargantext/Components/Nodes/Annuaire.purs
View file @
81e21c97
...
@@ -2,17 +2,18 @@ module Gargantext.Components.Nodes.Annuaire
...
@@ -2,17 +2,18 @@ module Gargantext.Components.Nodes.Annuaire
-- ( annuaire )
-- ( annuaire )
where
where
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Array as A
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Newtype (class Newtype)
import Data.Sequence as Seq
import Data.Sequence as Seq
import Data.Tuple (fst, snd)
import Data.Symbol (SProxy(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff_)
import Effect.Aff (Aff, launchAff_)
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as H
import Record as Record
import Simple.JSON as JSON
import Toestand as T
import Toestand as T
import Gargantext.Prelude
import Gargantext.Prelude
...
@@ -20,8 +21,8 @@ import Gargantext.Prelude
...
@@ -20,8 +21,8 @@ import Gargantext.Prelude
import Gargantext.Components.NgramsTable.Loader (clearCache)
import Gargantext.Components.NgramsTable.Loader (clearCache)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types as CT
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types as CT
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Table as TT
import Gargantext.Components.Table
(defaultContainer, initialParams, makeRow, table, tableHeaderLayout)
as TT
import Gargantext.Components.Table.Types as TT
import Gargantext.Components.Table.Types
(ColumnName(..), Params)
as TT
import Gargantext.Ends (url, Frontends)
import Gargantext.Ends (url, Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Routes (SessionRoute(..))
...
@@ -236,18 +237,13 @@ contactCellsCpt = here.component "contactCells" cpt where
...
@@ -236,18 +237,13 @@ contactCellsCpt = here.component "contactCells" cpt where
contactWhereRole (CT.ContactWhere { role: Nothing }) = "Empty Role"
contactWhereRole (CT.ContactWhere { role: Nothing }) = "Empty Role"
contactWhereRole (CT.ContactWhere { role: Just role }) = role
contactWhereRole (CT.ContactWhere { role: Just role }) = role
data
HyperdataAnnuaire = HyperdataAnnuaire
newtype
HyperdataAnnuaire = HyperdataAnnuaire
{ title :: Maybe String
{ title :: Maybe String
, desc :: Maybe String }
, desc :: Maybe String }
derive instance Generic HyperdataAnnuaire _
derive instance Generic HyperdataAnnuaire _
instance Eq HyperdataAnnuaire where
derive instance Newtype HyperdataAnnuaire _
eq = genericEq
instance Eq HyperdataAnnuaire where eq = genericEq
instance DecodeJson HyperdataAnnuaire where
derive newtype instance JSON.ReadForeign HyperdataAnnuaire
decodeJson json = do
obj <- decodeJson json
title <- obj .:? "title"
desc <- obj .:? "desc"
pure $ HyperdataAnnuaire { title, desc }
------------------------------------------------------------------------------
------------------------------------------------------------------------------
newtype AnnuaireInfo =
newtype AnnuaireInfo =
...
@@ -261,27 +257,17 @@ newtype AnnuaireInfo =
...
@@ -261,27 +257,17 @@ newtype AnnuaireInfo =
, hyperdata :: HyperdataAnnuaire
, hyperdata :: HyperdataAnnuaire
}
}
derive instance Generic AnnuaireInfo _
derive instance Generic AnnuaireInfo _
instance Eq AnnuaireInfo where
derive instance Newtype AnnuaireInfo _
eq = genericEq
instance Eq AnnuaireInfo where eq = genericEq
instance DecodeJson AnnuaireInfo where
instance JSON.ReadForeign AnnuaireInfo where
decodeJson json = do
readImpl f = do
obj <- decodeJson json
inst <- JSON.readImpl f
id <- obj .: "id"
pure $ AnnuaireInfo $ Record.rename user_idP userIdP $ Record.rename parent_idP parentIdP inst
typename <- obj .: "typename"
where
userId <- obj .: "user_id"
user_idP = SProxy :: SProxy "user_id"
parentId <- obj .: "parent_id"
userIdP = SProxy :: SProxy "userId"
name <- obj .: "name"
parent_idP = SProxy :: SProxy "parent_id"
date <- obj .: "date"
parentIdP = SProxy :: SProxy "parentId"
hyperdata <- obj .: "hyperdata"
pure $ AnnuaireInfo
{ id : id
, typename : typename
, userId : userId
, parentId : parentId
, name : name
, date : date
, hyperdata: hyperdata
}
--newtype AnnuaireTable = AnnuaireTable { annuaireTable :: Array (Maybe Contact)}
--newtype AnnuaireTable = AnnuaireTable { annuaireTable :: Array (Maybe Contact)}
...
...
src/Gargantext/Components/Nodes/Annuaire/User/Contacts/Types.purs
View file @
81e21c97
module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where
module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (.:!), (.:?), (:=), (~>), jsonEmptyObject)
import Data.Array as A
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Eq.Generic (genericEq)
import Data.Lens
import Data.Lens
(Lens', lens)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype (class Newtype)
import Data.Newtype (class Newtype)
import Data.String as S
import Data.String as S
import Data.Symbol (SProxy(..))
import Record as Record
import Simple.JSON as JSON
import Gargantext.Prelude
import Gargantext.Prelude
(class Eq, bind, pure, ($))
import Gargantext.Utils.DecodeMaybe ((.?|))
-- TODO: should it be a NodePoly HyperdataContact ?
-- TODO: should it be a NodePoly HyperdataContact ?
newtype NodeContact =
newtype NodeContact =
...
@@ -25,29 +26,13 @@ newtype NodeContact =
...
@@ -25,29 +26,13 @@ newtype NodeContact =
, userId :: Maybe Int
, userId :: Maybe Int
}
}
derive instance Generic NodeContact _
derive instance Generic NodeContact _
instance Eq NodeContact where
eq = genericEq
instance DecodeJson NodeContact where
decodeJson json = do
obj <- decodeJson json
date <- obj .?| "date"
hyperdata <- obj .: "hyperdata"
id <- obj .: "id"
name <- obj .:! "name"
parentId <- obj .?| "parent_id"
typename <- obj .?| "typename"
userId <- obj .:! "user_id"
pure $ NodeContact { id
, date
, hyperdata
, name
, parentId
, typename
, userId
}
derive instance Newtype NodeContact _
derive instance Newtype NodeContact _
instance Eq NodeContact where eq = genericEq
instance JSON.ReadForeign NodeContact where
readImpl f = do
inst <- JSON.readImpl f
pure $ NodeContact $ Record.rename parent_idP parentIdP $ Record.rename user_idP userIdP inst
----------------------------------------------------------------------------
----------------------------------------------------------------------------
newtype Contact' =
newtype Contact' =
...
@@ -61,27 +46,12 @@ newtype Contact' =
...
@@ -61,27 +46,12 @@ newtype Contact' =
, userId :: Maybe Int
, userId :: Maybe Int
}
}
derive instance Generic Contact' _
derive instance Generic Contact' _
instance Eq Contact' where
derive instance Newtype Contact' _
eq = genericEq
instance Eq Contact' where eq = genericEq
instance DecodeJson Contact' where
instance JSON.ReadForeign Contact' where
decodeJson json = do
readImpl f = do
obj <- decodeJson json
inst <- JSON.readImpl f
date <- obj .?| "date"
pure $ Contact' $ Record.rename parent_idP parentIdP $ Record.rename user_idP userIdP inst
hyperdata <- obj .: "hyperdata"
id <- obj .: "id"
name <- obj .:! "name"
parentId <- obj .?| "parent_id"
typename <- obj .?| "typename"
userId <- obj .:! "user_id"
pure $ Contact' { id
, date
, hyperdata
, name
, parentId
, typename
, userId
}
-- | TODO rename Contact with User
-- | TODO rename Contact with User
...
@@ -97,27 +67,12 @@ newtype Contact =
...
@@ -97,27 +67,12 @@ newtype Contact =
, userId :: Maybe Int
, userId :: Maybe Int
}
}
derive instance Generic Contact _
derive instance Generic Contact _
instance Eq Contact where
derive instance Newtype Contact _
eq = genericEq
instance Eq Contact where eq = genericEq
instance DecodeJson Contact where
instance JSON.ReadForeign Contact where
decodeJson json = do
readImpl f = do
obj <- decodeJson json
inst <- JSON.readImpl f
date <- obj .?| "date"
pure $ Contact $ Record.rename parent_idP parentIdP $ Record.rename user_idP userIdP inst
hyperdata <- obj .: "hyperdata"
id <- obj .: "id"
name <- obj .:! "name"
parentId <- obj .?| "parent_id"
typename <- obj .?| "typename"
userId <- obj .:! "user_id"
pure $ Contact { id
, date
, hyperdata
, name
, parentId
, typename
, userId
}
----------------------------------------------------------------------------
----------------------------------------------------------------------------
newtype User =
newtype User =
...
@@ -131,27 +86,12 @@ newtype User =
...
@@ -131,27 +86,12 @@ newtype User =
, userId :: Maybe Int
, userId :: Maybe Int
}
}
derive instance Generic User _
instance DecodeJson User where
derive instance Newtype User _
decodeJson json = do
instance JSON.ReadForeign User where
obj <- decodeJson json
readImpl f = do
date <- obj .?| "date"
inst <- JSON.readImpl f
hyperdata <- obj .: "hyperdata"
pure $ User $ Record.rename parent_idP parentIdP $ Record.rename user_idP userIdP inst
id <- obj .: "id"
name <- obj .:! "name"
parentId <- obj .?| "parent_id"
typename <- obj .?| "typename"
userId <- obj .:! "user_id"
pure $ User { id
, date
, hyperdata
, name
, parentId
, typename
, userId
}
newtype ContactWho =
newtype ContactWho =
ContactWho
ContactWho
...
@@ -164,31 +104,14 @@ newtype ContactWho =
...
@@ -164,31 +104,14 @@ newtype ContactWho =
derive instance Newtype ContactWho _
derive instance Newtype ContactWho _
derive instance Generic ContactWho _
derive instance Generic ContactWho _
instance Eq ContactWho where
instance Eq ContactWho where eq = genericEq
eq = genericEq
instance JSON.ReadForeign ContactWho where
instance DecodeJson ContactWho
readImpl f = do
where
inst <- JSON.readImpl f
decodeJson json = do
obj <- decodeJson json
pure $ ContactWho $ inst { keywords = fromMaybe [] inst.keywords
idWho <- obj .:? "id"
, freetags = fromMaybe [] inst.freetags }
firstName <- obj .:? "firstName"
derive newtype instance JSON.WriteForeign ContactWho
lastName <- obj .:? "lastName"
keywords <- obj .:! "keywords"
freetags <- obj .:! "freetags"
let k = fromMaybe [] keywords
let f = fromMaybe [] freetags
pure $ ContactWho {idWho, firstName, lastName, keywords:k, freetags:f}
instance EncodeJson ContactWho
where
encodeJson (ContactWho cw) =
"id" := cw.idWho
~> "firstName" := cw.firstName
~> "lastName" := cw.lastName
~> "keywords" := cw.keywords
~> "freetags" := cw.freetags
~> jsonEmptyObject
defaultContactWho :: ContactWho
defaultContactWho :: ContactWho
defaultContactWho =
defaultContactWho =
...
@@ -218,39 +141,13 @@ newtype ContactWhere =
...
@@ -218,39 +141,13 @@ newtype ContactWhere =
derive instance Newtype ContactWhere _
derive instance Newtype ContactWhere _
derive instance Generic ContactWhere _
derive instance Generic ContactWhere _
instance Eq ContactWhere where
instance Eq ContactWhere where eq = genericEq
eq = genericEq
instance JSON.ReadForeign ContactWhere where
instance DecodeJson ContactWhere
readImpl f = do
where
inst <- JSON.readImpl f
decodeJson json = do
pure $ ContactWhere $ inst { organization = fromMaybe [] inst.organization
obj <- decodeJson json
, labTeamDepts = fromMaybe [] inst.labTeamDepts }
organization <- obj .:! "organization"
derive newtype instance JSON.WriteForeign ContactWhere
labTeamDepts <- obj .:! "labTeamDepts"
role <- obj .:? "role"
office <- obj .:? "office"
country <- obj .:? "country"
city <- obj .:? "city"
touch <- obj .:? "touch"
entry <- obj .:? "entry"
exit <- obj .:? "exit"
let o = fromMaybe [] organization
let l = fromMaybe [] labTeamDepts
pure $ ContactWhere {organization:o, labTeamDepts:l, role, office, country, city, touch, entry, exit}
instance EncodeJson ContactWhere
where
encodeJson (ContactWhere cw) =
"city" := cw.city
~> "country" := cw.country
~> "entry" := cw.entry
~> "exit" := cw.exit
~> "labTeamDepts" := cw.labTeamDepts
~> "office" := cw.office
~> "organization" := cw.organization
~> "role" := cw.role
~> "touch" := cw.touch
~> jsonEmptyObject
defaultContactWhere :: ContactWhere
defaultContactWhere :: ContactWhere
defaultContactWhere =
defaultContactWhere =
...
@@ -274,23 +171,9 @@ newtype ContactTouch =
...
@@ -274,23 +171,9 @@ newtype ContactTouch =
derive instance Newtype ContactTouch _
derive instance Newtype ContactTouch _
derive instance Generic ContactTouch _
derive instance Generic ContactTouch _
instance Eq ContactTouch where
instance Eq ContactTouch where eq = genericEq
eq = genericEq
derive newtype instance JSON.ReadForeign ContactTouch
instance DecodeJson ContactTouch
derive newtype instance JSON.WriteForeign ContactTouch
where
decodeJson json = do
obj <- decodeJson json
mail <- obj .:? "mail"
phone <- obj .:? "phone"
url <- obj .:? "url"
pure $ ContactTouch {mail, phone, url}
instance EncodeJson ContactTouch
where
encodeJson (ContactTouch ct) =
"mail" := ct.mail
~> "phone" := ct.phone
~> "url" := ct.url
~> jsonEmptyObject
defaultContactTouch :: ContactTouch
defaultContactTouch :: ContactTouch
defaultContactTouch =
defaultContactTouch =
...
@@ -301,48 +184,44 @@ defaultContactTouch =
...
@@ -301,48 +184,44 @@ defaultContactTouch =
}
}
type HyperdataContactT =
( bdd :: Maybe String
, lastValidation :: Maybe String
, source :: Maybe String
, title :: Maybe String
, uniqId :: Maybe String
, uniqIdBdd :: Maybe String
, who :: Maybe ContactWho
)
newtype HyperdataContact =
newtype HyperdataContact =
HyperdataContact { bdd :: Maybe String
HyperdataContact { ou :: Array ContactWhere
, lastValidation :: Maybe String
| HyperdataContactT
, ou :: (Array ContactWhere)
}
, source :: Maybe String
, title :: Maybe String
, uniqId :: Maybe String
, uniqIdBdd :: Maybe String
, who :: Maybe ContactWho
}
derive instance Newtype HyperdataContact _
derive instance Newtype HyperdataContact _
derive instance Generic HyperdataContact _
derive instance Generic HyperdataContact _
instance Eq HyperdataContact where
instance Eq HyperdataContact where eq = genericEq
eq = genericEq
instance JSON.ReadForeign HyperdataContact where
instance DecodeJson HyperdataContact
readImpl f = do
inst :: { where :: Maybe (Array ContactWhere) | HyperdataContactT } <- JSON.readImpl f
pure $ HyperdataContact { bdd: inst.bdd
, lastValidation: inst.lastValidation
, ou: fromMaybe [] inst.where
, source: inst.source
, title: inst.title
, uniqId: inst.uniqId
, uniqIdBdd: inst.uniqIdBdd
, who: inst.who }
instance JSON.WriteForeign HyperdataContact
where
where
decodeJson json = do
writeImpl (HyperdataContact hc) = JSON.writeImpl { bdd: hc.bdd
obj <- decodeJson json
, lastValidation: hc.lastValidation
bdd <- obj .:? "bdd"
, where: hc.ou
lastValidation <- obj .:? "lastValidation"
, source: hc.source
ou <- obj .:! "where"
, title: hc.title
source <- obj .:? "source"
, uniqId: hc.uniqId
title <- obj .:? "title"
, uniqIdBdd: hc.uniqIdBdd
uniqId <- obj .:? "uniqId"
, who: hc.who }
uniqIdBdd <- obj .:? "uniqIdBdd"
who <- obj .:! "who"
let ou' = fromMaybe [] ou
pure $ HyperdataContact {bdd, who, ou:ou', title, source, lastValidation, uniqId, uniqIdBdd}
instance EncodeJson HyperdataContact
where
encodeJson (HyperdataContact {bdd, lastValidation, ou, source, title, uniqId, uniqIdBdd, who}) =
"bdd" := bdd
~> "lastValidation" := lastValidation
~> "where" := ou
~> "source" := source
~> "title" := title
~> "uniqId" := uniqId
~> "uniqIdBdd" := uniqIdBdd
~> "who" := who
~> jsonEmptyObject
defaultHyperdataContact :: HyperdataContact
defaultHyperdataContact :: HyperdataContact
defaultHyperdataContact =
defaultHyperdataContact =
...
@@ -362,19 +241,9 @@ newtype HyperdataUser =
...
@@ -362,19 +241,9 @@ newtype HyperdataUser =
}
}
derive instance Newtype HyperdataUser _
derive instance Newtype HyperdataUser _
derive instance Generic HyperdataUser _
derive instance Generic HyperdataUser _
instance Eq HyperdataUser where
instance Eq HyperdataUser where eq = genericEq
eq = genericEq
derive newtype instance JSON.ReadForeign HyperdataUser
instance DecodeJson HyperdataUser
derive newtype instance JSON.WriteForeign HyperdataUser
where
decodeJson json = do
obj <- decodeJson json
shared <- obj .:? "shared"
pure $ HyperdataUser { shared }
instance EncodeJson HyperdataUser
where
encodeJson (HyperdataUser {shared}) =
"shared" := shared
~> jsonEmptyObject
defaultHyperdataUser :: HyperdataUser
defaultHyperdataUser :: HyperdataUser
defaultHyperdataUser =
defaultHyperdataUser =
...
@@ -478,3 +347,8 @@ _phone = lens getter setter
...
@@ -478,3 +347,8 @@ _phone = lens getter setter
where
where
getter (ContactTouch {phone}) = fromMaybe "" phone
getter (ContactTouch {phone}) = fromMaybe "" phone
setter (ContactTouch ct) val = ContactTouch $ ct { phone = Just val }
setter (ContactTouch ct) val = ContactTouch $ ct { phone = Just val }
user_idP = SProxy :: SProxy "user_id"
userIdP = SProxy :: SProxy "userId"
parent_idP = SProxy :: SProxy "parent_id"
parentIdP = SProxy :: SProxy "parentId"
src/Gargantext/Components/Nodes/Corpus.purs
View file @
81e21c97
module Gargantext.Components.Nodes.Corpus where
module Gargantext.Components.Nodes.Corpus where
import DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, decodeJson, encodeJson)
import Data.Argonaut.Parser (jsonParser)
import Data.Array as A
import Data.Array as A
import Data.Either (Either(..))
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep (class Generic)
...
@@ -11,17 +8,23 @@ import Data.Show.Generic (genericShow)
...
@@ -11,17 +8,23 @@ import Data.Show.Generic (genericShow)
import Data.List as List
import Data.List as List
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..))
import Data.Tuple (Tuple(..))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Effect.Exception (error)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Gargantext.AsyncTasks as GAT
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.CodeEditor as CE
import Gargantext.Components.CodeEditor as CE
import Gargantext.Components.FolderView as FV
import Gargantext.Components.FolderView as FV
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Node (NodePoly(..), HyperdataList)
import Gargantext.Components.Node (NodePoly(..), HyperdataList)
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, Hyperdata(..))
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, Hyperdata(..))
import Gargantext.Components.Nodes.Types (FTField, FTField
WithIndex, FTFieldsWithIndex
, Field(..), FieldType(..), Hash, Index, defaultField, defaultHaskell', defaultJSON', defaultMarkdown', defaultPython')
import Gargantext.Components.Nodes.Types (FTField, FTField
List(..), FTFieldWithIndex, FTFieldsWithIndex(..)
, Field(..), FieldType(..), Hash, Index, defaultField, defaultHaskell', defaultJSON', defaultMarkdown', defaultPython')
import Gargantext.Data.Array as GDA
import Gargantext.Data.Array as GDA
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (class Eq, class Show, Unit, bind, discard, pure, show, unit, ($), (+), (-), (<), (<$>), (<<<), (<>), (==), (>))
import Gargantext.Prelude (class Eq, class Show, Unit, bind, discard, pure, show, unit, ($), (+), (-), (<), (<$>), (<<<), (<>), (==), (>))
...
@@ -31,9 +34,6 @@ import Gargantext.Types (AffTableResult, NodeType(..))
...
@@ -31,9 +34,6 @@ import Gargantext.Types (AffTableResult, NodeType(..))
import Gargantext.Utils.Crypto as Crypto
import Gargantext.Utils.Crypto as Crypto
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus"
here = R2.here "Gargantext.Components.Nodes.Corpus"
...
@@ -130,8 +130,8 @@ corpusLayoutView props = R.createElement corpusLayoutViewCpt props []
...
@@ -130,8 +130,8 @@ corpusLayoutView props = R.createElement corpusLayoutViewCpt props []
corpusLayoutViewCpt :: R.Component ViewProps
corpusLayoutViewCpt :: R.Component ViewProps
corpusLayoutViewCpt = here.component "corpusLayoutView" cpt
corpusLayoutViewCpt = here.component "corpusLayoutView" cpt
where
where
cpt {corpus: (NodePoly {hyperdata: Hyperdata {fields}}), nodeId, reload, session} _ = do
cpt {corpus: (NodePoly {hyperdata: Hyperdata {fields
: FTFieldList fields
}}), nodeId, reload, session} _ = do
let fieldsWithIndex =
List.mapWithIndex (\idx -> \t -> Tuple idx t
) fields
let fieldsWithIndex =
FTFieldsWithIndex $ List.mapWithIndex (\idx -> \ftField -> { idx, ftField }
) fields
fieldsS <- T.useBox fieldsWithIndex
fieldsS <- T.useBox fieldsWithIndex
fields' <- T.useLive T.unequal fieldsS
fields' <- T.useLive T.unequal fieldsS
fieldsRef <- R.useRef fields
fieldsRef <- R.useRef fields
...
@@ -171,16 +171,17 @@ corpusLayoutViewCpt = here.component "corpusLayoutView" cpt
...
@@ -171,16 +171,17 @@ corpusLayoutViewCpt = here.component "corpusLayoutView" cpt
, nodeId :: Int
, nodeId :: Int
, reload :: T2.ReloadS
, reload :: T2.ReloadS
, session :: Session } -> e -> Effect Unit
, session :: Session } -> e -> Effect Unit
onClickSave {fields, nodeId, reload, session} _ = do
onClickSave {fields
: FTFieldsWithIndex fields
, nodeId, reload, session} _ = do
launchAff_ do
launchAff_ do
saveCorpus $ { hyperdata: Hyperdata {fields:
(\(Tuple _ f) -> f
) <$> fields}
saveCorpus $ { hyperdata: Hyperdata {fields:
FTFieldList $ (_.ftField
) <$> fields}
, nodeId
, nodeId
, session }
, session }
liftEffect $ T2.reload reload
liftEffect $ T2.reload reload
onClickAdd :: forall e. T.Box FTFieldsWithIndex -> e -> Effect Unit
onClickAdd :: forall e. T.Box FTFieldsWithIndex -> e -> Effect Unit
onClickAdd fieldsS _ = do
onClickAdd fieldsS _ = do
T.modify_ (\fields -> List.snoc fields $ Tuple (List.length fields) defaultField) fieldsS
T.modify_ (\(FTFieldsWithIndex fs) -> FTFieldsWithIndex $
List.snoc fs $ { idx: List.length fs, ftField: defaultField }) fieldsS
type FieldsCodeEditorProps =
type FieldsCodeEditorProps =
...
@@ -191,19 +192,18 @@ type FieldsCodeEditorProps =
...
@@ -191,19 +192,18 @@ type FieldsCodeEditorProps =
fieldsCodeEditor :: R2.Component FieldsCodeEditorProps
fieldsCodeEditor :: R2.Component FieldsCodeEditorProps
fieldsCodeEditor = R.createElement fieldsCodeEditorCpt
fieldsCodeEditor = R.createElement fieldsCodeEditorCpt
fieldsCodeEditorCpt :: R.Component FieldsCodeEditorProps
fieldsCodeEditorCpt :: R.Component FieldsCodeEditorProps
fieldsCodeEditorCpt = here.component "fieldsCodeEditorCpt" cpt
fieldsCodeEditorCpt = here.component "fieldsCodeEditorCpt" cpt
where
where
cpt { fields, nodeId, session } _ = do
cpt { fields, nodeId, session } _ = do
fields'
<- T.useLive T.unequal fields
(FTFieldsWithIndex fields')
<- T.useLive T.unequal fields
masterKey <- T.useBox T2.newReload
masterKey <- T.useBox T2.newReload
masterKey' <- T.useLive T.unequal masterKey
masterKey' <- T.useLive T.unequal masterKey
let editorsMap
(Tuple idx field)
=
let editorsMap
{ idx, ftField }
=
fieldCodeEditorWrapper { canMoveDown: idx < (List.length fields' - 1)
fieldCodeEditorWrapper { canMoveDown: idx < (List.length fields' - 1)
, canMoveUp: idx > 0
, canMoveUp: idx > 0
, field
, field
: ftField
, key: (show masterKey') <> "-" <> (show idx)
, key: (show masterKey') <> "-" <> (show idx)
, onChange: onChange idx
, onChange: onChange idx
, onMoveDown: onMoveDown masterKey idx
, onMoveDown: onMoveDown masterKey idx
...
@@ -216,34 +216,35 @@ fieldsCodeEditorCpt = here.component "fieldsCodeEditorCpt" cpt
...
@@ -216,34 +216,35 @@ fieldsCodeEditorCpt = here.component "fieldsCodeEditorCpt" cpt
where
where
onChange :: Index -> FieldType -> Effect Unit
onChange :: Index -> FieldType -> Effect Unit
onChange idx typ = do
onChange idx typ = do
T.modify_ (\
fs
->
T.modify_ (\
(FTFieldsWithIndex fs)
->
fromMaybe fs $
FTFieldsWithIndex $
fromMaybe fs $
List.modifyAt idx (\
(Tuple _ (Field f)) -> Tuple idx (Field $ f { typ = typ })
) fs) fields
List.modifyAt idx (\
{ ftField: Field f} -> { idx, ftField: Field $ f { typ = typ } }
) fs) fields
onMoveDown :: T2.ReloadS -> Index -> Unit -> Effect Unit
onMoveDown :: T2.ReloadS -> Index -> Unit -> Effect Unit
onMoveDown masterKey idx _ = do
onMoveDown masterKey idx _ = do
T2.reload masterKey
T2.reload masterKey
T.modify_ (
recomputeIndices <<< (GDA.swapList idx (idx + 1))
) fields
T.modify_ (
\(FTFieldsWithIndex fs) -> recomputeIndices $ FTFieldsWithIndex $ GDA.swapList idx (idx + 1) fs
) fields
onMoveUp :: T2.ReloadS -> Index -> Unit -> Effect Unit
onMoveUp :: T2.ReloadS -> Index -> Unit -> Effect Unit
onMoveUp masterKey idx _ = do
onMoveUp masterKey idx _ = do
T2.reload masterKey
T2.reload masterKey
T.modify_ (
recomputeIndices <<< (GDA.swapList idx (idx - 1))
) fields
T.modify_ (
\(FTFieldsWithIndex fs) -> recomputeIndices $ FTFieldsWithIndex $ GDA.swapList idx (idx - 1) fs
) fields
onRemove :: Index -> Unit -> Effect Unit
onRemove :: Index -> Unit -> Effect Unit
onRemove idx _ = do
onRemove idx _ = do
T.modify_ (\
fs ->
fromMaybe fs $ List.deleteAt idx fs) fields
T.modify_ (\
(FTFieldsWithIndex fs) -> FTFieldsWithIndex $
fromMaybe fs $ List.deleteAt idx fs) fields
onRename :: Index -> String -> Effect Unit
onRename :: Index -> String -> Effect Unit
onRename idx newName = do
onRename idx newName = do
T.modify_ (\fs ->
T.modify_ (\(FTFieldsWithIndex fs) ->
fromMaybe fs $ List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { name = newName })) fs) fields
FTFieldsWithIndex $ fromMaybe fs $
List.modifyAt idx (\{ ftField: Field f } -> { idx, ftField: Field $ f { name = newName } }) fs) fields
recomputeIndices :: FTFieldsWithIndex -> FTFieldsWithIndex
recomputeIndices :: FTFieldsWithIndex -> FTFieldsWithIndex
recomputeIndices
= List.mapWithIndex $ \idx -> \(Tuple _ t) -> Tuple idx
t
recomputeIndices
(FTFieldsWithIndex lst) = FTFieldsWithIndex $ List.mapWithIndex (\idx -> \{ ftField } -> { idx, ftField }) ls
t
hash :: FTFieldWithIndex -> Hash
hash :: FTFieldWithIndex -> Hash
hash
(Tuple idx f) = Crypto.hash $ "--idx--" <> (show idx) <> "--field--" <> (show f
)
hash
{ idx, ftField } = Crypto.hash $ "--idx--" <> (show idx) <> "--field--" <> (show ftField
)
type FieldCodeEditorProps =
type FieldCodeEditorProps =
(
(
...
@@ -402,7 +403,7 @@ fieldCodeEditorCpt = here.component "fieldCodeEditorCpt" cpt
...
@@ -402,7 +403,7 @@ fieldCodeEditorCpt = here.component "fieldCodeEditorCpt" cpt
cpt {field: Field {typ: typ@(JSON j)}, onChange} _ = do
cpt {field: Field {typ: typ@(JSON j)}, onChange} _ = do
pure $ CE.codeEditor {code, defaultCodeType: CE.JSON, onChange: changeCode onChange typ}
pure $ CE.codeEditor {code, defaultCodeType: CE.JSON, onChange: changeCode onChange typ}
where
where
code = R2.stringify (
encodeJson
j) 2
code = R2.stringify (
JSON.writeImpl
j) 2
cpt {field: Field {typ: typ@(Markdown {text})}, onChange} _ = do
cpt {field: Field {typ: typ@(Markdown {text})}, onChange} _ = do
pure $ CE.codeEditor {code: text, defaultCodeType: CE.Markdown, onChange: changeCode onChange typ}
pure $ CE.codeEditor {code: text, defaultCodeType: CE.Markdown, onChange: changeCode onChange typ}
...
@@ -430,19 +431,22 @@ changeCode onc (Markdown md) CE.Markdown c = onc $ Markdown $ md {
...
@@ -430,19 +431,22 @@ changeCode onc (Markdown md) CE.Markdown c = onc $ Markdown $ md {
changeCode onc (JSON j@{desc}) CE.Haskell c = onc $ Haskell $ defaultHaskell' { haskell = haskell }
changeCode onc (JSON j@{desc}) CE.Haskell c = onc $ Haskell $ defaultHaskell' { haskell = haskell }
where
where
haskell = R2.stringify (
encodeJson
j) 2
haskell = R2.stringify (
JSON.writeImpl
j) 2
changeCode onc (JSON j@{desc}) CE.Python c = onc $ Python $ defaultPython' { python = toCode }
changeCode onc (JSON j@{desc}) CE.Python c = onc $ Python $ defaultPython' { python = toCode }
where
where
toCode = R2.stringify (
encodeJson
j) 2
toCode = R2.stringify (
JSON.writeImpl
j) 2
changeCode onc
(JSON j)
CE.JSON c = do
changeCode onc
_
CE.JSON c = do
case
jsonParser
c of
case
JSON.readJSON
c of
Left err -> log2 "[fieldCodeEditor'] cannot parse json" c
Left err -> log2 "[fieldCodeEditor'] cannot parse json" c
Right j' -> case decodeJson j' of
Right j' -> onc $ JSON j'
Left err -> log2 "[fieldCodeEditor'] cannot decode json" j'
-- case jsonParser c of
Right j'' -> onc $ JSON j''
-- Left err -> log2 "[fieldCodeEditor'] cannot parse json" c
changeCode onc (JSON j) CE.Markdown c = onc $ Markdown $ defaultMarkdown' { text = text }
-- Right j' -> case decodeJson j' of
-- Left err -> log2 "[fieldCodeEditor'] cannot decode json" j'
-- Right j'' -> onc $ JSON j''
changeCode onc (JSON j) CE.Markdown _ = onc $ Markdown $ defaultMarkdown' { text = text }
where
where
text = R2.stringify (
encodeJson
j) 2
text = R2.stringify (
JSON.writeImpl
j) 2
...
@@ -475,7 +479,7 @@ loadCorpus {nodeId, session} = do
...
@@ -475,7 +479,7 @@ loadCorpus {nodeId, session} = do
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get session nodePolyRoute
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get session nodePolyRoute
corpusNode <- get session $ corpusNodeRoute corpusId ""
corpusNode <- get session $ corpusNodeRoute corpusId ""
defaultListIds <- (get session $ defaultListIdsRoute corpusId)
defaultListIds <- (get session $ defaultListIdsRoute corpusId)
:: forall a.
DecodeJso
n a => AffTableResult (NodePoly a)
:: forall a.
JSON.ReadForeig
n a => AffTableResult (NodePoly a)
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
Just (NodePoly { id: defaultListId }) ->
pure {corpusId, corpusNode, defaultListId}
pure {corpusId, corpusNode, defaultListId}
...
@@ -493,7 +497,7 @@ loadCorpusWithChild { nodeId: childId, session } = do
...
@@ -493,7 +497,7 @@ loadCorpusWithChild { nodeId: childId, session } = do
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get session $ listNodeRoute childId ""
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get session $ listNodeRoute childId ""
corpusNode <- get session $ corpusNodeRoute corpusId ""
corpusNode <- get session $ corpusNodeRoute corpusId ""
defaultListIds <- (get session $ defaultListIdsRoute corpusId)
defaultListIds <- (get session $ defaultListIdsRoute corpusId)
:: forall a.
DecodeJso
n a => AffTableResult (NodePoly a)
:: forall a.
JSON.ReadForeig
n a => AffTableResult (NodePoly a)
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
Just (NodePoly { id: defaultListId }) ->
pure { corpusId, corpusNode, defaultListId }
pure { corpusId, corpusNode, defaultListId }
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Common.purs
View file @
81e21c97
module Gargantext.Components.Nodes.Corpus.Chart.Common where
module Gargantext.Components.Nodes.Corpus.Chart.Common where
import Data.Argonaut (class DecodeJson)
import Data.Tuple (fst)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Effect.Aff (Aff)
import Reactix as R
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
import Toestand as T
import Gargantext.Prelude
import Gargantext.Prelude
...
@@ -49,12 +49,12 @@ type MetricsWithCacheLoadViewProps res ret = (
...
@@ -49,12 +49,12 @@ type MetricsWithCacheLoadViewProps res ret = (
)
)
metricsWithCacheLoadView :: forall res ret.
metricsWithCacheLoadView :: forall res ret.
Eq ret =>
DecodeJso
n res =>
Eq ret =>
JSON.ReadForeig
n res =>
Record (MetricsWithCacheLoadViewProps res ret) -> R.Element
Record (MetricsWithCacheLoadViewProps res ret) -> R.Element
metricsWithCacheLoadView p = R.createElement metricsWithCacheLoadViewCpt p []
metricsWithCacheLoadView p = R.createElement metricsWithCacheLoadViewCpt p []
metricsWithCacheLoadViewCpt :: forall res ret.
metricsWithCacheLoadViewCpt :: forall res ret.
Eq ret =>
DecodeJso
n res =>
Eq ret =>
JSON.ReadForeig
n res =>
R.Component (MetricsWithCacheLoadViewProps res ret)
R.Component (MetricsWithCacheLoadViewProps res ret)
metricsWithCacheLoadViewCpt = here.component "metricsWithCacheLoadView" cpt
metricsWithCacheLoadViewCpt = here.component "metricsWithCacheLoadView" cpt
where
where
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Histo.purs
View file @
81e21c97
module Gargantext.Components.Nodes.Corpus.Chart.Histo where
module Gargantext.Components.Nodes.Corpus.Chart.Histo where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Tuple.Nested ((/\))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Effect.Aff (Aff)
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Toestand as T
import Gargantext.Prelude (class Eq, bind, map, pure, ($), (==))
import Gargantext.Prelude (class Eq, bind, map, pure, ($), (==))
...
@@ -35,29 +35,16 @@ newtype ChartMetrics = ChartMetrics {
...
@@ -35,29 +35,16 @@ newtype ChartMetrics = ChartMetrics {
"data" :: HistoMetrics
"data" :: HistoMetrics
}
}
derive instance Generic ChartMetrics _
derive instance Generic ChartMetrics _
instance Eq ChartMetrics where
derive instance Newtype ChartMetrics _
eq = genericEq
instance Eq ChartMetrics where eq = genericEq
instance DecodeJson ChartMetrics where
derive newtype instance JSON.ReadForeign ChartMetrics
decodeJson json = do
obj <- decodeJson json
d <- obj .: "data"
pure $ ChartMetrics { "data": d }
newtype HistoMetrics = HistoMetrics { dates :: Array String, count :: Array Number }
newtype HistoMetrics = HistoMetrics { dates :: Array String, count :: Array Number }
derive instance Generic HistoMetrics _
derive instance Generic HistoMetrics _
instance Eq HistoMetrics where
derive instance Newtype HistoMetrics _
eq = genericEq
instance Eq HistoMetrics where eq = genericEq
instance DecodeJson HistoMetrics where
derive newtype instance JSON.ReadForeign HistoMetrics
decodeJson json = do
derive newtype instance JSON.WriteForeign HistoMetrics
obj <- decodeJson json
d <- obj .: "dates"
c <- obj .: "count"
pure $ HistoMetrics { dates : d , count: c}
instance EncodeJson HistoMetrics where
encodeJson (HistoMetrics { dates, count }) =
"count" := encodeJson count
~> "dates" := encodeJson dates
~> jsonEmptyObject
type Loaded = HistoMetrics
type Loaded = HistoMetrics
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Metrics.purs
View file @
81e21c97
module Gargantext.Components.Nodes.Corpus.Chart.Metrics where
module Gargantext.Components.Nodes.Corpus.Chart.Metrics where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Eq.Generic (genericEq)
import Data.Map as Map
import Data.Map as Map
import Data.Map (Map)
import Data.Map (Map)
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Tuple (Tuple(..))
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Effect.Aff (Aff)
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Toestand as T
import Gargantext.Prelude (class Eq, bind, negate, pure, ($), (<$>), (<>))
import Gargantext.Prelude (class Eq, bind, negate, pure, ($), (<$>), (<>))
...
@@ -43,33 +43,17 @@ newtype Metric = Metric
...
@@ -43,33 +43,17 @@ newtype Metric = Metric
, cat :: TermList
, cat :: TermList
}
}
derive instance Generic Metric _
derive instance Generic Metric _
instance Eq Metric where
derive instance Newtype Metric _
eq = genericEq
instance Eq Metric where eq = genericEq
instance DecodeJson Metric where
derive newtype instance JSON.ReadForeign Metric
decodeJson json = do
derive newtype instance JSON.WriteForeign Metric
obj <- decodeJson json
label <- obj .: "label"
x <- obj .: "x"
y <- obj .: "y"
cat <- obj .: "cat"
pure $ Metric { label, x, y, cat }
instance EncodeJson Metric where
encodeJson (Metric { label, x, y, cat }) =
"label" := encodeJson label
~> "x" := encodeJson x
~> "y" := encodeJson y
~> "cat" := encodeJson cat
~> jsonEmptyObject
newtype Metrics = Metrics {
newtype Metrics = Metrics {
"data" :: Array Metric
"data" :: Array Metric
}
}
derive instance Generic Metrics _
instance DecodeJson Metrics where
derive instance Newtype Metrics _
decodeJson json = do
derive newtype instance JSON.ReadForeign Metrics
obj <- decodeJson json
d <- obj .: "data"
pure $ Metrics { "data": d }
type Loaded = Array Metric
type Loaded = Array Metric
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Pie.purs
View file @
81e21c97
module Gargantext.Components.Nodes.Corpus.Chart.Pie where
module Gargantext.Components.Nodes.Corpus.Chart.Pie where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Array (zip, filter)
import Data.Array (zip, filter)
import Data.Array as A
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.String (take, joinWith, Pattern(..), split, length)
import Data.String (take, joinWith, Pattern(..), split, length)
import Data.Tuple (Tuple(..))
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Effect.Aff (Aff)
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Toestand as T
import Gargantext.Prelude (class Eq, bind, map, pure, ($), (==), (>))
import Gargantext.Prelude (class Eq, bind, map, pure, ($), (==), (>))
...
@@ -39,32 +39,19 @@ here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Pie"
...
@@ -39,32 +39,19 @@ here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Pie"
newtype ChartMetrics = ChartMetrics {
newtype ChartMetrics = ChartMetrics {
"data" :: HistoMetrics
"data" :: HistoMetrics
}
}
derive instance Generic ChartMetrics _
instance DecodeJson ChartMetrics where
derive instance Newtype ChartMetrics _
decodeJson json = do
derive newtype instance JSON.ReadForeign ChartMetrics
obj <- decodeJson json
d <- obj .: "data"
pure $ ChartMetrics { "data": d }
newtype HistoMetrics = HistoMetrics
newtype HistoMetrics = HistoMetrics
{ dates :: Array String
{ dates :: Array String
, count :: Array Number
, count :: Array Number
}
}
derive instance Generic HistoMetrics _
derive instance Generic HistoMetrics _
instance Eq HistoMetrics where
derive instance Newtype HistoMetrics _
eq = genericEq
instance Eq HistoMetrics where eq = genericEq
instance DecodeJson HistoMetrics where
derive newtype instance JSON.ReadForeign HistoMetrics
decodeJson json = do
derive newtype instance JSON.WriteForeign HistoMetrics
obj <- decodeJson json
d <- obj .: "dates"
c <- obj .: "count"
pure $ HistoMetrics { dates : d , count: c}
instance EncodeJson HistoMetrics where
encodeJson (HistoMetrics { dates, count }) =
"count" := encodeJson count
~> "dates" := encodeJson dates
~> jsonEmptyObject
type Loaded = HistoMetrics
type Loaded = HistoMetrics
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Tree.purs
View file @
81e21c97
module Gargantext.Components.Nodes.Corpus.Chart.Tree where
module Gargantext.Components.Nodes.Corpus.Chart.Tree where
import Prelude (bind, pure, ($), (==))
import Data.Generic.Rep (class Generic)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Tuple.Nested ((/\))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Effect.Aff (Aff)
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Series (TreeNode, Trees(..), mkTree)
import Gargantext.Components.Charts.Options.Series (TreeNode, Trees(..), mkTree)
import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter)
...
@@ -29,16 +31,10 @@ here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Tree"
...
@@ -29,16 +31,10 @@ here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Tree"
newtype Metrics = Metrics {
newtype Metrics = Metrics {
"data" :: Array TreeNode
"data" :: Array TreeNode
}
}
derive instance Generic Metrics _
instance DecodeJson Metrics where
derive instance Newtype Metrics _
decodeJson json = do
derive newtype instance JSON.ReadForeign Metrics
obj <- decodeJson json
derive newtype instance JSON.WriteForeign Metrics
d <- obj .: "data"
pure $ Metrics { "data": d }
instance EncodeJson Metrics where
encodeJson (Metrics { "data": d }) =
"data" := encodeJson d
~> jsonEmptyObject
type Loaded = Array TreeNode
type Loaded = Array TreeNode
...
...
src/Gargantext/Components/Nodes/Corpus/Dashboard.purs
View file @
81e21c97
module Gargantext.Components.Nodes.Corpus.Dashboard where
module Gargantext.Components.Nodes.Corpus.Dashboard where
import Gargantext.Prelude
import Gargantext.Prelude (Unit, bind, discard, pure, read, show, unit, ($), (<$>), (<>), (==))
( Unit, bind, const, discard, pure, read, show, unit, ($), (<$>), (<>), (==) )
import Data.Array as A
import Data.Array as A
import Data.List as List
import Data.List as List
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..), snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Effect.Class (liftEffect)
...
@@ -18,7 +15,7 @@ import Toestand as T
...
@@ -18,7 +15,7 @@ import Toestand as T
import Gargantext.Components.Nodes.Corpus (fieldsCodeEditor)
import Gargantext.Components.Nodes.Corpus (fieldsCodeEditor)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Dashboard.Types as DT
import Gargantext.Components.Nodes.Dashboard.Types as DT
import Gargantext.Components.Nodes.Types (FTField
, FTFieldsWithIndex
, defaultField)
import Gargantext.Components.Nodes.Types (FTField
List(..), FTFieldsWithIndex(..)
, defaultField)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (NodeID)
import Gargantext.Types (NodeID)
...
@@ -32,7 +29,6 @@ type Props = ( nodeId :: NodeID, session :: Session )
...
@@ -32,7 +29,6 @@ type Props = ( nodeId :: NodeID, session :: Session )
dashboardLayout :: R2.Component Props
dashboardLayout :: R2.Component Props
dashboardLayout = R.createElement dashboardLayoutCpt
dashboardLayout = R.createElement dashboardLayoutCpt
dashboardLayoutCpt :: R.Component Props
dashboardLayoutCpt :: R.Component Props
dashboardLayoutCpt = here.component "dashboardLayout" cpt where
dashboardLayoutCpt = here.component "dashboardLayout" cpt where
cpt { nodeId, session } content = do
cpt { nodeId, session } content = do
...
@@ -47,7 +43,6 @@ type KeyProps =
...
@@ -47,7 +43,6 @@ type KeyProps =
dashboardLayoutWithKey :: R2.Component KeyProps
dashboardLayoutWithKey :: R2.Component KeyProps
dashboardLayoutWithKey = R.createElement dashboardLayoutWithKeyCpt
dashboardLayoutWithKey = R.createElement dashboardLayoutWithKeyCpt
dashboardLayoutWithKeyCpt :: R.Component KeyProps
dashboardLayoutWithKeyCpt :: R.Component KeyProps
dashboardLayoutWithKeyCpt = here.component "dashboardLayoutWithKey" cpt
dashboardLayoutWithKeyCpt = here.component "dashboardLayoutWithKey" cpt
where
where
...
@@ -67,7 +62,7 @@ dashboardLayoutWithKeyCpt = here.component "dashboardLayoutWithKey" cpt
...
@@ -67,7 +62,7 @@ dashboardLayoutWithKeyCpt = here.component "dashboardLayoutWithKey" cpt
, session } []
, session } []
where
where
onChange :: NodeID -> T2.ReloadS -> DT.Hyperdata -> { charts :: Array P.PredefinedChart
onChange :: NodeID -> T2.ReloadS -> DT.Hyperdata -> { charts :: Array P.PredefinedChart
, fields ::
List.List FTField
} -> Effect Unit
, fields ::
FTFieldList
} -> Effect Unit
onChange nodeId' reload (DT.Hyperdata h) { charts, fields } = do
onChange nodeId' reload (DT.Hyperdata h) { charts, fields } = do
launchAff_ do
launchAff_ do
DT.saveDashboard { hyperdata: DT.Hyperdata $ h { charts = charts, fields = fields }
DT.saveDashboard { hyperdata: DT.Hyperdata $ h { charts = charts, fields = fields }
...
@@ -79,16 +74,15 @@ type LoadedProps =
...
@@ -79,16 +74,15 @@ type LoadedProps =
( charts :: Array P.PredefinedChart
( charts :: Array P.PredefinedChart
, corpusId :: NodeID
, corpusId :: NodeID
, defaultListId :: Int
, defaultListId :: Int
, fields ::
List.List FTField
, fields ::
FTFieldList
, onChange :: { charts :: Array P.PredefinedChart
, onChange :: { charts :: Array P.PredefinedChart
, fields ::
List.List FTField
} -> Effect Unit
, fields ::
FTFieldList
} -> Effect Unit
, nodeId :: NodeID
, nodeId :: NodeID
, session :: Session
, session :: Session
)
)
dashboardLayoutLoaded :: R2.Component LoadedProps
dashboardLayoutLoaded :: R2.Component LoadedProps
dashboardLayoutLoaded = R.createElement dashboardLayoutLoadedCpt
dashboardLayoutLoaded = R.createElement dashboardLayoutLoadedCpt
dashboardLayoutLoadedCpt :: R.Component LoadedProps
dashboardLayoutLoadedCpt :: R.Component LoadedProps
dashboardLayoutLoadedCpt = here.component "dashboardLayoutLoaded" cpt
dashboardLayoutLoadedCpt = here.component "dashboardLayoutLoaded" cpt
where
where
...
@@ -125,20 +119,19 @@ dashboardLayoutLoadedCpt = here.component "dashboardLayoutLoaded" cpt
...
@@ -125,20 +119,19 @@ dashboardLayoutLoadedCpt = here.component "dashboardLayoutLoaded" cpt
, fields }
, fields }
type CodeEditorProps =
type CodeEditorProps =
( fields ::
List.List FTField
( fields ::
FTFieldList
, onChange ::
List.List FTField
-> Effect Unit
, onChange ::
FTFieldList
-> Effect Unit
, nodeId :: NodeID
, nodeId :: NodeID
, session :: Session
, session :: Session
)
)
dashboardCodeEditor :: R2.Component CodeEditorProps
dashboardCodeEditor :: R2.Component CodeEditorProps
dashboardCodeEditor = R.createElement dashboardCodeEditorCpt
dashboardCodeEditor = R.createElement dashboardCodeEditorCpt
dashboardCodeEditorCpt :: R.Component CodeEditorProps
dashboardCodeEditorCpt :: R.Component CodeEditorProps
dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt
dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt
where
where
cpt props@{ fields, nodeId, onChange, session } _ = do
cpt props@{ fields
: FTFieldList fields
, nodeId, onChange, session } _ = do
let fieldsWithIndex =
List.mapWithIndex (\idx -> \t -> Tuple idx t
) fields
let fieldsWithIndex =
FTFieldsWithIndex $ List.mapWithIndex (\idx -> \ftField -> { idx, ftField }
) fields
fieldsS <- T.useBox fieldsWithIndex
fieldsS <- T.useBox fieldsWithIndex
fields' <- T.useLive T.unequal fieldsS
fields' <- T.useLive T.unequal fieldsS
fieldsRef <- R.useRef fields'
fieldsRef <- R.useRef fields'
...
@@ -179,9 +172,9 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt
...
@@ -179,9 +172,9 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt
saveEnabled fs fsS = if fs == fsS then "disabled" else "enabled"
saveEnabled fs fsS = if fs == fsS then "disabled" else "enabled"
onClickSave :: forall e. FTFieldsWithIndex -> e -> Effect Unit
onClickSave :: forall e. FTFieldsWithIndex -> e -> Effect Unit
onClickSave
fields'
_ = do
onClickSave
(FTFieldsWithIndex fields')
_ = do
here.log "saving (TODO)"
here.log "saving (TODO)"
onChange $
snd
<$> fields'
onChange $
FTFieldList $ (_.ftField)
<$> fields'
-- launchAff_ do
-- launchAff_ do
-- saveCorpus $ { hyperdata: Hyperdata {fields: (\(Tuple _ f) -> f) <$> fieldsS}
-- saveCorpus $ { hyperdata: Hyperdata {fields: (\(Tuple _ f) -> f) <$> fieldsS}
-- , nodeId
-- , nodeId
...
@@ -189,7 +182,8 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt
...
@@ -189,7 +182,8 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt
onClickAddField :: forall e. T.Box FTFieldsWithIndex -> e -> Effect Unit
onClickAddField :: forall e. T.Box FTFieldsWithIndex -> e -> Effect Unit
onClickAddField fieldsS _ = do
onClickAddField fieldsS _ = do
T.modify_ (\fs -> List.snoc fs $ Tuple (List.length fs) defaultField) fieldsS
T.modify_ (\(FTFieldsWithIndex fs) -> FTFieldsWithIndex $
List.snoc fs $ { idx: List.length fs, ftField: defaultField }) fieldsS
type PredefinedChartProps =
type PredefinedChartProps =
( chart :: P.PredefinedChart
( chart :: P.PredefinedChart
...
@@ -202,7 +196,6 @@ type PredefinedChartProps =
...
@@ -202,7 +196,6 @@ type PredefinedChartProps =
renderChart :: R2.Component PredefinedChartProps
renderChart :: R2.Component PredefinedChartProps
renderChart = R.createElement renderChartCpt
renderChart = R.createElement renderChartCpt
renderChartCpt :: R.Component PredefinedChartProps
renderChartCpt :: R.Component PredefinedChartProps
renderChartCpt = here.component "renderChart" cpt
renderChartCpt = here.component "renderChart" cpt
where
where
...
...
src/Gargantext/Components/Nodes/Corpus/Document.purs
View file @
81e21c97
...
@@ -39,7 +39,6 @@ publicationDate (Document doc@{publication_year: Just py, publication_month: Jus
...
@@ -39,7 +39,6 @@ publicationDate (Document doc@{publication_year: Just py, publication_month: Jus
docViewWrapper :: R2.Component Props
docViewWrapper :: R2.Component Props
docViewWrapper = R.createElement docViewWrapperCpt
docViewWrapper = R.createElement docViewWrapperCpt
docViewWrapperCpt :: R.Component Props
docViewWrapperCpt :: R.Component Props
docViewWrapperCpt = here.component "docViewWrapper" cpt
docViewWrapperCpt = here.component "docViewWrapper" cpt
where
where
...
@@ -55,7 +54,6 @@ type DocViewProps = (
...
@@ -55,7 +54,6 @@ type DocViewProps = (
docView :: R2.Component DocViewProps
docView :: R2.Component DocViewProps
docView = R.createElement docViewCpt
docView = R.createElement docViewCpt
docViewCpt :: R.Component DocViewProps
docViewCpt :: R.Component DocViewProps
docViewCpt = here.component "docView" cpt
docViewCpt = here.component "docView" cpt
where
where
...
@@ -123,14 +121,12 @@ type LayoutProps =
...
@@ -123,14 +121,12 @@ type LayoutProps =
documentMainLayout :: R2.Component LayoutProps
documentMainLayout :: R2.Component LayoutProps
documentMainLayout = R.createElement documentMainLayoutCpt
documentMainLayout = R.createElement documentMainLayoutCpt
documentMainLayoutCpt :: R.Component LayoutProps
documentMainLayoutCpt :: R.Component LayoutProps
documentMainLayoutCpt = here.component "documentMainLayout" cpt where
documentMainLayoutCpt = here.component "documentMainLayout" cpt where
cpt props _ = pure $ R2.row [ R2.col 10 [ documentLayout props [] ] ]
cpt props _ = pure $ R2.row [ R2.col 10 [ documentLayout props [] ] ]
documentLayout :: R2.Component LayoutProps
documentLayout :: R2.Component LayoutProps
documentLayout = R.createElement documentLayoutCpt
documentLayout = R.createElement documentLayoutCpt
documentLayoutCpt :: R.Component LayoutProps
documentLayoutCpt :: R.Component LayoutProps
documentLayoutCpt = here.component "documentLayout" cpt where
documentLayoutCpt = here.component "documentLayout" cpt where
cpt { listId, mCorpusId, nodeId, session } children = do
cpt { listId, mCorpusId, nodeId, session } children = do
...
@@ -148,7 +144,6 @@ type KeyLayoutProps =
...
@@ -148,7 +144,6 @@ type KeyLayoutProps =
documentLayoutWithKey :: R2.Component KeyLayoutProps
documentLayoutWithKey :: R2.Component KeyLayoutProps
documentLayoutWithKey = R.createElement documentLayoutWithKeyCpt
documentLayoutWithKey = R.createElement documentLayoutWithKeyCpt
documentLayoutWithKeyCpt :: R.Component KeyLayoutProps
documentLayoutWithKeyCpt :: R.Component KeyLayoutProps
documentLayoutWithKeyCpt = here.component "documentLayoutWithKey" cpt
documentLayoutWithKeyCpt = here.component "documentLayoutWithKey" cpt
where
where
...
...
src/Gargantext/Components/Nodes/Corpus/Document/Types.purs
View file @
81e21c97
module Gargantext.Components.Nodes.Corpus.Document.Types where
module Gargantext.Components.Nodes.Corpus.Document.Types where
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Eq.Generic (genericEq)
import Data.Newtype (class Newtype)
import Data.Show.Generic (genericShow)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..))
import Simple.JSON as JSON
import Gargantext.Prelude
import Gargantext.Prelude
...
@@ -53,6 +54,12 @@ newtype Status = Status { failed :: Int
...
@@ -53,6 +54,12 @@ newtype Status = Status { failed :: Int
, remaining :: Int
, remaining :: Int
}
}
derive instance Generic Status _
derive instance Newtype Status _
derive newtype instance JSON.ReadForeign Status
derive newtype instance JSON.WriteForeign Status
instance Show Status where show = genericShow
newtype DocumentV3 =
newtype DocumentV3 =
DocumentV3 { abstract :: Maybe String
DocumentV3 { abstract :: Maybe String
, authors :: Maybe String
, authors :: Maybe String
...
@@ -73,6 +80,12 @@ newtype DocumentV3 =
...
@@ -73,6 +80,12 @@ newtype DocumentV3 =
, title :: Maybe String
, title :: Maybe String
}
}
derive instance Generic DocumentV3 _
derive instance Newtype DocumentV3 _
derive newtype instance JSON.ReadForeign DocumentV3
derive newtype instance JSON.WriteForeign DocumentV3
instance Show DocumentV3 where show = genericShow
defaultNodeDocumentV3 :: NodePoly DocumentV3
defaultNodeDocumentV3 :: NodePoly DocumentV3
defaultNodeDocumentV3 =
defaultNodeDocumentV3 =
NodePoly { id : 0
NodePoly { id : 0
...
@@ -105,8 +118,8 @@ defaultDocumentV3 =
...
@@ -105,8 +118,8 @@ defaultDocumentV3 =
, title : Nothing
, title : Nothing
}
}
data Document
newtype Document =
=
Document
Document
{ abstract :: Maybe String
{ abstract :: Maybe String
, authors :: Maybe String
, authors :: Maybe String
, bdd :: Maybe String
, bdd :: Maybe String
...
@@ -128,6 +141,12 @@ data Document
...
@@ -128,6 +141,12 @@ data Document
--, text :: Maybe String
--, text :: Maybe String
}
}
derive instance Generic Document _
derive instance Newtype Document _
derive newtype instance JSON.ReadForeign Document
derive newtype instance JSON.WriteForeign Document
instance Eq Document where eq = genericEq
instance Show Document where show = genericShow
defaultNodeDocument :: NodeDocument
defaultNodeDocument :: NodeDocument
defaultNodeDocument =
defaultNodeDocument =
...
@@ -164,111 +183,3 @@ defaultDocument =
...
@@ -164,111 +183,3 @@ defaultDocument =
--, text : Nothing
--, text : Nothing
}
}
derive instance Generic Document _
derive instance Generic DocumentV3 _
derive instance Generic Status _
instance Eq Document where
eq = genericEq
instance Show Document where
show = genericShow
instance Show DocumentV3 where
show = genericShow
instance Show Status where
show = genericShow
instance DecodeJson Status
where
decodeJson json = do
obj <- decodeJson json
failed <- obj .: "failed"
succeeded <- obj .: "succeeded"
remaining <- obj .: "remaining"
pure $ Status {failed, succeeded, remaining}
instance DecodeJson DocumentV3
where
decodeJson json = do
obj <- decodeJson json
abstract <- obj .:? "abstract"
authors <- obj .: "authors"
--error <- obj .: "error"
language_iso2 <- obj .: "language_iso2"
language_iso3 <- obj .: "language_iso3"
language_name <- obj .: "language_name"
publication_date <- obj .: "publication_date"
publication_day <- obj .: "publication_day"
publication_hour <- obj .: "publication_hour"
publication_minute <- obj .: "publication_minute"
publication_month <- obj .: "publication_month"
publication_second <- obj .: "publication_second"
publication_year <- obj .: "publication_year"
realdate_full_ <- obj .: "realdate_full_"
source <- obj .: "source"
statuses <- obj .: "statuses"
title <- obj .: "title"
pure $ DocumentV3 { abstract
, authors
--, error
, language_iso2
, language_iso3
, language_name
, publication_date
, publication_day
, publication_hour
, publication_minute
, publication_month
, publication_second
, publication_year
, realdate_full_
, source
, statuses
, title
}
instance DecodeJson Document
where
decodeJson json = do
obj <- decodeJson json
abstract <- obj .:? "abstract"
authors <- obj .:? "authors"
bdd <- obj .:? "bdd"
doi <- obj .:? "doi"
language_iso2 <- obj .:? "language_iso2"
-- page <- obj .:? "page"
publication_date <- obj .:? "publication_date"
--publication_second <- obj .:? "publication_second"
--publication_minute <- obj .:? "publication_minute"
--publication_hour <- obj .:? "publication_hour"
publication_day <- obj .:? "publication_day"
publication_month <- obj .:? "publication_month"
publication_year <- obj .:? "publication_year"
source <- obj .:? "sources"
institutes <- obj .:? "institutes"
title <- obj .:? "title"
uniqId <- obj .:? "uniqId"
--url <- obj .: "url"
--text <- obj .: "text"
pure $ Document { abstract
, authors
, bdd
, doi
, language_iso2
-- , page
, publication_date
--, publication_second
--, publication_minute
--, publication_hour
, publication_day
, publication_month
, publication_year
, source
, institutes
, title
, uniqId
--, url
--, text
}
src/Gargantext/Components/Nodes/Frame.purs
View file @
81e21c97
...
@@ -4,11 +4,17 @@ import Gargantext.Prelude
...
@@ -4,11 +4,17 @@ import Gargantext.Prelude
import Data.Argonaut (decodeJson, (.:))
import Data.Argonaut (decodeJson, (.:))
import Data.Argonaut as Argonaut
import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Eq.Generic (genericEq)
import Data.
Show.Generic (genericShow
)
import Data.
Generic.Rep (class Generic
)
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Show.Generic (genericShow)
import Effect.Aff (Aff)
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Gargantext.Components.FolderView as FV
import Gargantext.Components.FolderView as FV
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Loader (useLoader)
...
@@ -18,30 +24,17 @@ import Gargantext.Types (NodeType(..))
...
@@ -18,30 +24,17 @@ import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Argonaut (genericSumEncodeJson)
import Gargantext.Utils.Argonaut (genericSumEncodeJson)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Frame"
here = R2.here "Gargantext.Components.Nodes.Frame"
data Hyperdata = Hyperdata { base :: String, frame_id :: String }
newtype Hyperdata = Hyperdata { base :: String, frame_id :: String }
derive instance Generic Hyperdata _
derive instance Generic Hyperdata _
instance Eq Hyperdata where
derive instance Newtype Hyperdata _
eq = genericEq
instance Eq Hyperdata where eq = genericEq
instance Show Hyperdata where
instance Show Hyperdata where show = genericShow
show = genericShow
derive newtype instance JSON.ReadForeign Hyperdata
instance Argonaut.DecodeJson Hyperdata where
derive newtype instance JSON.WriteForeign Hyperdata
-- TODO
-- decodeJson = genericSumDecodeJson
decodeJson json = do
obj <- decodeJson json
base <- obj .: "base"
frame_id <- obj .: "frame_id"
pure $ Hyperdata {base, frame_id}
instance Argonaut.EncodeJson Hyperdata where
encodeJson = genericSumEncodeJson
type Props =
type Props =
( nodeId :: Int
( nodeId :: Int
...
...
src/Gargantext/Components/Nodes/Types.purs
View file @
81e21c97
...
@@ -28,8 +28,14 @@ type Title = String
...
@@ -28,8 +28,14 @@ type Title = String
-- We need FTFields with indices because it's the only way to identify the
-- We need FTFields with indices because it's the only way to identify the
-- FTField element inside a component (there are no UUIDs and such)
-- FTField element inside a component (there are no UUIDs and such)
type Index = Int
type Index = Int
type FTFieldWithIndex = Tuple Index FTField
type FTFieldWithIndex = { idx :: Index, ftField :: FTField }
type FTFieldsWithIndex = List.List FTFieldWithIndex
newtype FTFieldsWithIndex = FTFieldsWithIndex (List.List FTFieldWithIndex)
derive instance Generic FTFieldsWithIndex _
derive instance Newtype FTFieldsWithIndex _
instance Eq FTFieldsWithIndex where eq = genericEq
instance JSON.ReadForeign FTFieldsWithIndex where readImpl f = FTFieldsWithIndex <$> GUJ.readList f
instance JSON.WriteForeign FTFieldsWithIndex where writeImpl (FTFieldsWithIndex lst) = GUJ.writeList lst
newtype Field a =
newtype Field a =
Field { name :: String
Field { name :: String
...
@@ -54,18 +60,18 @@ type FieldFieldTypeJSONRead =
...
@@ -54,18 +60,18 @@ type FieldFieldTypeJSONRead =
{ name :: String
{ name :: String
, type :: String
, type :: String
, data :: { tag :: Tag
, data :: { tag :: Tag
-- HaskellFT
-- HaskellFT
, haskell :: Maybe HaskellCode
, haskell :: Maybe HaskellCode
-- JSONFT
-- JSONFT
, authors :: Maybe Author
, authors :: Maybe Author
, desc :: Maybe Description
, desc :: Maybe Description
, query :: Maybe Query
, query :: Maybe Query
, title :: Maybe Title
, title :: Maybe Title
-- MarkdownFT
-- MarkdownFT
, text :: Maybe MarkdownText
, text :: Maybe MarkdownText
-- PythonFT
-- PythonFT
, python :: Maybe PythonCode
, python :: Maybe PythonCode
}
}
}
}
derive instance Generic (Field FieldType) _
derive instance Generic (Field FieldType) _
...
@@ -93,10 +99,8 @@ instance JSON.WriteForeign (Field FieldType) where
...
@@ -93,10 +99,8 @@ instance JSON.WriteForeign (Field FieldType) where
typ' (JSON _) = "JSON"
typ' (JSON _) = "JSON"
typ' (Markdown _) = "Markdown"
typ' (Markdown _) = "Markdown"
typ' (Python _) = "Python"
typ' (Python _) = "Python"
instance Eq (Field FieldType) where
instance Eq (Field FieldType) where eq = genericEq
eq = genericEq
instance Show (Field FieldType) where show = genericShow
instance Show (Field FieldType) where
show = genericShow
data FieldType =
data FieldType =
Haskell { tag :: Tag | HaskellFT }
Haskell { tag :: Tag | HaskellFT }
...
@@ -116,10 +120,8 @@ newtype FTFieldList = FTFieldList (List.List FTField)
...
@@ -116,10 +120,8 @@ newtype FTFieldList = FTFieldList (List.List FTField)
derive instance Generic FTFieldList _
derive instance Generic FTFieldList _
derive instance Newtype FTFieldList _
derive instance Newtype FTFieldList _
instance Eq FTFieldList where eq = genericEq
instance Eq FTFieldList where eq = genericEq
instance JSON.ReadForeign FTFieldList where
instance JSON.ReadForeign FTFieldList where readImpl f = FTFieldList <$> GUJ.readList f
readImpl f = FTFieldList <$> GUJ.readList f
instance JSON.WriteForeign FTFieldList where writeImpl (FTFieldList lst) = GUJ.writeList lst
instance JSON.WriteForeign FTFieldList where
writeImpl (FTFieldList lst) = GUJ.writeList lst
isJSON :: FTField -> Boolean
isJSON :: FTField -> Boolean
...
...
src/Gargantext/Components/Search.purs
View file @
81e21c97
module Gargantext.Components.Search where
module Gargantext.Components.Search where
import Gargantext.Prelude (class Eq, class Show)
import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Eq.Generic (genericEq)
import Data.Show.Generic (genericShow)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe)
import Data.Maybe (Maybe)
import Data.Newtype (class Newtype)
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import Gargantext.
Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson, genericEnumDecodeJson, genericEnumEncodeJson)
import Gargantext.
Prelude
-- Example:
-- Example:
-- [["machine","learning"],["artificial","intelligence"]]
-- [["machine","learning"],["artificial","intelligence"]]
...
@@ -16,58 +17,46 @@ type TextQuery = Array (Array String)
...
@@ -16,58 +17,46 @@ type TextQuery = Array (Array String)
------------------------------------------------------------------------
------------------------------------------------------------------------
data SearchType = SearchDoc | SearchContact
data SearchType = SearchDoc | SearchContact
derive instance Eq SearchType
derive instance Generic SearchType _
derive instance Generic SearchType _
instance Show SearchType where
instance Eq SearchType where eq = genericEq
show = genericShow
instance Show SearchType where show = genericShow
instance Argonaut.DecodeJson SearchType where
instance JSON.ReadForeign SearchType where readImpl = JSONG.enumSumRep
decodeJson = genericEnumDecodeJson
instance JSON.WriteForeign SearchType where writeImpl = JSON.writeImpl <<< show
instance Argonaut.EncodeJson SearchType where
encodeJson = genericEnumEncodeJson
------------------------------------------------------------------------
------------------------------------------------------------------------
data SearchQuery = SearchQuery { query :: Array String, expected :: SearchType }
newtype SearchQuery = SearchQuery { query :: Array String, expected :: SearchType }
derive instance Eq SearchQuery
derive instance Generic SearchQuery _
derive instance Generic SearchQuery _
instance Show SearchQuery where
derive instance Newtype SearchQuery _
show = genericShow
instance Eq SearchQuery where eq = genericEq
instance Argonaut.DecodeJson SearchQuery where
instance Show SearchQuery where show = genericShow
decodeJson = genericSumDecodeJson
derive newtype instance JSON.ReadForeign SearchQuery
instance Argonaut.EncodeJson SearchQuery where
derive newtype instance JSON.WriteForeign SearchQuery
encodeJson = genericSumEncodeJson
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
data SearchResult = SearchResult { result :: SearchResultTypes }
newtype SearchResult = SearchResult { result :: SearchResultTypes }
derive instance Eq SearchResult
derive instance Generic SearchResult _
derive instance Generic SearchResult _
instance Show SearchResult where
derive instance Newtype SearchResult _
show = genericShow
instance Eq SearchResult where eq = genericEq
instance Argonaut.DecodeJson SearchResult where
instance Show SearchResult where show = genericShow
decodeJson = genericSumDecodeJson
derive newtype instance JSON.ReadForeign SearchResult
instance Argonaut.EncodeJson SearchResult where
derive newtype instance JSON.WriteForeign SearchResult
encodeJson = genericSumEncodeJson
------------------------------------------------------------------------
------------------------------------------------------------------------
data SearchResultTypes = SearchResultDoc { docs :: Array Document}
data SearchResultTypes = SearchResultDoc { docs :: Array Document}
| SearchNoResult { message :: String }
| SearchNoResult { message :: String }
| SearchResultContact { contacts :: Array Contact }
| SearchResultContact { contacts :: Array Contact }
derive instance Eq SearchResultTypes
derive instance Generic SearchResultTypes _
derive instance Generic SearchResultTypes _
instance
Show SearchResultTypes where
instance
Eq SearchResultTypes where eq = genericEq
show = genericShow
instance Show SearchResultTypes where
show = genericShow
instance
Argonaut.DecodeJson SearchResultTypes where
instance
JSON.ReadForeign SearchResultTypes where readImpl = JSONG.untaggedSumRep
decodeJson = genericSumDecodeJson
instance JSON.WriteForeign SearchResultTypes where
instance Argonaut.EncodeJson SearchResultTypes where
writeImpl (SearchResultDoc s) = JSON.writeImpl s
encodeJson = genericSumEncodeJson
writeImpl (SearchNoResult s) = JSON.writeImpl s
writeImpl (SearchResultContact s) = JSON.writeImpl s
------------------------------------------------------------------------
------------------------------------------------------------------------
data
Document =
newtype
Document =
Document { id :: Int
Document { id :: Int
, created :: String
, created :: String
, title :: String
, title :: String
...
@@ -76,14 +65,11 @@ data Document =
...
@@ -76,14 +65,11 @@ data Document =
, score :: Int
, score :: Int
}
}
derive instance Generic Document _
derive instance Generic Document _
instance Eq Document where
derive instance Newtype Document _
eq = genericEq
instance Eq Document where eq = genericEq
instance Show Document where
instance Show Document where show = genericShow
show = genericShow
derive newtype instance JSON.ReadForeign Document
instance Argonaut.DecodeJson Document where
derive newtype instance JSON.WriteForeign Document
decodeJson = genericSumDecodeJson
instance Argonaut.EncodeJson Document where
encodeJson = genericSumEncodeJson
------------------------------------------------------------------------
------------------------------------------------------------------------
newtype HyperdataRowDocument =
newtype HyperdataRowDocument =
...
@@ -108,19 +94,16 @@ newtype HyperdataRowDocument =
...
@@ -108,19 +94,16 @@ newtype HyperdataRowDocument =
, language_iso2 :: Maybe String
, language_iso2 :: Maybe String
}
}
derive instance Eq HyperdataRowDocument
derive instance Generic HyperdataRowDocument _
derive instance Generic HyperdataRowDocument _
instance Show HyperdataRowDocument where
instance Eq HyperdataRowDocument where eq = genericEq
show = genericShow
instance Show HyperdataRowDocument where show = genericShow
instance Argonaut.DecodeJson HyperdataRowDocument where
derive newtype instance JSON.ReadForeign HyperdataRowDocument
decodeJson = genericSumDecodeJson
derive newtype instance JSON.WriteForeign HyperdataRowDocument
instance Argonaut.EncodeJson HyperdataRowDocument where
encodeJson = genericSumEncodeJson
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
data
Contact =
newtype
Contact =
Contact { c_id :: Int
Contact { c_id :: Int
, c_created :: String
, c_created :: String
, c_hyperdata :: HyperdataRowContact
, c_hyperdata :: HyperdataRowContact
...
@@ -128,106 +111,85 @@ data Contact =
...
@@ -128,106 +111,85 @@ data Contact =
, c_annuaireId :: Int
, c_annuaireId :: Int
}
}
derive instance Eq Contact
derive instance Generic Contact _
derive instance Generic Contact _
instance Show Contact where
instance Eq Contact where eq = genericEq
show = genericShow
instance Show Contact where show = genericShow
instance Argonaut.DecodeJson Contact where
derive newtype instance JSON.ReadForeign Contact
decodeJson = genericSumDecodeJson
derive newtype instance JSON.WriteForeign Contact
instance Argonaut.EncodeJson Contact where
encodeJson = genericSumEncodeJson
newtype HyperdataRowContact =
HyperdataRowContact { firstname :: String
, lastname :: String
data HyperdataRowContact =
, labs :: String
HyperdataRowContact { firstname :: String
, lastname :: String
, labs :: String
}
derive instance Eq HyperdataRowContact
derive instance Generic HyperdataRowContact _
instance Show HyperdataRowContact where
show = genericShow
instance Argonaut.DecodeJson HyperdataRowContact where
decodeJson = genericSumDecodeJson
instance Argonaut.EncodeJson HyperdataRowContact where
encodeJson = genericSumEncodeJson
data HyperdataContact =
HyperdataContact { bdd :: Maybe String
, who :: Maybe ContactWho
, "where" :: Array ContactWhere
, title :: Maybe String
, source :: Maybe String
, lastValidation :: Maybe String
, uniqIdBdd :: Maybe String
, uniqId :: Maybe String
}
}
derive instance Eq HyperdataContact
derive instance Generic HyperdataRowContact _
instance Eq HyperdataRowContact where eq = genericEq
instance Show HyperdataRowContact where show = genericShow
derive newtype instance JSON.ReadForeign HyperdataRowContact
derive newtype instance JSON.WriteForeign HyperdataRowContact
newtype HyperdataContact =
HyperdataContact { bdd :: Maybe String
, who :: Maybe ContactWho
, "where" :: Array ContactWhere
, title :: Maybe String
, source :: Maybe String
, lastValidation :: Maybe String
, uniqIdBdd :: Maybe String
, uniqId :: Maybe String
}
derive instance Generic HyperdataContact _
derive instance Generic HyperdataContact _
instance Show HyperdataContact where
instance Eq HyperdataContact where eq = genericEq
show = genericShow
instance Show HyperdataContact where show = genericShow
instance Argonaut.DecodeJson HyperdataContact where
derive newtype instance JSON.ReadForeign HyperdataContact
decodeJson = genericSumDecodeJson
derive newtype instance JSON.WriteForeign HyperdataContact
instance Argonaut.EncodeJson HyperdataContact where
encodeJson = genericSumEncodeJson
-------
-------
data ContactWho =
newtype ContactWho =
ContactWho { id :: Maybe String
ContactWho { id :: Maybe String
, firstName :: Maybe String
, firstName :: Maybe String
, lastName :: Maybe String
, lastName :: Maybe String
, keywords :: Array String
, keywords :: Array String
, freetags :: Array String
, freetags :: Array String
}
}
derive instance Eq ContactWho
derive instance Generic ContactWho _
derive instance Generic ContactWho _
instance Show ContactWho where
instance Eq ContactWho where eq = genericEq
show = genericShow
instance Show ContactWho where show = genericShow
instance Argonaut.DecodeJson ContactWho where
derive newtype instance JSON.ReadForeign ContactWho
decodeJson = genericSumDecodeJson
derive newtype instance JSON.WriteForeign ContactWho
instance Argonaut.EncodeJson ContactWho where
encodeJson = genericSumEncodeJson
data ContactWhere =
newtype ContactWhere =
ContactWhere { organization :: Array String
ContactWhere { organization :: Array String
, labTeamDepts :: Array String
, labTeamDepts :: Array String
, role :: Maybe String
, role :: Maybe String
, office :: Maybe String
, country :: Maybe String
, city :: Maybe String
, office :: Maybe String
, touch :: Maybe ContactTouch
, country :: Maybe String
, city :: Maybe String
, touch :: Maybe ContactTouch
, entry :: Maybe String
, exit :: Maybe String
, entry :: Maybe String
}
, exit :: Maybe String
}
derive instance Eq ContactWhere
derive instance Generic ContactWhere _
derive instance Generic ContactWhere _
instance Show ContactWhere where
instance Eq ContactWhere where eq = genericEq
show = genericShow
instance Show ContactWhere where show = genericShow
instance Argonaut.DecodeJson ContactWhere where
derive newtype instance JSON.ReadForeign ContactWhere
decodeJson = genericSumDecodeJson
derive newtype instance JSON.WriteForeign ContactWhere
instance Argonaut.EncodeJson ContactWhere where
encodeJson = genericSumEncodeJson
newtype ContactTouch =
ContactTouch { mail :: Maybe String
data ContactTouch =
, phone :: Maybe String
ContactTouch { mail :: Maybe String
, url :: Maybe String
, phone :: Maybe String
}
, url :: Maybe String
}
derive instance Eq ContactTouch
derive instance Generic ContactTouch _
derive instance Generic ContactTouch _
instance Show ContactTouch where
instance Eq ContactTouch where eq = genericEq
show = genericShow
instance Show ContactTouch where show = genericShow
instance Argonaut.DecodeJson ContactTouch where
derive newtype instance JSON.ReadForeign ContactTouch
decodeJson = genericSumDecodeJson
derive newtype instance JSON.WriteForeign ContactTouch
instance Argonaut.EncodeJson ContactTouch where
encodeJson = genericSumEncodeJson
src/Gargantext/Hooks/Loader.purs
View file @
81e21c97
module Gargantext.Hooks.Loader where
module Gargantext.Hooks.Loader where
import Data.
Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject
)
import Data.
Generic.Rep (class Generic
)
import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Newtype (class Newtype)
import Data.Tuple (fst)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Effect.Exception (error)
import Reactix as R
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
import Toestand as T
import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Components.LoadingSpinner (loadingSpinner)
...
@@ -77,20 +79,10 @@ useLoaderEffect path state loader = do
...
@@ -77,20 +79,10 @@ useLoaderEffect path state loader = do
newtype HashedResponse a = HashedResponse { hash :: Hash, value :: a }
newtype HashedResponse a = HashedResponse { hash :: Hash, value :: a }
derive instance Generic (HashedResponse a) _
instance DecodeJson a => DecodeJson (HashedResponse a) where
derive instance Newtype (HashedResponse a) _
decodeJson json = do
derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (HashedResponse a)
obj <- decodeJson json
derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (HashedResponse a)
hash <- obj .: "hash"
value <- obj .: "value"
pure $ HashedResponse { hash, value }
instance EncodeJson a => EncodeJson (HashedResponse a) where
encodeJson (HashedResponse { hash, value }) = do
"hash" := encodeJson hash
~> "value" := encodeJson value
~> jsonEmptyObject
type LoaderWithCacheAPIProps path res ret = (
type LoaderWithCacheAPIProps path res ret = (
cacheEndpoint :: path -> Aff Hash
cacheEndpoint :: path -> Aff Hash
...
@@ -102,7 +94,7 @@ type LoaderWithCacheAPIProps path res ret = (
...
@@ -102,7 +94,7 @@ type LoaderWithCacheAPIProps path res ret = (
useLoaderWithCacheAPI :: forall path res ret.
useLoaderWithCacheAPI :: forall path res ret.
Eq ret => Eq path =>
DecodeJso
n res =>
Eq ret => Eq path =>
JSON.ReadForeig
n res =>
Record (LoaderWithCacheAPIProps path res ret)
Record (LoaderWithCacheAPIProps path res ret)
-> R.Hooks R.Element
-> R.Hooks R.Element
useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer } = do
useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer } = do
...
@@ -125,7 +117,7 @@ type LoaderWithCacheAPIEffectProps path res ret = (
...
@@ -125,7 +117,7 @@ type LoaderWithCacheAPIEffectProps path res ret = (
)
)
useCachedAPILoaderEffect :: forall path res ret.
useCachedAPILoaderEffect :: forall path res ret.
Eq ret => Eq path =>
DecodeJso
n res =>
Eq ret => Eq path =>
JSON.ReadForeig
n res =>
Record (LoaderWithCacheAPIEffectProps path res ret)
Record (LoaderWithCacheAPIEffectProps path res ret)
-> R.Hooks Unit
-> R.Hooks Unit
useCachedAPILoaderEffect { cacheEndpoint
useCachedAPILoaderEffect { cacheEndpoint
...
...
src/Gargantext/Sessions/Types.purs
View file @
81e21c97
module Gargantext.Sessions.Types
module Gargantext.Sessions.Types
( Session(..), Sessions(..), OpenNodes, NodeId, mkNodeId
( Session(..), Sessions(..), OpenNodes
(..)
, NodeId, mkNodeId
, sessionUrl, sessionId
, sessionUrl, sessionId
, empty, null, unSessions, lookup, cons, tryCons, update, remove, tryRemove
, empty, null, unSessions, lookup, cons, tryCons, update, remove, tryRemove
, useOpenNodesMemberBox, openNodesInsert, openNodesDelete
) where
) where
import Data.Array as A
import Data.Array as A
...
@@ -16,10 +17,12 @@ import Data.Newtype (class Newtype)
...
@@ -16,10 +17,12 @@ import Data.Newtype (class Newtype)
import Data.Sequence (Seq)
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Sequence as Seq
import Data.Set (Set)
import Data.Set (Set)
import Data.
Traversable (traverse)
import Data.
Set as Set
import Data.Tuple (Tuple
(..)
)
import Data.Tuple (Tuple)
import Foreign.Object as Object
import Foreign.Object as Object
import Reactix as R
import Simple.JSON as JSON
import Simple.JSON as JSON
import Toestand as T
import Gargantext.Prelude
import Gargantext.Prelude
...
@@ -29,7 +32,6 @@ import Gargantext.Ends (class ToUrl, Backend(..), backendUrl, sessionPath)
...
@@ -29,7 +32,6 @@ import Gargantext.Ends (class ToUrl, Backend(..), backendUrl, sessionPath)
import Gargantext.Routes (SessionRoute)
import Gargantext.Routes (SessionRoute)
import Gargantext.Types (NodePath, SessionId(..), nodePath)
import Gargantext.Types (NodePath, SessionId(..), nodePath)
import Gargantext.Utils.JSON as GJSON
import Gargantext.Utils.JSON as GJSON
import Gargantext.Utils.String as GUS
import Gargantext.Utils.Tuple as GUT
import Gargantext.Utils.Tuple as GUT
-- | A Session represents an authenticated session for a user at a
-- | A Session represents an authenticated session for a user at a
...
@@ -138,7 +140,36 @@ tryRemove sid old@(Sessions ss) = ret where
...
@@ -138,7 +140,36 @@ tryRemove sid old@(Sessions ss) = ret where
| otherwise = Right new
| otherwise = Right new
-- open tree nodes data
-- open tree nodes data
type OpenNodes = Set NodeId
newtype OpenNodes = OpenNodes (Set NodeId)
derive instance Generic OpenNodes _
derive instance Newtype OpenNodes _
instance JSON.ReadForeign OpenNodes where
readImpl f = do
inst :: Array NodeId <- JSON.readImpl f
pure $ OpenNodes $ Set.fromFoldable inst
instance JSON.WriteForeign OpenNodes where
writeImpl (OpenNodes ns) = JSON.writeImpl $ (Set.toUnfoldable ns :: Array NodeId)
openNodesInsert :: NodeId -> OpenNodes -> OpenNodes
openNodesInsert nodeId (OpenNodes set) = OpenNodes $ Set.insert nodeId set
openNodesDelete :: NodeId -> OpenNodes -> OpenNodes
openNodesDelete nodeId (OpenNodes set) = OpenNodes $ Set.delete nodeId set
-- | Creates a cursor which presents a Boolean over whether the member
-- | is in the set. Adjusting the value will toggle whether the value
-- | is in the underlying set.
useOpenNodesMemberBox
:: forall box. T.ReadWrite box OpenNodes
=> NodeId -> box -> R.Hooks (T.Box Boolean)
useOpenNodesMemberBox val box = T.useFocused (\(OpenNodes ns) -> Set.member val ns) (toggleSet val) box
-- utility for useOpenNodesMemberBox
toggleSet :: NodeId -> Boolean -> OpenNodes -> OpenNodes
toggleSet val true (OpenNodes ns) = OpenNodes $ Set.insert val ns
toggleSet val false (OpenNodes ns) = OpenNodes $ Set.delete val ns
type NodeId =
type NodeId =
{ treeId :: TreeId -- Id of the node
{ treeId :: TreeId -- Id of the node
...
...
src/Gargantext/Types.purs
View file @
81e21c97
module Gargantext.Types where
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.Array as A
import Data.Either (Either(..))
import Data.Either (Either(..))
import Data.Newtype (class Newtype)
import Data.Newtype (class Newtype)
...
@@ -58,8 +56,8 @@ instance Show SessionId where
...
@@ -58,8 +56,8 @@ instance Show SessionId where
data TermSize = MonoTerm | MultiTerm
data TermSize = MonoTerm | MultiTerm
data Term = Term String TermList
data Term = Term String TermList
derive instance Generic TermSize _
derive instance Eq TermSize
instance Eq TermSize where eq = genericEq
-- | Converts a data structure to a query string
-- | Converts a data structure to a query string
class ToQuery a where
class ToQuery a where
...
@@ -83,28 +81,12 @@ termSizes = [ { desc: "All types", mval: Nothing }
...
@@ -83,28 +81,12 @@ termSizes = [ { desc: "All types", mval: Nothing }
data TermList = MapTerm | StopTerm | CandidateTerm
data TermList = MapTerm | StopTerm | CandidateTerm
-- TODO use generic JSON instance
-- TODO use generic JSON instance
derive instance Generic TermList _
derive instance Eq TermList
instance Eq TermList where eq = genericEq
derive instance Ord TermList
instance Ord TermList where compare = genericCompare
instance JSON.WriteForeign TermList where writeImpl = JSON.writeImpl <<< show
instance EncodeJson TermList where
instance JSON.ReadForeign TermList where readImpl = JSONG.enumSumRep
encodeJson MapTerm = encodeJson "MapTerm"
instance Show TermList where show = genericShow
encodeJson StopTerm = encodeJson "StopTerm"
encodeJson CandidateTerm = encodeJson "CandidateTerm"
instance DecodeJson TermList where
decodeJson json = do
s <- decodeJson json
case s of
"MapTerm" -> pure MapTerm
"StopTerm" -> pure StopTerm
"CandidateTerm" -> pure CandidateTerm
s' -> Left (AtKey s' $ TypeMismatch "Unexpected list name")
instance Show TermList where
show MapTerm = "MapTerm"
show StopTerm = "StopTerm"
show CandidateTerm = "CandidateTerm"
-- TODO: Can we replace the show instance above with this?
-- TODO: Can we replace the show instance above with this?
termListName :: TermList -> String
termListName :: TermList -> String
...
@@ -135,22 +117,16 @@ showTabType' (TabCorpus t) = show t
...
@@ -135,22 +117,16 @@ showTabType' (TabCorpus t) = show t
showTabType' (TabDocument t) = show t
showTabType' (TabDocument t) = show t
showTabType' (TabPairing t) = show t
showTabType' (TabPairing t) = show t
data
TabPostQuery = TabPostQuery {
newtype
TabPostQuery = TabPostQuery {
offset :: Int
offset :: Int
, limit :: Int
, limit :: Int
, orderBy :: OrderBy
, orderBy :: OrderBy
, tabType :: TabType
, tabType :: TabType
, query :: String
, query :: String
}
}
derive instance Generic TabPostQuery _
instance EncodeJson TabPostQuery where
derive instance Newtype TabPostQuery _
encodeJson (TabPostQuery post) =
derive newtype instance JSON.WriteForeign TabPostQuery
"view" := showTabType' post.tabType
~> "offset" := post.offset
~> "limit" := post.limit
~> "orderBy" := show post.orderBy
~> "query" := post.query
~> jsonEmptyObject
data NodeType = Annuaire
data NodeType = Annuaire
| Corpus
| Corpus
...
@@ -324,14 +300,6 @@ instance Eq NodeType where
...
@@ -324,14 +300,6 @@ instance Eq NodeType where
eq n1 n2 = eq (show n1) (show n2)
eq n1 n2 = eq (show n1) (show n2)
-}
-}
------------------------------------------------------------
------------------------------------------------------------
instance DecodeJson NodeType where
decodeJson json = do
obj <- decodeJson json
pure $ fromMaybe Error $ read obj
instance EncodeJson NodeType where
encodeJson nodeType = encodeJson $ show nodeType
nodeTypePath :: NodeType -> String
nodeTypePath :: NodeType -> String
nodeTypePath Folder = "folder"
nodeTypePath Folder = "folder"
nodeTypePath FolderPrivate = "folderPrivate"
nodeTypePath FolderPrivate = "folderPrivate"
...
@@ -370,10 +338,8 @@ type ContactId = Int
...
@@ -370,10 +338,8 @@ type ContactId = Int
data ScoreType = Occurrences
data ScoreType = Occurrences
derive instance Generic ScoreType _
derive instance Generic ScoreType _
instance Eq ScoreType where
instance Eq ScoreType where eq = genericEq
eq = genericEq
instance Show ScoreType where show = genericShow
instance Show ScoreType where
show = genericShow
type SearchQuery = String
type SearchQuery = String
...
@@ -450,9 +416,9 @@ data OrderBy = DateAsc | DateDesc
...
@@ -450,9 +416,9 @@ data OrderBy = DateAsc | DateDesc
| SourceAsc | SourceDesc
| SourceAsc | SourceDesc
derive instance Generic OrderBy _
derive instance Generic OrderBy _
instance Show OrderBy where show = genericShow
instance
Show OrderBy where
instance
JSON.ReadForeign OrderBy where readImpl = JSONG.enumSumRep
show = genericS
how
instance JSON.WriteForeign OrderBy where writeImpl = JSON.writeImpl <<< s
how
------------------------------------------------------------
------------------------------------------------------------
-- V0 is the dummy case (impossible)
-- V0 is the dummy case (impossible)
...
@@ -474,23 +440,12 @@ instance Eq ApiVersion where
...
@@ -474,23 +440,12 @@ instance Eq ApiVersion where
eq V10 V10 = true
eq V10 V10 = true
eq V11 V11 = true
eq V11 V11 = true
eq _ _ = false
eq _ _ = false
instance EncodeJson ApiVersion where
encodeJson v = encodeJson (show v)
instance DecodeJson ApiVersion where
decodeJson json = do
v <- decodeJson json
case v of
"v1.0" -> pure V10
"v1.1" -> pure V11
_ -> pure V0
------------------------------------------------------------
------------------------------------------------------------
-- Types of ngrams. Used to display user-selectable tabs and is sent via API,
-- Types of ngrams. Used to display user-selectable tabs and is sent via API,
-- wrapped in `TabNgramType a :: TabSubType`
-- wrapped in `TabNgramType a :: TabSubType`
data CTabNgramType = CTabTerms | CTabSources | CTabAuthors | CTabInstitutes
data CTabNgramType = CTabTerms | CTabSources | CTabAuthors | CTabInstitutes
derive instance Generic CTabNgramType _
derive instance Eq CTabNgramType
derive instance Eq CTabNgramType
derive instance Ord CTabNgramType
derive instance Ord CTabNgramType
instance Show CTabNgramType where
instance Show CTabNgramType where
...
@@ -498,45 +453,33 @@ instance Show CTabNgramType where
...
@@ -498,45 +453,33 @@ instance Show CTabNgramType where
show CTabSources = "Sources"
show CTabSources = "Sources"
show CTabAuthors = "Authors"
show CTabAuthors = "Authors"
show CTabInstitutes = "Institutes"
show CTabInstitutes = "Institutes"
instance EncodeJson CTabNgramType where
instance JSON.WriteForeign CTabNgramType where writeImpl = JSON.writeImpl <<< show
encodeJson t = encodeJson $ show t
data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication
data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication
derive instance Generic PTabNgramType _
derive instance Eq PTabNgramType
instance Eq PTabNgramType where eq = genericEq
derive instance Ord PTabNgramTyp
e
instance Ord PTabNgramType where compare = genericCompar
e
instance Show PTabNgramType where
instance Show PTabNgramType where
show PTabPatents = "Patents"
show PTabPatents = "Patents"
show PTabBooks = "Books"
show PTabBooks = "Books"
show PTabCommunication = "Communication"
show PTabCommunication = "Communication"
instance EncodeJson PTabNgramType where
instance JSON.WriteForeign PTabNgramType where writeImpl = JSON.writeImpl <<< show
encodeJson t = encodeJson $ show t
data TabSubType a = TabDocs | TabNgramType a | TabTrash | TabMoreLikeFav | TabMoreLikeTrash
data TabSubType a = TabDocs | TabNgramType a | TabTrash | TabMoreLikeFav | TabMoreLikeTrash
derive instance Generic (TabSubType a) _
derive instance Eq a => Eq (TabSubType a)
instance Eq a => Eq (TabSubType a) where eq = genericEq
derive instance Ord a => Ord (TabSubType a)
instance Ord a => Ord (TabSubType a) where compare = genericCompare
instance EncodeJson a => EncodeJson (TabSubType a) where
instance JSON.WriteForeign a => JSON.WriteForeign (TabSubType a) where
encodeJson TabDocs =
writeImpl TabDocs = JSON.writeImpl { type: "TabDocs"
"type" := "TabDocs"
, data: (Nothing :: Maybe String) }
~> "data" := (Nothing :: Maybe String)
writeImpl (TabNgramType a) = JSON.writeImpl { type: "TabNgramType"
~> jsonEmptyObject
, data: a }
encodeJson (TabNgramType a) =
writeImpl TabTrash = JSON.writeImpl { type: "TabTrash"
"type" := "TabNgramType"
, data: (Nothing :: Maybe String) }
~> "data" := encodeJson a
writeImpl TabMoreLikeFav = JSON.writeImpl { type: "TabMoreLikeFav"
~> jsonEmptyObject
, data: (Nothing :: Maybe String) }
encodeJson TabTrash =
writeImpl TabMoreLikeTrash = JSON.writeImpl { type: "TabMoreLikeTrash"
"type" := "TabTrash"
, data: (Nothing :: Maybe String) }
~> "data" := (Nothing :: Maybe String)
~> jsonEmptyObject
encodeJson TabMoreLikeFav =
"type" := "TabMoreLikeFav"
~> "data" := (Nothing :: Maybe String)
~> jsonEmptyObject
encodeJson TabMoreLikeTrash =
"type" := "TabMoreLikeTrash"
~> "data" := (Nothing :: Maybe String)
~> jsonEmptyObject
{-
{-
instance DecodeJson a => DecodeJson (TabSubType a) where
instance DecodeJson a => DecodeJson (TabSubType a) where
decodeJson j = do
decodeJson j = do
...
@@ -566,26 +509,25 @@ data TabType
...
@@ -566,26 +509,25 @@ data TabType
derive instance Generic TabType _
derive instance Generic TabType _
derive instance Eq TabType
derive instance Eq TabType
derive instance Ord TabType
derive instance Ord TabType
instance Show TabType where
instance Show TabType where show = genericShow
show = genericShow
instance JSON.WriteForeign TabType where
instance EncodeJson TabType where
writeImpl (TabCorpus TabDocs) = JSON.writeImpl "Docs"
encodeJson (TabCorpus TabDocs) = encodeJson "Docs"
writeImpl (TabCorpus (TabNgramType CTabAuthors)) = JSON.writeImpl "Authors"
encodeJson (TabCorpus (TabNgramType CTabAuthors)) = encodeJson "Authors"
writeImpl (TabCorpus (TabNgramType CTabInstitutes)) = JSON.writeImpl "Institutes"
encodeJson (TabCorpus (TabNgramType CTabInstitutes)) = encodeJson "Institutes"
writeImpl (TabCorpus (TabNgramType CTabSources)) = JSON.writeImpl "Sources"
encodeJson (TabCorpus (TabNgramType CTabSources)) = encodeJson "Sources"
writeImpl (TabCorpus (TabNgramType CTabTerms)) = JSON.writeImpl "Terms"
encodeJson (TabCorpus (TabNgramType CTabTerms)) = encodeJson "Terms"
writeImpl (TabCorpus TabMoreLikeFav) = JSON.writeImpl "MoreFav"
encodeJson (TabCorpus TabMoreLikeFav) = encodeJson "MoreFav"
writeImpl (TabCorpus TabMoreLikeTrash) = JSON.writeImpl "MoreTrash"
encodeJson (TabCorpus TabMoreLikeTrash) = encodeJson "MoreTrash"
writeImpl (TabCorpus TabTrash) = JSON.writeImpl "Trash"
encodeJson (TabCorpus TabTrash) = encodeJson "Trash"
writeImpl (TabDocument TabDocs) = JSON.writeImpl "Docs"
encodeJson (TabDocument TabDocs) = encodeJson "Docs"
writeImpl (TabDocument (TabNgramType CTabAuthors)) = JSON.writeImpl "Authors"
encodeJson (TabDocument (TabNgramType CTabAuthors)) = encodeJson "Authors"
writeImpl (TabDocument (TabNgramType CTabInstitutes)) = JSON.writeImpl "Institutes"
encodeJson (TabDocument (TabNgramType CTabInstitutes)) = encodeJson "Institutes"
writeImpl (TabDocument (TabNgramType CTabSources)) = JSON.writeImpl "Sources"
encodeJson (TabDocument (TabNgramType CTabSources)) = encodeJson "Sources"
writeImpl (TabDocument (TabNgramType CTabTerms)) = JSON.writeImpl "Terms"
encodeJson (TabDocument (TabNgramType CTabTerms)) = encodeJson "Terms"
writeImpl (TabDocument TabMoreLikeFav) = JSON.writeImpl "MoreFav"
encodeJson (TabDocument TabMoreLikeFav) = encodeJson "MoreFav"
writeImpl (TabDocument TabMoreLikeTrash) = JSON.writeImpl "MoreTrash"
encodeJson (TabDocument TabMoreLikeTrash) = encodeJson "MoreTrash"
writeImpl (TabDocument TabTrash) = JSON.writeImpl "Trash"
encodeJson (TabDocument TabTrash) = encodeJson "Trash"
writeImpl (TabPairing _d) = JSON.writeImpl "TabPairing" -- TODO
encodeJson (TabPairing _d) = encodeJson "TabPairing" -- TODO
-- ["Docs","Trash","MoreFav","MoreTrash","Terms","Sources","Authors","Institutes","Contacts"]
-- ["Docs","Trash","MoreFav","MoreTrash","Terms","Sources","Authors","Institutes","Contacts"]
{-
{-
instance DecodeJson TabType where
instance DecodeJson TabType where
...
@@ -608,13 +550,10 @@ data Mode = Authors
...
@@ -608,13 +550,10 @@ data Mode = Authors
| Terms
| Terms
derive instance Generic Mode _
derive instance Generic Mode _
instance Show Mode where
instance Show Mode where show = genericShow
show = genericShow
instance Eq Mode where eq = genericEq
derive instance Eq Mode
instance Ord Mode where compare = genericCompare
instance Ord Mode where
instance JSON.WriteForeign Mode where writeImpl = JSON.writeImpl <<< show
compare = genericCompare
instance EncodeJson Mode where
encodeJson x = encodeJson $ show x
modeTabType :: Mode -> CTabNgramType
modeTabType :: Mode -> CTabNgramType
modeTabType Authors = CTabAuthors
modeTabType Authors = CTabAuthors
...
...
src/Gargantext/Utils/CacheAPI.purs
View file @
81e21c97
...
@@ -2,7 +2,6 @@ module Gargantext.Utils.CacheAPI where
...
@@ -2,7 +2,6 @@ module Gargantext.Utils.CacheAPI where
import Control.Monad.Except (runExcept)
import Control.Monad.Except (runExcept)
import Control.Promise (Promise, toAffE)
import Control.Promise (Promise, toAffE)
import Data.Argonaut (class DecodeJson, decodeJson)
import Data.Either (Either(..))
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Data.Tuple (Tuple(..))
...
@@ -12,6 +11,7 @@ import Effect.Exception (error)
...
@@ -12,6 +11,7 @@ import Effect.Exception (error)
import Foreign as F
import Foreign as F
import Foreign.Object as O
import Foreign.Object as O
import Milkis as M
import Milkis as M
import Simple.JSON as JSON
import Type.Row (class Union)
import Type.Row (class Union)
import Gargantext.Prelude hiding (add)
import Gargantext.Prelude hiding (add)
...
@@ -19,14 +19,14 @@ import Gargantext.Ends (class ToUrl, toUrl)
...
@@ -19,14 +19,14 @@ import Gargantext.Ends (class ToUrl, toUrl)
import Gargantext.Sessions (Session(..))
import Gargantext.Sessions (Session(..))
get :: forall a p.
DecodeJso
n a => ToUrl Session p => Cache -> Session -> p -> Aff a
get :: forall a p.
JSON.ReadForeig
n a => ToUrl Session p => Cache -> Session -> p -> Aff a
get cache session p = do
get cache session p = do
let req = makeGetRequest session p
let req = makeGetRequest session p
res <- cached cache req
res <- cached cache req
j <- M.
json
res
j <- M.
text
res
case
decodeJson (F.unsafeFromForeign j)
of
case
JSON.readJSON j
of
Left err -> throwError $ error $ "decodeJson affResp.body: " <> show err
Left err -> throwError $ error $ "decodeJson affResp.body: " <> show err
Right b -> pure b
Right b -> pure b
...
@@ -88,14 +88,14 @@ cached cache req = do
...
@@ -88,14 +88,14 @@ cached cache req = do
Just res -> pure res
Just res -> pure res
Nothing -> throwError $ error $ "Cannot add to cache"
Nothing -> throwError $ error $ "Cannot add to cache"
cachedJson :: forall a.
DecodeJso
n a => Cache -> Request -> Aff a
cachedJson :: forall a.
JSON.ReadForeig
n a => Cache -> Request -> Aff a
cachedJson cache req = do
cachedJson cache req = do
res <- cached cache req
res <- cached cache req
-- liftEffect $ do
-- liftEffect $ do
-- log2 "[cachedJson] res" res
-- log2 "[cachedJson] res" res
j <- M.
json
res
j <- M.
text
res
case
decodeJson (F.unsafeFromForeign j)
of
case
JSON.readJSON j
of
Left err -> throwError $ error $ "[cachedJson] decodeJson affResp.body: " <> show err
Left err -> throwError $ error $ "[cachedJson] decodeJson affResp.body: " <> show err
Right b -> pure b
Right b -> pure b
...
@@ -110,11 +110,11 @@ fetch req = do
...
@@ -110,11 +110,11 @@ fetch req = do
res <- toAffE $ _fetch req
res <- toAffE $ _fetch req
pure $ F.unsafeFromForeign res
pure $ F.unsafeFromForeign res
pureJson :: forall a.
DecodeJso
n a => Request -> Aff a
pureJson :: forall a.
JSON.ReadForeig
n a => Request -> Aff a
pureJson req = do
pureJson req = do
res <- fetch req
res <- fetch req
j <- M.
json
res
j <- M.
text
res
case
decodeJson (F.unsafeFromForeign j)
of
case
JSON.readJSON j
of
Left err -> throwError $ error $ "[pureJson] decodeJson affResp.body: " <> show err
Left err -> throwError $ error $ "[pureJson] decodeJson affResp.body: " <> show err
Right b -> pure b
Right b -> pure b
...
...
src/Gargantext/Utils/JSON.purs
View file @
81e21c97
...
@@ -6,8 +6,9 @@ import Control.Monad.Except (withExcept)
...
@@ -6,8 +6,9 @@ import Control.Monad.Except (withExcept)
import Data.Int as Int
import Data.Int as Int
import Data.List as List
import Data.List as List
import Data.Map as Map
import Data.Map as Map
import Data.Maybe (fromJust)
import Data.Maybe (fromJust
, Maybe(..)
)
import Data.Sequence as Seq
import Data.Sequence as Seq
import Data.Traversable (sequence)
import Data.TraversableWithIndex (traverseWithIndex)
import Data.TraversableWithIndex (traverseWithIndex)
import Data.Tuple (Tuple(..))
import Data.Tuple (Tuple(..))
import Foreign (F, Foreign, ForeignError(..), readArray, unsafeToForeign)
import Foreign (F, Foreign, ForeignError(..), readArray, unsafeToForeign)
...
@@ -42,9 +43,16 @@ writeList xs = unsafeToForeign $ JSON.writeImpl <$> xs
...
@@ -42,9 +43,16 @@ writeList xs = unsafeToForeign $ JSON.writeImpl <$> xs
readMapInt :: forall v. JSON.ReadForeign v => Foreign -> F (Map.Map Int v)
readMapInt :: forall v. JSON.ReadForeign v => Foreign -> F (Map.Map Int v)
readMapInt f = do
readMapInt f = do
inst <- readObject' f
(inst :: Object.Object Foreign) <- readObject' f
let mapped = GUT.mapFst (fromJust <<< Int.fromString) <$> Object.toUnfoldable inst
let (mapped :: Array (F (Tuple Int v))) = (\(Tuple k v) ->
pure $ Map.fromFoldable mapped
case Int.fromString k of
Nothing -> F.fail $ ErrorAtProperty k $ ForeignError "Cannot convert to int"
Just kInt -> do
v' <- JSON.readImpl v
pure $ Tuple kInt v'
) <$> Object.toUnfoldable inst
seq <- sequence mapped
pure $ Map.fromFoldable seq
where
where
readObject' :: Foreign -> F (Object.Object Foreign)
readObject' :: Foreign -> F (Object.Object Foreign)
readObject' value
readObject' value
...
...
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