Skip to content

P
purescript-gargantext
Commit 9a6d8cc0 authored by Mael NICOLAS's avatar Mael NICOLAS
Browse files
Options

merged

parents 8309e9f4 9264eae1
Hide whitespace changes
Inline Side-by-side
Showing with 5417 additions and 2166 deletions
bower.json
View file @ 9a6d8cc0
{
"name": "purescript-gargantext",
"ignore": [
"**/.*",
"node_modules",
"bower_components",
"output"
],
"dependencies": {
"purescript-prelude": "^3.1.0",
"purescript-console": "^3.0.0",
"purescript-thermite": "^5.0.0",
"purescript-affjax": "^5.0.0",
"purescript-routing": "^6.1.2",
"purescript-argonaut-codecs": "^2.0.0",
"purescript-argonaut-traversals": "^2.0.0",
"purescript-argonaut": "^3.1.0",
"purescript-random": "^3.0.0",
"purescript-css": "^3.4.0"
},
"devDependencies": {
"purescript-psci-support": "^3.0.0"
},
"resolutions": {
"purescript-maybe": "^3.0.0",
"purescript-monoid": "^3.0.0",
"purescript-invariant": "^3.0.0",
"purescript-functions": "^3.0.0",
"purescript-functors": "^2.0.0",
"purescript-const": "^3.0.0",
"purescript-contravariant": "^3.0.0",
"purescript-tuples": "^4.0.0",
"purescript-distributive": "^3.0.0",
"purescript-identity": "^3.0.0",
"purescript-transformers": "^3.0.0",
"purescript-arrays": "^4.0.1",
"purescript-nonempty": "^4.0.0",
"purescript-unfoldable": "^3.0.0",
"purescript-lazy": "^3.0.0",
"purescript-unsafe-coerce": "^3.0.0",
"purescript-strings": "^3.0.0",
"purescript-generics": "^4.0.0",
"purescript-tailrec": "^3.0.0",
"purescript-proxy": "^2.0.0",
"purescript-integers": "^3.0.0",
"purescript-globals": "^3.0.0",
"purescript-maps": "^3.0.0",
"purescript-st": "^3.0.0",
"purescript-eff": "^3.0.0",
"purescript-profunctor": "^3.0.0",
"purescript-enums": "^3.1.0",
"purescript-profunctor-lenses": "^3.0.0",
"purescript-sets": "^3.0.0",
"purescript-argonaut-core": "^3.1.0",
"purescript-lists": "^4.0.0",
"purescript-argonaut-codecs": "^3.0.0",
"purescript-argonaut-traversals": "^3.0.0",
"purescript-argonaut": "^3.1.0",
"purescript-prelude": "^3.1.0",
"purescript-either": "^3.1.0",
"purescript-foldable-traversable": "^3.6.1",
"purescript-control": "^3.0.0",
"purescript-bifunctors": "^3.0.0",
"purescript-newtype": "^2.0.0"
}
"name": "purescript-gargantext",
"ignore": [
"**/.*",
"node_modules",
"bower_components",
"output"
],
"dependencies": {
"purescript-console": "^4.1.0",
"purescript-thermite": "https://github.com/np/purescript-thermite.git#hide",
"purescript-affjax": "^7.0.0",
"purescript-routing": "^8.0.0",
"purescript-argonaut": "^4.0.1",
"purescript-random": "^4.0.0",
"purescript-css": "^4.0.0"
},
"devDependencies": {
"purescript-psci-support": "^4.0.0"
},
"resolutions": {
"purescript-react": "exports"
}
}
src/Gargantext/Components/Charts/Charts.purs → src/Gargantext/Components/Charts/Charts.hs
View file @ 9a6d8cc0
......@@ -2,6 +2,7 @@ module Gargantext.Components.Charts.Charts where
import Prelude hiding (min)
import Gargantext.Components.Charts.Options.Series (Series(..), D1, seriesType, SeriesShape(..))
import CSS (Color, white)
import Data.Maybe (Maybe(..))
import React as R
......@@ -30,7 +31,7 @@ group = unsafeMkProps "group"
-- resizable :: Boolean, -- PropTypes.bool,
-- onEvents :: String -- PropTypes.object
type EchartsProps eff =
type EchartsProps=
{ className :: String,
style :: String, -- objealect-black-altdarkmincnaquadahherry-blossomect,
theme :: String,
......@@ -55,7 +56,7 @@ type OptsLoading =
}
type OpTest =
{option :: Option}
{children :: R.Children, option :: Option}
type Option =
{ title :: Maybe Title
......@@ -161,11 +162,12 @@ type AxisLabel =
}
type Series =
{ name :: String
, "type" :: String
, "data" :: Array Int
}
--type Series =
-- { name :: String
-- , "type" :: String
-- , "data" :: Array Int
-- }
type Title =
{ text :: String
......@@ -202,14 +204,14 @@ type Title =
type Rich = {}
foreign import eChartsClass :: forall props. R.ReactClass props
foreign import eChartsClass :: forall props. R.ReactClass { children :: R.Children | props}
foreign import eChartsClass2 :: R.ReactClass OpTest
echarts :: forall eff. Array Props -> R.ReactElement
echarts p = R.createElementDynamic eChartsClass (unsafeFromPropsArray p) []
echarts :: Array Props -> R.ReactElement
echarts p = R.unsafeCreateElementDynamic eChartsClass (unsafeFromPropsArray p) []
echarts' :: forall eff. Option -> R.ReactElement
echarts' chart = R.createElementDynamic eChartsClass2 {option: chart} []
echarts' :: Option -> R.ReactElement
echarts' chart = R.unsafeCreateElementDynamic eChartsClass2 {option: chart} []
-- Props
......@@ -436,12 +438,12 @@ tooltip' =
}
series' :: Series
series' :: D1
series' =
{
name: "All"
, "type": "bar"
, "data": [201, 777, 879]
, "type": seriesType Bar
, "data": [201.0, 777, 879]
}
opt :: Option
......@@ -453,7 +455,7 @@ opt =
,grid: {containLabel: true}
,xAxis: xAxis'
,yAxis: yData1
,series: [series']
,series: [SeriesD1 series']
,dataZoom: [dz1', dz1', dz2', dz2']
}
......@@ -591,5 +593,4 @@ sd2 = unsafeFromPropsArray
]
p'' :: R.ReactElement
p'' = p [] []
src/Gargantext/Components/Charts/Options/Data.purs
View file @ 9a6d8cc0
......@@ -17,3 +17,4 @@ type DataS =
{ name :: String
, value :: Number
}
src/Gargantext/Components/Charts/Options/ECharts.purs
View file @ 9a6d8cc0
......@@ -11,9 +11,11 @@ import Gargantext.Components.Charts.Options.Data (DataN, DataS, DataV)
import Gargantext.Components.Charts.Options.Font (IconOptions(..), Shape(..), TextStyle, chartFontStyle, chartFontWeight, icon)
import Gargantext.Components.Charts.Options.Legend (legendType, LegendMode(..), PlainOrScroll(..), selectedMode, Orientation(..), orient)
import Gargantext.Components.Charts.Options.Position (Align(..), LeftRelativePosition(..), TopRelativePosition(..), numberPosition, percentPosition, relativePosition)
import Gargantext.Components.Charts.Options.Series (Series, SeriesName, SeriesShape(..), seriesType)
import Gargantext.Components.Charts.Options.Series (Serie(..), Series(..), toSeries, SeriesName, Chart(..), seriesType, D1, D2)
import Gargantext.Components.Charts.Options.Type (DataZoom, Echarts, Legend, Option, Title, Tooltip, XAxis, YAxis)
import React (unsafeCreateElementDynamic)
import React as R
import Unsafe.Coerce (unsafeCoerce)
foreign import eChartsClass :: R.ReactClass Echarts
......@@ -23,23 +25,23 @@ chart = echarts <<< chartWith <<< opts
chartWith :: Option -> Echarts
chartWith opts = { className: Nothing
, style: Nothing
, theme: Nothing
, group: Nothing
, option: opts
, initOpts: Nothing
, notMerge: Nothing
, lazyUpdate: Nothing
, loading: Nothing
, optsLoading: Nothing
, onReady: Nothing
, resizable: Nothing
, onEvents: Nothing
}
echarts :: forall eff. Echarts -> R.ReactElement
echarts chart = R.createElementDynamic eChartsClass chart []
chartWith opts = { className : Nothing
, style : Nothing
, theme : Nothing
, group : Nothing
, option : opts
, initOpts : Nothing
, notMerge : Nothing
, lazyUpdate: Nothing
, loading : Nothing
, optsLoading: Nothing
, onReady : Nothing
, resizable : Nothing
, onEvents : Nothing
}
echarts :: Echarts -> R.ReactElement
echarts chart = unsafeCreateElementDynamic (unsafeCoerce eChartsClass) chart []
type MainTitle = String
type SubTitle = String
......@@ -112,7 +114,9 @@ data2 = {name: "Favorites", icon: icon $ Shape Circle, textStyle: textStyle'}
data3 :: DataN
data3 = {name: "Test", icon: icon $ Shape Diamond, textStyle: textStyle'}
xAxis :: Array String -> XAxis
xAxis [] = unsafeCoerce {}
xAxis xs = { "data": xData xs
, "type": "category"
, axisTick: {alignWithLabel: true}
......@@ -153,12 +157,20 @@ tooltip' =
}
series :: SeriesShape -> SeriesName -> Array DataS -> Series
series :: Chart -> SeriesName -> Array DataS -> D1
series sh name ss = { name: name
, "type": seriesType sh
, "data": ss
}
seriesD2 :: Chart -> Number -> Array (Array Number) -> D2
seriesD2 sh size ds = { "symbolSize" : size
, "data" : ds
, "type" : seriesType sh
}
data YAxisFormat = YAxisFormat { position :: String
, visible :: Boolean
}
......@@ -166,7 +178,7 @@ data YAxisFormat = YAxisFormat { position :: String
data Options = Options { mainTitle :: MainTitle
, subTitle :: SubTitle
, xAxis :: XAxis
, yAxis :: Array Series
, yAxis :: Array Serie
, yAxisFormat :: YAxisFormat
, addZoom :: Boolean
}
......@@ -187,7 +199,7 @@ opts (Options { mainTitle : mainTitle
}
, grid : {containLabel: true}
, xAxis : xs
, series : ss
, series : map toSeries $ ss
, yAxis : { "type": "value"
, name: "data"
, min: 0
......@@ -195,7 +207,8 @@ opts (Options { mainTitle : mainTitle
, axisLabel: {formatter: "{value}"}
, show: visible
}
,dataZoom: if addZoom then [zoom Slider, zoom Inside] else []
, dataZoom: if addZoom then [zoom Slider, zoom Inside] else []
, children : unsafeCoerce []
}
......@@ -215,10 +228,10 @@ zoom z = {
}
seriesPie :: Series
seriesPie :: D1
seriesPie =
{
name: "Pie"
name: "Pie name"
, "type": seriesType Pie
, "data": [{name: "t1", value: 50.0},
{name: "t2", value: 45.0},
......@@ -229,7 +242,6 @@ seriesPie =
}
textStyle2 :: TextStyle
textStyle2 =
{
......
src/Gargantext/Components/Charts/Options/Font.purs
View file @ 9a6d8cc0
......@@ -14,8 +14,9 @@ module Gargantext.Components.Charts.Options.Font
import Prelude (Unit, ($), (<<<), (<>))
import Data.Generic.Rep
import Data.Generic.Rep.Show
import CSS (FontStyle(..), FontWeight(..), Prefixed(..), Value(..))
import Data.Generic (class Generic, gShow)
import Data.String (toLower)
import Gargantext.Components.Charts.Options.Color (ChartColor)
import Gargantext.Components.Charts.Options.Position (LeftRelativePosition, Position, TopRelativePosition)
......@@ -63,10 +64,10 @@ newtype Icon = Icon String
newtype ImageURL = ImageURL String
data Shape = Circle | Rect | RoundRect | Triangle | Diamond | Pin | Arrow
derive instance genericShape :: Generic Shape
derive instance genericShape :: Generic Shape _
data IconOptions = Shape Shape | Image ImageURL
icon :: IconOptions -> Icon
icon (Shape s) = Icon <<< toLower $ gShow s
icon (Shape s) = Icon <<< toLower $ genericShow s
icon (Image (ImageURL url)) = Icon $ "image://" <> url
src/Gargantext/Components/Charts/Options/Legend.purs
View file @ 9a6d8cc0
......@@ -13,7 +13,8 @@ module Gargantext.Components.Charts.Options.Legend
import Prelude (class Show, show, (<<<))
import Data.Generic (class Generic, gShow)
import Data.Generic.Rep
import Data.Generic.Rep.Show
import Data.String (toLower)
import Unsafe.Coerce (unsafeCoerce)
......@@ -31,16 +32,16 @@ legendType = LegendType <<< toLower <<< show
newtype Orient = Orient String
data Orientation = Horizontal | Vertical
derive instance genericOrientation :: Generic Orientation
derive instance genericOrientation :: Generic Orientation _
orient :: Orientation -> Orient
orient = Orient <<< toLower <<< gShow
orient = Orient <<< toLower <<< genericShow
foreign import data SelectedMode :: Type
data LegendMode = Bool Boolean | Single | Multiple
derive instance genericLegendMode :: Generic LegendMode
derive instance genericLegendMode :: Generic LegendMode _
selectedMode :: LegendMode -> SelectedMode
selectedMode (Bool b) = unsafeCoerce b
......
src/Gargantext/Components/Charts/Options/Series.purs
View file @ 9a6d8cc0
module Gargantext.Components.Charts.Options.Series where
import Effect.Exception (error, Error(..))
import Unsafe.Coerce (unsafeCoerce)
import Prelude
import Gargantext.Components.Charts.Options.Data (DataS)
......@@ -9,39 +11,152 @@ newtype SeriesType = SeriesType String
type SeriesName = String
data SeriesShape = Line
| Bar | PictorialBar
| Pie
| Scatter | EffectScater
| Radar
| Tree | TreeMap
| Sunburst
| Boxplot
| Candlestick
| Heatmap
| Map
| Parallel
| Lines
| Graph
| Sankey
| Funnel
| Gauge
| ThemeRiver
instance showSeriesShape :: Show SeriesShape where
show Line = "line"
data Chart = Line
| Bar | PictorialBar
| Pie
| Scatter | EffectScatter
| Radar
| Trees
| Sunburst
| Boxplot
| Candlestick
| Heatmap
| Map
| Parallel
| Lines
| Graph
| Sankey
| Funnel
| Gauge
| ThemeRiver
-- Trees
instance showChart :: Show Chart where
show Bar = "bar"
show Pie = "pie"
show Sunburst = "sunburst"
show EffectScatter = "effectScatter" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter-effect
show Funnel = "funnel"
show Heatmap = "heatmap"
show _ = ""
show Line = "line"
show Pie = "pie"
show Sankey = "sankey"
show Scatter = "scatter" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter-simple
show Sunburst = "sunburst"
show _ = "not implemented yet: should throw error here"
seriesType :: SeriesShape -> SeriesType
seriesType :: Chart -> SeriesType
seriesType = SeriesType <<< show
type Series =
type Series = {}
data Serie = SeriesD1 D1 | SeriesD2 D2 | SerieSankey Sankey | SerieTree Tree
type D1 =
{ name :: String
, "type" :: SeriesType
, "data" :: Array DataS
}
-- | Scatter Dimension 2 data
type D2 =
{ "symbolSize" :: Number
, "data" :: Array (Array Number)
, "type" :: SeriesType
}
toSeries :: Serie -> Series
toSeries (SeriesD1 a) = unsafeCoerce a
toSeries (SeriesD2 a) = unsafeCoerce a
toSeries (SerieSankey a) = unsafeCoerce a
toSeries (SerieTree a) = unsafeCoerce a
-- | Sankey Chart
-- https://ecomfe.github.io/echarts-examples/public/editor.html?c=sankey-simple
type Sankey = { "type" :: SeriesType
, layout :: String
, "data" :: Array Node
, "links" :: Array Link
}
type Node = { name :: String}
type Link = { source :: String
, target :: String
, value :: Number
}
mkSankey :: Array Node -> Array Link -> Serie
mkSankey ns ls = SerieSankey { "type" : seriesType Sankey
, layout : "none"
, "data" : ns
, "links" : ls
}
-- | * Trees Chart
-- All these Trees are hierarchical Trees structure (or diagram)
-- https://en.wikipedia.org/wiki/Tree_structure
-- Tree types
data Trees = TreeLine | TreeRadial | TreeMap
instance showTrees :: Show Trees where
show TreeLine = "tree" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=tree-radial
show TreeRadial = "tree" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter-simple
show TreeMap = "treemap" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=treemap-simple
-- TreeLine is a 1-Dimension horizontal hierchical Tree
-- TreeRadial is 1-Dimension radial (as circle) Tree with no surface meaning
-- https://en.wikipedia.org/wiki/Radial_tree
-- https://ecomfe.github.io/echarts-examples/public/editor.html?c=tree-radial
-- TreeMap is a is 2-Dimension Tree with surface meaning
-- TreeMap example implementation:
-- https://ecomfe.github.io/echarts-examples/public/editor.html?c=treemap-simple
type Tree = { "type" :: SeriesType
, "data" :: Array TreeData
, layout :: String
}
mkTree :: Trees -> Array TreeData -> Serie
mkTree t ts = SerieTree { "type" : SeriesType (show t)
, "data" : map toJsTree ts
, layout : layout
}
where
layout = case t of
TreeRadial -> "radial"
_ -> "none"
-- ** Data Structure of the Trees
data TreeData = TreeLeaf TreeLeaf
| TreeNode TreeNode
toJsTree :: TreeData -> TreeData
toJsTree (TreeLeaf x) = unsafeCoerce x
toJsTree (TreeNode x) = unsafeCoerce { name : x.name
, value : x.value
, children : (map toJsTree x.children)
}
type TreeNode = { name :: String
, value :: Number
, children :: Array TreeData
}
type TreeLeaf = { name :: String
, value :: Number
}
treeNode :: String -> Number -> Array TreeData -> TreeData
treeNode n v ts = TreeNode {name : n, value:v, children:ts}
treeLeaf :: String -> Number -> TreeData
treeLeaf n v = TreeLeaf { name : n, value : v}
-- | TODO
-- 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
src/Gargantext/Components/Charts/Options/Type.purs
View file @ 9a6d8cc0
......@@ -10,23 +10,23 @@ import Gargantext.Components.Charts.Options.Font (TextStyle)
import Gargantext.Components.Charts.Options.Legend (LegendType, Orient, SelectedMode)
import Gargantext.Components.Charts.Options.Position (LeftRelativePosition, Position, TopRelativePosition)
import Gargantext.Components.Charts.Options.Series (Series)
import React as R
newtype ChartAlign = ChartAlign String
type Echarts =
{ className :: Maybe String,
style :: Maybe String, -- objealect-black-altdarkmincnaquadahherry-blossomect,
theme :: Maybe String,
group :: Maybe String,
option :: Option, -- PropTypes.object.isRequired,
initOpts :: Maybe String, -- PropTypes.object,
notMerge :: Maybe Boolean,
lazyUpdate :: Maybe Boolean,
loading :: Maybe Boolean,
optsLoading :: Maybe OptsLoading, -- PropTypes.object,
onReady :: Maybe String, -- PropTypes.func,
resizable :: Maybe Boolean, -- PropTypes.bool,
onEvents :: Maybe String -- PropTypes.object
{ className :: Maybe String
, style :: Maybe String -- objealect-black-altdarkmincnaquadahherry-blossomect,
, theme :: Maybe String
, group :: Maybe String
, option :: Option -- PropTypes.object.isRequired,
, initOpts :: Maybe String -- PropTypes.object,
, notMerge :: Maybe Boolean
, lazyUpdate :: Maybe Boolean
, loading :: Maybe Boolean
, optsLoading :: Maybe OptsLoading -- PropTypes.object,
, onReady :: Maybe String -- PropTypes.func,
, resizable :: Maybe Boolean -- PropTypes.bool,
, onEvents :: Maybe String -- PropTypes.object
}
type Option =
......@@ -38,11 +38,11 @@ type Option =
, yAxis :: YAxis
, series :: Array Series
, dataZoom :: Array DataZoom
, children :: R.Children
}
type Title =
{
id :: String -- None by default
{ id :: String -- None by default
, show :: Boolean -- default True
, text :: String -- default ''
, link :: String -- default ''
......@@ -71,11 +71,11 @@ type Title =
}
type OptsLoading =
{ text :: String,
color :: Color, --- color
textColor :: Color, --color
maskColor :: Color, --color
zlevel :: Int
{ text :: String
, color :: Color --- color
, textColor :: Color --color
, maskColor :: Color --color
, zlevel :: Int
}
type DataZoom =
......
src/Gargantext/Components/GraphExplorer/Sigmajs.purs
View file @ 9a6d8cc0
......@@ -2,8 +2,9 @@ module Gargantext.Components.GraphExplorer.Sigmajs where
import Prelude
import Control.Monad.Eff (Eff)
import React (ReactClass, ReactElement, createElement)
import Effect (Effect)
import Prim.Row (class Union)
import React (Children, ReactClass, ReactElement, createElement, unsafeCreateElement)
import Unsafe.Coerce (unsafeCoerce)
foreign import edgeShapesClass :: forall props. ReactClass props
......@@ -12,51 +13,51 @@ foreign import forceAtlas2Class :: forall props. ReactClass props
foreign import forceLinkClass :: forall props. ReactClass props
foreign import loadGEXFClass :: forall props. ReactClass props
foreign import loadJSONClass :: forall props. ReactClass props
foreign import nOverlapClass :: forall props. ReactClass props
foreign import neoCypherClass :: forall props. ReactClass props
foreign import nOverlapClass :: ReactClass {children :: Children}
foreign import neoCypherClass :: ReactClass {children :: Children}
foreign import neoGraphItemsProducersClass :: forall props. ReactClass props
foreign import nodeShapesClass :: forall props. ReactClass props
foreign import randomizeNodePositionsClass :: forall props. ReactClass props
foreign import nodeShapesClass :: ReactClass {children :: Children}
foreign import randomizeNodePositionsClass :: ReactClass {children :: Children}
foreign import relativeSizeClass :: forall props. ReactClass props
foreign import sigmaClass :: forall props. ReactClass props
foreign import sigmaClass :: ReactClass {children :: Children}
foreign import sigmaEnableSVGClass :: forall props. ReactClass props
foreign import sigmaEnableWebGLClass :: forall props. ReactClass props
foreign import sigmaEnableWebGLClass :: ReactClass {children :: Children}
neoCypher :: forall eff o. Optional o (NeoCypherOptProps eff) => NeoCypherReqProps o -> ReactElement
neoCypher props = createElement neoCypherClass props []
neoCypher :: forall o. Optional o NeoCypherOptProps => NeoCypherReqProps o -> ReactElement
neoCypher props = unsafeCreateElement neoCypherClass (unsafeCoerce props) []
loadJSON :: forall eff o. Optional o (onGraphLoaded :: Eff eff Unit) => { "path" :: String | o } -> ReactElement
loadJSON props = createElement loadJSONClass props []
loadJSON :: forall o. Optional o (onGraphLoaded :: Effect Unit) => { "path" :: String | o } -> ReactElement
loadJSON props = unsafeCreateElement loadJSONClass props []
loadGEXF :: forall eff o. Optional o (onGraphLoaded :: Eff eff Unit) => { "path" :: String | o } -> ReactElement
loadGEXF props = createElement loadGEXFClass props []
loadGEXF :: forall o. Optional o (onGraphLoaded :: Effect Unit) => { "path" :: String | o } -> ReactElement
loadGEXF props = unsafeCreateElement loadGEXFClass props []
forceLink :: forall eff o. Optional o (ForceLinkOptProps eff) => { | o} -> ReactElement
forceLink props = createElement forceLinkClass props []
forceLink :: forall o. Optional o ForceLinkOptProps => { | o} -> ReactElement
forceLink props = unsafeCreateElement forceLinkClass props []
nOverlap :: forall o. Optional o NOverlapOptProps => { | o } -> ReactElement
nOverlap props = createElement nOverlapClass props []
nOverlap props = unsafeCreateElement nOverlapClass (unsafeCoerce props) []
randomizeNodePositions :: ReactElement
randomizeNodePositions = createElement randomizeNodePositionsClass {} []
relativeSize :: {initialSize :: Number } -> ReactElement
relativeSize props = createElement randomizeNodePositionsClass props []
relativeSize props = unsafeCreateElement randomizeNodePositionsClass (unsafeCoerce props) []
forceAtlas2 :: forall eff o. Optional o (ForceAtlas2OptProps eff) => { | o } -> ReactElement
forceAtlas2 props = createElement forceAtlas2Class props []
forceAtlas2 :: forall o. Optional o ForceAtlas2OptProps => { | o } -> ReactElement
forceAtlas2 props = unsafeCreateElement forceAtlas2Class props []
sigma :: forall props eff. Optional props (SigmaProps eff) => { | props} -> Array ReactElement -> ReactElement
sigma = createElement sigmaClass
sigma :: forall props. Optional props SigmaProps => { | props} -> Array ReactElement -> ReactElement
sigma props children = unsafeCreateElement sigmaClass (unsafeCoerce props) children
sigmaEnableWebGL :: ReactElement
sigmaEnableWebGL = createElement sigmaEnableWebGLClass {} []
edgeShapes :: { "default" :: EdgeShape } -> ReactElement
edgeShapes props = createElement edgeShapesClass props []
edgeShapes props = unsafeCreateElement edgeShapesClass props []
nodeShapes :: { "default" :: NodeShape } -> ReactElement
nodeShapes props = createElement nodeShapesClass props []
nodeShapes props = unsafeCreateElement nodeShapesClass (unsafeCoerce props) []
foreign import data SigmaNode :: Type
......@@ -69,9 +70,9 @@ instance srInstance :: Union r t s => Optional r s
type NeoCypherOptProps eff =
type NeoCypherOptProps =
( producers :: String
, onGraphLoaded :: Eff eff Unit
, onGraphLoaded :: Effect Unit
)
type NeoCypherReqProps o =
......@@ -84,7 +85,7 @@ type NeoCypherReqProps o =
type ForceLinkOptProps eff =
type ForceLinkOptProps =
( barnesHutOptimize :: Boolean
, barnesHutTheta :: Number
, adjustSizes :: Boolean
......@@ -138,7 +139,7 @@ sigmaEasing =
, cubicInOut : SigmaEasing "cubicInOut"
}
type ForceAtlas2OptProps eff =
type ForceAtlas2OptProps =
( worker :: Boolean
, barnesHutOptimize :: Boolean
, barnesHutTheta :: Number
......@@ -248,17 +249,17 @@ sigmaSettings = unsafeCoerce
foreign import data SigmaStyle :: Type
type SigmaProps eff =
type SigmaProps =
( renderer :: Renderer
, settings :: SigmaSettings
, style :: SigmaStyle
, graph :: SigmaGraphData
, onClickNode :: SigmaNodeEvent -> Unit
, onOverNode :: SigmaNodeEvent -> Unit
, onOutNode :: SigmaNodeEvent -> Eff eff Unit
, onClickEdge :: SigmaEdgeEvent -> Eff eff Unit
, onOverEdge :: SigmaEdgeEvent -> Eff eff Unit
, onOutEdge :: SigmaEdgeEvent -> Eff eff Unit
, onOutNode :: SigmaNodeEvent -> Effect Unit
, onClickEdge :: SigmaEdgeEvent -> Effect Unit
, onOverEdge :: SigmaEdgeEvent -> Effect Unit
, onOutEdge :: SigmaEdgeEvent -> Effect Unit
)
sStyle :: forall style. { | style } -> SigmaStyle
......
src/Gargantext/Components/GraphExplorer/Types.purs
View file @ 9a6d8cc0
......@@ -3,11 +3,8 @@ module Gargantext.Components.GraphExplorer.Types where
import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Array (concat, group, head, length, sort, take)
import Data.Maybe (fromJust)
import Data.Array (concat, fromFoldable, group, sort, take)
import Data.Newtype (class Newtype)
import Data.NonEmpty (NonEmpty(..))
import Partial.Unsafe (unsafePartial)
newtype Node = Node
{ id_ :: String
......@@ -82,10 +79,10 @@ instance ordLegend :: Ord Legend where
getLegendData :: GraphData -> Array Legend
getLegendData (GraphData {nodes, edges}) = nn
where
mp (NonEmpty a ary) = [a] <> (if length ary > 0 then [unsafePartial $ fromJust $ head ary] else [])
--mp (NonEmptyArray a ary) = [a] <> (if length ary > 0 then [unsafePartial $ fromJust $ head ary] else [])
n = sort $ map t' nodes
g = group n
nn = take 5 $ concat $ map mp g
nn = take 5 $ concat $ map fromFoldable g -- TODO: fix this after checking the output
t' :: Node -> Legend
t' (Node r) = Legend { id_ : clustDefault, label : r.label}
......
src/Gargantext/Components/Login.purs
View file @ 9a6d8cc0
......@@ -2,30 +2,28 @@ module Gargantext.Components.Login where
import Prelude hiding (div)
import Control.Monad.Aff (Aff, attempt)
import Control.Monad.Aff.Class (liftAff)
import Control.Monad.Aff.Console (log)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import DOM.HTML (window)
import DOM.HTML.Window (localStorage)
import DOM.WebStorage.Storage (getItem, setItem)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, stringify, (.?), (:=), (~>))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Lens (over)
import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationJSON)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.Modals.Modal (modalHide)
import Network.HTTP.Affjax (AJAX, affjax, defaultRequest)
import Network.HTTP.RequestHeader (RequestHeader(..))
import React.DOM (a, button, div, h2, h4, h5, i, input, label, p, span, text)
import React.DOM.Props (_data, _id, _type, aria, className, href, maxLength, name, onClick, onInput, placeholder, role, target, value)
import Thermite (PerformAction, Render, Spec, _render, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce)
import Web.HTML (window)
import Web.HTML.Window (localStorage)
import Web.Storage.Storage (getItem, setItem)
-- TODO: ask for login (modal) or account creation after 15 mn when user is not logged and has made one search at least
......@@ -48,19 +46,12 @@ initialState = State
}
data Action
= NoOp
| Login
= Login
| SetUserName String
| SetPassword String
performAction :: forall eff props. PerformAction ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
performAction NoOp _ _ = void do
modifyState id
performAction :: PerformAction State {} Action
performAction (SetUserName usr) _ _ = void do
modifyState \(State state) -> State $ state { username = usr }
......@@ -71,9 +62,9 @@ performAction (SetPassword pwd) _ _ = void do
performAction Login _ (State state) = void do
performAction Login _ _ = void do
--lift $ setHash "/search"
liftEff $ modalHide "loginModal"
liftEffect $ modalHide "loginModal"
modifyState \(State state) -> State $ state {loginC = true}
-- res <- lift $ loginReq $ LoginReq { username : state.username, password : state.password }
-- case res of
......@@ -85,7 +76,7 @@ performAction Login _ (State state) = void do
-- modifyState \(State s) -> State $ s {response = r, errorMessage = ""}
modalSpec :: forall eff props. Boolean -> String -> Spec eff State props Action -> Spec eff State props Action
modalSpec :: forall props. Boolean -> String -> Spec State props Action -> Spec State props Action
modalSpec sm t = over _render \render d p s c ->
[ div [ _id "loginModal", className $ "modal myModal" <> if sm then "" else " fade"
, role "dialog"
......@@ -113,13 +104,13 @@ modalSpec sm t = over _render \render d p s c ->
]
]
spec' :: forall eff props. Spec (console:: CONSOLE, ajax :: AJAX, dom :: DOM | eff) State props Action
spec' :: Spec State {} Action
spec' = modalSpec true "Login" renderSpec
renderSpec :: forall props eff . Spec (console::CONSOLE, ajax::AJAX, dom::DOM | eff) State props Action
renderSpec :: Spec State {} Action
renderSpec = simpleSpec performAction render
where
render :: Render State props Action
render :: Render State {} Action
render dispatch _ (State state) _ =
[
div [className "row"]
......@@ -149,13 +140,13 @@ renderSpec = simpleSpec performAction render
[ input [_type "hidden",
name "csrfmiddlewaretoken",
value "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM" ]
[]
, div [className "form-group"]
[ p [] [text state.errorMessage]
, input [className "form-control", _id "id_username",maxLength "254", name "username", placeholder "username", _type "text",value state.username, onInput \e -> dispatch (SetUserName (unsafeEventValue e))] []
, input [className "form-control", _id "id_username",maxLength "254", name "username", placeholder "username", _type "text",value state.username, onInput \e -> dispatch (SetUserName (unsafeEventValue e))]
]
, div [className "form-group"]
[ input [className "form-control", _id "id_password", name "password", placeholder "password", _type "password",value state.password,onInput \e -> dispatch (SetPassword (unsafeEventValue e))] []
[ input [className "form-control", _id "id_password", name "password", placeholder "password", _type "password",value state.password,onInput \e -> dispatch (SetPassword (unsafeEventValue e))]
, div [className "clearfix"] []
]
, div [className "center"]
......@@ -163,8 +154,6 @@ renderSpec = simpleSpec performAction render
label [] [
div [className "checkbox"]
[ input [_id "terms-accept", _type "checkbox", value "", className "checkbox"]
[
]
, text "I accept the terms of uses ",
a [href "http://gitlab.iscpif.fr/humanities/tofu/tree/master"] [text "[Read the terms of use]"]
]
......@@ -219,14 +208,14 @@ unsafeEventValue e = (unsafeCoerce e).target.value
getDeviseID :: forall eff. Eff (dom :: DOM | eff) (Maybe String)
getDeviseID :: Effect (Maybe String)
getDeviseID = do
w <- window
ls <- localStorage w
getItem "token" ls
setToken :: forall e . String -> Eff (dom :: DOM | e) Unit
setToken :: String -> Effect Unit
setToken s = do
w <- window
ls <- localStorage w
......@@ -244,37 +233,37 @@ newtype LoginReq = LoginReq
, password :: String
}
loginReq :: forall eff. LoginReq -> Aff (console :: CONSOLE, ajax :: AJAX, dom :: DOM | eff) (Either String LoginRes)
loginReq :: LoginReq -> Aff (Either String LoginRes)
loginReq encodeData =
let
setting =
defaultRequest
{ url = "https://dev.gargantext.org/api/auth/token"
, method = Left POST
, responseFormat = ResponseFormat.json
, headers =
[ ContentType applicationJSON
, Accept applicationJSON
]
, content = Just $ encodeJson encodeData
, content = Just $ Json $ encodeJson encodeData
}
in
do
affResp <- liftAff $ attempt $ affjax setting
case affResp of
affResp <- request setting
case affResp.body of
Left err -> do
liftAff $ log $ show err
pure $ Left $ show err
Right a -> do
liftAff $ log $ "POST method Completed"
liftAff $ log $ "GET /api response: " <> show a.response
let res = decodeJson a.response
liftAff $ log $ "res: " <> show a.response
case res of
liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
liftEffect $ log $ "POST method Completed"
liftEffect $ log $ "GET /api response: " <> stringify json
let obj = decodeJson json
case obj of
Left e ->
liftAff $ log $ "Error Decoding : " <> show e
liftEffect $ log $ "Error Decoding : " <> show e
Right (LoginRes res1) ->
liftEff $ setToken res1.token
pure res
liftEffect $ setToken res1.token
pure obj
instance decodeLoginRes :: DecodeJson LoginRes where
decodeJson json = do
......
src/Gargantext/Components/Modals/Modal.purs
View file @ 9a6d8cc0
......@@ -2,8 +2,8 @@ module Gargantext.Components.Modals.Modal where
import Prelude (Unit)
import Control.Monad.Eff (Eff)
import Effect (Effect)
foreign import modalShow :: forall eff. String -> Eff eff Unit
foreign import modalShow :: String -> Effect Unit
foreign import modalHide :: forall eff. String -> Eff eff Unit
foreign import modalHide :: String -> Effect Unit
src/Gargantext/Components/RandomText.purs
View file @ 9a6d8cc0
......@@ -21,28 +21,29 @@ module Gargantext.Components.RandomText where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Random (RANDOM, randomInt)
import Data.Array (drop, dropEnd, filter, foldl, head, length, tail, take, takeEnd, (!!))
import Data.Maybe (Maybe(Nothing, Just), fromJust)
import Data.String (Pattern(..), fromCharArray, split, toCharArray)
import Data.String (Pattern(..), split)
import Data.String.CodeUnits (fromCharArray, toCharArray)
import Effect (Effect)
import Effect.Random (randomInt)
import Partial (crash)
import Partial.Unsafe (unsafePartial)
-------------------------------------------------------------------
randomSentences :: forall a. String -> Eff ( random :: RANDOM | a ) String
randomSentences :: String -> Effect String
randomSentences ss = case (length (sentences ss)) >= 5 of
true -> foldl (\a b -> a <> "." <> b) "" <$> randomPart (sentences ss)
_ -> pure ss
randomWords :: forall a. String -> Eff ( random :: RANDOM | a ) String
randomWords :: String -> Effect String
randomWords ws = case (length (words ws)) >= 5 of
true -> foldl (\a b -> a <> " " <> b) "" <$> randomPart (words ws)
_ -> pure ws
randomChars :: forall a. String -> Eff ( random :: RANDOM | a ) String
randomChars :: String -> Effect String
randomChars word = case (length (toCharArray word)) >= 5 of
true -> fromCharArray <$> randomPart (toCharArray word)
_ -> pure word
......@@ -61,7 +62,7 @@ data RandomWheel a = RandomWheel { before :: Array a
, after :: Array a
}
randomPart :: forall a b. Array b -> Eff ( random :: RANDOM | a ) (Array b)
randomPart :: forall b. Array b -> Effect (Array b)
randomPart array = randomArrayPoly middle >>= \(middle') -> pure ( start <> middle' <> end)
where
start = take 2 array
......@@ -69,13 +70,13 @@ randomPart array = randomArrayPoly middle >>= \(middle') -> pure ( start <> midd
end = takeEnd 2 array
randomArrayPoly :: forall a b. Array a -> Eff ( random :: RANDOM | b ) (Array a)
randomArrayPoly :: forall a. Array a -> Effect (Array a)
randomArrayPoly wheel = case head wheel of
Nothing -> pure []
Just wheel' -> randomWheel (RandomWheel { before:wheel, during:wheel', after:[]})
>>= \(RandomWheel rand) -> (pure rand.after)
randomWheel :: forall a b. RandomWheel b -> Eff ( random :: RANDOM | a ) (RandomWheel b)
randomWheel :: forall b. RandomWheel b -> Effect (RandomWheel b)
randomWheel (RandomWheel {before:[], during:d, after:a}) =
pure (RandomWheel {before:[], during:d, after:a})
......@@ -84,7 +85,7 @@ randomWheel (RandomWheel {before:b, during:d, after:a}) = do
randomWheel $ RandomWheel {before:b', during:d', after:(a <> [d'])}
randomArray :: forall a b. Array b -> Eff ( random :: RANDOM | a ) (RandomWheel b)
randomArray :: forall b. Array b -> Effect (RandomWheel b)
randomArray array = unsafePartial $ do
n <- randomInt 0 (length array - 1)
......
src/Gargantext/Components/Tab.purs
View file @ 9a6d8cc0
......@@ -9,13 +9,13 @@ import Data.Tuple (Tuple(..))
import React (ReactElement)
import React.DOM (a, div, nav, text)
import React.DOM.Props (className, onClick)
import Thermite (PerformAction, Render, Spec, _render, cotransform, focus, simpleSpec, withState)
import Thermite (PerformAction, Render, Spec, _render, modifyState, focus, simpleSpec, withState)
type State = Int
data Action = ChangeTab Int
tabs :: forall eff state props action . Lens' state State -> Prism' action Action -> List (Tuple String (Spec eff state props action)) -> Spec eff state props action
tabs :: forall state props action . Lens' state State -> Prism' action Action -> List (Tuple String (Spec state props action)) -> Spec state props action
tabs l p ls = withState \st ->
fold
[ focus l p $ simpleSpec performAction (render (activeTab st) ls)
......@@ -26,18 +26,17 @@ tabs l p ls = withState \st ->
wrapper = over _render \render d p s c ->
[div [className "tab-content"] $ render d p s c]
tab :: forall eff state props action. Int -> Int -> Tuple String (Spec eff state props action) -> Spec eff state props action
tab :: forall state props action. Int -> Int -> Tuple String (Spec state props action) -> Spec state props action
tab sid iid (Tuple name spec) = over _render tabRender spec
where
tabRender renderer d p s c =
[div [ className $ "tab-pane " <> if sid ==iid then " show active" else " fade"] $ renderer d p s c]
performAction :: forall eff props. PerformAction eff State props Action
performAction (ChangeTab i) _ _ = void do
cotransform \_ -> i
performAction :: forall props. PerformAction State props Action
performAction (ChangeTab i) _ _ = void $ modifyState $ const i
render :: forall eff state props action. State -> List (Tuple String (Spec eff state props action)) -> Render State props Action
render :: forall state props action. State -> List (Tuple String (Spec state props action)) -> Render State props Action
render at ls d p s c =
[ nav []
[ div [className "nav nav-tabs"]
......
src/Gargantext/Components/Tree.purs
View file @ 9a6d8cc0
......@@ -2,69 +2,83 @@ module Gargantext.Components.Tree where
import Prelude hiding (div)
import Control.Monad.Aff (Aff, attempt)
import Control.Monad.Aff.Class (liftAff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, Json, decodeJson, encodeJson, (.?))
import Data.Argonaut.Core (Json)
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Tuple (Tuple(..))
import Network.HTTP.Affjax (AJAX, affjax, defaultRequest)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import React (ReactElement)
import React.DOM (a, div, i, li, text, ul)
import React.DOM.Props (Props, className, href, onClick)
import Thermite (PerformAction, Render, Spec, cotransform, simpleSpec)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Gargantext.Config (NodeType(..), toUrl, readNodeType, End(..), ApiVersion, defaultRoot)
type Name = String
type Open = Boolean
type URL = String
type ID = Int
data NTree a = NLeaf a | NNode ID Open Name (Array (NTree a))
data NTree a = NTree a (Array (NTree a))
type FTree = NTree (Tuple Name URL)
type FTree = NTree LNode
data Action = ToggleFolder ID
data Action = ToggleFolder ID --| Initialize
type State = FTree
initialState :: State
initialState = NLeaf (Tuple "" "")
initialState = NTree (LNode {id : 1, name : "", nodeType : "", open : true}) []
performAction :: PerformAction _ State _ Action
performAction (ToggleFolder i) _ _ = void (cotransform (\td -> toggleNode i td))
performAction :: PerformAction State {} Action
performAction (ToggleFolder i) _ _ = void $ modifyState $ toggleNode i
toggleNode :: forall t10. Int -> NTree t10 -> NTree t10
toggleNode sid (NNode iid open name ary) =
NNode iid nopen name $ map (toggleNode sid) ary
where
nopen = if sid == iid then not open else open
toggleNode sid a = a
-- performAction Initialize _ _ = void $ do
-- s <- lift $ loadDefaultNode
-- case s of
-- Left err -> modifyState identity
-- Right d -> modifyState (\state -> d)
toggleNode :: Int -> NTree LNode -> NTree LNode
toggleNode sid (NTree (LNode {id, name, nodeType, open}) ary) =
NTree (LNode {id,name, nodeType, open : nopen}) $ map (toggleNode sid) ary
where
nopen = if sid == id then not open else open
------------------------------------------------------------------------
-- Realistic Tree for the UI
exampleTree :: NTree (Tuple String String)
exampleTree =
NNode 1 true "françois.pineau"
[ annuaire 2 "Annuaire"
, corpus 3 "IMT publications"
]
exampleTree :: NTree LNode
exampleTree = NTree (LNode {id : 1, name : "", nodeType : "", open : false}) []
annuaire :: Int -> String -> NTree (Tuple String String)
annuaire n name = NNode n false name
[ NLeaf (Tuple "IMT community" "#/docView")
]
-- exampleTree :: NTree LNode
-- exampleTree =
-- NTree 1 true "françois.pineau"
-- [ --annuaire 2 "Annuaire"
-- --, corpus 3 "IMT publications"
-- ]
corpus :: Int -> String -> NTree (Tuple String String)
corpus n name = NNode n false name
[ NLeaf (Tuple "Facets" "#/corpus")
, NLeaf (Tuple "Dashboard" "#/dashboard")
, NLeaf (Tuple "Graph" "#/graphExplorer")
]
-- annuaire :: Int -> String -> NTree (Tuple String String)
-- annuaire n name = NTree n false name
-- [ NTree (Tuple "IMT community" "#/docView")
-- ]
-- corpus :: Int -> String -> NTree (Tuple String String)
-- corpus n name = NTree (LNode {id : n, name, nodeType : "", open : false})
-- [ NTree (Tuple "Facets" "#/corpus") []
-- , NTree (Tuple "Dashboard" "#/dashboard") []
-- , NTree (Tuple "Graph" "#/graphExplorer") []
-- ]
------------------------------------------------------------------------
......@@ -87,27 +101,32 @@ nodeOptionsView activated = case activated of
false -> []
treeview :: Spec _ State _ Action
treeview :: Spec State {} Action
treeview = simpleSpec performAction render
where
render :: Render State _ Action
render :: Render State {} Action
render dispatch _ state _ =
[div [className "tree"] [toHtml dispatch state]]
toHtml :: _ -> FTree -> ReactElement
toHtml d (NLeaf (Tuple name link)) =
li []
[ a [ href link]
( [ text (name <> " ")
] <> nodeOptionsView false
)
toHtml :: (Action -> Effect Unit) -> FTree -> ReactElement
toHtml d (NTree (LNode {id, name, nodeType, open}) []) =
ul []
[
li []
[
a [ href (toUrl Front (readNodeType nodeType) id)]
( [ text (name <> " ")
] <> nodeOptionsView false
)
]
]
toHtml d (NNode id open name ary) =
toHtml d (NTree (LNode {id, name, nodeType, open}) ary) =
ul [ ]
[ li [] $
( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []]
, text $ " " <> name <> " "
, a [ href (toUrl Front (readNodeType nodeType) id )]
[ text $ " " <> name <> " " ]
] <> nodeOptionsCorp false <>
if open then
map (toHtml d) ary
......@@ -119,34 +138,133 @@ fldr :: Boolean -> Props
fldr open = if open then className "fas fa-folder-open" else className "fas fa-folder"
newtype LNode = LNode {id :: Int, name :: String}
newtype LNode = LNode {id :: Int, name :: String, nodeType :: String, open :: Boolean}
-- derive instance newtypeLNode :: Newtype LNode _
derive instance newtypeLNode :: Newtype LNode _
instance decodeJsonLNode :: DecodeJson LNode where
decodeJson json = do
obj <- decodeJson json
id_ <- obj .? "id"
name <- obj .? "name"
pure $ LNode {id : id_, name}
nodeType <- obj .? "type"
pure $ LNode {id : id_, name, nodeType, open : true}
instance decodeJsonFTree :: DecodeJson (NTree LNode) where
decodeJson json = do
obj <- decodeJson json
node <- obj .? "node"
nodes <- obj .? "children"
node' <- decodeJson node
nodes' <- decodeJson nodes
pure $ NTree node' nodes'
loadDefaultNode :: forall eff. Aff (ajax :: AJAX, console :: CONSOLE | eff) (Either String (Array LNode))
loadDefaultNode :: Aff (Either String (NTree LNode))
loadDefaultNode = do
res <- liftAff $ attempt $ affjax defaultRequest
{ url = "http://localhost:8008/user"
res <- request $ defaultRequest
{ url = toUrl Back Tree defaultRoot
, responseFormat = ResponseFormat.json
, method = Left GET
, headers = []
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
----- TREE CRUD Operations
renameNode :: Aff (Either String (Int)) --- need to change return type herre
renameNode = do
res <- request $ defaultRequest
{ url = toUrl Back Tree 1
, responseFormat = ResponseFormat.json
, method = Left PUT
, headers = []
}
case res of
case res.body of
Left err -> do
_ <- liftEff $ log $ show err
pure $ Left $ show err
Right a -> do
_ <- liftEff $ log $ show a.status
_ <- liftEff $ log $ show a.headers
_ <- liftEff $ log $ show a.response
let resp = decodeJson a.response
pure resp
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
deleteNode :: Aff (Either String (Int))
deleteNode = do
res <- request $ defaultRequest
{ url = toUrl Back Tree 1
, responseFormat = ResponseFormat.json
, method = Left DELETE
, headers = []
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
deleteNodes :: String -> Aff (Either String Int)
deleteNodes reqbody = do
res <- request $ defaultRequest
{ url = toUrl Back Tree 1
, responseFormat = ResponseFormat.json
, method = Left DELETE
, headers = []
, content = Just $ Json $ encodeJson reqbody
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
createNode :: String -> Aff (Either String (Int))
createNode reqbody= do
res <- request $ defaultRequest
{ url = toUrl Back Tree 1
, responseFormat = ResponseFormat.json
, method = Left POST
, headers = []
, content = Just $ Json $ encodeJson reqbody
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
fnTransform :: LNode -> FTree
fnTransform (LNode r) = NNode r.id false r.name []
fnTransform n = NTree n []
src/Gargantext/Config.purs 0 → 100644
View file @ 9a6d8cc0
{- | Main Configuration of Gargantext Front-End
The main function to use for internal link in the Front-End
developpement is : toUrl.
* Example usage (depending on your Config):
toUrl Back Corpus 1 == "http://localhost:8008/api/v1.0/corpus/1"
toUrl Front Corpus 1 == "http://localhost:2015/#/corpus/1"
-}
module Gargantext.Config where
import Prelude ( class Eq, class Ord, class Show
, compare, eq, show, (<>), identity)
import Data.Map (Map)
import Data.Map as DM
import Data.Maybe (maybe)
import Data.Tuple (Tuple(..))
endConfig :: EndConfig
endConfig = endConfig' V10
endConfig' :: ApiVersion -> EndConfig
endConfig' v = { front : frontCaddy
, back : backDev v }
-- | Default Root on shared database to develop
-- until authentication implementation
-- (Default Root will be given after authentication)
defaultRoot :: Int
defaultRoot = 347474
------------------------------------------------------------------------
frontCaddy :: Config
frontCaddy = { proto : "http://"
, port : 2015
, domain : "localhost"
, prePath : "/#/"
}
frontHaskell :: Config
frontHaskell = { proto : "http://"
, port : 8008
, domain : "localhost"
, prePath : "/index.html#/"
}
frontProd :: Config
frontProd = { proto : "https://"
, port : 8080
, domain : "gargantext.org"
, prePath : "/index.html#/"
}
------------------------------------------------------------------------
backDev :: ApiVersion -> Config
backDev v = { proto : "http://"
, port : 8008
, domain : "localhost"
, prePath : "/api/" <> show v <> "/"
}
backProd :: ApiVersion -> Config
backProd v = { proto : "https://"
, port : 8080
, domain : "gargantext.org"
, prePath : "/api/" <> show v <> "/"
}
------------------------------------------------------------------------
type EndConfig = { front :: Config
, back :: Config
}
type Config = { proto :: String
, port :: Int
, domain :: String
, prePath :: String
}
------------------------------------------------------------
type UrlBase = String
type UrlPath = String
type UrlParam = String
type Url = String
doUrl :: UrlBase -> UrlPath -> UrlParam -> Url
doUrl b p ps = b <> p <> ps
------------------------------------------------------------
endBaseUrl :: End -> EndConfig -> UrlBase
endBaseUrl Back c = baseUrl c.back
endBaseUrl Front c = baseUrl c.front
baseUrl :: Config -> UrlBase
baseUrl conf = conf.proto <> conf.domain <> ":" <> show conf.port
------------------------------------------------------------
endPathUrl :: End -> EndConfig -> NodeType -> Id -> UrlPath
endPathUrl Back c nt i = pathUrl c.back nt i
endPathUrl Front c nt i = pathUrl c.front nt i
pathUrl :: Config -> NodeType -> Id -> UrlPath
pathUrl c Children i = pathUrl c Node i <> "/" <> show Children
pathUrl c nt i = c.prePath <> urlConfig nt <> "/" <> show i
------------------------------------------------------------
toUrl :: End -> NodeType -> Id -> Url
toUrl e nt i = doUrl base path params
where
base = endBaseUrl e endConfig
path = endPathUrl e endConfig nt i
params = ""
------------------------------------------------------------
data NodeType = NodeUser
| Annuaire
| Children
| Corpus
| Dashboard
| Document
| Error
| Folder
| Graph
| Individu
| Node
| Tree
data End = Back | Front
type Id = Int
------------------------------------------------------------
data ApiVersion = V10 | V11
instance showApiVersion :: Show ApiVersion where
show V10 = "v1.0"
show V11 = "v1.1"
------------------------------------------------------------
------------------------------------------------------------
urlConfig :: NodeType -> Url
urlConfig Annuaire = show Annuaire
urlConfig Children = show Children
urlConfig Corpus = show Corpus
urlConfig Dashboard = show Dashboard
urlConfig Document = show Document
urlConfig Error = show Error
urlConfig Folder = show Folder
urlConfig Graph = show Graph
urlConfig Individu = show Individu
urlConfig Node = show Node
urlConfig NodeUser = show NodeUser
urlConfig Tree = show Tree
------------------------------------------------------------
instance showNodeType :: Show NodeType where
show Annuaire = "annuaire"
show Children = "children"
show Corpus = "corpus"
show Dashboard = "dashboard"
show Document = "document"
show Error = "ErrorNodeType"
show Folder = "folder"
show Graph = "graph"
show Individu = "individu"
show Node = "node"
show NodeUser = "user"
show Tree = "tree"
-- | TODO : where is the Read Class ?
-- instance readNodeType :: Read NodeType where
readNodeType :: String -> NodeType
readNodeType "Annuaire" = Annuaire
readNodeType "Children" = Children
readNodeType "Dashboard" = Dashboard
readNodeType "Document" = Document
readNodeType "Folder" = Folder
readNodeType "Graph" = Graph
readNodeType "Individu" = Individu
readNodeType "Node" = Node
readNodeType "NodeCorpus" = Corpus
readNodeType "NodeUser" = NodeUser
readNodeType "Tree" = Tree
readNodeType _ = Error
------------------------------------------------------------
instance ordNodeType :: Ord NodeType where
compare n1 n2 = compare (show n1) (show n2)
instance eqNodeType :: Eq NodeType where
eq n1 n2 = eq (show n1) (show n2)
------------------------------------------------------------
src/Gargantext/Config/REST.purs
View file @ 9a6d8cc0
......@@ -2,31 +2,30 @@ module Gargantext.Config.REST where
import Prelude
import Control.Monad.Aff (Aff, attempt)
import Control.Monad.Aff.Class (liftAff)
import Control.Monad.Eff.Console (CONSOLE)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut (class DecodeJson, decodeJson)
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.MediaType.Common (applicationJSON)
import Network.HTTP.Affjax (AJAX, affjax, defaultRequest)
import Network.HTTP.RequestHeader (RequestHeader(..))
import Effect.Aff (Aff)
get :: forall eff t2 t31. DecodeJson t31 => String ->
Aff (console :: CONSOLE, ajax :: AJAX| eff)
(Either String t31)
get :: forall t31. DecodeJson t31 => String ->
Aff (Either String t31)
get url = do
affResp <- liftAff $ attempt $ affjax defaultRequest
affResp <- request defaultRequest
{ method = Left GET
, url = url
, responseFormat = ResponseFormat.json
, headers = [ ContentType applicationJSON
, Accept applicationJSON
-- , RequestHeader "Authorization" $ "Bearer " <> token
-- , RequestHeader "Authorization" $ "Bearer " <> token
]
}
case affResp of
case affResp.body of
Left err -> do
pure $ Left $ show err
pure $ Left $ printResponseFormatError err
Right a -> do
let res = decodeJson a.response
let res = decodeJson a
pure res
src/Gargantext/Folder.purs 0 → 100644
View file @ 9a6d8cc0
module Gargantext.Folder where
import Prelude
import React.DOM (div, h1, text, p)
import Thermite (Render, Spec, simpleSpec, defaultPerformAction)
-- TODO : get REST informations
render :: Render {} {} Void
render dispatch _ state _ = [ h1 [] [text "Folder"]
, text "Some description of the folder here"
]
layoutFolder :: Spec {} {} Void
layoutFolder = simpleSpec defaultPerformAction render
src/Gargantext/Pages/Corpus.purs
View file @ 9a6d8cc0
......@@ -2,250 +2,58 @@ module Gargantext.Pages.Corpus where
import Prelude hiding (div)
import Control.Monad.Aff (Aff, attempt)
import Control.Monad.Aff.Class (liftAff)
import Control.Monad.Aff.Console (log)
import Control.Monad.Cont.Trans (lift)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Lens (over)
import Data.Maybe (Maybe(Just))
import Data.MediaType.Common (applicationJSON)
import Gargantext.Components.Modals.Modal (modalHide)
import Network.HTTP.Affjax (AJAX, affjax, defaultRequest)
import Network.HTTP.RequestHeader (RequestHeader(..))
import React (ReactElement)
import React.DOM (button, div, h3, h5, li, span, text, ul)
import React.DOM.Props (_data, _id, _type, aria, className, onClick, role)
import Routing.Hash.Aff (setHash)
import Thermite (PerformAction, Render, Spec, _render, cotransform, modifyState, simpleSpec)
type State =
{ select_database :: Boolean
, unselect_database :: Boolean -- dummy state
, response :: Array Response
}
newtype Response = Response
{
count :: Int
, name :: String
}
initialState :: State
initialState =
{
select_database : true
, unselect_database : true
, response : []
}
data Action
= NoOp
| SelectDatabase Boolean
| UnselectDatabase Boolean
| LoadDatabaseDetails
| GO
performAction :: forall eff props. PerformAction ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff ) State props Action
performAction NoOp _ _ = void do
modifyState id
performAction (SelectDatabase selected) _ _ = void do
modifyState \( state) -> state { select_database = selected }
performAction (UnselectDatabase unselected) _ _ = void do
modifyState \( state) -> state { unselect_database = unselected }
performAction (LoadDatabaseDetails) _ _ = void do
res <- lift $ getDatabaseDetails $ QueryString { query_query: "string",query_name: ["Pubmed"]}
case res of
Left err -> cotransform $ \(state) -> state
Right resData -> do
cotransform $ \(state) -> state {response = resData}
performAction GO _ _ = void do
lift $ setHash "/corpus"
_ <- liftEff $ modalHide "addCorpus"
modifyState id
modalSpec :: forall eff props. Boolean -> String -> Spec eff State props Action -> Spec eff State props Action
modalSpec sm t = over _render \render d p s c ->
[ div [ _id "addCorpus", className $ "modal myModal" <> if sm then "" else " fade"
, role "dialog"
, _data {show : true}
][ div [ className "modal-dialog"
, role "document"
] [ div [ className "modal-content"]
[ div [ className "modal-header"]
[ h5 [ className "modal-title"
]
[ text $ t
]
, button [ _type "button"
, className "close"
, _data { dismiss : "modal"}
] [ span [ aria {hidden : true}]
[ text "X"]
]
]
, div [ className "modal-body"]
(render d p s c)
]
]
]
]
spec' :: forall eff props. Spec (console:: CONSOLE, ajax :: AJAX, dom :: DOM | eff) State props Action
spec' = modalSpec true "Search Results" layoutAddcorpus
layoutModal :: forall e. { response :: Array Response | e} -> Array ReactElement
layoutModal state =
[button [ _type "button"
, _data { "toggle" : "modal"
, "target" : ".myModal"
}
][text "Launch modal"]
, div [ className "modal fade myModal"
, role "dialog"
, _data {show : true}
][ div [ className "modal-dialog"
, role "document"
] [ div [ className "modal-content"]
[ div [ className "modal-header"]
[ h5 [ className "modal-title"
]
[ text "CorpusView"
]
, button [ _type "button"
, className "close"
, _data { dismiss : "modal"}
] [ span [ aria {hidden : true}]
[ text "X"]
]
]
, div [ className "modal-body"]
[ ul [ className "list-group"] ( map fn1 state.response ) ]
, div [className "modal-footer"]
[ button [ _type "button"
, className "btn btn-secondary"
, _data {dismiss : "modal"}
] [ text "GO"]
]
]
]
]
]
where
fn1 (Response o) =
li [className "list-group-item justify-content-between"]
[
span [] [text o.name]
, span [className "badge badge-default badge-pill"] [ text $ show o.count]
]
layoutAddcorpus :: forall props eff . Spec (console::CONSOLE, ajax::AJAX, dom::DOM | eff) State props Action
layoutAddcorpus = simpleSpec performAction render
import Gargantext.Components.Charts.Options.ECharts (chart)
import Gargantext.Pages.Corpus.Doc.Facets.Dashboard (globalPublis)
import Gargantext.Pages.Corpus.Doc.Facets as Tab
import React.DOM (div, h3, hr, i, p, text)
import React.DOM.Props (className, style)
import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
type Corpus = { title :: String
, desc :: String
, query :: String
, date :: String
, authors :: String
}
spec' :: Spec {} {} Void
spec' = corpusSpec <> Tab.pureTab1
corpusSpec :: Spec {} {} Void
corpusSpec = simpleSpec defaultPerformAction render
where
render :: Render State props Action
render dispatch _ state _ =
[
div [className "container1"] []
, div [className "container1"]
[
div [className "jumbotron"]
[ div [className "row"]
[
div [className "col-md-6"] (layoutModal state)
, div [className "col-md-6"]
[
h3 [] [text "Corpusview"]
, ul [className "list-group"] $ map fn1 state.response
, button [onClick \_ -> dispatch GO] [text "GO"]
]
]
]
render :: Render {} {} Void
render _ _ _ _ =
[ div [className "row"]
[ div [className "col-md-3"] [ h3 [] [text corpus.title] ]
, div [className "col-md-9"] [ hr [style {height : "2px",backgroundColor : "black"}] ]
]
]
where
fn1 (Response o) =
li [className "list-group-item justify-content-between"]
[
span [] [text o.name]
, span [className "badge badge-default badge-pill"] [ text $ show o.count]
]
newtype QueryString = QueryString
{
query_query :: String
, query_name :: Array String
}
queryString :: QueryString
queryString = QueryString
{
query_query: "string",
query_name: [
"Pubmed"
]
}
instance encodeJsonQueryString :: EncodeJson QueryString where
encodeJson (QueryString obj) =
"query_query" := obj.query_query
~> "query_name" := obj.query_name
~> jsonEmptyObject
getDatabaseDetails :: forall eff. QueryString -> Aff (console::CONSOLE,ajax :: AJAX | eff) (Either String (Array Response))
getDatabaseDetails reqBody = do
let token = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE1MTk5OTg1ODMsInVzZXJfaWQiOjUsImVtYWlsIjoiYWxleGFuZHJlLmRlbGFub2VAaXNjcGlmLmZyIiwidXNlcm5hbWUiOiJkZXZlbG9wZXIifQ.Os-3wuFNSmRIxCZi98oFNBu2zqGc0McO-dgDayozHJg"
affResp <- liftAff $ attempt $ affjax defaultRequest
{ method = Left POST
, url ="http://localhost:8009/count"
, headers = [ ContentType applicationJSON
, Accept applicationJSON
-- , RequestHeader "Authorization" $ "Bearer " <> token
, div [className "row"] [ div [className "jumbotron1", style {padding : "12px 0px 20px 12px"}]
[ div [ className "col-md-8 content"]
[ p [] [ i [className "fa fa-globe"] []
, text corpus.desc
]
, p [] [ i [className "fab fa-searchengin"] []
, text corpus.query
]
]
, div [ className "col-md-4 content"]
[ p [] [ i [className "fa fa-calendar"] []
, text corpus.date
]
, p [] [ i [className "fa fa-user"] []
, text corpus.authors
]
]
]
, content = Just $ encodeJson reqBody
}
case affResp of
Left err -> do
liftAff $ log $ "error" <> show err
pure $ Left $ show err
Right a -> do
liftAff $ log $ "POST method Completed"
liftAff $ log $ "GET /api response: " <> show a.response
let res = decodeJson a.response
pure res
instance decodeJsonresponse :: DecodeJson Response where
decodeJson json = do
obj <- decodeJson json
count <- obj .? "count"
name <- obj .? "name"
pure $ Response {count,name }
]
, chart globalPublis
]
where
corpus :: Corpus
corpus = { title : "IMT Global Publications"
, desc : " Hal Database"
, query : " Query: all publications"
, date : " June. 26 2018, 10:59 am"
, authors : " Author(s): françois.pineau"
}
src/Gargantext/Pages/Corpus/Annuaire.purs 0 → 100644
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.Annuaire where
import Prelude
import Data.Array (concat)
import Data.Traversable (foldl)
import Control.Monad.Trans.Class (lift)
import Data.Either (Either(..))
import Data.Lens (Lens', Prism', lens, prism, (?~))
import Data.Maybe (Maybe(..), maybe)
import Effect.Class (liftEffect)
import React.DOM (div, h1, h3, hr, i, p, text)
import React.DOM.Props (className, style)
import Thermite (Render, Spec
, simpleSpec, defaultPerformAction
, PerformAction, modifyState)
import Effect.Console (log)
import Effect.Aff (Aff)
import Gargantext.Config (toUrl, NodeType(..), End(..))
import Gargantext.Config.REST (get)
import Gargantext.Pages.Corpus.User.Users.Types.Types (User(..))
import Gargantext.Utils.DecodeMaybe ((.?|))
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
------------------------------------------------------------------------------
type State = { info :: Maybe AnnuaireInfo
, table :: Maybe AnnuaireTable
}
type Offset = Int
type Limit = Int
data Action = Load Int
-- | ChangePageSize PageSizes
-- | ChangePage Int
------------------------------------------------------------------------------
initialState :: State
initialState = { info : Nothing, table : Nothing }
defaultAnnuaireTable :: AnnuaireTable
defaultAnnuaireTable = AnnuaireTable { annuaireTable : [Nothing] }
defaultAnnuaireInfo :: AnnuaireInfo
defaultAnnuaireInfo = AnnuaireInfo { id : 0
, typename : 0
, userId : 0
, parentId : 0
, name : ""
, date : ""
, hyperdata : ""
}
------------------------------------------------------------------------------
toRows :: AnnuaireTable -> Array (Maybe User)
toRows (AnnuaireTable a) = a.annuaireTable
layoutAnnuaire :: Spec State {} Action
layoutAnnuaire = simpleSpec performAction render
render :: Render State {} Action
render dispatch _ state _ = [ div [className "row"]
[ div [className "col-md-3"] [ h3 [] [text info.name] ]
, div [className "col-md-9"] [ hr [style {height : "2px",backgroundColor : "black"}] ]
]
, div [className "row"] [ div [className "jumbotron1", style {padding : "12px 0px 20px 12px"}]
[ div [ className "col-md-8 content"]
[ p [] [ i [className "fa fa-globe"] []
, text info.name
]
]
, div [ className "col-md-4 content"]
[ p [] [ i [className "fa fa-calendar"] []
, text info.date
]
]
]
]
, p [] [text $ foldl (<>) " "
$ map (maybe "Nothing" (\(User u) -> show u.name))
$ maybe (toRows defaultAnnuaireTable) toRows state.table]
]
where
(AnnuaireInfo info) = maybe defaultAnnuaireInfo identity state.info
(AnnuaireTable table) = maybe defaultAnnuaireTable identity state.table
------------------------------------------------------------------------------
newtype AnnuaireInfo = AnnuaireInfo { id :: Int
, typename :: Int
, userId :: Int
, parentId :: Int
, name :: String
, date :: String
, hyperdata :: String
}
instance decodeAnnuaireInfo :: DecodeJson AnnuaireInfo where
decodeJson json = do
obj <- decodeJson json
id <- obj .? "id"
typename <- obj .? "typename"
userId <- obj .? "userId"
parentId <- obj .? "parentId"
name <- obj .? "name"
date <- obj .? "date"
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 User)}
instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
decodeJson json = do
rows <- decodeJson json
pure $ AnnuaireTable { annuaireTable : rows}
------------------------------------------------------------------------
performAction :: PerformAction State {} Action
performAction (Load aId) _ _ = do
eitherTable <- lift $ getTable aId
liftEffect $ log "Feching Table"
_ <- case eitherTable of
(Right table') -> void $ modifyState $ _table ?~ table'
(Left err) -> do
liftEffect $ log err
eitherInfo <- lift $ getInfo aId
_ <- case eitherInfo of
(Right info') -> void $ modifyState $ _info ?~ info'
(Left err) -> do
liftEffect $ log err
liftEffect <<< log $ "Fetching annuaire page..."
performAction _ _ _ = pure unit
------------------------------------------------------------------------
getTable :: Int -> Aff (Either String AnnuaireTable)
getTable id = get $ toUrl Back Children id
getInfo :: Int -> Aff (Either String AnnuaireInfo)
getInfo id = get $ toUrl Back Node id
------------------------------------------------------------------------------
_table :: Lens' State (Maybe AnnuaireTable)
_table = lens (\s -> s.table) (\s ss -> s{table = ss})
_info :: Lens' State (Maybe AnnuaireInfo)
_info = lens (\s -> s.info) (\s ss -> s{info = ss})
------------------------------------------------------------------------------
src/Gargantext/Pages/Corpus/Doc/Annotation.purs
View file @ 9a6d8cc0
......@@ -3,8 +3,8 @@ module Gargantext.Pages.Corpus.Doc.Annotation where
import Prelude hiding (div)
import React (ReactElement)
import React.DOM (a, button, div, h4, h6, input, li, nav, option, p, select, span, text, ul)
import React.DOM.Props (_data, _id, _type, aria, className, href, name, onChange, onInput, placeholder, role, selected, style, value)
import Thermite (PerformAction, Render, Spec, cotransform, modifyState, simpleSpec)
import React.DOM.Props (_data, _id, _type, aria, className, href, name, onChange, onInput, placeholder, role, style, value)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce)
......@@ -21,28 +21,25 @@ initialState =
data Action
= NoOp
| ChangeString String
= ChangeString String
| ChangeAnotherString String
| SetInput String
performAction :: PerformAction _ State _ Action
performAction NoOp _ _ = pure unit
performAction :: PerformAction State {} Action
performAction (ChangeString ps) _ _ = pure unit
performAction (ChangeAnotherString ps) _ _ = pure unit
performAction (SetInput ps) _ _ = void do
modifyState \( state) -> state { inputValue = ps }
modifyState $ _ { inputValue = ps }
docview :: Spec _ State _ Action
docview :: Spec State {} Action
docview = simpleSpec performAction render
where
render :: Render State _ Action
render :: Render State {} Action
render dispatch _ state _ =
[
div [className "container1"]
......@@ -76,7 +73,7 @@ docview = simpleSpec performAction render
[
h6 [] [text "Add a free term to STOPLIST"]
, div [className "form-group"]
[ input [className "form-control", _id "id_password", name "password", placeholder "Any text", _type "value",value state.inputValue,onInput \e -> dispatch (SetInput (unsafeEventValue e))] []
[ input [className "form-control", _id "id_password", name "password", placeholder "Any text", _type "value",value state.inputValue,onInput \e -> dispatch (SetInput (unsafeEventValue e))]
, div [className "clearfix"] []
]
, button [className "btn btn-primary", _type "button"] [text "Create and Add"]
......
src/Gargantext/Pages/Corpus/Doc/Body.purs deleted 100644 → 0
View file @ 8309e9f4
module Gargantext.Pages.Corpus.Doc.Body where
import Prelude hiding (div)
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Data.Array (fold)
import Gargantext.Components.Charts.Options.ECharts (chart)
import Gargantext.Pages.Corpus.Doc.Facets.Dashboard (globalPublis)
import Gargantext.Pages.Corpus.Doc.Facets as Tab
import Network.HTTP.Affjax (AJAX)
import React.DOM (div, h3, hr, i, p, text)
import React.DOM.Props (className, style)
import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
type State = Tab.State
type Action = Tab.Action
initialState :: State
initialState = Tab.initialState
spec' :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) Tab.State props Tab.Action
spec' = fold [ corpusAnalysisSpec
, Tab.tab1
]
corpusAnalysisSpec :: forall props eff . Spec eff Tab.State props Tab.Action
corpusAnalysisSpec = simpleSpec defaultPerformAction render
where
render :: Render Tab.State props Tab.Action
render dispatch _ state _ =
[ div [className "row"]
[ div [className "col-md-3"]
[ h3 [] [text "IMT Global publications"]
]
, div [className "col-md-9"]
[ hr [style {height : "2px",backgroundColor : "black"}] []
]
]
, div [className "row"]
[ div [className "jumbotron1", style {padding : "12px 0px 20px 12px"}]
[ div [ className "col-md-8 content"]
[ p [] [ i [className "fa fa-globe"] []
, text " Hal Database"
]
, p [] [ i [className "fab fa-searchengin"] []
, text " Query: all publications with all schools ids"
]
]
, div [ className "col-md-4 content"]
[ p [] [ i [className "fa fa-calendar"] []
, text " June. 26 2018, 10:59 am"
]
, p [] [ i [className "fa fa-user"] []
, text " Author(s): françois.pineau"
]
]
]
]
, chart globalPublis
]
src/Gargantext/Pages/Corpus/Doc/Document.purs deleted 100644 → 0
View file @ 8309e9f4
module Gargantext.Pages.Corpus.Doc.Document where
import Prelude
import Control.Monad.Aff (Aff)
import Control.Monad.Cont.Trans (lift)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Array (filter)
import Data.Either (Either(..))
import Data.Generic (class Generic, gShow)
import Data.Tuple (Tuple(..))
import Gargantext.Components.Charts.Charts (p'')
import Gargantext.Config.REST (get)
import Network.HTTP.Affjax (AJAX)
import React (ReactElement)
import React.DOM (a, b, b', br', div, input, option, select, span, table, tbody, td, text, th, thead, tr)
import React.DOM.Props (_type, className, href, onChange, onClick, scope, selected, value)
import Thermite (PerformAction, Render, Spec, cotransform, defaultPerformAction, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce)
--main :: forall e. Eff (dom:: DOM, console :: CONSOLE, ajax :: AJAX | e) Unit
--main = do
-- case createReactSpec layoutDocview tdata of
-- { spec, dispatcher } -> void $ do
-- document <- DOM.window >>= DOM.document
-- container <- unsafePartial (fromJust <$> DOM.querySelector (QuerySelector "#app") (DOM.htmlDocumentToParentNode document))
-- RDOM.render (R.createFactory (R.createClass spec) {}) container
--
-- TODO: Pagination Details are not available from the BackEnd
-- TODO: PageSize Change manually sets the totalPages, need to get from backend and reload the data
-- TODO: Search is pending
-- TODO: Delete is pending
-- TODO: Fav is pending
-- TODO: Sort is Pending
-- TODO: Filter is Pending
-- TODO: When a pagination link is clicked, reload data. Right now it doesn't make sense to reload mock data.
data Action
= LoadData
| ChangePageSize PageSizes
| ChangePage Int
type State = CorpusTableData
type CorpusTableData = TableData Corpus
newtype TableData a
= TableData
{ rows :: Array { row :: a
, delete :: Boolean
}
, totalPages :: Int
, currentPage :: Int
, pageSize :: PageSizes
, totalRecords :: Int
, title :: String
-- , tree :: FTree
}
newtype Corpus
= Corpus
{ _id :: Int
, url :: String
, date :: String
, title :: String
, source :: String
, fav :: Boolean
, ngramCount :: Int
}
derive instance genericCorpus :: Generic Corpus
instance showCorpus :: Show Corpus where
show = gShow
newtype Response = Response
{ cid :: Int
, created :: String
, hyperdata :: Hyperdata
, favorite :: Boolean
, ngramCount :: Int
}
newtype Hyperdata = Hyperdata
{ title :: String
, source :: String
}
--instance decodeHyperdata :: DecodeJson Hyperdata where
-- decodeJson json = do
-- obj <- decodeJson json
-- title <- obj .? "title"
-- source <- obj .? "source"
-- pure $ Hyperdata { title,source }
--instance decodeResponse :: DecodeJson Response where
-- decodeJson json = do
-- obj <- decodeJson json
-- cid <- obj .? "id"
-- created <- obj .? "created"
-- favorite <- obj .? "favorite"
-- ngramCount <- obj .? "ngramCount"
-- hyperdata <- obj .? "hyperdata"
-- pure $ Response { cid, created, favorite, ngramCount, hyperdata }
instance decodeHyperdata :: DecodeJson Hyperdata where
decodeJson json = do
obj <- decodeJson json
title <- obj .? "nom"
source <- obj .? "fonction"
pure $ Hyperdata { title,source }
instance decodeResponse :: DecodeJson Response where
decodeJson json = do
obj <- decodeJson json
cid <- obj .? "id"
created <- pure "2018"
--created <- obj .? "date"
favorite <- pure true
ngramCount <- obj .? "id"
hyperdata <- obj .? "hyperdata"
pure $ Response { cid, created, favorite, ngramCount, hyperdata }
-- | Filter
filterSpec :: forall eff props. Spec eff State props Action
filterSpec = simpleSpec defaultPerformAction render
where
render d p s c = [div [] [ text " Filter "
, input [] []
]]
layoutDocview :: Spec _ State _ Action
layoutDocview = simpleSpec performAction render
where
render :: Render State _ Action
render dispatch _ state@(TableData d) _ =
[ div [className "container1"]
[ div [className "row"]
[
div [className "col-md-12"]
[ p''
, div [] [ text " Filter ", input [] []]
, br' []
, div [className "row"]
[ div [className "col-md-1"] [b [] [text d.title]]
, div [className "col-md-2"] [sizeDD d.pageSize dispatch]
, div [className "col-md-3"] [textDescription d.currentPage d.pageSize d.totalRecords]
, div [className "col-md-3"] [pagination dispatch d.totalPages d.currentPage]
]
, table [ className "table"]
[thead [ className "thead-dark"]
[tr [] [ th [scope "col"] [ b' [text ""] ]
, th [scope "col"] [ b' [text "Date"]]
, th [scope "col"] [ b' [text "Name"] ]
--, th [scope "col"] [ b' [text "Title"] ]
--, th [scope "col"] [ b' [text "Source"] ]
, th [scope "col"] [ b' [text "Fonction"] ]
, th [scope "col"] [ b' [text "Delete"] ]
]
]
, tbody [] $ map showRow d.rows
]
]
]
]
]
performAction :: PerformAction _ State _ Action
performAction (ChangePageSize ps) _ _ = void (cotransform (\state -> changePageSize ps state ))
performAction (ChangePage p) _ _ = void (cotransform (\(TableData td) -> TableData $ td { currentPage = p} ))
performAction LoadData _ _ = void do
res <- lift $ loadPage
case res of
Left err -> cotransform $ \state -> state
Right resData -> modifyState (\s -> resData)
loadPage :: forall eff. Aff (ajax :: AJAX, console :: CONSOLE | eff) (Either String CorpusTableData)
loadPage = do
res <- get "http://localhost:8008/node/452132/children"
-- res <- get "http://localhost:8008/corpus/472764/facet/documents/table?offset=0&limit=10"
case res of
Left err -> do
_ <- liftEff $ log $ show err
pure $ Left $ show err
Right resData -> do
let docs = toTableData (res2corpus $ resData)
_ <- liftEff $ log $ show $ map (\({ row: r, delete :_}) -> show r) ((\(TableData docs') -> docs'.rows) docs)
_ <- liftEff $ log $ show "loading"
pure $ Right docs
where
res2corpus :: Array Response -> Array Corpus
res2corpus rs = map (\(Response r) ->
Corpus { _id : r.cid
, url : ""
, date : r.created
, title : (\(Hyperdata r) -> r.title) r.hyperdata
, source : (\(Hyperdata r) -> r.source) r.hyperdata
, fav : r.favorite
, ngramCount : r.ngramCount
}) rs
toTableData :: Array Corpus -> CorpusTableData
toTableData ds = TableData
{ rows : map (\d -> { row : d , delete : false}) ds
, totalPages : 474
, currentPage : 1
, pageSize : PS100
, totalRecords : 47361
, title : "Documents"
-- , tree : exampleTree
}
---------------------------------------------------------
sampleData' :: Corpus
sampleData' = Corpus {_id : 1, url : "", date : "date3", title : "title", source : "source", fav : false, ngramCount : 1}
--
sampleData :: Array Corpus
--sampleData = replicate 10 sampleData'
sampleData = map (\(Tuple t s) -> Corpus {_id : 1, url : "", date : "2017", title: t, source: s, fav : false, ngramCount : 10}) sampleDocuments
sampleDocuments :: Array (Tuple String String)
sampleDocuments = [Tuple "Macroscopic dynamics of the fusion process" "Journal de Physique Lettres",Tuple "Effects of static and cyclic fatigue at high temperature upon reaction bonded silicon nitride" "Journal de Physique Colloques",Tuple "Reliability of metal/glass-ceramic junctions made by solid state bonding" "Journal de Physique Colloques",Tuple "High temperature mechanical properties and intergranular structure of sialons" "Journal de Physique Colloques",Tuple "SOLUTIONS OF THE LANDAU-VLASOV EQUATION IN NUCLEAR PHYSICS" "Journal de Physique Colloques",Tuple "A STUDY ON THE FUSION REACTION 139La + 12C AT 50 MeV/u WITH THE VUU EQUATION" "Journal de Physique Colloques",Tuple "Atomic structure of \"vitreous\" interfacial films in sialon" "Journal de Physique Colloques",Tuple "MICROSTRUCTURAL AND ANALYTICAL CHARACTERIZATION OF Al2O3/Al-Mg COMPOSITE INTERFACES" "Journal de Physique Colloques",Tuple "Development of oxidation resistant high temperature NbTiAl alloys and intermetallics" "Journal de Physique IV Colloque",Tuple "Determination of brazed joint constitutive law by inverse method" "Journal de Physique IV Colloque",Tuple "Two dimensional estimates from ocean SAR images" "Nonlinear Processes in Geophysics",Tuple "Comparison Between New Carbon Nanostructures Produced by Plasma with Industrial Carbon Black Grades" "Journal de Physique III",Tuple "<i>Letter to the Editor:</i> SCIPION, a new flexible ionospheric sounder in Senegal" "Annales Geophysicae",Tuple "Is reducibility in nuclear multifragmentation related to thermal scaling?" "Physics Letters B",Tuple "Independence of fragment charge distributions of the size of heavy multifragmenting sources" "Physics Letters B",Tuple "Hard photons and neutral pions as probes of hot and dense nuclear matter" "Nuclear Physics A",Tuple "Surveying the nuclear caloric curve" "Physics Letters B",Tuple "A hot expanding source in 50 A MeV Xe+Sn central reactions" "Physics Letters B"]
data' :: Array Corpus -> Array {row :: Corpus, delete :: Boolean}
data' = map {row : _, delete : false}
sdata :: Array { row :: Corpus, delete :: Boolean }
sdata = data' sampleData
tdata = TableData
{ rows : sdata
, totalPages : 10
, currentPage : 1
, pageSize : PS10
, totalRecords : 100
, title : "Documents"
-- , tree : exampleTree
}
showRow :: {row :: Corpus, delete :: Boolean} -> ReactElement
showRow {row : (Corpus c), delete} =
tr []
[ td [] [div [className $ fa <> "fa-star"][]]
-- TODO show date: Year-Month-Day only
, td [] [text c.date]
, td [] [ a [ if c.fav == true then href "#/userPage" else href "#/documentView/1" ] [ text c.title ] ]
, td [] [text c.source]
, td [] [input [ _type "checkbox"] []]
]
where
fa = case c.fav of
true -> "fas "
false -> "far "
--------------------------------------------------------------
-- | Action
-- ChangePageSize
changePageSize :: PageSizes -> CorpusTableData -> CorpusTableData
changePageSize ps (TableData td) =
TableData $ td { pageSize = ps
, totalPages = td.totalRecords / pageSizes2Int ps
, currentPage = 1
}
data PageSizes = PS10 | PS20 | PS50 | PS100
derive instance eqPageSizes :: Eq PageSizes
instance showPageSize :: Show PageSizes where
show PS10 = "10"
show PS20 = "20"
show PS50 = "50"
show PS100 = "100"
pageSizes2Int :: PageSizes -> Int
pageSizes2Int PS10 = 10
pageSizes2Int PS20 = 20
pageSizes2Int PS50 = 50
pageSizes2Int PS100 = 100
aryPS :: Array PageSizes
aryPS = [PS10, PS20, PS50, PS100]
string2PageSize :: String -> PageSizes
string2PageSize "10" = PS10
string2PageSize "20" = PS20
string2PageSize "50" = PS50
string2PageSize "100" = PS100
string2PageSize _ = PS10
sizeDD :: PageSizes -> _ -> ReactElement
sizeDD ps d
= span []
[ text "Show : "
, select [onChange (\e -> d (ChangePageSize $ string2PageSize $ (unsafeCoerce e).target.value))] $ map (optps ps) aryPS
]
optps :: PageSizes -> PageSizes -> ReactElement
optps cv val = option [ selected (cv == val), value $ show val ] [text $ show val]
textDescription :: Int -> PageSizes -> Int -> ReactElement
textDescription currPage pageSize totalRecords
= div [className "row1"]
[ div [className ""]
[ text $ "Showing " <> show start <> " to " <> show end <> " of " <> show totalRecords ]
]
where
start = (currPage - 1) * pageSizes2Int pageSize + 1
end' = currPage * pageSizes2Int pageSize
end = if end' > totalRecords then totalRecords else end'
pagination :: _ -> Int -> Int -> ReactElement
pagination d tp cp
= span [] $
[ text "Pages: ", prev, first, ldots]
<>
lnums
<>
[b' [text $ " " <> show cp <> " "]]
<>
rnums
<>
[ rdots, last, next ]
where
prev = if cp == 1 then
text " Previous "
else
span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> d $ ChangePage $ cp - 1)
] [text "Previous"]
, text " "
]
next = if cp == tp then
text " Next "
else
span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> d $ ChangePage $ cp + 1)
] [text "Next"]
, text " "
]
first = if cp == 1 then
text ""
else
span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> d $ ChangePage 1)
] [text "1"]
, text " "
]
last = if cp == tp then
text ""
else
span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> d $ ChangePage tp)
] [text $ show tp]
, text " "
]
ldots = if cp >= 5 then
text " ... "
else
text ""
rdots = if cp + 3 < tp then
text " ... "
else
text ""
lnums = map (\i -> fnmid d i) $ filter (lessthan 1) [cp - 2, cp - 1]
rnums = map (\i -> fnmid d i) $ filter (greaterthan tp) [cp + 1, cp + 2]
fnmid :: _ -> Int -> ReactElement
fnmid d i
= span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> d $ ChangePage i)
] [text $ show i]
, text " "
]
lessthan :: forall t28. Ord t28 => t28 -> t28 -> Boolean
lessthan x y = x < y
greaterthan :: forall t28. Ord t28 => t28 -> t28 -> Boolean
greaterthan x y = x > y
src/Gargantext/Pages/Corpus/Doc/Facets.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.Doc.Facets where
module Gargantext.Pages.Corpus.Doc.Facets
( module Gargantext.Pages.Corpus.Doc.Facets.States
, module Gargantext.Pages.Corpus.Doc.Facets.Actions
, module Gargantext.Pages.Corpus.Doc.Facets.Specs
) where
import Prelude hiding (div)
import Gargantext.Pages.Corpus.Doc.Facets.States
import Gargantext.Pages.Corpus.Doc.Facets.Actions
import Gargantext.Pages.Corpus.Doc.Facets.Specs
import Gargantext.Pages.Corpus.Doc.Facets.Authors as AV
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Data.Either (Either(..))
import Data.Lens (Lens', Prism', lens, prism)
import Data.List (fromFoldable)
import Data.Tuple (Tuple(..))
import Gargantext.Pages.Corpus.Doc.Document as DV
import Gargantext.Components.Tab as Tab
import Network.HTTP.Affjax (AJAX)
import Gargantext.Pages.Corpus.Doc.Facets.Sources as SV
import Gargantext.Pages.Corpus.Doc.Facets.Terms as TV
import Thermite (Spec, focus)
data Action
= DocviewA DV.Action
| SourceviewA SV.Action
| AuthorviewA AV.Action
| TermsviewA TV.Action
| TabViewA Tab.Action
| NoOp
type State =
{ docview :: DV.State
, authorview :: AV.State
, sourceview :: SV.State
, termsview :: TV.State
, activeTab :: Int
}
initialState :: State
initialState =
{ docview : DV.tdata
, authorview : AV.initialState
, sourceview : SV.initialState
, termsview : TV.initialState
, activeTab : 0
}
_doclens :: Lens' State DV.State
_doclens = lens (\s -> s.docview) (\s ss -> s {docview = ss})
_docAction :: Prism' Action DV.Action
_docAction = prism DocviewA \ action ->
case action of
DocviewA laction -> Right laction
_-> Left action
docPageSpec :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
docPageSpec = focus _doclens _docAction DV.layoutDocview
_authorlens :: Lens' State AV.State
_authorlens = lens (\s -> s.authorview) (\s ss -> s {authorview = ss})
_authorAction :: Prism' Action AV.Action
_authorAction = prism AuthorviewA \ action ->
case action of
AuthorviewA laction -> Right laction
_-> Left action
authorPageSpec :: forall eff props. Spec (dom :: DOM, console::CONSOLE, ajax :: AJAX | eff) State props Action
authorPageSpec = focus _authorlens _authorAction AV.authorspec'
_sourcelens :: Lens' State SV.State
_sourcelens = lens (\s -> s.sourceview) (\s ss -> s {sourceview = ss})
_sourceAction :: Prism' Action SV.Action
_sourceAction = prism SourceviewA \ action ->
case action of
SourceviewA laction -> Right laction
_-> Left action
sourcePageSpec :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
sourcePageSpec = focus _sourcelens _sourceAction SV.sourcespec'
_termslens :: Lens' State TV.State
_termslens = lens (\s -> s.termsview) (\s ss -> s {termsview = ss})
_termsAction :: Prism' Action TV.Action
_termsAction = prism TermsviewA \ action ->
case action of
TermsviewA laction -> Right laction
_-> Left action
termsPageSpec :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
termsPageSpec = focus _termslens _termsAction TV.termSpec'
_tablens :: Lens' State Tab.State
_tablens = lens (\s -> s.activeTab) (\s ss -> s {activeTab = ss})
_tabAction :: Prism' Action Tab.Action
_tabAction = prism TabViewA \ action ->
case action of
TabViewA laction -> Right laction
_-> Left action
tab1 :: forall eff props. Spec ( dom :: DOM, console :: CONSOLE, ajax :: AJAX| eff) State props Action
tab1 = Tab.tabs _tablens _tabAction $ fromFoldable [ Tuple "Doc View" docPageSpec
, Tuple "Author View" authorPageSpec
, Tuple "Source View" sourcePageSpec
, Tuple "Terms View" termsPageSpec
]
src/Gargantext/Pages/Corpus/Doc/Facets/Actions.purs 0 → 100644
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.Doc.Facets.Actions where
import Data.Lens (Prism', prism)
import Data.Either (Either(..))
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Sources as SV
import Gargantext.Pages.Corpus.Doc.Facets.Authors as AV
import Gargantext.Pages.Corpus.Doc.Facets.Terms as TV
import Gargantext.Components.Tab as Tab
data Action
= DocviewA DV.Action
| SourceviewA SV.Action
| AuthorviewA AV.Action
| TermsviewA TV.Action
| TabViewA Tab.Action
_docAction :: Prism' Action DV.Action
_docAction = prism DocviewA \ action ->
case action of
DocviewA laction -> Right laction
_-> Left action
_authorAction :: Prism' Action AV.Action
_authorAction = prism AuthorviewA \ action ->
case action of
AuthorviewA laction -> Right laction
_-> Left action
_sourceAction :: Prism' Action SV.Action
_sourceAction = prism SourceviewA \ action ->
case action of
SourceviewA laction -> Right laction
_-> Left action
_termsAction :: Prism' Action TV.Action
_termsAction = prism TermsviewA \ action ->
case action of
TermsviewA laction -> Right laction
_-> Left action
_tabAction :: Prism' Action Tab.Action
_tabAction = prism TabViewA \ action ->
case action of
TabViewA laction -> Right laction
_-> Left action
src/Gargantext/Pages/Corpus/Doc/Facets/Authors.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.Doc.Facets.Authors where
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Data.Array (fold)
import Gargantext.Pages.Corpus.Doc.Document as D
import Network.HTTP.Affjax (AJAX)
import Gargantext.Pages.Corpus.Doc.Facets.Documents as D
import Prelude hiding (div)
import React.DOM (h3, text)
import Thermite (PerformAction, Render, Spec, defaultPerformAction, modifyState, simpleSpec)
import Thermite (PerformAction, Render, Spec, defaultPerformAction, simpleSpec)
type State = D.State
initialState :: State
initialState = D.tdata
type Action = D.Action
authorSpec :: forall props eff . Spec ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
authorSpec :: Spec State {} Action
authorSpec = simpleSpec defaultPerformAction render
where
render :: Render State props Action
render :: Render State {} Action
render dispatch _ state _ =
[ h3 [] [text "AuthorView"]]
authorspec' :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
authorspec' :: Spec State {} Action
authorspec' = fold [authorSpec, D.layoutDocview]
src/Gargantext/Pages/Corpus/Doc/Facets/Dashboard.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.Doc.Facets.Dashboard where
import Prelude
import Prelude hiding (div)
import Data.Array (zip)
import Data.Tuple (Tuple(..))
import Gargantext.Components.Charts.Options.ECharts
import Gargantext.Components.Charts.Options.Series
import DOM (DOM)
import Gargantext.Components.Charts.Options.Type (Option)
import Data.Unit (Unit)
import Data.Int (toNumber)
import React.DOM (div, h1, text, title)
import React.DOM (div, h1, text)
import React.DOM.Props (className)
import Thermite (PerformAction, Render, Spec, simpleSpec)
import Thermite (Render, Spec, simpleSpec, defaultPerformAction)
type State = Unit
data Action = None
initialState :: State
initialState = unit
performAction :: forall eff props. PerformAction (dom :: DOM | eff) State props Action
performAction _ _ _ = pure unit
render :: forall props. Render State props Action
render :: Render {} {} Void
render dispatch _ state _ = [
h1 [] [text "IMT DashBoard"]
, div [className "row"] [ div [className "col-md-9 content"] [chart globalPublis]
......@@ -33,18 +23,23 @@ render dispatch _ state _ = [
, div [className "row"] (map (\school -> div [className "col-md-4 content"] [chart $ focus school])
[ "Télécom Bretagne", "Mines Nantes", "Eurecom"]
)
, chart scatterEx
, chart sankeyEx
, chart treeMapEx
, chart treeEx
]
where
myData = [SeriesD1 $ series Bar "Bar Data" [ {name: "val1", value: 50.0}
, {name: "val2", value: 70.0}
, {name: "val3", value: 80.0}
]
]
focus :: String -> Options
focus school = Options { mainTitle : ("Focus " <> school)
, subTitle : "Total scientific publications"
, xAxis : xAxis ["2015", "2016", "2017"]
, yAxis : [series Bar "Bar Data" [ {name: "val1", value: 50.0}
, {name: "val2", value: 70.0}
, {name: "val3", value: 80.0}
]
]
, yAxis : myData
, yAxisFormat : (YAxisFormat { position : "left"
, visible : true
})
......@@ -52,19 +47,21 @@ render dispatch _ state _ = [
, addZoom : false
}
-----------------------------------------------------------------------------------------------------------
naturePublis_x :: Array String
naturePublis_x = ["Com","Articles","Thèses","Reports"]
naturePublis_y' :: Array Int
naturePublis_y' = [23901,17417,1188,1176]
naturePublis_y :: Array {name :: String, value :: Number}
naturePublis_y = map (\(Tuple n v) -> {name: n, value: toNumber v }) (zip naturePublis_x naturePublis_y')
naturePublis :: Options
naturePublis = Options { mainTitle : "Nature of publications"
, subTitle : "Distribution by type"
, xAxis : xAxis []
, yAxis : [series Funnel "Funnel Data" naturePublis_y]
, yAxis : [SeriesD1 $ series Funnel "Funnel Data" naturePublis_y]
, yAxisFormat : (YAxisFormat { position : "left"
, visible : false
})
......@@ -73,7 +70,9 @@ naturePublis = Options { mainTitle : "Nature of publications"
-----------------------------------------------------------------------------------------------------------
globalPublis_x :: Array Int
globalPublis_x = [1982,1986,1987,1988,1990,1993,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012,2013,2014,2015,2016,2017]
globalPublis_y :: Array Int
globalPublis_y = [1,4,2,1,1,2,1,1,8,38,234,76,40,82,75,202,1475,1092,1827,2630,4978,3668,4764,5915,4602,5269,6814,4018]
......@@ -81,7 +80,7 @@ globalPublis :: Options
globalPublis = (Options { mainTitle : "Global Scientific Publications"
, subTitle : "Distribution of scientific publications by IMT's Schools over time"
, xAxis : xAxis (map show globalPublis_x)
, yAxis : [series Bar "Number of publication of IMT / year" $ map (\n -> {name: "", value: toNumber n }) globalPublis_y]
, yAxis : [SeriesD1 $ series Bar "Number of publication of IMT / year" $ map (\n -> {name: "", value: toNumber n }) globalPublis_y]
, yAxisFormat : (YAxisFormat { position : "left"
, visible : true
})
......@@ -90,6 +89,7 @@ globalPublis = (Options { mainTitle : "Global Scientific Publications"
distriBySchool_y :: Array (Tuple String Int)
distriBySchool_y = [Tuple "Télécom Bretagne" 1150,Tuple "Télécom SudParis" 946,Tuple "Mines Nantes" 547,Tuple "Télécom ParisTech" 429,Tuple "IMT Atlantique" 205,Tuple "Mines Alès" 56
,Tuple "Télécom Ecole de Management" 52,Tuple "Mines Albi-Carmaux" 6]
......@@ -97,13 +97,114 @@ distriBySchool :: Options
distriBySchool = Options { mainTitle : "School production in 2017"
, subTitle : "Distribution by school"
, xAxis : xAxis []
, yAxis : [ series Pie "Pie data" (map (\(Tuple n v) -> {name: n, value: toNumber v}) distriBySchool_y)]
, yAxis : [ SeriesD1 $ series Pie "Pie data" (map (\(Tuple n v) -> {name: n, value: toNumber v}) distriBySchool_y)]
, yAxisFormat : (YAxisFormat { position : ""
, visible : false
})
, addZoom : false
}
scatterEx :: Options
scatterEx = Options { mainTitle : "Scatter test"
, subTitle : "Scatter subtitle"
, xAxis : xAxis []
, yAxis : [ SeriesD2 $ seriesD2 Scatter 10.0 [[2.0,3.0],[3.0,4.0]]
, SeriesD2 $ seriesD2 Scatter 5.0 [[1.0,3.0],[5.0,4.0]]
, SeriesD2 $ seriesD2 Scatter 10.0 [[10.0,3.0],[8.0,4.0]]
]
, yAxisFormat : (YAxisFormat { position : ""
, visible : true
})
, addZoom : false
}
sankeyEx :: Options
sankeyEx = Options { mainTitle : ""
, subTitle : ""
, xAxis : xAxis []
, yAxis : [ mkSankey [{name : "a"}, {name : "b"}, {name:"c"}, {name:"d"}]
[{source : "a", target : "b", value :2.0}
, {source : "a", target : "c", value :1.0}
, {source : "b", target : "c", value :1.0}
, {source : "b", target : "d", value :3.0}
]
]
, yAxisFormat : (YAxisFormat { position : ""
, visible : false
})
, addZoom : false
}
treeData :: Array TreeData
treeData = [ treeNode "nodeA" 10.0 [ treeLeaf "nodeAa" 4.0
, treeLeaf "nodeAb" 5.0
, treeNode "nodeAc" 1.0 [ treeLeaf "nodeAca" 0.5
, treeLeaf "nodeAcb" 0.5
]
]
, treeNode "nodeB" 20.0 [ treeNode "nodeBa" 20.0 [ treeLeaf "nodeBa1" 20.0]]
, treeNode "nodeC" 20.0 [ treeNode "nodeCa" 20.0 [ treeLeaf "nodeCa1" 10.0
, treeLeaf "nodeCa2" 10.0
]
]
, treeNode "nodeD" 20.0 [ treeNode "nodeDa" 20.0 [ treeLeaf "nodeDa1" 2.0
, treeLeaf "nodeDa2" 2.0
, treeLeaf "nodeDa3" 2.0
, treeLeaf "nodeDa4" 2.0
, treeLeaf "nodeDa5" 2.0
, treeLeaf "nodeDa6" 2.0
, treeLeaf "nodeDa7" 2.0
, treeLeaf "nodeDa8" 2.0
, treeLeaf "nodeDa9" 2.0
, treeLeaf "nodeDa10" 2.0
]
]
]
treeData' :: Array TreeData
treeData' = [ treeNode "nodeA" 10.0 [ treeLeaf "nodeAa" 4.0
, treeLeaf "nodeAb" 5.0
, treeNode "nodeAc" 1.0 [ treeLeaf "nodeAca" 0.5
, treeLeaf "nodeAcb" 0.5
]
, treeNode "nodeB" 20.0 [ treeNode "nodeBa" 20.0 [ treeLeaf "nodeBa1" 20.0]]
, treeNode "nodeC" 20.0 [ treeNode "nodeBa" 20.0 [ treeLeaf "nodeBa1" 20.0]]
, treeNode "nodeD" 20.0 [ treeNode "nodeBa" 20.0 [ treeLeaf "nodeBa1" 20.0]]
, treeNode "nodeE" 20.0 [ treeNode "nodeBa" 20.0 [ treeLeaf "nodeBa1" 20.0]]
, treeNode "nodeF" 20.0 [ treeNode "nodeBa" 20.0 [ treeLeaf "nodeBa1" 20.0]]
, treeNode "nodeG" 20.0 [ treeNode "nodeBa" 20.0 [ treeLeaf "nodeBa1" 20.0]]
, treeNode "nodeH" 20.0 [ treeNode "nodeBa" 20.0 [ treeLeaf "nodeBa1" 20.0]]
]
]
treeMapEx :: Options
treeMapEx = Options { mainTitle : ""
, subTitle : ""
, xAxis : xAxis []
, yAxis : [mkTree TreeMap treeData]
, yAxisFormat : (YAxisFormat { position : ""
, visible : false
})
, addZoom : false
}
treeEx :: Options
treeEx = Options { mainTitle : "Tree"
, subTitle : "Radial"
, xAxis : xAxis []
, yAxis : [mkTree TreeRadial treeData']
, yAxisFormat : (YAxisFormat { position : ""
, visible : false
})
, addZoom : false
}
layoutDashboard :: forall props eff. Spec (dom :: DOM | eff) State props Action
layoutDashboard = simpleSpec performAction render
layoutDashboard :: Spec {} {} Void
layoutDashboard = simpleSpec defaultPerformAction render
src/Gargantext/Pages/Corpus/Doc/Facets/Documents.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.Doc.Facets.Documents where
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Network.HTTP.Affjax (AJAX)
import Prelude (id, void)
import React.DOM (table, tbody, td, text, th, thead, tr)
import React.DOM.Props (className, scope)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Prelude hiding (div)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Array (filter)
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.HTTP.Method (Method(..))
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
type State = String
import Gargantext.Config (NodeType(..), toUrl, End(Back))
import Gargantext.Config.REST (get)
import Gargantext.Utils.DecodeMaybe ((.|))
initialState :: State
initialState = ""
import React (ReactElement)
import React.DOM (a, b, b', br', div, input, option, select, span, table, tbody, td, text, th, thead, tr, p)
import React.DOM.Props (_type, className, href, onChange, onClick, scope, selected, value)
import Thermite (PerformAction, Render, Spec, modifyState, defaultPerformAction, simpleSpec)
import Unsafe.Coerce (unsafeCoerce)
data Action = NoOp
--main :: forall e. Eff (dom:: DOM, console :: CONSOLE, ajax :: AJAX | e) Unit
--main = do
-- case createReactSpec layoutDocview tdata of
-- { spec, dispatcher } -> void $ do
-- document <- DOM.window >>= DOM.document
-- container <- unsafePartial (fromJust <$> DOM.querySelector (QuerySelector "#app") (DOM.htmlDocumentToParentNode document))
-- RDOM.render (R.createFactory (R.createClass spec) {}) container
--
-- TODO: Pagination Details are not available from the BackEnd
-- TODO: PageSize Change manually sets the totalPages, need to get from backend and reload the data
-- TODO: Search is pending
-- TODO: Fav is pending
-- TODO: Sort is Pending
-- TODO: Filter is Pending
-- TODO: When a pagination link is clicked, reload data.
-- Right now it doesn't make sense to reload mock data.
performAction :: forall eff props. PerformAction ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
performAction NoOp _ _ = void do
modifyState id
data Action
= LoadData Int
| ChangePageSize PageSizes
| ChangePage Int
type State = CorpusTableData
type CorpusTableData = TableData CorpusView
publicationSpec :: forall props eff . Spec ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
publicationSpec = simpleSpec performAction render
newtype TableData a
= TableData
{ rows :: Array { row :: a
, delete :: Boolean
}
, totalPages :: Int
, currentPage :: Int
, pageSize :: PageSizes
, totalRecords :: Int
, title :: String
-- , tree :: FTree
}
newtype CorpusView
= CorpusView
{ _id :: Int
, url :: String
, date :: String
, title :: String
, source :: String
, fav :: Boolean
, ngramCount :: Int
}
derive instance genericCorpus :: Generic CorpusView _
instance showCorpus :: Show CorpusView where
show = genericShow
newtype Response = Response
{ cid :: Int
, created :: String
, hyperdata :: Hyperdata
, favorite :: Boolean
, ngramCount :: Int
}
newtype Hyperdata = Hyperdata
{ title :: String
, source :: String
}
--instance decodeHyperdata :: DecodeJson Hyperdata where
-- decodeJson json = do
-- obj <- decodeJson json
-- title <- obj .? "title"
-- source <- obj .? "source"
-- pure $ Hyperdata { title,source }
--instance decodeResponse :: DecodeJson Response where
-- decodeJson json = do
-- obj <- decodeJson json
-- cid <- obj .? "id"
-- created <- obj .? "created"
-- favorite <- obj .? "favorite"
-- ngramCount <- obj .? "ngramCount"
-- hyperdata <- obj .? "hyperdata"
-- pure $ Response { cid, created, favorite, ngramCount, hyperdata }
instance decodeHyperdata :: DecodeJson Hyperdata where
decodeJson json = do
obj <- decodeJson json
title <- obj .| "title"
source <- obj .| "source"
pure $ Hyperdata { title,source }
instance decodeResponse :: DecodeJson Response where
decodeJson json = do
obj <- decodeJson json
cid <- obj .? "id"
created <- pure "2018"
--created <- obj .? "date"
favorite <- pure true
ngramCount <- obj .? "id"
hyperdata <- obj .? "hyperdata"
pure $ Response { cid, created, favorite, ngramCount, hyperdata }
-- | Filter
filterSpec :: Spec State {} Action
filterSpec = simpleSpec defaultPerformAction render
where
render d p s c = [div [] [ text " Filter "
, input []
]]
layoutDocview :: Spec State {} Action
layoutDocview = simpleSpec performAction render
where
render :: Render State props Action
render dispatch _ state _ =
[ table [ className "table"]
[ thead [ className "thead-dark"]
[ tr []
[ th [ scope "col"] [ text "Date" ]
, th [ scope "col"] [ text "Description" ]
, th [ scope "col"] [ text "Projects" ]
, th [ scope "col"] [ text "Favorite" ]
, th [ scope "col"] [ text "Delete" ]
]
]
, tbody []
[ tr [] [ td [] [ text "2012/03/06"]
, td [] [ text "Big data and text mining"]
, td [] [ text "European funds"]
, td [] [ text "True"]
, td [] [ text "False"]
]
, tr [] [ td [] [ text "2013/03/06"]
, td [] [ text "Cryptography"]
, td [] [ text "French funds"]
, td [] [ text "True"]
, td [] [ text "False"]
]
, tr [] [ td [] [ text "2013/03/06"]
, td [] [ text "Artificial Intelligence"]
, td [] [ text "Not found"]
, td [] [ text "True"]
, td [] [ text "False"]
]
]
]
]
render :: Render State {} Action
render dispatch _ state@(TableData d) _ =
[ div [className "container1"]
[ div [className "row"]
[
div [className "col-md-12"]
[ p [] []
, div [] [ text " Filter ", input []]
, br'
, div [className "row"]
[ div [className "col-md-1"] [b [] [text d.title]]
, div [className "col-md-2"] [sizeDD d.pageSize dispatch]
, div [className "col-md-3"] [textDescription d.currentPage d.pageSize d.totalRecords]
, div [className "col-md-3"] [pagination dispatch d.totalPages d.currentPage]
]
, table [ className "table"]
[thead [ className "thead-dark"]
[tr [] [ th [scope "col"] [ b' [text ""] ]
, th [scope "col"] [ b' [text "Date"]]
, th [scope "col"] [ b' [text "Name"] ]
--, th [scope "col"] [ b' [text "Title"] ]
--, th [scope "col"] [ b' [text "Source"] ]
, th [scope "col"] [ b' [text "Fonction"] ]
, th [scope "col"] [ b' [text "Delete"] ]
]
]
, tbody [] $ map showRow d.rows
]
]
]
]
]
performAction :: PerformAction State {} Action
performAction (ChangePageSize ps) _ _ = void $ modifyState $ changePageSize ps
performAction (ChangePage p) _ _ = void $ modifyState \(TableData td) -> TableData $ td { currentPage = p }
performAction (LoadData n) _ _ = do
res <- lift $ loadPage n
case res of
Left err -> do
_ <- liftEffect $ log $ show err
_ <- liftEffect $ log $ show "Error: loading page documents"
pure unit
Right resData -> do
_ <- liftEffect $ log $ show "OK: loading page documents"
void $ modifyState $ const resData
loadPage :: Int -> Aff (Either String CorpusTableData)
loadPage n = do
res <- get $ toUrl Back Children n
-- TODO: offset and limit
-- res <- get "http://localhost:8008/corpus/472764/facet/documents/table?offset=0&limit=10"
case res of
Left err -> do
_ <- liftEffect $ log $ show "Err: loading page documents"
_ <- liftEffect $ log $ show err
pure $ Left $ show err
Right resData -> do
let docs = toTableData (res2corpus $ resData)
_ <- liftEffect $ log $ show "Ok: loading page documents"
_ <- liftEffect $ log $ show $ map (\({ row: r, delete :_}) -> show r) ((\(TableData docs') -> docs'.rows) docs)
pure $ Right docs
where
res2corpus :: Array Response -> Array CorpusView
res2corpus rs = map (\(Response r) ->
CorpusView { _id : r.cid
, url : ""
, date : r.created
, title : (\(Hyperdata hr) -> hr.title) r.hyperdata
, source : (\(Hyperdata hr) -> hr.source) r.hyperdata
, fav : r.favorite
, ngramCount : r.ngramCount
}) rs
toTableData :: Array CorpusView -> CorpusTableData
toTableData ds = TableData
{ rows : map (\d -> { row : d , delete : false}) ds
, totalPages : 474
, currentPage : 1
, pageSize : PS100
, totalRecords : 47361
, title : "Documents"
}
---------------------------------------------------------
sampleData' :: CorpusView
sampleData' = CorpusView {_id : 1, url : "", date : "date3", title : "title", source : "source", fav : false, ngramCount : 1}
sampleData :: Array CorpusView
--sampleData = replicate 10 sampleData'
sampleData = map (\(Tuple t s) -> CorpusView {_id : 1, url : "", date : "2017", title: t, source: s, fav : false, ngramCount : 10}) sampleDocuments
sampleDocuments :: Array (Tuple String String)
sampleDocuments = [Tuple "Macroscopic dynamics of the fusion process" "Journal de Physique Lettres",Tuple "Effects of static and cyclic fatigue at high temperature upon reaction bonded silicon nitride" "Journal de Physique Colloques",Tuple "Reliability of metal/glass-ceramic junctions made by solid state bonding" "Journal de Physique Colloques",Tuple "High temperature mechanical properties and intergranular structure of sialons" "Journal de Physique Colloques",Tuple "SOLUTIONS OF THE LANDAU-VLASOV EQUATION IN NUCLEAR PHYSICS" "Journal de Physique Colloques",Tuple "A STUDY ON THE FUSION REACTION 139La + 12C AT 50 MeV/u WITH THE VUU EQUATION" "Journal de Physique Colloques",Tuple "Atomic structure of \"vitreous\" interfacial films in sialon" "Journal de Physique Colloques",Tuple "MICROSTRUCTURAL AND ANALYTICAL CHARACTERIZATION OF Al2O3/Al-Mg COMPOSITE INTERFACES" "Journal de Physique Colloques",Tuple "Development of oxidation resistant high temperature NbTiAl alloys and intermetallics" "Journal de Physique IV Colloque",Tuple "Determination of brazed joint constitutive law by inverse method" "Journal de Physique IV Colloque",Tuple "Two dimensional estimates from ocean SAR images" "Nonlinear Processes in Geophysics",Tuple "Comparison Between New Carbon Nanostructures Produced by Plasma with Industrial Carbon Black Grades" "Journal de Physique III",Tuple "<i>Letter to the Editor:</i> SCIPION, a new flexible ionospheric sounder in Senegal" "Annales Geophysicae",Tuple "Is reducibility in nuclear multifragmentation related to thermal scaling?" "Physics Letters B",Tuple "Independence of fragment charge distributions of the size of heavy multifragmenting sources" "Physics Letters B",Tuple "Hard photons and neutral pions as probes of hot and dense nuclear matter" "Nuclear Physics A",Tuple "Surveying the nuclear caloric curve" "Physics Letters B",Tuple "A hot expanding source in 50 A MeV Xe+Sn central reactions" "Physics Letters B"]
data' :: Array CorpusView -> Array {row :: CorpusView, delete :: Boolean}
data' = map {row : _, delete : false}
sdata :: Array { row :: CorpusView, delete :: Boolean }
sdata = data' sampleData
tdata :: TableData CorpusView
tdata = TableData
{ rows : sdata
, totalPages : 10
, currentPage : 1
, pageSize : PS10
, totalRecords : 100
, title : "Documents"
-- , tree : exampleTree
}
showRow :: {row :: CorpusView, delete :: Boolean} -> ReactElement
showRow {row : (CorpusView c), delete} =
tr []
[ td [] [div [className $ fa <> "fa-star"][]]
-- TODO show date: Year-Month-Day only
, td [] [text c.date]
, td [] [ a [ href (toUrl Back Document 1) ] [ text c.title ] ]
, td [] [text c.source]
, td [] [input [ _type "checkbox"]]
]
where
fa = case c.fav of
true -> "fas "
false -> "far "
--------------------------------------------------------------
-- | Action
-- ChangePageSize
changePageSize :: PageSizes -> CorpusTableData -> CorpusTableData
changePageSize ps (TableData td) =
TableData $ td { pageSize = ps
, totalPages = td.totalRecords / pageSizes2Int ps
, currentPage = 1
}
data PageSizes = PS10 | PS20 | PS50 | PS100
derive instance eqPageSizes :: Eq PageSizes
instance showPageSize :: Show PageSizes where
show PS10 = "10"
show PS20 = "20"
show PS50 = "50"
show PS100 = "100"
pageSizes2Int :: PageSizes -> Int
pageSizes2Int PS10 = 10
pageSizes2Int PS20 = 20
pageSizes2Int PS50 = 50
pageSizes2Int PS100 = 100
aryPS :: Array PageSizes
aryPS = [PS10, PS20, PS50, PS100]
string2PageSize :: String -> PageSizes
string2PageSize "10" = PS10
string2PageSize "20" = PS20
string2PageSize "50" = PS50
string2PageSize "100" = PS100
string2PageSize _ = PS10
sizeDD :: PageSizes -> (Action -> Effect Unit) -> ReactElement
sizeDD ps d
= span []
[ text "Show : "
, select [onChange (\e -> d (ChangePageSize $ string2PageSize $ (unsafeCoerce e).target.value))] $ map (optps ps) aryPS
]
optps :: PageSizes -> PageSizes -> ReactElement
optps cv val = option [ selected (cv == val), value $ show val ] [text $ show val]
textDescription :: Int -> PageSizes -> Int -> ReactElement
textDescription currPage pageSize totalRecords
= div [className "row1"]
[ div [className ""]
[ text $ "Showing " <> show start <> " to " <> show end <> " of " <> show totalRecords ]
]
where
start = (currPage - 1) * pageSizes2Int pageSize + 1
end' = currPage * pageSizes2Int pageSize
end = if end' > totalRecords then totalRecords else end'
pagination :: (Action -> Effect Unit) -> Int -> Int -> ReactElement
pagination d tp cp
= span [] $
[ text "Pages: ", prev, first, ldots]
<>
lnums
<>
[b' [text $ " " <> show cp <> " "]]
<>
rnums
<>
[ rdots, last, next ]
where
prev = if cp == 1 then
text " Previous "
else
span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> d $ ChangePage $ cp - 1)
] [text "Previous"]
, text " "
]
next = if cp == tp then
text " Next "
else
span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> d $ ChangePage $ cp + 1)
] [text "Next"]
, text " "
]
first = if cp == 1 then
text ""
else
span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> d $ ChangePage 1)
] [text "1"]
, text " "
]
last = if cp == tp then
text ""
else
span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> d $ ChangePage tp)
] [text $ show tp]
, text " "
]
ldots = if cp >= 5 then
text " ... "
else
text ""
rdots = if cp + 3 < tp then
text " ... "
else
text ""
lnums = map (\i -> fnmid d i) $ filter (lessthan 1) [cp - 2, cp - 1]
rnums = map (\i -> fnmid d i) $ filter (greaterthan tp) [cp + 1, cp + 2]
fnmid :: (Action -> Effect Unit) -> Int -> ReactElement
fnmid d i
= span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> d $ ChangePage i)
] [text $ show i]
, text " "
]
lessthan :: forall t28. Ord t28 => t28 -> t28 -> Boolean
lessthan x y = x < y
greaterthan :: forall t28. Ord t28 => t28 -> t28 -> Boolean
greaterthan x y = x > y
newtype SearchQuery = SearchQuery
{
query :: Array String
, parent_id :: Int
}
instance encodeJsonSQuery :: EncodeJson SearchQuery where
encodeJson (SearchQuery post)
= "query" := post.query
~> "parent_id" := post.parent_id
~> jsonEmptyObject
searchResults :: SearchQuery -> Aff (Either String (Int))
searchResults squery = do
res <- request $ defaultRequest
{ url = "http://localhost:8008/count"
, responseFormat = ResponseFormat.json
, method = Left POST
, headers = []
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
src/Gargantext/Pages/Corpus/Doc/Facets/Graph.purs
View file @ 9a6d8cc0
......@@ -2,14 +2,11 @@ module Gargantext.Pages.Corpus.Doc.Facets.Graph where
import Prelude hiding (div)
import Control.Monad.Aff (Aff, attempt)
import Control.Monad.Aff.Class (liftAff)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.Unsafe (unsafePerformEff)
import DOM (DOM)
import Data.Argonaut (decodeJson)
import Data.Argonaut (decodeJson, stringify)
import Data.Array (length, mapWithIndex, (!!))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
......@@ -17,12 +14,13 @@ import Data.Int (toNumber)
import Data.Maybe (Maybe(..), fromJust)
import Data.MediaType.Common (applicationJSON)
import Data.Newtype (class Newtype)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.GraphExplorer.Sigmajs (Color(Color), SigmaEasing, SigmaGraphData(SigmaGraphData), SigmaNode, SigmaSettings, canvas, edgeShape, edgeShapes, forceAtlas2, sStyle, sigma, sigmaEasing, sigmaEdge, sigmaEnableWebGL, sigmaNode, sigmaSettings)
import Gargantext.Components.GraphExplorer.Types (Cluster(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData)
import Gargantext.Utils (getter)
import Math (cos, sin)
import Network.HTTP.Affjax (AJAX, affjax, defaultRequest)
import Network.HTTP.RequestHeader (RequestHeader(..))
import Partial.Unsafe (unsafePartial)
import React (ReactElement)
import React.DOM (a, br', button, div, form', input, li, li', menu, option, p, select, span, text, ul, ul')
......@@ -30,8 +28,8 @@ import React.DOM.Props (_id, _type, checked, className, href, name, onChange, pl
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce)
data Action = NoOp
| LoadGraph String
data Action
= LoadGraph String
| SelectNode SelectedNode
newtype SelectedNode = SelectedNode {id :: String, label :: String}
......@@ -56,12 +54,12 @@ initialState = State
, selectedNode : Nothing
}
graphSpec :: forall eff props. Spec (ajax :: AJAX, console :: CONSOLE, dom :: DOM | eff) State props Action
graphSpec :: Spec State {} Action
graphSpec = simpleSpec performAction render
performAction :: forall eff props. PerformAction (ajax :: AJAX, console :: CONSOLE , dom :: DOM | eff) State props Action
performAction :: PerformAction State {} Action
performAction (LoadGraph fp) _ _ = void do
_ <- liftEff $ log fp
_ <- liftEffect $ log fp
case fp of
"" -> do
modifyState \(State s) -> State s {filePath = fp, graphData = GraphData {nodes : [], edges : []}, sigmaGraphData = Nothing}
......@@ -77,10 +75,6 @@ performAction (LoadGraph fp) _ _ = void do
performAction (SelectNode node) _ _ = void do
modifyState $ \(State s) -> State s {selectedNode = pure node}
performAction NoOp _ _ = void do
modifyState id
convert :: GraphData -> SigmaGraphData
convert (GraphData r) = SigmaGraphData { nodes, edges}
where
......@@ -99,7 +93,7 @@ convert (GraphData r) = SigmaGraphData { nodes, edges}
edges = map edgeFn r.edges
edgeFn (Edge e) = sigmaEdge {id : e.id_, source : e.source, target : e.target}
render :: forall props. Render State props Action
render :: Render State {} Action
render d p (State s) c =
[ select [ onChange $ \e -> d $ LoadGraph (unsafeCoerce e).target.value, value s.filePath]
[ option [value ""] [text ""]
......@@ -122,10 +116,11 @@ render d p (State s) c =
, renderer : canvas
, settings : mySettings
, style : sStyle { height : "95%"}
, onClickNode : \e -> unsafePerformEff $ do
log $ unsafeCoerce e
d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
pure unit
-- , onClickNode : \e -> do
-- log $ unsafeCoerce e
-- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
-- pure unit
-- TODO: fix this!
}
[ sigmaEnableWebGL
, forceAtlas2 forceAtlas2Config
......@@ -226,23 +221,24 @@ mySettings = sigmaSettings { verbose : true
-- loadJSON {path : "http://localhost:2015/examples/sites_coords.json"}
getGraphData :: forall eff. String -> Aff (console :: CONSOLE, ajax :: AJAX , dom :: DOM | eff ) (Either String GraphData)
getGraphData :: String -> Aff (Either String GraphData)
getGraphData fp = do
resp <- liftAff $ attempt $ affjax defaultRequest
resp <- request defaultRequest
{ url =("http://localhost:2015/examples/" <> fp)
, method = Left GET
, responseFormat = ResponseFormat.json
, headers =
[ ContentType applicationJSON
, Accept applicationJSON
]
}
case resp of
case resp.body of
Left err -> do
liftEff $ log $ show err
pure $ Left $ show err
Right a -> do
liftEff $ log $ show a.response
let gd = decodeJson a.response
liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
liftEffect $ log $ stringify json
let gd = decodeJson json
pure gd
......@@ -296,11 +292,11 @@ dispLegend ary = div [] $ map dl ary
]
specOld :: forall eff props. Spec (console :: CONSOLE, dom :: DOM, ajax :: AJAX | eff) State props Action
specOld = simpleSpec performAction render
specOld :: Spec State {} Action
specOld = simpleSpec performAction render'
where
render :: Render State props Action
render d _ (State st) _ =
render' :: Render State {} Action
render' d _ (State st) _ =
[ div [className "row"] [
div [className "col-md-12", style {marginTop : "21px", marginBottom : "21px"}]
[ menu [_id "toolbar"]
......@@ -319,7 +315,7 @@ specOld = simpleSpec performAction render
[ input [_type "file"
, name "file"
-- , onChange (\e -> d $ SetFile (getFile e) (unsafeCoerce $ d <<< SetProgress))
, className "btn btn-primary"] []
, className "btn btn-primary"]
-- , text $ show st.readyState
]
......@@ -328,7 +324,7 @@ specOld = simpleSpec performAction render
, className "btn btn-warning btn-sm"
,value "Run Demo"
-- , onClick \_ -> d SetGraph, disabled (st.readyState /= DONE)
] []
]
]
, li'
......@@ -343,24 +339,24 @@ specOld = simpleSpec performAction render
[ span [className "glyphicon glyphicon-search"] []
]
]
,input [_type "text", className "form-control", placeholder "select topics"] []
,input [_type "text", className "form-control", placeholder "select topics"]
]
]
]
]
, li [className "col-md-2"]
[ span [] [text "selector size"],input [_type "range", _id "myRange", value "90"] []
[ span [] [text "selector size"],input [_type "range", _id "myRange", value "90"]
]
, li [className "col-md-2"]
[ span [] [text "label size"],input [_type "range", _id "myRange", value "90"] []
[ span [] [text "label size"],input [_type "range", _id "myRange", value "90"]
]
, li [className "col-md-2"]
[ span [] [text "Nodes"],input [_type "range", _id "myRange", value "90"] []
[ span [] [text "Nodes"],input [_type "range", _id "myRange", value "90"]
]
, li [className "col-md-2"]
[ span [] [text "Edges"],input [_type "range", _id "myRange", value "90"] []
[ span [] [text "Edges"],input [_type "range", _id "myRange", value "90"]
]
, li'
[ button [className "btn btn-primary"] [text "Save"] -- TODO: Implement Save!
......@@ -395,10 +391,10 @@ specOld = simpleSpec performAction render
, renderer : canvas
, settings : mySettings
, style : sStyle { height : "95%"}
, onClickNode : \e -> unsafePerformEff $ do
log $ unsafeCoerce e
d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
pure unit
-- , onClickNode : \e -> do
-- log $ unsafeCoerce e
-- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
-- pure unit
}
[ sigmaEnableWebGL
, forceAtlas2 forceAtlas2Config
......@@ -414,7 +410,7 @@ specOld = simpleSpec performAction render
[ case st.selectedNode of
Nothing -> span [] []
Just selectedNode -> p [] [text $ "selected Node : " <> getter _.label selectedNode
, br' []
, br'
, p [] [button [className "btn btn-primary", style {marginBottom : "18px"}] [text "Remove"]]
]
]
......@@ -461,7 +457,7 @@ specOld = simpleSpec performAction render
, checked $ true
, title "Mark as completed"
-- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
] []
]
]
, li []
......@@ -471,7 +467,7 @@ specOld = simpleSpec performAction render
, checked $ false
, title "Mark as completed"
-- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
] []
]
]
, li []
[ span [] [text "Patents"]
......@@ -480,7 +476,7 @@ specOld = simpleSpec performAction render
, checked $ false
, title "Mark as completed"
-- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
] []
]
]
, li []
[ span [] [text "Others"]
......@@ -489,7 +485,7 @@ specOld = simpleSpec performAction render
, checked $ false
, title "Mark as completed"
-- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
] []
]
]
]
......
src/Gargantext/Pages/Corpus/Doc/Facets/Sources.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.Doc.Facets.Sources where
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Data.Array (fold)
import Gargantext.Pages.Corpus.Doc.Document as D
import Network.HTTP.Affjax (AJAX)
import Gargantext.Pages.Corpus.Doc.Facets.Documents as D
import Prelude hiding (div)
import React.DOM (h3, text)
import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
......@@ -19,16 +16,12 @@ initialState = D.tdata
type Action = D.Action
sourceSpec :: forall props eff . Spec ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
sourceSpec :: Spec State {} Action
sourceSpec = simpleSpec defaultPerformAction render
where
render :: Render State props Action
render :: Render State {} Action
render dispatch _ state _ =
[ h3 [] [text "Source view"]]
sourcespec' :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
sourcespec' :: Spec State {} Action
sourcespec' = fold [sourceSpec, D.layoutDocview]
src/Gargantext/Pages/Corpus/Doc/Facets/Specs.purs 0 → 100644
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.Doc.Facets.Specs where
import Prelude hiding (div)
import Data.List (fromFoldable)
import Data.Tuple (Tuple(..))
import Gargantext.Pages.Corpus.Doc.Facets.States (State(), _doclens, _sourcelens, _authorlens, _termslens, _tablens, initialState)
import Gargantext.Pages.Corpus.Doc.Facets.Actions (Action(), _docAction, _sourceAction, _authorAction, _termsAction, _tabAction)
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Sources as SV
import Gargantext.Pages.Corpus.Doc.Facets.Authors as AV
import Gargantext.Pages.Corpus.Doc.Facets.Terms as TV
import Gargantext.Components.Tab as Tab
import Thermite (Spec, focus, hide)
pureTab1 :: Spec {} {} Void
pureTab1 = hide initialState statefulTab1
statefulTab1 :: Spec State {} Action
statefulTab1 =
Tab.tabs _tablens _tabAction $ fromFoldable [ Tuple "Doc View" docPageSpec
, Tuple "Author View" authorPageSpec
, Tuple "Source View" sourcePageSpec
, Tuple "Terms View" termsPageSpec
]
docPageSpec :: Spec State {} Action
docPageSpec = focus _doclens _docAction DV.layoutDocview
authorPageSpec :: Spec State {} Action
authorPageSpec = focus _authorlens _authorAction AV.authorspec'
sourcePageSpec :: Spec State {} Action
sourcePageSpec = focus _sourcelens _sourceAction SV.sourcespec'
termsPageSpec :: Spec State {} Action
termsPageSpec = focus _termslens _termsAction TV.termSpec'
src/Gargantext/Pages/Corpus/Doc/Facets/States.purs 0 → 100644
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.Doc.Facets.States where
import Data.Lens (Lens', lens)
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Sources as SV
import Gargantext.Pages.Corpus.Doc.Facets.Authors as AV
import Gargantext.Pages.Corpus.Doc.Facets.Terms as TV
import Gargantext.Components.Tab as Tab
type State =
{ docview :: DV.State
, authorview :: AV.State
, sourceview :: SV.State
, termsview :: TV.State
, activeTab :: Int
}
initialState :: State
initialState =
{ docview : DV.tdata
, authorview : AV.initialState
, sourceview : SV.initialState
, termsview : TV.initialState
, activeTab : 0
}
_doclens :: Lens' State DV.State
_doclens = lens (\s -> s.docview) (\s ss -> s {docview = ss})
_authorlens :: Lens' State AV.State
_authorlens = lens (\s -> s.authorview) (\s ss -> s {authorview = ss})
_sourcelens :: Lens' State SV.State
_sourcelens = lens (\s -> s.sourceview) (\s ss -> s {sourceview = ss})
_termslens :: Lens' State TV.State
_termslens = lens (\s -> s.termsview) (\s ss -> s {termsview = ss})
_tablens :: Lens' State Tab.State
_tablens = lens (\s -> s.activeTab) (\s ss -> s {activeTab = ss})
src/Gargantext/Pages/Corpus/Doc/Facets/Terms.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.Doc.Facets.Terms where
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Data.Array (fold)
import Gargantext.Pages.Corpus.Doc.Document as D
import Network.HTTP.Affjax (AJAX)
import Gargantext.Pages.Corpus.Doc.Facets.Documents as D
import Prelude hiding (div)
import React.DOM (h3, text)
import Thermite (PerformAction, Render, Spec, defaultPerformAction, modifyState, simpleSpec)
import Thermite (PerformAction, Render, Spec, defaultPerformAction, simpleSpec)
......@@ -20,16 +17,12 @@ initialState = D.tdata
type Action = D.Action
termsSpec :: forall props eff . Spec ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
termsSpec :: Spec State {} Action
termsSpec = simpleSpec defaultPerformAction render
where
render :: Render State props Action
render :: Render State {} Action
render dispatch _ state _ =
[ h3 [] [text "Terms view"]]
termSpec' :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
termSpec' :: Spec State {} Action
termSpec' = fold [termsSpec, D.layoutDocview]
src/Gargantext/Pages/Corpus/Doc/Facets/Terms/NgramsItem.purs
View file @ 9a6d8cc0
......@@ -2,20 +2,21 @@ module Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsItem where
import Prelude
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Data.Newtype (class Newtype)
import Network.HTTP.Affjax (AJAX)
import Data.Newtype (class Newtype, unwrap)
import Data.Lens.Iso (re)
import Data.Lens.Iso.Newtype (_Newtype)
import React (ReactElement)
import React.DOM (input, span, td, text, tr)
import React.DOM.Props (_type, checked, className, onChange, style, title)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec, hide, focusState)
import Gargantext.Utils (getter, setter)
newtype State = State
{ term :: Term
}
derive instance newtypeState :: Newtype State _
initialState :: State
initialState = State {term : Term {id : 10, term : "hello", occurrence : 10, _type : None, children : []}}
......@@ -36,17 +37,19 @@ data Action
= SetMap Boolean
| SetStop Boolean
performAction :: forall eff props. PerformAction ( console :: CONSOLE , ajax :: AJAX, dom :: DOM | eff ) State props Action
performAction :: PerformAction State {} Action
performAction (SetMap b) _ _ = void do
modifyState \(State s) -> State s {term = setter (_{_type = (if b then MapTerm else None)}) s.term}
performAction (SetStop b) _ _ = void do
modifyState \(State s) -> State s {term = setter (_{_type = (if b then StopTerm else None)}) s.term}
ngramsItemSpec :: forall props eff . Spec (console::CONSOLE, ajax::AJAX, dom::DOM | eff) State props Action
ngramsItemSpec = simpleSpec performAction render
ngramsItemSpec :: Spec {} {} Void
ngramsItemSpec = hide (unwrap initialState) $
focusState (re _Newtype) $
simpleSpec performAction render
where
render :: Render State props Action
render :: Render State {} Action
render dispatch _ (State state) _ =
[
tr []
......@@ -63,7 +66,7 @@ ngramsItemSpec = simpleSpec performAction render
, checked $ getter _._type state.term == MapTerm
, title "Mark as completed"
, onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
] []
]
checkbox_stop =
input
[ _type "checkbox"
......@@ -71,7 +74,7 @@ ngramsItemSpec = simpleSpec performAction render
, checked $ getter _._type state.term == StopTerm
, title "Mark as completed"
, onChange $ dispatch <<< ( const $ SetStop $ not (getter _._type state.term == StopTerm))
] []
]
dispTerm :: String -> TermType -> ReactElement
......
src/Gargantext/Pages/Corpus/Doc/Facets/Terms/NgramsTable.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable where
import CSS.TextAlign (center, textAlign)
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Data.Array (filter, fold, toUnfoldable)
import Data.Array (filter, toUnfoldable)
import Data.Either (Either(..))
import Data.Newtype (class Newtype, unwrap)
import Data.Lens (Lens', Prism', lens, over, prism)
import Data.Lens.Iso (re)
import Data.Lens.Iso.Newtype (_Newtype)
import Data.List (List)
import Data.Tuple (Tuple(..), uncurry)
import Network.HTTP.Affjax (AJAX)
import Data.Void (Void)
import Data.Unit (Unit)
import Effect (Effect)
import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsItem as NI
import Prelude (class Eq, class Ord, class Show, Unit, bind, map, not, pure, show, void, ($), (*), (+), (-), (/), (<), (<$>), (<>), (==), (>), (>=), (>>=))
import Prelude (class Eq, class Ord, class Show, map, show, void, ($), (*), (+), (-), (/), (<), (<>), (==), (>), (>=), pure, unit)
import React (ReactElement)
import React.DOM hiding (style)
import React.DOM hiding (style, map)
import React.DOM.Props (_id, _type, className, href, name, onChange, onClick, onInput, placeholder, scope, selected, style, value)
import Thermite (PerformAction, Spec, _render, cotransform, focus, foreach, modifyState, withState)
import Thermite (PerformAction, Spec, _render, focus, foreach, modifyState, focusState, hide)
import Unsafe.Coerce (unsafeCoerce)
newtype State = State
{ items :: List NI.State
, search :: String
{ items :: List {}
, search :: String
, selectString :: String
, totalPages :: Int
, currentPage :: Int
......@@ -27,38 +30,39 @@ newtype State = State
, totalRecords :: Int
}
derive instance newtypeState :: Newtype State _
initialState :: State
initialState = State { items : toUnfoldable [NI.initialState]
, search : ""
initialState = State { items : toUnfoldable [{}]
, search : ""
, selectString : ""
,totalPages : 10
, totalPages : 10
, currentPage : 1
, pageSize : PS10
, totalRecords : 100
}
data Action
= NoOp
| ItemAction Int NI.Action
= ItemAction Int Void
| ChangeString String
| SetInput String
| ChangePageSize PageSizes
| ChangePage Int
_itemsList :: Lens' State (List NI.State)
_itemsList :: Lens' State (List {})
_itemsList = lens (\(State s) -> s.items) (\(State s) v -> State s { items = v })
_ItemAction :: Prism' Action (Tuple Int NI.Action)
_ItemAction :: Prism' Action (Tuple Int Void)
_ItemAction = prism (uncurry ItemAction) \ta ->
case ta of
ItemAction i a -> Right (Tuple i a)
_ -> Left ta
performAction :: forall eff props. PerformAction ( console :: CONSOLE , ajax :: AJAX, dom :: DOM | eff ) State props Action
performAction _ _ _ = void do
modifyState \(State state) -> State $ state
type Dispatch = Action -> Effect Unit
performAction :: PerformAction State {} Action
performAction (ChangePageSize ps) _ _ = void (cotransform (\state -> changePageSize ps state ))
performAction (ChangePageSize ps) _ _ = void $ modifyState $ changePageSize ps
performAction (ChangePage p) _ _ = void do
modifyState \(State state) -> State $ state {currentPage = p}
......@@ -72,7 +76,9 @@ performAction (ChangeString c) _ _ = void do
performAction (SetInput s) _ _ = void do
modifyState \(State state) -> State $ state { search = s }
tableSpec :: forall eff props .Spec eff State props Action -> Spec eff State props Action
performAction _ _ _ = pure unit
tableSpec :: Spec State {} Action -> Spec State {} Action
tableSpec = over _render \render dispatch p (State s) c ->
[div [className "container-fluid"]
[
......@@ -100,7 +106,7 @@ tableSpec = over _render \render dispatch p (State s) c ->
, _type "value"
,value s.search
,onInput \e -> dispatch (SetInput (unsafeEventValue e))
] []
]
]
......@@ -149,14 +155,17 @@ tableSpec = over _render \render dispatch p (State s) c ->
]
]
ngramsTableSpec :: forall props eff . Spec (console::CONSOLE, ajax::AJAX, dom::DOM | eff) State props Action
ngramsTableSpec = container $ fold
[ tableSpec $ withState \st ->
focus _itemsList _ItemAction $
foreach \_ -> NI.ngramsItemSpec
]
container :: forall eff state props action. Spec eff state props action -> Spec eff state props action
ngramsTableSpec :: Spec {} {} Void
ngramsTableSpec =
hide (unwrap initialState) $
focusState (re _Newtype) $
container $
tableSpec $
focus _itemsList _ItemAction $
foreach $ \ _ ->
NI.ngramsItemSpec
container :: forall state props action. Spec state props action -> Spec state props action
container = over _render \render d p s c ->
[ div [ className "container-fluid" ] $
(render d p s c)
......@@ -214,7 +223,7 @@ string2PageSize "50" = PS50
string2PageSize "100" = PS100
string2PageSize _ = PS10
sizeDD :: PageSizes -> _ -> ReactElement
sizeDD :: PageSizes -> Dispatch -> ReactElement
sizeDD ps d
= p []
[ text "Show : "
......@@ -237,7 +246,7 @@ textDescription currPage pageSize totalRecords
end = if end' > totalRecords then totalRecords else end'
pagination :: _ -> Int -> Int -> ReactElement
pagination :: Dispatch -> Int -> Int -> ReactElement
pagination d tp cp
= span [] $
[ text "Pages: "
......@@ -308,7 +317,7 @@ pagination d tp cp
lnums = map (\i -> fnmid d i) $ filter (lessthan 1) [cp - 2, cp - 1]
rnums = map (\i -> fnmid d i) $ filter (greaterthan tp) [cp + 1, cp + 2]
fnmid :: _ -> Int -> ReactElement
fnmid :: Dispatch -> Int -> ReactElement
fnmid d i
= span []
[ text " "
......
src/Gargantext/Pages/Corpus/User/Brevets.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.User.Brevets where
import Prelude
import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Network.HTTP.Affjax (AJAX)
import Prelude (id, void)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
type State = String
initialState :: State
initialState = ""
data Action = NoOp
performAction :: forall eff props. PerformAction ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
performAction NoOp _ _ = void do
modifyState id
brevetsSpec :: forall props eff . Spec ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
brevetsSpec = simpleSpec performAction render
brevetsSpec :: Spec {} {} Void
brevetsSpec = simpleSpec defaultPerformAction render
where
render :: Render State props Action
render :: Render {} {} Void
render dispatch _ state _ =
[]
src/Gargantext/Pages/Corpus/User/Users/API.purs
View file @ 9a6d8cc0
......@@ -2,36 +2,29 @@ module Gargantext.Pages.Corpus.User.Users.API where
import Prelude
import Gargantext.Pages.Corpus.User.Users.Types (Action(..), State, User, _user)
import Control.Monad.Aff (Aff)
import Control.Monad.Aff.Console (CONSOLE, log)
import Control.Monad.Trans.Class (lift)
import DOM (DOM)
import Data.Either (Either(..))
import Data.Lens (set)
import Data.Lens ((?~))
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Config (toUrl, NodeType(..), End(..))
import Gargantext.Config.REST (get)
import Network.HTTP.Affjax (AJAX)
import Gargantext.Pages.Corpus.User.Users.Types (Action(..), State, User, _user)
import Thermite (PerformAction, modifyState)
getUser :: forall eff. Int -> Aff
(console :: CONSOLE, ajax :: AJAX | eff) (Either String User)
getUser id = get $ "http://localhost:8008/node/" <> show id
getUser :: Int -> Aff (Either String User)
getUser id = get $ toUrl Back Node id
performAction :: forall eff props. PerformAction ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff ) State props Action
performAction NoOp _ _ = void do
modifyState id
performAction (FetchUser userId) _ _ = void do
performAction :: PerformAction State {} Action
performAction (FetchUser userId) _ _ = do
value <- lift $ getUser userId
_ <- case value of
(Right user) -> modifyState \state -> set _user (Just user) state
(Right user) -> void $ modifyState $ _user ?~ user
(Left err) -> do
_ <- lift $ log err
modifyState id
lift <<< log $ "Fetching user..."
performAction _ _ _ = void do
modifyState id
liftEffect $ log err
liftEffect <<< log $ "Fetching user..."
performAction _ _ _ = pure unit
src/Gargantext/Pages/Corpus/User/Users/Specs.purs
View file @ 9a6d8cc0
......@@ -5,19 +5,12 @@ module Gargantext.Pages.Corpus.User.Users.Specs
import Gargantext.Pages.Corpus.User.Users.Specs.Renders
import Control.Monad.Aff.Console (CONSOLE)
import DOM (DOM)
import Network.HTTP.Affjax (AJAX)
import Thermite (Spec, simpleSpec)
import Gargantext.Pages.Corpus.User.Users.Actions
import Gargantext.Pages.Corpus.User.Users.States
import Gargantext.Pages.Corpus.User.Users.API (performAction)
layoutUser :: forall props eff . Spec ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
layoutUser :: Spec State {} Action
layoutUser = simpleSpec performAction render
publicationSpec :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
......
src/Gargantext/Pages/Corpus/User/Users/Specs/Documents.purs 0 → 100644
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.User.Users.Specs.Documents where
import Prelude
import React.DOM (table, tbody, td, text, th, thead, tr)
import React.DOM.Props (className, scope)
import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
publicationSpec :: Spec {} {} Void
publicationSpec = simpleSpec defaultPerformAction render
where
render :: Render {} {} Void
render dispatch _ state _ =
[ table [ className "table"]
[ thead [ className "thead-dark"]
[ tr []
[ th [ scope "col"] [ text "Date" ]
, th [ scope "col"] [ text "Description" ]
, th [ scope "col"] [ text "Projects" ]
, th [ scope "col"] [ text "Favorite" ]
, th [ scope "col"] [ text "Delete" ]
]
]
, tbody []
[ tr [] [ td [] [ text "2012/03/06"]
, td [] [ text "Big data and text mining"]
, td [] [ text "European funds"]
, td [] [ text "True"]
, td [] [ text "False"]
]
, tr [] [ td [] [ text "2013/03/06"]
, td [] [ text "Cryptography"]
, td [] [ text "French funds"]
, td [] [ text "True"]
, td [] [ text "False"]
]
, tr [] [ td [] [ text "2013/03/06"]
, td [] [ text "Artificial Intelligence"]
, td [] [ text "Not found"]
, td [] [ text "True"]
, td [] [ text "False"]
]
]
]
]
src/Gargantext/Pages/Corpus/User/Users/Specs/Renders.purs
View file @ 9a6d8cc0
......@@ -11,12 +11,12 @@ import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..), uncurry)
import Prelude (($), (<<<), (<$>))
import React (ReactElement)
import React.DOM (div, h3, h1, li, span, text, ul, img)
import React.DOM (div, h3, img, li, span, text, ul)
import React.DOM.Props (_id, className, src)
import Thermite (Render)
render :: forall props. Render State props Action
render :: Render State {} Action
render dispatch _ state _ =
[
div [className "col-md-12"]
......@@ -25,7 +25,7 @@ render dispatch _ state _ =
Nothing -> display "User not found" []
]
display :: forall props. String -> Array ReactElement -> Array ReactElement
display :: String -> Array ReactElement -> Array ReactElement
display title elems =
[ div [className "container-fluid"]
[ div [className "row", _id "user-page-header"]
......@@ -37,7 +37,7 @@ display title elems =
[ div [className "col-md-12"]
[ div [className "row"]
[ div [className "col-md-2"]
[ img [src "/images/Gargantextuel-212x300.jpg"] [] ]
[ img [src "/images/Gargantextuel-212x300.jpg"] ]
, div [className "col-md-1"] []
, div [className "col-md-8"] elems
]
......@@ -62,11 +62,11 @@ userInfos hyperdata =
listInfo :: String -> String -> ReactElement
listInfo s ss = listElement $ infoRender s ss
listElement :: forall props. Array ReactElement -> ReactElement
listElement :: Array ReactElement -> ReactElement
listElement = li [className "list-group-item justify-content-between"]
infoRender :: forall props. String -> String -> Array ReactElement
infoRender title content =
[ span [] [text title]
, span [className "badge badge-default badge-pill"] [text content]
]
infoRender :: Tuple String String -> Array ReactElement
infoRender (Tuple title content) =
[ span [] [text title]
, span [className "badge badge-default badge-pill"] [text content]
]
src/Gargantext/Pages/Corpus/User/Users/Types.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.User.Users.Types where
import Prelude (bind, pure, ($))
module Gargantext.Pages.Corpus.User.Users.Types
(module Gargantext.Pages.Corpus.User.Users.Types.Types,
module Gargantext.Pages.Corpus.User.Users.Types.Lens,
module Gargantext.Pages.Corpus.User.Users.Types.States,
brevetSpec,
projectSpec,
facets
)
where
import Prelude
import Gargantext.Pages.Corpus.User.Users.Types.Lens
import Gargantext.Pages.Corpus.User.Users.Types.Types
import Gargantext.Pages.Corpus.User.Users.Types.States
import Gargantext.Pages.Corpus.User.Brevets as B
import Gargantext.Pages.Folder as PS
import Gargantext.Components.Tab (tabs)
import Gargantext.Utils.DecodeMaybe ((.?|))
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Map (Map, fromFoldable)
import Data.Maybe (Maybe)
import Data.List (fromFoldable)
import Data.Tuple (Tuple(..))
import Control.Monad.Aff.Console (CONSOLE)
import DOM (DOM)
import Network.HTTP.Affjax (AJAX)
import Thermite (Spec, focus)
newtype User =
User {
id ::Int,
typename :: Maybe Int,
userId ::Int,
parentId :: Int,
name :: String,
date ::Maybe String,
hyperdata :: Maybe HyperData
}
instance decodeUser :: DecodeJson User where
decodeJson json = do
obj <- decodeJson json
id <- obj .? "id"
typename <- obj .?| "typename"
userId <- obj .? "userId"
parentId <- obj .? "parentId"
name <- obj .? "name"
date <- obj .?| "date"
hyperdata <- obj .?| "hyperdata"
pure $ User {id, typename, userId, parentId, name, date, hyperdata}
newtype HyperData = HyperData (Map String String)
instance decodeHyperData :: DecodeJson HyperData where
decodeJson json = do
obj <- decodeJObject json
pure <<< HyperData $ fromFoldable obj
import Gargantext.Components.Tab (tabs)
import Thermite (Render, Spec, focus, noState, defaultPerformAction, simpleSpec)
brevetSpec :: Spec State {} Action
brevetSpec = noState B.brevetsSpec
projets :: Spec {} {} Void
projets = simpleSpec defaultPerformAction render
where
render :: Render {} {} Void
render dispatch _ state _ =
[]
projectSpec :: Spec State {} Action
projectSpec = noState projets
facets :: Spec State {} Action
facets = tabs _tablens _tabAction $ fromFoldable
[ Tuple "Publications (12)" publicationSpec
, Tuple "Brevets (2)" brevetSpec
, Tuple "Projets IMT (5)" projectSpec
]
src/Gargantext/Pages/Corpus/User/Users/Types/Lens.purs 0 → 100644
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.User.Users.Types.Lens where
import Gargantext.Pages.Corpus.User.Brevets as B
import Data.Either (Either(..))
import Data.Lens (Lens', Prism', lens, prism)
import Data.Maybe (Maybe)
import Gargantext.Pages.Corpus.User.Users.Types.States (Action(..), State)
import Gargantext.Pages.Corpus.User.Users.Types.Types (User)
import Gargantext.Pages.Corpus.User.Users.Specs.Documents as P
import Gargantext.Components.Tab as Tab
import Thermite (Spec, noState)
_user :: Lens' State (Maybe User)
_user = lens (\s -> s.user) (\s ss -> s{user = ss})
_tablens :: Lens' State Tab.State
_tablens = lens (\s -> s.activeTab) (\s ss -> s {activeTab = ss})
_tabAction :: Prism' Action Tab.Action
_tabAction = prism TabA \ action ->
case action of
TabA laction -> Right laction
_-> Left action
publicationSpec :: Spec State {} Action
publicationSpec = noState P.publicationSpec
src/Gargantext/Pages/Corpus/User/Users/Types/States.purs 0 → 100644
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.User.Users.Types.States where
import Data.Maybe (Maybe(..))
import Gargantext.Pages.Corpus.User.Users.Types.Types (User)
import Gargantext.Pages.Corpus.User.Users.Specs.Documents as P
import Gargantext.Components.Tab as Tab
data Action
= TabA Tab.Action
| FetchUser Int
type State =
{ activeTab :: Int
, user :: Maybe User
}
initialState :: State
initialState =
{ activeTab : 0
, user: Nothing
}
src/Gargantext/Pages/Corpus/User/Users/Types/Types.purs 0 → 100644
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.User.Users.Types.Types where
import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Maybe (Maybe)
import Gargantext.Utils.DecodeMaybe ((.?|))
newtype User =
User { id :: Int
, typename :: Maybe Int
, userId :: Int
, parentId :: Int
, name :: String
, date :: Maybe String
, hyperdata :: HyperData
}
newtype HyperData =
HyperData
{ bureau :: Maybe String
, atel :: Maybe String
, fax :: Maybe String
, aprecision :: Maybe String
, service :: Maybe String
, service2 :: Maybe String
, groupe :: Maybe String
, lieu :: Maybe String
, pservice :: Maybe String
, date_modification :: Maybe String
, fonction :: Maybe String
, pfonction :: Maybe String
, url :: Maybe String
, prenom :: Maybe String
, nom :: Maybe String
, idutilentite :: Maybe String
, afonction :: Maybe String
, grprech :: Maybe String
, entite :: Maybe String
, entite2 :: Maybe String
, mail :: Maybe String
}
instance decodeUserHyperData :: DecodeJson HyperData where
decodeJson json = do
obj <- decodeJson json
bureau <- obj .?| "bureau"
atel <- obj .?| "atel"
fax <- obj .?| "fax"
aprecision <- obj .?| "aprecision"
service <- obj .?| "service"
service2 <- obj .?| "service2"
groupe <- obj .?| "groupe"
lieu <- obj .?| "lieu"
pservice <- obj .?| "pservice"
date_modification <- obj .?| "date_modification"
fonction <- obj .?| "fonction"
pfonction <- obj .?| "pfonction"
url <- obj .?| "url"
prenom <- obj .?| "prenom"
nom <- obj .?| "nom"
idutilentite <- obj .?| "idutilentite"
afonction <- obj .?| "afonction"
grprech <- obj .?| "grprech"
entite <- obj .?| "entite"
entite2 <- obj .?| "entite2"
mail <- obj .?| "mail"
pure $ HyperData { bureau, atel, fax
, aprecision, service
, service2, groupe, lieu
, pservice, date_modification
, fonction, pfonction, url
, prenom, nom, idutilentite
, afonction, grprech, entite
, entite2, mail
}
instance decodeUser :: DecodeJson User where
decodeJson json = do
obj <- decodeJson json
id <- obj .? "id"
typename <- obj .?| "typename"
userId <- obj .? "userId"
parentId <- obj .? "parentId"
name <- obj .? "name"
date <- obj .?| "date"
hyperdata <- obj .? "hyperdata"
pure $ User { id, typename, userId
, parentId, name, date
, hyperdata
}
src/Gargantext/Pages/Folder.purs deleted 100644 → 0
View file @ 8309e9f4
module Gargantext.Pages.Folder where
import Prelude (id, void)
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Network.HTTP.Affjax (AJAX)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
type State = String
initialState :: State
initialState = ""
data Action = NoOp
performAction :: forall eff props. PerformAction ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
performAction NoOp _ _ = void do
modifyState id
projets :: forall props eff . Spec ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
projets = simpleSpec performAction render
where
render :: Render State props Action
render dispatch _ state _ =
[]
src/Gargantext/Pages/Home/Actions.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Home.Actions where
import Prelude hiding (div)
import Control.Monad.Cont.Trans (lift)
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Gargantext.Components.Lang.Landing.EnUS as En
import Gargantext.Components.Lang.Landing.FrFR as Fr
import Gargantext.Components.Data.Landing (BlockText(..), BlockTexts(..), Button(..), LandingData(..))
import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Pages.Home.States (State(..))
import Network.HTTP.Affjax (AJAX)
import React (ReactElement)
import React.DOM (a, div, h3, i, img, p, span, text)
import React.DOM.Props (Props, _id, aria, className, href, src, target, title)
import Routing.Hash.Aff (setHash)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Effect.Class (liftEffect)
import Gargantext.Pages.Home.States (State)
import Routing.Hash (setHash)
import Thermite (PerformAction)
data Action
= NoOp
| Documentation
= Documentation
| Enter
| Login
| SignUp
performAction :: forall eff props. PerformAction ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
performAction NoOp _ _ = void do
modifyState \state -> state
performAction Documentation _ _ = void do
modifyState \state -> state
performAction :: PerformAction State {} Action
performAction Documentation _ _ = pure unit
performAction Enter _ _ = void do
lift $ setHash "/search"
modifyState \state -> state
liftEffect $ setHash "/search"
performAction Login _ _ = void do
lift $ setHash "/login"
modifyState \state -> state
performAction SignUp _ _ = void do
modifyState \state -> state
liftEffect $ setHash "/login"
performAction SignUp _ _ = pure unit
src/Gargantext/Pages/Home/Specs.purs
View file @ 9a6d8cc0
......@@ -2,45 +2,40 @@ module Gargantext.Pages.Home.Specs where
import Prelude hiding (div)
import Control.Monad.Cont.Trans (lift)
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Data.Lens (re)
import Data.Lens.Iso.Newtype (_Newtype)
import Data.Newtype (unwrap)
import Gargantext.Components.Lang.Landing.EnUS as En
import Gargantext.Components.Lang.Landing.FrFR as Fr
import Gargantext.Components.Data.Landing (BlockText(..), BlockTexts(..), Button(..), LandingData(..))
import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Pages.Home.States (State(..))
import Gargantext.Pages.Home.Actions (Action(..), performAction)
import Gargantext.Pages.Home.States (State, initialState)
import Gargantext.Pages.Home.Actions (Action, performAction)
import Network.HTTP.Affjax (AJAX)
import React (ReactElement)
import React.DOM (a, div, h3, i, img, p, span, text)
import React.DOM.Props (Props, _id, aria, className, href, src, target, title)
import Routing.Hash.Aff (setHash)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Thermite (Render, Spec, simpleSpec, hide, focusState)
-- Layout |
layoutLanding :: forall props eff . Lang -> Spec ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
layoutLanding FR = layoutLanding' Fr.landingData
layoutLanding EN = layoutLanding' En.landingData
landingData :: Lang -> LandingData
landingData FR = Fr.landingData
landingData EN = En.landingData
layoutLanding :: Lang -> Spec {} {} Void
layoutLanding = hide (unwrap initialState)
<<< focusState (re _Newtype)
<<< layoutLanding' <<< landingData
------------------------------------------------------------------------
layoutLanding' :: forall props eff . LandingData -> Spec ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
layoutLanding' :: LandingData -> Spec State {} Action
layoutLanding' hd = simpleSpec performAction render
where
render :: Render State props Action
render :: Render State {} Action
render dispatch _ state _ =
[ div [ className "container1" ] [ jumboTitle hd false ]
, div [ className "container1" ] [] -- put research here
......@@ -83,11 +78,11 @@ jumboTitle :: LandingData -> Boolean -> ReactElement
jumboTitle (LandingData hd) b = div jumbo
[ div [className "row" ]
[ div [ className "col-md-8 content"]
[ p [ className "left" ]
[ div [ className "left" ]
[ div [_id "logo-designed" ]
[ img [ src "images/logo.png"
, title hd.logoTitle
] []
]
]
]
]
......@@ -96,7 +91,7 @@ jumboTitle (LandingData hd) b = div jumbo
, _id "funnyimg"
, title hd.imageTitle
]
[]
]
]
]
......@@ -113,6 +108,5 @@ imageEnter (LandingData hd) action = div [className "row"]
, title hd.imageTitle
, action
]
[]
]
]
src/Gargantext/Pages/Home/States.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Home.States where
import Prelude hiding (div)
import Control.Monad.Cont.Trans (lift)
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Gargantext.Components.Lang.Landing.EnUS as En
import Gargantext.Components.Lang.Landing.FrFR as Fr
import Gargantext.Components.Data.Landing (BlockText(..), BlockTexts(..), Button(..), LandingData(..))
import Gargantext.Components.Data.Lang (Lang(..))
import Network.HTTP.Affjax (AJAX)
import React (ReactElement)
import React.DOM (a, div, h3, i, img, p, span, text)
import React.DOM.Props (Props, _id, aria, className, href, src, target, title)
import Routing.Hash.Aff (setHash)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Data.Newtype (class Newtype)
newtype State = State
{ userName :: String
, password :: String
}
derive instance newtypeState :: Newtype State _
initialState :: State
initialState = State
{userName : ""
, password : ""
{ userName : ""
, password : ""
}
src/Gargantext/Pages/Layout.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Layout where
import Prelude hiding (div)
import Gargantext.Components.Login as LN
-- import Gargantext.Components.Login as LN
import Gargantext.Pages.Layout.Actions (Action(..))
import Gargantext.Pages.Corpus as AC
import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus.Doc.Document as DV
import Gargantext.Pages.Corpus.Doc.Facets as TV
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
-- import Gargantext.Pages.Corpus.Doc.Facets as TV
-- import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
-- import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG
import Gargantext.Pages.Corpus.User.Users as U
import Gargantext.Pages.Home as L
import Gargantext.Pages.Search as S
import Gargantext.Pages.Corpus.Annuaire as Annuaire
-- import Gargantext.Pages.Home as L
-- import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Router (Routes(..))
dispatchAction :: forall t115 t445 t447.
Bind t445 => Applicative t445 =>
(Action -> t445 t447) -> t115 -> Routes -> t445 Unit
dispatchAction :: forall ignored m.
Monad m =>
(Action -> m Unit) -> ignored -> Routes -> m Unit
dispatchAction dispatcher _ Home = do
_ <- dispatcher Initialize
_ <- dispatcher $ SetRoute Home
_ <- dispatcher $ LandingA L.NoOp
pure unit
dispatcher Initialize
dispatcher $ SetRoute Home
-- dispatcher $ LandingA TODO
dispatchAction dispatcher _ Login = do
_ <- dispatcher Initialize
_ <- dispatcher $ SetRoute Login
_ <- dispatcher $ LoginA LN.NoOp
pure unit
dispatcher Initialize
dispatcher $ SetRoute Login
-- dispatcher $ LoginA TODO
dispatchAction dispatcher _ AddCorpus = do
_ <- dispatcher $ SetRoute AddCorpus
_ <- dispatcher $ AddCorpusA AC.LoadDatabaseDetails
pure unit
dispatcher $ SetRoute AddCorpus
dispatcher $ AddCorpusA AC.LoadDatabaseDetails
dispatchAction dispatcher _ DocView = do
_ <- dispatcher $ SetRoute $ DocView
_ <- dispatcher $ DocViewA $ DV.LoadData
pure unit
dispatchAction dispatcher _ (DocView n) = do
dispatcher $ SetRoute (DocView n)
dispatcher $ DocViewA $ DV.LoadData n
dispatchAction dispatcher _ SearchView = do
_ <- dispatcher $ SetRoute $ SearchView
_ <- dispatcher $ SearchA $ S.NoOp
pure unit
dispatcher $ SetRoute SearchView
-- dispatcher $ SearchA TODO
dispatchAction dispatcher _ (UserPage id) = do
_ <- dispatcher $ SetRoute $ UserPage id
_ <- dispatcher $ UserPageA $ U.NoOp
_ <- dispatcher $ UserPageA $ U.FetchUser id
pure unit
dispatcher $ SetRoute $ UserPage id
-- dispatcher $ UserPageA TODO
dispatcher $ UserPageA $ U.FetchUser id
dispatchAction dispatcher _ (Annuaire id) = do
dispatcher $ SetRoute $ Annuaire id
dispatcher $ AnnuaireAction $ Annuaire.Load id
dispatchAction dispatcher _ (Folder id) = do
dispatcher $ SetRoute $ Folder id
dispatchAction dispatcher _ (DocAnnotation i) = do
_ <- dispatcher $ SetRoute $ DocAnnotation i
_ <- dispatcher $ DocAnnotationViewA $ D.NoOp
pure unit
dispatcher $ SetRoute $ DocAnnotation i
-- dispatcher $ DocAnnotationViewA TODO
dispatchAction dispatcher _ Tabview = do
_ <- dispatcher $ SetRoute $ Tabview
_ <- dispatcher $ TabViewA $ TV.NoOp
pure unit
dispatcher $ SetRoute Tabview
-- dispatcher $ TabViewA TODO
dispatchAction dispatcher _ CorpusAnalysis = do
_ <- dispatcher $ SetRoute $ CorpusAnalysis
--_ <- dispatcher $ CorpusAnalysisA $ CA.NoOp
pure unit
dispatcher $ SetRoute CorpusAnalysis
-- dispatcher $ CorpusAnalysisA TODO
dispatchAction dispatcher _ PGraphExplorer = do
_ <- dispatcher $ SetRoute $ PGraphExplorer
_ <- dispatcher $ GraphExplorerA $ GE.LoadGraph "imtNew.json"
pure unit
dispatcher $ SetRoute PGraphExplorer
dispatcher $ GraphExplorerA $ GE.LoadGraph "imtNew.json"
dispatchAction dispatcher _ NGramsTable = do
_ <- dispatcher $ SetRoute $ NGramsTable
_ <- dispatcher $ NgramsA $ NG.NoOp
pure unit
dispatcher $ SetRoute NGramsTable
-- dispatcher $ NgramsA TODO
dispatchAction dispatcher _ Dashboard = do
_ <- dispatcher $ SetRoute $ Dashboard
pure unit
dispatcher $ SetRoute Dashboard
src/Gargantext/Pages/Layout/Actions.purs
View file @ 9a6d8cc0
-- | Module Description
module Gargantext.Pages.Layout.Actions where
import Prelude hiding (div)
import Control.Monad.Cont.Trans (lift)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (CONSOLE, log)
import DOM (DOM)
import Data.Array (length)
import Data.Either (Either(..))
import Data.Lens (Lens', Prism', lens, prism)
import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus.Doc.Body as CA
import Gargantext.Pages.Corpus.Doc.Document as DV
import Gargantext.Components.Login as LN
import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Components.Tree as Tree
import Gargantext.Pages.Corpus.Doc.Facets.Dashboard as Dsh
import Gargantext.Pages.Corpus as AC
import Gargantext.Router (Routes(..))
import Gargantext.Pages.Corpus.User.Users as U
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
import Gargantext.Pages.Home as L
import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG
import Gargantext.Pages.Search as S
import Gargantext.Pages.Corpus.Doc.Facets as TV
import Gargantext.Pages.Layout.States (AppState)
import Gargantext.Pages.Corpus.Doc.Document as DV
import Network.HTTP.Affjax (AJAX)
import Thermite (PerformAction, modifyState)
import Control.Monad.Cont.Trans (lift)
import Data.Either (Either(..))
import Data.Lens (Prism', prism)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.Login as LN
import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Components.Tree as Tree
import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
import Gargantext.Pages.Corpus.User.Users as U
import Gargantext.Pages.Corpus.Annuaire as Annuaire
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Pages.Layout.States (AppState)
import Gargantext.Router (Routes)
import Thermite (PerformAction, modifyState)
------------------------------------------------------------------------
data Action
= Initialize
| LandingA L.Action
| LoginA LN.Action
| SetRoute Routes
| AddCorpusA AC.Action
| DocViewA DV.Action
| SearchA S.Action
| UserPageA U.Action
| DocAnnotationViewA D.Action
| TreeViewA Tree.Action
| TabViewA TV.Action
| GraphExplorerA GE.Action
| DashboardA Dsh.Action
| Search String
| DocAnnotationViewA D.Action
| TreeViewA Tree.Action
| GraphExplorerA GE.Action
| Search String
| AnnuaireAction Annuaire.Action
| Go
| CorpusAnalysisA CA.Action
| ShowLogin
| ShowAddcorpus
| NgramsA NG.Action
performAction :: forall eff props. PerformAction ( dom :: DOM
, ajax :: AJAX
, console :: CONSOLE
| eff
) AppState props Action
performAction :: PerformAction AppState {} Action
performAction (SetRoute route) _ _ = void do
modifyState $ _ {currentRoute = pure route}
performAction (Search s) _ _ = void do
modifyState $ _ {search = s}
performAction (ShowLogin) _ _ = void do
liftEff $ modalShow "loginModal"
liftEffect $ modalShow "loginModal"
modifyState $ _ {showLogin = true}
performAction (ShowAddcorpus) _ _ = void do
liftEff $ modalShow "addCorpus"
liftEffect $ modalShow "addCorpus"
modifyState $ _ {showCorpus = true}
performAction Go _ _ = void do
liftEff $ modalShow "addCorpus"
liftEffect $ modalShow "addCorpus"
modifyState $ _ {showCorpus = true}
-- _ <- lift $ setHash "/addCorpus"
--modifyState id
performAction Initialize _ state = void do
_ <- liftEff $ log "loading Initial nodes"
_ <- liftEffect $ log "loading Initial nodes"
case state.initialized of
false -> do
lnodes <- lift $ Tree.loadDefaultNode
case lnodes of
Left err -> do
modifyState id
pure unit
Right d -> do
page <- lift $ DV.loadPage
case page of
Left err -> do
modifyState id
Right docs -> do
modifyState $ _ { initialized = true
, ntreeView = if length d > 0
then Tree.exampleTree
--then fnTransform $ unsafePartial $ fromJust $ head d
else Tree.initialState
, docViewState = docs
}
_ <- modifyState $ _ { initialized = true, ntreeState = d}
pure unit
-- page <- lift $ DV.loadPage
-- case page of
-- Left err -> do
-- pure unit
-- Right docs -> void do
-- modifyState $ _ { initialized = true
-- , ntreeState = d
-- -- if length d > 0
-- -- then Tree.exampleTree
-- -- --then fnTransform $ unsafePartial $ fromJust $ head d
-- -- else Tree.initialState
--
-- , docViewState = docs
-- }
_ -> do
modifyState id
performAction _ _ _ = void do
modifyState id
pure unit
performAction (LoginA _) _ _ = pure unit
performAction (AddCorpusA _) _ _ = pure unit
performAction (DocViewA _) _ _ = pure unit
performAction (SearchA _) _ _ = pure unit
performAction (UserPageA _) _ _ = pure unit
performAction (DocAnnotationViewA _) _ _ = pure unit
performAction (TreeViewA _) _ _ = pure unit
performAction (GraphExplorerA _) _ _ = pure unit
performAction (AnnuaireAction _) _ _ = pure unit
----------------------------------------------------------
_landingAction :: Prism' Action L.Action
_landingAction = prism LandingA \action ->
case action of
LandingA caction -> Right caction
_-> Left action
_loginAction :: Prism' Action LN.Action
_loginAction = prism LoginA \action ->
case action of
......@@ -148,11 +133,11 @@ _userPageAction = prism UserPageA \action ->
UserPageA caction -> Right caction
_-> Left action
_dashBoardAction :: Prism' Action Dsh.Action
_dashBoardAction = prism DashboardA \action ->
_annuaireAction :: Prism' Action Annuaire.Action
_annuaireAction = prism AnnuaireAction \action ->
case action of
DashboardA caction -> Right caction
_ -> Left action
AnnuaireAction a -> Right a
_ -> Left action
_docAnnotationViewAction :: Prism' Action D.Action
_docAnnotationViewAction = prism DocAnnotationViewA \action ->
......@@ -166,29 +151,8 @@ _treeAction = prism TreeViewA \action ->
TreeViewA caction -> Right caction
_-> Left action
_tabviewAction :: Prism' Action TV.Action
_tabviewAction = prism TabViewA \action ->
case action of
TabViewA caction -> Right caction
_-> Left action
_corpusAction :: Prism' Action CA.Action
_corpusAction = prism CorpusAnalysisA \action ->
case action of
CorpusAnalysisA caction -> Right caction
_-> Left action
_graphExplorerAction :: Prism' Action GE.Action
_graphExplorerAction = prism GraphExplorerA \action ->
case action of
GraphExplorerA caction -> Right caction
_-> Left action
_ngAction :: Prism' Action NG.Action
_ngAction = prism NgramsA \action ->
case action of
NgramsA caction -> Right caction
_-> Left action
src/Gargantext/Pages/Layout/Specs.purs
View file @ 9a6d8cc0
......@@ -2,100 +2,81 @@ module Gargantext.Pages.Layout.Specs where
import Prelude hiding (div)
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Data.Foldable (fold, intercalate)
import Data.Lens (over)
import Data.Maybe (Maybe(Nothing, Just))
import Effect (Effect)
import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Components.Login as LN
import Gargantext.Components.Tree as Tree
-- | [Naming] metrics indicator: reduce spaces between "," and "_"
import Gargantext.Pages.Layout.States ( _addCorpusState
, _corpusState
, _dashBoardSate
, _docAnnotationViewState
, _docViewState
, _graphExplorerState
, _landingState
, _loginState
, _ngState
, _searchState
, _tabviewState
, _treeState
, _userPageState
)
-- | [Naming] metrics indicator: reduce spaces between "," and "_"
import Gargantext.Pages.Layout.Actions ( _addCorpusAction
, _corpusAction
, _dashBoardAction
, _docAnnotationViewAction
, _docViewAction
, _graphExplorerAction
, _landingAction
, _loginAction
, _ngAction
, _searchAction
, _tabviewAction
, _treeAction
, _userPageAction
)
import Gargantext.Pages.Corpus as AC
import Gargantext.Components.Tree as Tree
import Gargantext.Pages.Corpus.Annuaire as A
import Gargantext.Folder as F
import Gargantext.Pages.Corpus as CA
import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus.Doc.Body as CA
import Gargantext.Pages.Corpus.Doc.Document as DV
import Gargantext.Pages.Corpus.Doc.Facets as TV
import Gargantext.Pages.Corpus.Doc.Facets.Dashboard as Dsh
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG
import Gargantext.Pages.Corpus.User.Users as U
import Gargantext.Pages.Home as L
import Gargantext.Pages.Layout.Actions (Action(..), performAction)
import Gargantext.Pages.Layout.States (AppState, E)
import Gargantext.Pages.Search as S
import Gargantext.Pages.Layout.Actions (Action(..), _addCorpusAction, _docAnnotationViewAction, _docViewAction, _graphExplorerAction, _loginAction, _searchAction, _treeAction, _userPageAction, performAction, _annuaireAction)
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Pages.Layout.States (AppState, _addCorpusState, _docAnnotationViewState, _docViewState, _graphExplorerState, _loginState, _searchState, _treeState, _userPageState, _annuaireState)
import Gargantext.Router (Routes(..))
import Network.HTTP.Affjax (AJAX)
import React (ReactElement)
import React.DOM (a, button, div, footer, hr, img, input, li, p, span, text, ul)
import React.DOM (a, button, div, footer, hr', img, input, li, p, span, text, ul)
import React.DOM.Props (_data, _id, _type, aria, className, href, onChange, onClick, placeholder, role, src, style, tabIndex, target, title)
import Thermite (Render, Spec, _render, defaultPerformAction, defaultRender, focus, simpleSpec, withState)
import Thermite (Render, Spec, _render, defaultPerformAction, defaultRender, focus, simpleSpec, withState, noState)
import Unsafe.Coerce (unsafeCoerce)
pagesComponent :: forall props eff. AppState -> Spec (E eff) AppState props Action
layoutSpec :: Spec AppState {} Action
layoutSpec =
fold
[ routingSpec
, container $ withState pagesComponent
, withState \st ->
fold [ focus _loginState _loginAction (LN.modalSpec st.showLogin "Login" LN.renderSpec)
, focus _addCorpusState _addCorpusAction (AC.modalSpec st.showCorpus "Search Results" AC.layoutAddcorpus)
]
]
where
-- NP: what is it for ?
container :: Spec AppState {} Action -> Spec AppState {} Action
container = over _render \render d p s c ->
(render d p s c)
pagesComponent :: AppState -> Spec AppState {} Action
pagesComponent s =
case s.currentRoute of
Just route -> selectSpec route
Nothing -> selectSpec Home
where
selectSpec :: Routes -> Spec ( ajax :: AJAX
, console :: CONSOLE
, dom :: DOM
| eff
) AppState props Action
selectSpec CorpusAnalysis = layout0 $ focus _corpusState _corpusAction CA.spec'
selectSpec :: Routes -> Spec AppState {} Action
selectSpec CorpusAnalysis = layout0 $ noState CA.spec'
selectSpec Login = focus _loginState _loginAction LN.renderSpec
selectSpec Home = layout0 $ focus _landingState _landingAction (L.layoutLanding EN)
selectSpec Home = layout0 $ noState (L.layoutLanding EN)
selectSpec AddCorpus = layout0 $ focus _addCorpusState _addCorpusAction AC.layoutAddcorpus
selectSpec DocView = layout0 $ focus _docViewState _docViewAction DV.layoutDocview
selectSpec (DocView i) = layout0 $ focus _docViewState _docViewAction DV.layoutDocview
selectSpec (UserPage i) = layout0 $ focus _userPageState _userPageAction U.layoutUser
selectSpec (DocAnnotation i) = layout0 $ focus _docAnnotationViewState _docAnnotationViewAction D.docview
selectSpec Tabview = layout0 $ focus _tabviewState _tabviewAction TV.tab1
selectSpec Tabview = layout0 $ noState TV.pureTab1
-- To be removed
selectSpec SearchView = layout0 $ focus _searchState _searchAction S.searchSpec
selectSpec NGramsTable = layout0 $ focus _ngState _ngAction NG.ngramsTableSpec
selectSpec NGramsTable = layout0 $ noState NG.ngramsTableSpec
selectSpec PGraphExplorer = focus _graphExplorerState _graphExplorerAction GE.specOld
selectSpec Dashboard = layout0 $ focus _dashBoardSate _dashBoardAction Dsh.layoutDashboard
selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard
selectSpec (Annuaire i) = layout0 $ focus _annuaireState _annuaireAction A.layoutAnnuaire
selectSpec (Folder i) = layout0 $ noState F.layoutFolder
-- selectSpec _ = simpleSpec defaultPerformAction defaultRender
routingSpec :: forall props eff. Spec (ajax :: AJAX, console :: CONSOLE, dom :: DOM |eff) AppState props Action
routingSpec :: Spec AppState {} Action
routingSpec = simpleSpec performAction defaultRender
layout0 :: forall eff props. Spec (E eff) AppState props Action
-> Spec (E eff) AppState props Action
layout0 :: Spec AppState {} Action
-> Spec AppState {} Action
layout0 layout =
fold
[ layoutSidebar divSearchBar
......@@ -104,11 +85,11 @@ layout0 layout =
]
where
outerLayout1 = simpleSpec defaultPerformAction defaultRender
outerLayout :: Spec (E eff) AppState props Action
outerLayout :: Spec AppState {} Action
outerLayout =
cont $ fold
[ withState \st ->
if ((\(LN.State s) -> s.loginC) st.loginState == true)
if ((\(LN.State s) -> s.loginC) st.loginState == true)
then ls as
else outerLayout1
, rs bs ]
......@@ -120,8 +101,8 @@ layout0 layout =
bs = innerLayout $ layout
innerLayout :: Spec (E eff) AppState props Action
-> Spec (E eff) AppState props Action
innerLayout :: Spec AppState {} Action
-> Spec AppState {} Action
innerLayout = over _render \render d p s c ->
[ div [_id "page-wrapper"]
[
......@@ -129,8 +110,8 @@ layout0 layout =
]
]
layoutSidebar :: forall props eff. Spec (E eff) AppState props Action
-> Spec (E eff) AppState props Action
layoutSidebar :: Spec AppState {} Action
-> Spec AppState {} Action
layoutSidebar = over _render \render d p s c ->
[ div [ _id "dafixedtop"
, className "navbar navbar-inverse navbar-fixed-top"
......@@ -153,7 +134,7 @@ divLogo = a [ className "navbar-brand logoSmall"
, href "#/"
] [ img [ src "images/logoSmall.png"
, title "Back to home."
] []
]
]
divDropdownLeft :: ReactElement
......@@ -264,10 +245,10 @@ liNav (LiNav { title : title'
]
-- TODO put the search form in the center of the navBar
divSearchBar :: forall props eff. Spec (ajax :: AJAX, console :: CONSOLE, dom :: DOM |eff) AppState props Action
divSearchBar :: Spec AppState {} Action
divSearchBar = simpleSpec performAction render
where
render :: Render AppState props Action
render :: Render AppState {} Action
render dispatch _ state _ = [div [ className "" ] [ searchbar']]
where
searchbar' = ul [ className "nav navbar-nav col-md-6 col-md-offset-3"
......@@ -280,13 +261,13 @@ divSearchBar = simpleSpec performAction render
, width: "400px"
}
, onChange \e -> dispatch $ Search (unsafeCoerce e).target.value
] []
]
, button [onClick \e -> dispatch Go, className "btn btn-primary"] [text "Enter"]
]
]
--divDropdownRight :: Render AppState props Action
divDropdownRight :: _ -> ReactElement
--divDropdownRight :: Render AppState {} Action
divDropdownRight :: (Action -> Effect Unit) -> ReactElement
divDropdownRight d =
ul [className "nav navbar-nav pull-right"]
[
......@@ -308,11 +289,11 @@ divDropdownRight d =
]
]
layoutFooter :: forall props eff. Spec (ajax :: AJAX, console :: CONSOLE, dom :: DOM |eff) AppState props Action
layoutFooter :: Spec AppState {} Action
layoutFooter = simpleSpec performAction render
where
render :: Render AppState props Action
render dispatch _ state _ = [div [ className "container1" ] [ hr [] [], footerLegalInfo']]
render :: Render AppState {} Action
render dispatch _ state _ = [div [ className "container1" ] [ hr', footerLegalInfo']]
where
footerLegalInfo' = footer [] [ p [] [ text "Gargantext "
, span [className "glyphicon glyphicon-registration-mark" ] []
......@@ -333,18 +314,3 @@ layoutFooter = simpleSpec performAction render
, text "."
]
]
layoutSpec :: forall eff props. Spec (E eff) AppState props Action
layoutSpec =
fold
[ routingSpec
, container $ withState pagesComponent
, withState \st ->
fold [ focus _loginState _loginAction (LN.modalSpec st.showLogin "Login" LN.renderSpec)
, focus _addCorpusState _addCorpusAction (AC.modalSpec st.showCorpus "Search Results" AC.layoutAddcorpus)
]
]
where
container :: Spec (E eff) AppState props Action -> Spec (E eff) AppState props Action
container = over _render \render d p s c ->
(render d p s c)
src/Gargantext/Pages/Layout/Specs/AddCorpus.purs 0 → 100644
View file @ 9a6d8cc0
module Gargantext.Pages.Layout.Specs.AddCorpus
( module Gargantext.Pages.Layout.Specs.AddCorpus.States
, module Gargantext.Pages.Layout.Specs.AddCorpus.Actions
, module Gargantext.Pages.Layout.Specs.AddCorpus.Specs
) where
import Gargantext.Pages.Layout.Specs.AddCorpus.States
import Gargantext.Pages.Layout.Specs.AddCorpus.Actions
import Gargantext.Pages.Layout.Specs.AddCorpus.Specs
src/Gargantext/Pages/Layout/Specs/AddCorpus/Actions.purs 0 → 100644
View file @ 9a6d8cc0
module Gargantext.Pages.Layout.Specs.AddCorpus.Actions where
import Prelude hiding (div)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, stringify, (:=), (~>))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(Just))
import Data.MediaType.Common (applicationJSON)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.Modals.Modal (modalHide)
import Gargantext.Pages.Layout.Specs.AddCorpus.States (Response, State)
import Routing.Hash (setHash)
import Thermite (PerformAction, modifyState)
data Action
= SelectDatabase Boolean
| UnselectDatabase Boolean
| LoadDatabaseDetails
| GO
performAction :: PerformAction State {} Action
performAction (SelectDatabase selected) _ _ = void do
modifyState $ _ { select_database = selected }
performAction (UnselectDatabase unselected) _ _ = void do
modifyState $ _ { unselect_database = unselected }
performAction (LoadDatabaseDetails) _ _ = do
res <- lift $ getDatabaseDetails $ QueryString { query_query: "string",query_name: ["Pubmed"]}
case res of
Left err -> pure unit
Right resData -> do
void $ modifyState $ _ {response = resData}
performAction GO _ _ = do
liftEffect $ setHash "/corpus"
liftEffect $ modalHide "addCorpus"
pure unit
newtype QueryString = QueryString
{
query_query :: String
, query_name :: Array String
}
queryString :: QueryString
queryString = QueryString
{
query_query: "string",
query_name: [
"Pubmed"
]
}
instance encodeJsonQueryString :: EncodeJson QueryString where
encodeJson (QueryString obj) =
"query_query" := obj.query_query
~> "query_name" := obj.query_name
~> jsonEmptyObject
getDatabaseDetails :: QueryString -> Aff (Either String (Array Response))
getDatabaseDetails reqBody = do
let token = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE1MTk5OTg1ODMsInVzZXJfaWQiOjUsImVtYWlsIjoiYWxleGFuZHJlLmRlbGFub2VAaXNjcGlmLmZyIiwidXNlcm5hbWUiOiJkZXZlbG9wZXIifQ.Os-3wuFNSmRIxCZi98oFNBu2zqGc0McO-dgDayozHJg"
affResp <- request $ defaultRequest
{ method = Left POST
, responseFormat = ResponseFormat.json
, url = "http://localhost:8009/count"
, headers = [ ContentType applicationJSON
, Accept applicationJSON
-- , RequestHeader "Authorization" $ "Bearer " <> token
]
, content = Just $ Json $ encodeJson reqBody
}
case affResp.body of
Left err -> do
liftEffect $ log $ "error" <> printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
liftEffect $ log $ "POST method Completed"
liftEffect $ log $ "GET /api response: " <> stringify json
let obj = decodeJson json
pure obj
src/Gargantext/Pages/Layout/Specs/AddCorpus/Specs.purs 0 → 100644
View file @ 9a6d8cc0
module Gargantext.Pages.Layout.Specs.AddCorpus.Specs where
import Gargantext.Pages.Layout.Specs.AddCorpus.Actions
import Gargantext.Pages.Layout.Specs.AddCorpus.States
import Prelude hiding (div)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Lens (over)
import Data.Maybe (Maybe(Just))
import Data.MediaType.Common (applicationJSON)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.Modals.Modal (modalHide)
import React (ReactElement)
import React.DOM (button, div, h3, h5, li, span, text, ul)
import React.DOM.Props (_data, _id, _type, aria, className, onClick, role)
import Thermite (PerformAction, Render, Spec, _render, simpleSpec)
modalSpec :: Boolean -> String -> Spec State {} Action -> Spec State {} Action
modalSpec sm t = over _render \render d p s c ->
[ div [ _id "addCorpus", className $ "modal myModal" <> if sm then "" else " fade"
, role "dialog"
, _data {show : true}
][ div [ className "modal-dialog", role "document"]
[ div [ className "modal-content"]
[ div [ className "modal-header"]
[ h5 [ className "modal-title" ] [ text $ t ]
, button [ _type "button"
, className "close"
, _data { dismiss : "modal"}
] [ span [ aria {hidden : true}] [ text "X"] ]
]
, div [ className "modal-body"] (render d p s c)
]
]
]
]
spec' :: Spec State {} Action
spec' = modalSpec true "Search Results" layoutAddcorpus
layoutModal :: forall e. { response :: Array Response | e} -> Array ReactElement
layoutModal state =
[button [ _type "button"
, _data { "toggle" : "modal"
, "target" : ".myModal"
}
][text "Launch modal"]
, div [ className "modal fade myModal"
, role "dialog"
, _data {show : true}
][ div [ className "modal-dialog"
, role "document"
] [ div [ className "modal-content"]
[ div [ className "modal-header"]
[ h5 [className "modal-title"]
[text "CorpusView" ]
, button [ _type "button"
, className "close"
, _data { dismiss : "modal"}
] [ span [ aria {hidden : true}]
[ text "X"]
]
]
, div [ className "modal-body"]
[ ul [ className "list-group"] ( map fn1 state.response ) ]
, div [className "modal-footer"]
[ button [ _type "button"
, className "btn btn-secondary"
, _data {dismiss : "modal"}
] [ text "GO"]
]
]
]
]
]
where
fn1 (Response o) =
li [className "list-group-item justify-content-between"]
[
span [] [text o.name]
, span [className "badge badge-default badge-pill"] [ text $ show o.count]
]
layoutAddcorpus :: Spec State {} Action
layoutAddcorpus = simpleSpec performAction render
where
render :: Render State {} Action
render dispatch _ state _ =
[ div [className "container1"] []
, div [className "container1"]
[ div [className "jumbotron"]
[ div [className "row"]
[ div [className "col-md-6"] (layoutModal state)
, div [className "col-md-6"]
[ h3 [] [text "Corpusview"]
, ul [className "list-group"] $ map fn1 state.response
, button [onClick \_ -> dispatch GO] [text "GO"]
]
]
]
]
]
where
fn1 (Response o) =
li [className "list-group-item justify-content-between"]
[
span [] [text o.name]
, span [className "badge badge-default badge-pill"] [ text $ show o.count]
]
countResults :: Query -> Aff (Either String (Int))
countResults query = do
res <- request $ defaultRequest
{ url = "http://localhost:8008/count"
, responseFormat = ResponseFormat.json
, method = Left POST
, headers = []
, content = Just $ Json $ encodeJson query
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
src/Gargantext/Pages/Layout/Specs/AddCorpus/States.purs 0 → 100644
View file @ 9a6d8cc0
module Gargantext.Pages.Layout.Specs.AddCorpus.States where
import Prelude hiding (div)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
type State =
{ select_database :: Boolean
, unselect_database :: Boolean -- dummy state
, response :: Array Response
}
newtype Response = Response
{
count :: Int
, name :: String
}
newtype Query = Query
{
query_query :: String
, query_name :: Array String
}
instance encodeJsonQuery :: EncodeJson Query where
encodeJson (Query post)
= "query_query" := post.query_query
~> "query_name" := post.query_name
~> jsonEmptyObject
instance decodeJsonresponse :: DecodeJson Response where
decodeJson json = do
obj <- decodeJson json
count <- obj .? "count"
name <- obj .? "name"
pure $ Response {count,name }
initialState :: State
initialState =
{
select_database : true
, unselect_database : true
, response : []
}
src/Gargantext/Pages/Search.purs → src/Gargantext/Pages/Layout/Specs/Search.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Search where
module Gargantext.Pages.Layout.Specs.Search where
import Control.Monad.Aff.Console (CONSOLE)
import Control.Monad.Cont.Trans (lift)
import DOM (DOM)
import Network.HTTP.Affjax (AJAX)
import Prelude hiding (div)
import React.DOM (br', button, div, h3, input, text, i, span, img)
import React.DOM.Props (_id, _type, className, name, onClick, onInput, placeholder, value, aria, src, title)
import Routing.Hash.Aff (setHash)
import Effect.Class (liftEffect)
import React.DOM (br', button, div, input, text)
import React.DOM.Props (_id, _type, className, name, onClick, onInput, placeholder, value)
import Routing.Hash (setHash)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Pages.Home as L
type State =
{
......@@ -21,49 +18,38 @@ type State =
initialState :: State
initialState =
{
query : ""
query : "empty query"
}
data Action
= NoOp
| GO
= GO
| SetQuery String
performAction :: forall eff props. PerformAction (console :: CONSOLE, ajax :: AJAX,dom::DOM | eff) State props Action
performAction NoOp _ _ = void do
modifyState id
performAction :: PerformAction State {} Action
performAction (SetQuery q) _ _ = void do
modifyState \( state) -> state { query = q }
modifyState $ _ { query = q }
performAction GO _ _ = void do
lift $ setHash "/addCorpus"
modifyState id
liftEffect $ setHash "/addCorpus"
unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value
searchSpec :: forall props eff . Spec ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
searchSpec :: Spec State {} Action
searchSpec = simpleSpec performAction render
where
render :: Render State props Action
render :: Render State {} Action
render dispatch _ state _ =
[ div [className "container1"] []
, div [className "container1"]
[ div [className "jumbotron" ]
[ div [className "row" ]
[ div [className "col-md-10" ]
[ br' []
, br' []
[ br'
, br'
, div [ className "form-group"]
[ input [ className "form-control"
, _id "id_password"
......@@ -72,16 +58,16 @@ searchSpec = simpleSpec performAction render
, _type "text"
, value state.query
, onInput \e -> dispatch (SetQuery (unsafeEventValue e))
] []
, br'[]
]
, br'
]
]
, div [ className "col-md-2"]
[ br' []
, br' []
[ br'
, br'
, button [onClick \_ -> dispatch GO] [text "GO"]
]
, br' []
, br'
]
]
]
......
src/Gargantext/Pages/Layout/States.purs
View file @ 9a6d8cc0
......@@ -2,83 +2,55 @@ module Gargantext.Pages.Layout.States where
import Prelude hiding (div)
import Control.Monad.Cont.Trans (lift)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (CONSOLE, log)
import DOM (DOM)
import Data.Array (length)
import Data.Either (Either(..))
import Data.Lens (Lens', Prism', lens, prism)
import Data.Maybe (Maybe(Just))
import Gargantext.Components.Login as LN
import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Components.Tree as Tree
import Gargantext.Pages.Corpus as AC
import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus.Doc.Body as CA
import Gargantext.Pages.Corpus.Doc.Document as DV
import Gargantext.Pages.Corpus.Doc.Facets as TV
import Gargantext.Pages.Corpus.Doc.Facets.Dashboard as Dsh
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG
import Gargantext.Pages.Corpus.User.Users as U
import Gargantext.Pages.Home as L
import Gargantext.Pages.Search as S
import Gargantext.Router (Routes(..))
import Network.HTTP.Affjax (AJAX)
import Thermite (PerformAction, modifyState)
type E e = (dom :: DOM, ajax :: AJAX, console :: CONSOLE | e)
import Data.Lens (Lens', lens)
import Data.Maybe (Maybe(Just))
import Gargantext.Components.Login as LN
import Gargantext.Components.Tree as Tree
import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus.Annuaire as Annuaire
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
import Gargantext.Pages.Corpus.User.Users as U
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Router (Routes(..))
type AppState =
{ currentRoute :: Maybe Routes
, landingState :: L.State
, loginState :: LN.State
, loginState :: LN.State
, addCorpusState :: AC.State
, docViewState :: DV.State
, searchState :: S.State
, userPage :: U.State
, docAnnotationView :: D.State
, ntreeView :: Tree.State
, tabview :: TV.State
, userPageState :: U.State
, docAnnotationState :: D.State
, annuaireState :: Annuaire.State
, ntreeState :: Tree.State
, search :: String
, corpusAnalysis :: CA.State
, showLogin :: Boolean
, showCorpus :: Boolean
, graphExplorer :: GE.State
, graphExplorerState :: GE.State
, initialized :: Boolean
, ngState :: NG.State
, dashboard :: Dsh.State
}
initAppState :: AppState
initAppState =
{ currentRoute : Just Home
, landingState : L.initialState
, loginState : LN.initialState
, addCorpusState : AC.initialState
, docViewState : DV.tdata
, searchState : S.initialState
, userPage : U.initialState
, docAnnotationView : D.initialState
, ntreeView : Tree.exampleTree
, tabview : TV.initialState
, userPageState : U.initialState
, docAnnotationState : D.initialState
, ntreeState : Tree.exampleTree
, annuaireState : Annuaire.initialState
, search : ""
, corpusAnalysis : CA.initialState
, showLogin : false
, showCorpus : false
, graphExplorer : GE.initialState
, graphExplorerState : GE.initialState
, initialized : false
, ngState : NG.initialState
, dashboard : Dsh.initialState
}
---------------------------------------------------------
_landingState :: Lens' AppState L.State
_landingState = lens (\s -> s.landingState) (\s ss -> s{landingState = ss})
_loginState :: Lens' AppState LN.State
_loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss})
......@@ -92,27 +64,16 @@ _searchState :: Lens' AppState S.State
_searchState = lens (\s -> s.searchState) (\s ss -> s{searchState = ss})
_userPageState :: Lens' AppState U.State
_userPageState = lens (\s -> s.userPage) (\s ss -> s{userPage = ss})
_userPageState = lens (\s -> s.userPageState) (\s ss -> s{userPageState = ss})
_annuaireState :: Lens' AppState Annuaire.State
_annuaireState = lens (\s -> s.annuaireState) (\s ss -> s{annuaireState = ss})
_docAnnotationViewState :: Lens' AppState D.State
_docAnnotationViewState = lens (\s -> s.docAnnotationView) (\s ss -> s{docAnnotationView = ss})
_docAnnotationViewState = lens (\s -> s.docAnnotationState) (\s ss -> s{docAnnotationState = ss})
_treeState :: Lens' AppState Tree.State
_treeState = lens (\s -> s.ntreeView) (\s ss -> s {ntreeView = ss})
_tabviewState :: Lens' AppState TV.State
_tabviewState = lens (\s -> s.tabview) (\s ss -> s {tabview = ss})
_corpusState :: Lens' AppState CA.State
_corpusState = lens (\s -> s.corpusAnalysis) (\s ss -> s {corpusAnalysis = ss})
_dashBoardSate :: Lens' AppState Dsh.State
_dashBoardSate = lens (\s -> s.dashboard) (\s ss -> s {dashboard = ss})
_treeState = lens (\s -> s.ntreeState) (\s ss -> s {ntreeState = ss})
_graphExplorerState :: Lens' AppState GE.State
_graphExplorerState = lens (\s -> s.graphExplorer) (\s ss -> s{graphExplorer = ss})
_ngState :: Lens' AppState NG.State
_ngState = lens (\s -> s.ngState) (\s ss -> s{ngState = ss})
_graphExplorerState = lens (\s -> s.graphExplorerState) (\s ss -> s{graphExplorerState = ss})
src/Gargantext/Router.purs
View file @ 9a6d8cc0
......@@ -3,23 +3,21 @@ module Gargantext.Router where
import Prelude
import Control.Alt ((<|>))
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (CONSOLE, log)
import DOM (DOM)
import DOM.HTML (window)
import DOM.HTML.Window (localStorage)
import DOM.WebStorage.Storage (getItem)
import Data.Int (floor)
import Data.Maybe (Maybe(..))
import Routing.Match (Match)
import Routing.Match.Class (lit, num)
import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Routing.Match (Match, lit, num)
import Web.HTML (window)
import Web.HTML.Window (localStorage)
import Web.Storage.Storage (getItem)
data Routes
= Home
| Login
| AddCorpus
| DocView
| DocView Int
| SearchView
| UserPage Int
| DocAnnotation Int
......@@ -28,20 +26,24 @@ data Routes
| PGraphExplorer
| NGramsTable
| Dashboard
| Annuaire Int
| Folder Int
instance showRoutes :: Show Routes where
show Login = "Login"
show AddCorpus = "AddCorpus"
show DocView = "DocView"
show SearchView = "SearchView"
show (UserPage i) = "UserPage"
show (DocAnnotation i)= "DocumentView"
show (DocView i) = "DocView"
show SearchView = "Search"
show (UserPage i) = "User"
show (DocAnnotation i)= "Document"
show Tabview = "Tabview"
show CorpusAnalysis = "corpus"
show CorpusAnalysis = "Corpus"
show PGraphExplorer = "graphExplorer"
show NGramsTable = "NGramsTable"
show Dashboard = "Dashboard"
show (Annuaire i) = "Annuaire"
show (Folder i) = "Folder"
show Home = "Home"
int :: Match Int
......@@ -51,40 +53,33 @@ routing :: Match Routes
routing =
Login <$ route "login"
<|> Tabview <$ route "tabview"
<|> DocAnnotation <$> (route "documentView" *> int)
<|> UserPage <$> (route "user" *> int)
<|> DocAnnotation <$> (route "document" *> int)
<|> UserPage <$> (route "user" *> int)
<|> SearchView <$ route "search"
<|> DocView <$ route "docView"
<|> DocView <$> (route "docView" *> int)
<|> AddCorpus <$ route "addCorpus"
<|> CorpusAnalysis <$ route "corpus"
<|> PGraphExplorer <$ route "graphExplorer"
<|> PGraphExplorer <$ route "graph"
<|> NGramsTable <$ route "ngrams"
<|> Dashboard <$ route "dashboard"
<|> Annuaire <$> (route "annuaire" *> int)
<|> Folder <$> (route "folder" *> int)
<|> Home <$ lit ""
where
route str = lit "" *> lit str
routeHandler :: forall e. ( Maybe Routes -> Routes -> Eff
( dom :: DOM
, console :: CONSOLE
| e
) Unit
) -> Maybe Routes -> Routes -> Eff
( dom :: DOM
, console :: CONSOLE
| e
) Unit
routeHandler :: (Maybe Routes -> Routes -> Effect Unit) -> Maybe Routes -> Routes -> Effect Unit
routeHandler dispatchAction old new = do
liftEff $ log $ "change route : " <> show new
liftEffect $ log $ "change route : " <> show new
w <- window
ls <- localStorage w
token <- getItem "accessToken" ls
let tkn = token
liftEff $ log $ "JWToken : " <> show tkn
liftEffect $ log $ "JWToken : " <> show tkn
case tkn of
Nothing -> do
dispatchAction old new
liftEff $ log $ "called SignIn Route :"
liftEffect $ log $ "called SignIn Route :"
Just t -> do
dispatchAction old new
liftEff $ log $ "called Route : " <> show new
liftEffect $ log $ "called Route : " <> show new
src/Gargantext/Utils/DecodeMaybe.purs
View file @ 9a6d8cc0
......@@ -2,16 +2,22 @@ module Gargantext.Utils.DecodeMaybe where
import Prelude
import Data.Argonaut (class DecodeJson, JObject, getFieldOptional)
import Data.Argonaut (class DecodeJson, Json, getFieldOptional)
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..), fromMaybe)
import Foreign.Object (Object)
foreign import isNull :: forall a. a -> Boolean
getFieldOptional' :: forall a. DecodeJson a => JObject -> String -> Either String (Maybe a)
getFieldOptional' :: forall a. DecodeJson a => Object Json -> String -> Either String (Maybe a)
getFieldOptional' o s = (case _ of
Just v -> if isNull v then Nothing else v
Nothing -> Nothing
) <$> (getFieldOptional o s)
infix 7 getFieldOptional' as .?|
getFieldOptionalAsMempty :: forall a. DecodeJson a => Monoid a => Object Json -> String -> Either String a
getFieldOptionalAsMempty o s = fromMaybe mempty <$> (getFieldOptional' o s)
infix 7 getFieldOptionalAsMempty as .|
src/Main.purs
View file @ 9a6d8cc0
......@@ -2,42 +2,40 @@ module Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import DOM.HTML (window) as DOM
import DOM.HTML.Types (htmlDocumentToParentNode) as DOM
import DOM.HTML.Window (document) as DOM
import DOM.Node.ParentNode (QuerySelector(..))
import DOM.Node.ParentNode (querySelector) as DOM
import Data.Maybe (fromJust)
import Gargantext.Pages.Layout (dispatchAction)
import Gargantext.Pages.Layout.Specs (layoutSpec)
import Effect (Effect)
import Gargantext.Pages.Layout (dispatchAction)
import Gargantext.Pages.Layout.Specs (layoutSpec)
import Gargantext.Pages.Layout.States (initAppState)
import Gargantext.Router (routeHandler, routing)
import Network.HTTP.Affjax (AJAX)
import Partial.Unsafe (unsafePartial)
import React as R
import ReactDOM as RDOM
import Routing (matches)
import Routing.Hash (getHash, setHash)
import Record.Unsafe (unsafeSet)
import Routing.Hash (getHash, matches, setHash)
import Thermite as T
import Web.DOM.ParentNode (QuerySelector(..), querySelector)
import Web.HTML (window)
import Web.HTML.Window (document)
import Web.HTML.HTMLDocument (toParentNode)
setUnsafeComponentWillMount :: forall s. Effect Unit -> Record s -> Record (unsafeComponentWillMount :: Effect Unit | s)
setUnsafeComponentWillMount = unsafeSet "unsafeComponentWillMount"
main :: forall e. Eff (dom:: DOM, console :: CONSOLE, ajax :: AJAX | e ) Unit
main :: Effect Unit
main = do
case T.createReactSpec layoutSpec initAppState of
{ spec, dispatcher } -> void $ do
let setRouting this = void $ do
matches routing (routeHandler (dispatchAction (dispatcher this)))
spec' = spec { componentWillMount = setRouting }
document <- DOM.window >>= DOM.document
container <- unsafePartial (fromJust <$> DOM.querySelector (QuerySelector "#app") (DOM.htmlDocumentToParentNode document))
spec' this = setUnsafeComponentWillMount (setRouting this) <$> (spec this)
document <- window >>= document
container <- unsafePartial (fromJust <$> querySelector (QuerySelector "#app") (toParentNode document))
h <- getHash
case h of
"" -> setHash "/"
_ -> do
setHash "/"
setHash h
RDOM.render (R.createFactory (R.createClass spec') {}) container
let e = R.unsafeCreateElement (R.component "GargantextMain" spec') {} []
RDOM.render e container
test/Main.purs
View file @ 9a6d8cc0
module Test.Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
--import Control.Monad.Eff (Eff)
--import Control.Monad.Eff.Console (CONSOLE, log)
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log "You should add some tests."
--main :: forall e. Eff (console :: CONSOLE | e) Unit
--main = do
-- log "You should add some tests."
yarn.lock
View file @ 9a6d8cc0
This source diff could not be displayed because it is too large. You can view the blob instead.
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