Commit 4ca0c477 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-dashboard-charts' of...

Merge branch 'dev-dashboard-charts' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge
parents 906b6406 11c18cea
......@@ -240,9 +240,10 @@ codeTypeSelectorCpt = R.hooksComponent "G.C.CE.CodeTypeSelector" cpt
where
cpt {codeType, onChange} _ = do
pure $ R2.select { className: "form-control"
, on: { change: onSelectChange codeType onChange }
, style: { width: "150px" }
, value: show $ fst codeType }
, defaultValue: show $ fst codeType
, on: { change: onSelectChange codeType onChange }
, style: { width: "150px" }
}
(option <$> [Haskell, JSON, Markdown])
option :: CodeType -> R.Element
......
......@@ -33,7 +33,7 @@ import Gargantext.Utils.Reactix as R2
import Gargantext.Routes as Routes
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, sessionId, post, delete, put)
import Gargantext.Types (NodeType(..), OrderBy(..), TabType, TabPostQuery(..), AffTableResult)
import Gargantext.Types (NodeType(..), OrderBy(..), TabType, TabPostQuery(..), AffTableResult, NodeID)
------------------------------------------------------------------------
data Category = Trash | UnRead | Checked | Topic | Favorite
......@@ -143,7 +143,6 @@ categoryRoute nodeId = NodeAPI Node (Just nodeId) "category"
putCategories :: Session -> Int -> CategoryQuery -> Aff (Array Int)
putCategories session nodeId = put session $ categoryRoute nodeId
type NodeID = Int
type TotalRecords = Int
type LayoutProps =
......
......@@ -25,13 +25,12 @@ import Gargantext.Components.Table as T
import Gargantext.Routes (SessionRoute(Search, NodeAPI))
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, post, deleteWithBody)
import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..))
import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..), NodeID)
import Gargantext.Utils (toggleSet, zeroPad)
import Gargantext.Utils.DecodeMaybe ((.|))
import Gargantext.Utils.Reactix as R2
------------------------------------------------------------------------
type NodeID = Int
type TotalRecords = Int
-- Example:
......
......@@ -54,7 +54,7 @@ nodeMainSpan :: (Action -> Aff Unit)
-> R.Element
nodeMainSpan d p folderOpen session frontends = R.createElement el p []
where
el = R.hooksComponent "NodeMainSpan" cpt
el = R.hooksComponent "G.C.F.T.N.B.NodeMainSpan" cpt
cpt props@{id, asyncTasks, mCurrentRoute, name, nodeType, onAsyncTaskFinish} _ = do
-- only 1 popup at a time is allowed to be opened
popupOpen <- R.useState' (Nothing :: Maybe NodePopup)
......
......@@ -5,7 +5,7 @@ import Data.Argonaut.Parser (jsonParser)
import Data.Array as A
import Data.Either (Either(..))
import Data.List as List
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
......@@ -84,7 +84,7 @@ corpusLayoutViewCpt = R.hooksComponent "G.C.N.C.corpusLayoutView" cpt
H.div { className: "btn btn-default " <> (saveEnabled fieldsWithIndex fieldsS)
, on: { click: onClickSave {fields: fieldsS, nodeId, reload, session} }
} [
H.span { className: "glyphicon glyphicon-floppy-disk" } [ ]
H.span { className: "fa fa-floppy-o" } [ ]
]
]
, H.div {} [ fieldsCodeEditor { fields: fieldsS
......@@ -94,7 +94,7 @@ corpusLayoutViewCpt = R.hooksComponent "G.C.N.C.corpusLayoutView" cpt
H.div { className: "btn btn-default"
, on: { click: onClickAdd fieldsS }
} [
H.span { className: "glyphicon glyphicon-plus" } [ ]
H.span { className: "fa fa-plus" } [ ]
]
]
]
......@@ -151,9 +151,8 @@ fieldsCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldsCodeEditorCpt" cpt
onChange :: R.State FTFieldsWithIndex -> Index -> FieldType -> Effect Unit
onChange (_ /\ setFields) idx typ = do
setFields $ \fields ->
case List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { typ = typ })) fields of
Nothing -> fields
Just newFields -> newFields
fromMaybe fields $
List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { typ = typ })) fields
onMoveDown :: R.State Int -> R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit
onMoveDown (_ /\ setMasterKey) (fs /\ setFields) idx _ = do
......@@ -168,16 +167,12 @@ fieldsCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldsCodeEditorCpt" cpt
onRemove :: R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit
onRemove (_ /\ setFields) idx _ = do
setFields $ \fields ->
case List.deleteAt idx fields of
Nothing -> fields
Just newFields -> recomputeIndices newFields
fromMaybe fields $ List.deleteAt idx fields
onRename :: R.State FTFieldsWithIndex -> Index -> String -> Effect Unit
onRename (_ /\ setFields) idx newName = do
setFields $ \fields ->
case List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { name = newName })) fields of
Nothing -> fields
Just newFields -> newFields
fromMaybe fields $ List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { name = newName })) fields
recomputeIndices :: FTFieldsWithIndex -> FTFieldsWithIndex
recomputeIndices = List.mapWithIndex $ \idx -> \(Tuple _ t) -> Tuple idx t
......@@ -213,7 +208,7 @@ fieldCodeEditorWrapperCpt = R.hooksComponent "G.C.N.C.fieldCodeEditorWrapperCpt"
H.div { className: "btn btn-danger"
, on: { click: \_ -> onRemove unit }
} [
H.span { className: "glyphicon glyphicon-trash" } [ ]
H.span { className: "fa fa-trash" } [ ]
]
]
, moveDownButton canMoveDown
......@@ -230,14 +225,14 @@ fieldCodeEditorWrapperCpt = R.hooksComponent "G.C.N.C.fieldCodeEditorWrapperCpt"
H.div { className: "btn btn-default"
, on: { click: \_ -> onMoveDown unit }
} [
H.span { className: "glyphicon glyphicon-arrow-down" } [ ]
H.span { className: "fa fa-arrow-down" } [ ]
]
moveUpButton false = H.div {} []
moveUpButton true =
H.div { className: "btn btn-default"
, on: { click: \_ -> onMoveUp unit }
} [
H.span { className: "glyphicon glyphicon-arrow-up" } [ ]
H.span { className: "fa fa-arrow-up" } [ ]
]
type RenameableProps =
......@@ -287,7 +282,7 @@ renameableTextCpt = R.hooksComponent "G.C.N.C.renameableTextCpt" cpt
H.span { className: "text" } [ H.text text ]
, H.span { className: "btn btn-default"
, on: { click: \_ -> setIsEditing $ const true } } [
H.span { className: "glyphicon glyphicon-pencil" } []
H.span { className: "fa fa-pencil" } []
]
]
cpt {isEditing: (true /\ setIsEditing), onRename, state: (text /\ setText)} _ = do
......@@ -300,7 +295,7 @@ renameableTextCpt = R.hooksComponent "G.C.N.C.renameableTextCpt" cpt
setIsEditing $ const false
onRename text
} } [
H.span { className: "glyphicon glyphicon-floppy-disk" } []
H.span { className: "fa fa-floppy-o" } []
]
]
......@@ -401,3 +396,14 @@ loadCorpusWithChild {nodeId:childId, session} = do
listNodeRoute = NodeAPI Node <<< Just
defaultListIdsRoute = Children NodeList 0 1 Nothing <<< Just
type LoadWithReloadProps =
(
reload :: Int
| LoadProps
)
-- Just to make reloading effective
loadCorpusWithChildAndReload :: Record LoadWithReloadProps -> Aff CorpusData
loadCorpusWithChildAndReload {nodeId, reload, session} = loadCorpusWithChild {nodeId, session}
module Gargantext.Components.Nodes.Corpus.Chart.Predefined where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Ord (genericCompare)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe, fromMaybe)
import Reactix as R
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeID, Mode(..), TabSubType(..), TabType(..), modeTabType)
data PredefinedChart =
CDocsHistogram
| CAuthorsPie
| CInstitutesTree
| CTermsMetrics
derive instance genericPredefinedChart :: Generic PredefinedChart _
instance showPredefinedChart :: Show PredefinedChart where
show = genericShow
derive instance eqPredefinedChart :: Eq PredefinedChart
instance ordPredefinedChart :: Ord PredefinedChart where
compare = genericCompare
instance decodePredefinedChart :: DecodeJson PredefinedChart where
decodeJson json = do
obj <- decodeJson json
pure $ readChart' obj
instance encodePredefinedChart :: EncodeJson PredefinedChart where
encodeJson c = encodeJson $ show c
readChart' :: String -> PredefinedChart
readChart' "CDocsHistogram" = CDocsHistogram
readChart' "CAuthorsPie" = CAuthorsPie
readChart' "CInstitutesTree" = CInstitutesTree
readChart' "CTermsMetrics" = CTermsMetrics
readChart' _ = CDocsHistogram
allPredefinedCharts :: Array PredefinedChart
allPredefinedCharts = [
CDocsHistogram
, CAuthorsPie
, CTermsMetrics
, CInstitutesTree
]
type Params =
(
corpusId :: NodeID
, session :: Session
-- optinal params
, limit :: Maybe Int
, listId :: Maybe Int
)
render :: PredefinedChart -> Record Params -> R.Element
render CDocsHistogram { corpusId, session } = histo { path, session }
where
path = { corpusId
, tabType: TabCorpus TabDocs
}
render CAuthorsPie { corpusId, session } = pie { path, session }
where
path = { corpusId
, tabType: TabCorpus (TabNgramType $ modeTabType Authors)
}
render CInstitutesTree { corpusId, limit, listId, session } = tree { path, session }
where
path = { corpusId
, limit
, listId: fromMaybe 0 listId
, tabType: TabCorpus (TabNgramType $ modeTabType Institutes)
}
render CTermsMetrics { corpusId, limit, listId, session } = metrics { path, session }
where
path = { corpusId
, limit
, listId: fromMaybe 0 listId
, tabType: TabCorpus (TabNgramType $ modeTabType Authors)
}
module Gargantext.Components.Nodes.Corpus.Dashboard where
import Data.Array (zipWith)
import Data.Int (toNumber)
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Data.Array as A
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis', tooltipTriggerAxis)
import Gargantext.Components.Charts.Options.Data
import Gargantext.Components.Charts.Options.Series
( TreeNode, Trees(..), mkTree, seriesBarD1, seriesFunnelD1, seriesPieD1
, seriesSankey, seriesScatterD2, treeLeaf, treeNode )
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Components.Nodes.Corpus.Types (getCorpusInfo, CorpusInfo(..), Hyperdata(..))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChildAndReload, saveCorpus)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Corpus.Types (getCorpusInfo, updateHyperdataCharts, CorpusInfo(..), Hyperdata(..))
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.Reactix as R2
import Gargantext.Sessions (Session)
import Gargantext.Types (Mode(..), TabSubType(..), TabType(..), modeTabType)
import Gargantext.Types (NodeID)
type Props =
(
nodeId :: Int
nodeId :: NodeID
, session :: Session
)
......@@ -35,20 +32,39 @@ dashboardLayout :: Record Props -> R.Element
dashboardLayout props = R.createElement dashboardLayoutCpt props []
dashboardLayoutCpt :: R.Component Props
dashboardLayoutCpt = R.hooksComponent "G.P.C.D.dashboardLayout" cpt
dashboardLayoutCpt = R.hooksComponent "G.C.N.C.D.dashboardLayout" cpt
where
cpt params@{nodeId, session} _ = do
useLoader params loadCorpusWithChild $
\corpusData@{corpusId, defaultListId, corpusNode: NodePoly poly} ->
reload <- R.useState' 0
useLoader {nodeId, reload: fst reload, session} loadCorpusWithChildAndReload $
\corpusData@{corpusId, defaultListId, corpusNode: NodePoly poly} -> do
let { name, date, hyperdata : Hyperdata h} = poly
CorpusInfo {desc,query,authors} = getCorpusInfo h.fields
in
dashboardLayoutLoaded {corpusId, defaultListId, nodeId, session}
let CorpusInfo {authors, charts, desc, query} = getCorpusInfo h.fields
dashboardLayoutLoaded { charts
, corpusId
, defaultListId
, key: show $ fst reload
, nodeId
, onChange: onChange corpusId reload (Hyperdata h)
, session }
where
onChange :: NodeID -> R.State Int -> Hyperdata -> Array P.PredefinedChart -> Effect Unit
onChange corpusId (_ /\ setReload) h charts = do
launchAff_ do
saveCorpus $ { hyperdata: updateHyperdataCharts h charts
, nodeId: corpusId
, session }
liftEffect $ setReload $ (+) 1
type LoadedProps =
(
corpusId :: Int
charts :: Array P.PredefinedChart
, corpusId :: NodeID
, defaultListId :: Int
, key :: String
, onChange :: Array P.PredefinedChart -> Effect Unit
| Props
)
......@@ -56,65 +72,89 @@ dashboardLayoutLoaded :: Record LoadedProps -> R.Element
dashboardLayoutLoaded props = R.createElement dashboardLayoutLoadedCpt props []
dashboardLayoutLoadedCpt :: R.Component LoadedProps
dashboardLayoutLoadedCpt = R.hooksComponent "G.P.C.D.dashboardLayoutLoaded" cpt
dashboardLayoutLoadedCpt = R.hooksComponent "G.C.N.C.D.dashboardLayoutLoaded" cpt
where
cpt props _ = do
pure $ H.div {} [
H.h1 {} [ H.text "DashBoard" ]
, H.div {className: "row"} [
--H.div {className: "col-md-9 content"} [ chart globalPublis ]
H.div {className: "col-md-12 content"} [ histo (globalPublisParams props) ]
--, H.div {className: "col-md-3 content"} [ chart naturePublis ]
]
--, chart distriBySchool
, pie (authorsParams props)
--, H.div {className: "row"} (aSchool <$> schools)
--, chart scatterEx
, metrics (termsParams props)
--, chart sankeyEx
, tree (institutesParams props)
--, chart treeMapEx
--, chart treeEx
]
authorsParams {corpusId, session} = {path, session}
cpt props@{ charts, corpusId, defaultListId, onChange, session } _ = do
pure $
H.div {} ([
H.h1 {} [ H.text "DashBoard" ]
] <> chartsEls <> [addNew])
where
path = {corpusId, tabType: TabCorpus (TabNgramType $ modeTabType Authors)}
globalPublisParams {corpusId, session} = { path, session}
where
path = {corpusId, tabType: TabCorpus TabDocs}
institutesParams {corpusId, defaultListId, session} = {path, session}
where
path = { corpusId
, limit: Just 1000 -- TODO Fix
, listId: defaultListId -- TODO Is this correct?
, tabType: TabCorpus (TabNgramType $ modeTabType Institutes)
}
termsParams {corpusId, defaultListId, session} = {path, session}
addNew = H.div { className: "row" } [
H.span { className: "btn btn-default"
, on: { click: onClickAdd }} [ H.span { className: "fa fa-plus" } [] ]
]
where
onClickAdd _ = onChange $ A.cons P.CDocsHistogram charts
chartsEls = A.mapWithIndex chartIdx charts
chartIdx idx chart =
renderChart { chart, corpusId, defaultListId, onChange: onChangeChart, onRemove, session }
where
onChangeChart c = do
log2 "[dashboardLayout] idx" idx
log2 "[dashboardLayout] new chart" c
onChange $ fromMaybe charts (A.modifyAt idx (\_ -> c) charts)
onRemove _ = onChange $ fromMaybe charts $ A.deleteAt idx charts
type PredefinedChartProps =
(
corpusId :: NodeID
, chart :: P.PredefinedChart
, defaultListId :: Int
, onChange :: P.PredefinedChart -> Effect Unit
, onRemove :: Unit -> Effect Unit
, session :: Session
)
renderChart :: Record PredefinedChartProps -> R.Element
renderChart props = R.createElement renderChartCpt props []
renderChartCpt :: R.Component PredefinedChartProps
renderChartCpt = R.hooksComponent "G.C.N.C.D.renderChart" cpt
where
cpt { chart, corpusId, defaultListId, onChange, onRemove, session } _ = do
pure $ H.div { className: "row" } [
H.div {} [
R2.select { defaultValue: show chart
, on: { change: onSelectChange }
} (option <$> P.allPredefinedCharts)
]
, H.div {} [
H.span { className: "btn btn-danger"
, on: { click: onRemoveClick }} [ H.span { className: "fa fa-trash" } [] ]
]
, P.render chart params
]
where
path = { corpusId
, limit: Just 1000 -- TODO Fix
, listId: defaultListId -- TODO Is this correct?
, tabType: TabCorpus (TabNgramType $ modeTabType Terms)
}
aSchool school = H.div {className: "col-md-4 content"} [ chart $ focus school ]
schools = [ "Télécom Bretagne", "Mines Nantes", "Eurecom" ]
myData =
[seriesBarD1 {name: "Bar Data"}
[ dataSerie {name: "val1", value: 50.0}
, dataSerie {name: "val2", value: 70.0}
, dataSerie {name: "val3", value: 80.0} ] ]
focus :: String -> Options
focus school =
Options
{ mainTitle : "Focus " <> school
, subTitle : "Total scientific publications"
, xAxis : xAxis' ["2015", "2016", "2017"]
, yAxis : yAxis' { position: "left", show: false, min : 0 }
, series : myData
, addZoom : false
, tooltip : tooltipTriggerAxis } -- Necessary?
option pc =
H.option { value: show pc } [ H.text $ show pc ]
onSelectChange e = onChange $ P.readChart' value
where
value = R2.unsafeEventValue e
onRemoveClick _ = onRemove unit
params = { corpusId
, limit: Just 1000
, listId: Just defaultListId
, session
}
-- aSchool school = H.div {className: "col-md-4 content"} [ chart $ focus school ]
-- schools = [ "Télécom Bretagne", "Mines Nantes", "Eurecom" ]
-- myData =
-- [seriesBarD1 {name: "Bar Data"}
-- [ dataSerie {name: "val1", value: 50.0}
-- , dataSerie {name: "val2", value: 70.0}
-- , dataSerie {name: "val3", value: 80.0} ] ]
-- focus :: String -> Options
-- focus school =
-- Options
-- { mainTitle : "Focus " <> school
-- , subTitle : "Total scientific publications"
-- , xAxis : xAxis' ["2015", "2016", "2017"]
-- , yAxis : yAxis' { position: "left", show: false, min : 0 }
-- , series : myData
-- , addZoom : false
-- , tooltip : tooltipTriggerAxis } -- Necessary?
-----------------------------------------------------------------------------------------------------------
......
......@@ -6,12 +6,14 @@ import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.List ((:))
import Data.List as List
import Data.Maybe (Maybe)
import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
type Author = String
type Description = String
......@@ -55,6 +57,7 @@ data FieldType =
}
| JSON {
authors :: Author
, charts :: Array P.PredefinedChart
, desc :: Description
, query :: Query
, tag :: Tag
......@@ -66,30 +69,39 @@ data FieldType =
}
isJSON :: Field FieldType -> Boolean
isJSON :: FTField -> Boolean
isJSON (Field {typ}) = isJSON' typ
where
isJSON' (JSON _) = true
isJSON' _ = false
getCorpusInfo :: List.List (Field FieldType) -> CorpusInfo
getCorpusInfo :: List.List FTField -> CorpusInfo
getCorpusInfo as = case List.head (List.filter isJSON as) of
Just (Field {typ: JSON {authors, desc,query,title}}) -> CorpusInfo { title
Just (Field {typ: JSON {authors, charts, desc, query, title}}) -> CorpusInfo { title
, desc
, query
, authors
, chart:Nothing
, totalRecords:0
, charts
, totalRecords: 0
}
_ -> CorpusInfo { title:"Empty"
, desc:""
, query:""
, authors:""
, chart:Nothing
, totalRecords:0
, charts: []
, totalRecords: 0
}
updateHyperdataCharts :: Hyperdata -> Array P.PredefinedChart -> Hyperdata
updateHyperdataCharts (Hyperdata h@{fields}) charts = Hyperdata $ h { fields = updateFieldsCharts fields charts }
updateFieldsCharts :: List.List FTField -> Array P.PredefinedChart -> List.List FTField
updateFieldsCharts List.Nil _ = List.Nil
updateFieldsCharts fs [] = fs
updateFieldsCharts ((Field f@{typ: JSON j@{charts}}):as) pcharts = (Field $ f { typ = JSON $ j { charts = pcharts } }):as
updateFieldsCharts (a@(Field {typ: _}):as) pcharts = a:(updateFieldsCharts as pcharts)
derive instance genericFieldType :: Generic FieldType _
instance eqFieldType :: Eq FieldType where
eq = genericEq
......@@ -108,11 +120,12 @@ instance decodeFTField :: DecodeJson (Field FieldType) where
pure $ Haskell {haskell, tag}
"JSON" -> do
authors <- data_ .: "authors"
charts <- data_ .: "charts"
desc <- data_ .: "desc"
query <- data_ .: "query"
tag <- data_ .: "tag"
title <- data_ .: "title"
pure $ JSON {authors, desc, query, tag, title}
pure $ JSON {authors, charts, desc, query, tag, title}
"Markdown" -> do
tag <- data_ .: "tag"
text <- data_ .: "text"
......@@ -134,8 +147,9 @@ instance encodeFieldType :: EncodeJson FieldType where
"haskell" := haskell
~> "tag" := "HaskellField"
~> jsonEmptyObject
encodeJson (JSON {authors, desc, query, tag, title}) =
encodeJson (JSON {authors, charts, desc, query, tag, title}) =
"authors" := authors
~> "charts" := charts
~> "desc" := desc
~> "query" := query
~> "tag" := "JsonField"
......@@ -157,6 +171,7 @@ defaultJSON :: FieldType
defaultJSON = JSON defaultJSON'
defaultJSON' = {
authors: ""
, charts: []
, desc: ""
, query: ""
, tag: "JSONField"
......@@ -179,10 +194,10 @@ defaultField = Field {
newtype CorpusInfo =
CorpusInfo
{ title :: String
, authors :: String
, charts :: Array P.PredefinedChart
, desc :: String
, query :: String
, authors :: String
, chart :: (Maybe (Array Number))
, totalRecords :: Int }
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
......@@ -192,10 +207,10 @@ instance decodeCorpusInfo :: DecodeJson CorpusInfo where
desc <- obj .: "desc"
query <- obj .: "query"
authors <- obj .: "authors"
chart <- obj .:? "chart"
charts <- obj .: "charts"
let totalRecords = 47361 -- TODO
pure $ CorpusInfo {title, desc, query, authors, chart, totalRecords}
pure $ CorpusInfo {title, authors, charts, desc, query, totalRecords}
type CorpusData = { corpusId :: Int
, corpusNode :: NodePoly Hyperdata -- CorpusInfo
, defaultListId :: Int}
, defaultListId :: Int }
......@@ -16,6 +16,7 @@ import Prim.Row (class Union)
import URI.Query (Query)
newtype SessionId = SessionId String
type NodeID = Int
derive instance genericSessionId :: Generic SessionId _
......@@ -207,7 +208,7 @@ fldr FolderPrivate true = "fa fa-lock"
fldr FolderPrivate false = "fa fa-lock-circle"
fldr FolderShared true = "fa fa-share-alt"
fldr FolderShared false = "fa fa-share-circle"
fldr FolderShared false = "fa fa-share-alt"
fldr Team true = "fa fa-users"
fldr Team false = "fa fa-users-closed"
......@@ -216,7 +217,7 @@ fldr FolderPublic false = "fa fa-globe"
------------------------------------------------------
fldr Corpus true = "fa fa-book"
fldr Corpus false = "fa fa-book-circle"
fldr Corpus false = "fa fa-book"
fldr Phylo _ = "fa fa-code-fork"
......
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