Commit 81e21c97 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[simple-json] code compiles now

parent 0f9d2064
Pipeline #1566 failed with stage
...@@ -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" ]
......
...@@ -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
]; ];
......
...@@ -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"
, "read" , "record"
, "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" ]
......
...@@ -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
......
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
......
...@@ -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
......
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
-- 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 (mempty :: 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 (mempty :: 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
......
...@@ -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 =
......
This diff is collapsed.
...@@ -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
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -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: mempty 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 = mempty } setParentResetChildren p = _ { ngramsParent = p, ngramsChildren = Map.empty }
performAction :: Action -> Effect Unit performAction :: Action -> Effect Unit
performAction (SetParentResetChildren p) = performAction (SetParentResetChildren p) =
......
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 => DecodeJson res => Eq ret => useLoaderWithCacheAPI :: forall path res ret. Eq path => JSON.ReadForeign 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 => DecodeJson res => Eq ret => useCachedAPILoaderEffect :: forall path res ret. Eq path => JSON.ReadForeign res => Eq ret =>
Record (LoaderWithCacheAPIEffectProps path res ret) Record (LoaderWithCacheAPIEffectProps path res ret)
-> R.Hooks Unit -> R.Hooks Unit
useCachedAPILoaderEffect { cacheEndpoint useCachedAPILoaderEffect { cacheEndpoint
......
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 }
...@@ -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)}
......
This diff is collapsed.
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 => DecodeJson res => Eq ret => JSON.ReadForeign 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 => DecodeJson res => Eq ret => JSON.ReadForeign res =>
R.Component (MetricsWithCacheLoadViewProps res ret) R.Component (MetricsWithCacheLoadViewProps res ret)
metricsWithCacheLoadViewCpt = here.component "metricsWithCacheLoadView" cpt metricsWithCacheLoadViewCpt = here.component "metricsWithCacheLoadView" cpt
where where
......
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
......
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
......
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
......
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
......
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 (FTFieldList(..), 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
......
...@@ -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
......
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
}
...@@ -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
......
...@@ -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
......
This diff is collapsed.
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 => DecodeJson res => Eq ret => Eq path => JSON.ReadForeign 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 => DecodeJson res => Eq ret => Eq path => JSON.ReadForeign res =>
Record (LoaderWithCacheAPIEffectProps path res ret) Record (LoaderWithCacheAPIEffectProps path res ret)
-> R.Hooks Unit -> R.Hooks Unit
useCachedAPILoaderEffect { cacheEndpoint useCachedAPILoaderEffect { cacheEndpoint
......
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
......
This diff is collapsed.
...@@ -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. DecodeJson a => ToUrl Session p => Cache -> Session -> p -> Aff a get :: forall a p. JSON.ReadForeign 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. DecodeJson a => Cache -> Request -> Aff a cachedJson :: forall a. JSON.ReadForeign 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. DecodeJson a => Request -> Aff a pureJson :: forall a. JSON.ReadForeign 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
......
...@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment