Skip to content

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

merged

parents 8309e9f4 9264eae1
Show whitespace changes
Inline Side-by-side
Showing with 5417 additions and 2166 deletions
bower.json
View file @ 9a6d8cc0
...@@ -7,61 +7,18 @@ ...@@ -7,61 +7,18 @@
"output" "output"
], ],
"dependencies": { "dependencies": {
"purescript-prelude": "^3.1.0", "purescript-console": "^4.1.0",
"purescript-console": "^3.0.0", "purescript-thermite": "https://github.com/np/purescript-thermite.git#hide",
"purescript-thermite": "^5.0.0", "purescript-affjax": "^7.0.0",
"purescript-affjax": "^5.0.0", "purescript-routing": "^8.0.0",
"purescript-routing": "^6.1.2", "purescript-argonaut": "^4.0.1",
"purescript-argonaut-codecs": "^2.0.0", "purescript-random": "^4.0.0",
"purescript-argonaut-traversals": "^2.0.0", "purescript-css": "^4.0.0"
"purescript-argonaut": "^3.1.0",
"purescript-random": "^3.0.0",
"purescript-css": "^3.4.0"
}, },
"devDependencies": { "devDependencies": {
"purescript-psci-support": "^3.0.0" "purescript-psci-support": "^4.0.0"
}, },
"resolutions": { "resolutions": {
"purescript-maybe": "^3.0.0", "purescript-react": "exports"
"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"
} }
} }
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 ...@@ -2,6 +2,7 @@ module Gargantext.Components.Charts.Charts where
import Prelude hiding (min) import Prelude hiding (min)
import Gargantext.Components.Charts.Options.Series (Series(..), D1, seriesType, SeriesShape(..))
import CSS (Color, white) import CSS (Color, white)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import React as R import React as R
...@@ -30,7 +31,7 @@ group = unsafeMkProps "group" ...@@ -30,7 +31,7 @@ group = unsafeMkProps "group"
-- resizable :: Boolean, -- PropTypes.bool, -- resizable :: Boolean, -- PropTypes.bool,
-- onEvents :: String -- PropTypes.object -- onEvents :: String -- PropTypes.object
type EchartsProps eff = type EchartsProps=
{ className :: String, { className :: String,
style :: String, -- objealect-black-altdarkmincnaquadahherry-blossomect, style :: String, -- objealect-black-altdarkmincnaquadahherry-blossomect,
theme :: String, theme :: String,
...@@ -55,7 +56,7 @@ type OptsLoading = ...@@ -55,7 +56,7 @@ type OptsLoading =
} }
type OpTest = type OpTest =
{option :: Option} {children :: R.Children, option :: Option}
type Option = type Option =
{ title :: Maybe Title { title :: Maybe Title
...@@ -161,11 +162,12 @@ type AxisLabel = ...@@ -161,11 +162,12 @@ type AxisLabel =
} }
type Series = --type Series =
{ name :: String -- { name :: String
, "type" :: String -- , "type" :: String
, "data" :: Array Int -- , "data" :: Array Int
} -- }
type Title = type Title =
{ text :: String { text :: String
...@@ -202,14 +204,14 @@ type Title = ...@@ -202,14 +204,14 @@ type Title =
type Rich = {} 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 foreign import eChartsClass2 :: R.ReactClass OpTest
echarts :: forall eff. Array Props -> R.ReactElement echarts :: Array Props -> R.ReactElement
echarts p = R.createElementDynamic eChartsClass (unsafeFromPropsArray p) [] echarts p = R.unsafeCreateElementDynamic eChartsClass (unsafeFromPropsArray p) []
echarts' :: forall eff. Option -> R.ReactElement echarts' :: Option -> R.ReactElement
echarts' chart = R.createElementDynamic eChartsClass2 {option: chart} [] echarts' chart = R.unsafeCreateElementDynamic eChartsClass2 {option: chart} []
-- Props -- Props
...@@ -436,12 +438,12 @@ tooltip' = ...@@ -436,12 +438,12 @@ tooltip' =
} }
series' :: Series series' :: D1
series' = series' =
{ {
name: "All" name: "All"
, "type": "bar" , "type": seriesType Bar
, "data": [201, 777, 879] , "data": [201.0, 777, 879]
} }
opt :: Option opt :: Option
...@@ -453,7 +455,7 @@ opt = ...@@ -453,7 +455,7 @@ opt =
,grid: {containLabel: true} ,grid: {containLabel: true}
,xAxis: xAxis' ,xAxis: xAxis'
,yAxis: yData1 ,yAxis: yData1
,series: [series'] ,series: [SeriesD1 series']
,dataZoom: [dz1', dz1', dz2', dz2'] ,dataZoom: [dz1', dz1', dz2', dz2']
} }
...@@ -591,5 +593,4 @@ sd2 = unsafeFromPropsArray ...@@ -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 = ...@@ -17,3 +17,4 @@ type DataS =
{ name :: String { name :: String
, value :: Number , 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) ...@@ -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.Font (IconOptions(..), Shape(..), TextStyle, chartFontStyle, chartFontWeight, icon)
import Gargantext.Components.Charts.Options.Legend (legendType, LegendMode(..), PlainOrScroll(..), selectedMode, Orientation(..), orient) 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.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 Gargantext.Components.Charts.Options.Type (DataZoom, Echarts, Legend, Option, Title, Tooltip, XAxis, YAxis)
import React (unsafeCreateElementDynamic)
import React as R import React as R
import Unsafe.Coerce (unsafeCoerce)
foreign import eChartsClass :: R.ReactClass Echarts foreign import eChartsClass :: R.ReactClass Echarts
...@@ -23,23 +25,23 @@ chart = echarts <<< chartWith <<< opts ...@@ -23,23 +25,23 @@ chart = echarts <<< chartWith <<< opts
chartWith :: Option -> Echarts chartWith :: Option -> Echarts
chartWith opts = { className: Nothing chartWith opts = { className : Nothing
, style: Nothing , style : Nothing
, theme: Nothing , theme : Nothing
, group: Nothing , group : Nothing
, option: opts , option : opts
, initOpts: Nothing , initOpts : Nothing
, notMerge: Nothing , notMerge : Nothing
, lazyUpdate: Nothing , lazyUpdate: Nothing
, loading: Nothing , loading : Nothing
, optsLoading: Nothing , optsLoading: Nothing
, onReady: Nothing , onReady : Nothing
, resizable: Nothing , resizable : Nothing
, onEvents: Nothing , onEvents : Nothing
} }
echarts :: forall eff. Echarts -> R.ReactElement echarts :: Echarts -> R.ReactElement
echarts chart = R.createElementDynamic eChartsClass chart [] echarts chart = unsafeCreateElementDynamic (unsafeCoerce eChartsClass) chart []
type MainTitle = String type MainTitle = String
type SubTitle = String type SubTitle = String
...@@ -112,7 +114,9 @@ data2 = {name: "Favorites", icon: icon $ Shape Circle, textStyle: textStyle'} ...@@ -112,7 +114,9 @@ data2 = {name: "Favorites", icon: icon $ Shape Circle, textStyle: textStyle'}
data3 :: DataN data3 :: DataN
data3 = {name: "Test", icon: icon $ Shape Diamond, textStyle: textStyle'} data3 = {name: "Test", icon: icon $ Shape Diamond, textStyle: textStyle'}
xAxis :: Array String -> XAxis xAxis :: Array String -> XAxis
xAxis [] = unsafeCoerce {}
xAxis xs = { "data": xData xs xAxis xs = { "data": xData xs
, "type": "category" , "type": "category"
, axisTick: {alignWithLabel: true} , axisTick: {alignWithLabel: true}
...@@ -153,12 +157,20 @@ tooltip' = ...@@ -153,12 +157,20 @@ tooltip' =
} }
series :: SeriesShape -> SeriesName -> Array DataS -> Series series :: Chart -> SeriesName -> Array DataS -> D1
series sh name ss = { name: name series sh name ss = { name: name
, "type": seriesType sh , "type": seriesType sh
, "data": ss , "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 data YAxisFormat = YAxisFormat { position :: String
, visible :: Boolean , visible :: Boolean
} }
...@@ -166,7 +178,7 @@ data YAxisFormat = YAxisFormat { position :: String ...@@ -166,7 +178,7 @@ data YAxisFormat = YAxisFormat { position :: String
data Options = Options { mainTitle :: MainTitle data Options = Options { mainTitle :: MainTitle
, subTitle :: SubTitle , subTitle :: SubTitle
, xAxis :: XAxis , xAxis :: XAxis
, yAxis :: Array Series , yAxis :: Array Serie
, yAxisFormat :: YAxisFormat , yAxisFormat :: YAxisFormat
, addZoom :: Boolean , addZoom :: Boolean
} }
...@@ -187,7 +199,7 @@ opts (Options { mainTitle : mainTitle ...@@ -187,7 +199,7 @@ opts (Options { mainTitle : mainTitle
} }
, grid : {containLabel: true} , grid : {containLabel: true}
, xAxis : xs , xAxis : xs
, series : ss , series : map toSeries $ ss
, yAxis : { "type": "value" , yAxis : { "type": "value"
, name: "data" , name: "data"
, min: 0 , min: 0
...@@ -195,7 +207,8 @@ opts (Options { mainTitle : mainTitle ...@@ -195,7 +207,8 @@ opts (Options { mainTitle : mainTitle
, axisLabel: {formatter: "{value}"} , axisLabel: {formatter: "{value}"}
, show: visible , 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 = { ...@@ -215,10 +228,10 @@ zoom z = {
} }
seriesPie :: Series seriesPie :: D1
seriesPie = seriesPie =
{ {
name: "Pie" name: "Pie name"
, "type": seriesType Pie , "type": seriesType Pie
, "data": [{name: "t1", value: 50.0}, , "data": [{name: "t1", value: 50.0},
{name: "t2", value: 45.0}, {name: "t2", value: 45.0},
...@@ -229,7 +242,6 @@ seriesPie = ...@@ -229,7 +242,6 @@ seriesPie =
} }
textStyle2 :: TextStyle textStyle2 :: TextStyle
textStyle2 = textStyle2 =
{ {
......
src/Gargantext/Components/Charts/Options/Font.purs
View file @ 9a6d8cc0
...@@ -14,8 +14,9 @@ module Gargantext.Components.Charts.Options.Font ...@@ -14,8 +14,9 @@ module Gargantext.Components.Charts.Options.Font
import Prelude (Unit, ($), (<<<), (<>)) import Prelude (Unit, ($), (<<<), (<>))
import Data.Generic.Rep
import Data.Generic.Rep.Show
import CSS (FontStyle(..), FontWeight(..), Prefixed(..), Value(..)) import CSS (FontStyle(..), FontWeight(..), Prefixed(..), Value(..))
import Data.Generic (class Generic, gShow)
import Data.String (toLower) import Data.String (toLower)
import Gargantext.Components.Charts.Options.Color (ChartColor) import Gargantext.Components.Charts.Options.Color (ChartColor)
import Gargantext.Components.Charts.Options.Position (LeftRelativePosition, Position, TopRelativePosition) import Gargantext.Components.Charts.Options.Position (LeftRelativePosition, Position, TopRelativePosition)
...@@ -63,10 +64,10 @@ newtype Icon = Icon String ...@@ -63,10 +64,10 @@ newtype Icon = Icon String
newtype ImageURL = ImageURL String newtype ImageURL = ImageURL String
data Shape = Circle | Rect | RoundRect | Triangle | Diamond | Pin | Arrow 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 data IconOptions = Shape Shape | Image ImageURL
icon :: IconOptions -> Icon icon :: IconOptions -> Icon
icon (Shape s) = Icon <<< toLower $ gShow s icon (Shape s) = Icon <<< toLower $ genericShow s
icon (Image (ImageURL url)) = Icon $ "image://" <> url 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 ...@@ -13,7 +13,8 @@ module Gargantext.Components.Charts.Options.Legend
import Prelude (class Show, show, (<<<)) 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 Data.String (toLower)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
...@@ -31,16 +32,16 @@ legendType = LegendType <<< toLower <<< show ...@@ -31,16 +32,16 @@ legendType = LegendType <<< toLower <<< show
newtype Orient = Orient String newtype Orient = Orient String
data Orientation = Horizontal | Vertical data Orientation = Horizontal | Vertical
derive instance genericOrientation :: Generic Orientation derive instance genericOrientation :: Generic Orientation _
orient :: Orientation -> Orient orient :: Orientation -> Orient
orient = Orient <<< toLower <<< gShow orient = Orient <<< toLower <<< genericShow
foreign import data SelectedMode :: Type foreign import data SelectedMode :: Type
data LegendMode = Bool Boolean | Single | Multiple data LegendMode = Bool Boolean | Single | Multiple
derive instance genericLegendMode :: Generic LegendMode derive instance genericLegendMode :: Generic LegendMode _
selectedMode :: LegendMode -> SelectedMode selectedMode :: LegendMode -> SelectedMode
selectedMode (Bool b) = unsafeCoerce b selectedMode (Bool b) = unsafeCoerce b
......
src/Gargantext/Components/Charts/Options/Series.purs
View file @ 9a6d8cc0
module Gargantext.Components.Charts.Options.Series where module Gargantext.Components.Charts.Options.Series where
import Effect.Exception (error, Error(..))
import Unsafe.Coerce (unsafeCoerce)
import Prelude import Prelude
import Gargantext.Components.Charts.Options.Data (DataS) import Gargantext.Components.Charts.Options.Data (DataS)
...@@ -9,12 +11,13 @@ newtype SeriesType = SeriesType String ...@@ -9,12 +11,13 @@ newtype SeriesType = SeriesType String
type SeriesName = String type SeriesName = String
data SeriesShape = Line
data Chart = Line
| Bar | PictorialBar | Bar | PictorialBar
| Pie | Pie
| Scatter | EffectScater | Scatter | EffectScatter
| Radar | Radar
| Tree | TreeMap | Trees
| Sunburst | Sunburst
| Boxplot | Boxplot
| Candlestick | Candlestick
...@@ -27,21 +30,133 @@ data SeriesShape = Line ...@@ -27,21 +30,133 @@ data SeriesShape = Line
| Funnel | Funnel
| Gauge | Gauge
| ThemeRiver | ThemeRiver
-- Trees
instance showSeriesShape :: Show SeriesShape where instance showChart :: Show Chart where
show Line = "line"
show Bar = "bar" show Bar = "bar"
show Pie = "pie" show EffectScatter = "effectScatter" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter-effect
show Sunburst = "sunburst"
show Funnel = "funnel" show Funnel = "funnel"
show Heatmap = "heatmap" 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 seriesType = SeriesType <<< show
type Series =
type Series = {}
data Serie = SeriesD1 D1 | SeriesD2 D2 | SerieSankey Sankey | SerieTree Tree
type D1 =
{ name :: String { name :: String
, "type" :: SeriesType , "type" :: SeriesType
, "data" :: Array DataS , "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) ...@@ -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.Legend (LegendType, Orient, SelectedMode)
import Gargantext.Components.Charts.Options.Position (LeftRelativePosition, Position, TopRelativePosition) import Gargantext.Components.Charts.Options.Position (LeftRelativePosition, Position, TopRelativePosition)
import Gargantext.Components.Charts.Options.Series (Series) import Gargantext.Components.Charts.Options.Series (Series)
import React as R
newtype ChartAlign = ChartAlign String newtype ChartAlign = ChartAlign String
type Echarts = type Echarts =
{ className :: Maybe String, { className :: Maybe String
style :: Maybe String, -- objealect-black-altdarkmincnaquadahherry-blossomect, , style :: Maybe String -- objealect-black-altdarkmincnaquadahherry-blossomect,
theme :: Maybe String, , theme :: Maybe String
group :: Maybe String, , group :: Maybe String
option :: Option, -- PropTypes.object.isRequired, , option :: Option -- PropTypes.object.isRequired,
initOpts :: Maybe String, -- PropTypes.object, , initOpts :: Maybe String -- PropTypes.object,
notMerge :: Maybe Boolean, , notMerge :: Maybe Boolean
lazyUpdate :: Maybe Boolean, , lazyUpdate :: Maybe Boolean
loading :: Maybe Boolean, , loading :: Maybe Boolean
optsLoading :: Maybe OptsLoading, -- PropTypes.object, , optsLoading :: Maybe OptsLoading -- PropTypes.object,
onReady :: Maybe String, -- PropTypes.func, , onReady :: Maybe String -- PropTypes.func,
resizable :: Maybe Boolean, -- PropTypes.bool, , resizable :: Maybe Boolean -- PropTypes.bool,
onEvents :: Maybe String -- PropTypes.object , onEvents :: Maybe String -- PropTypes.object
} }
type Option = type Option =
...@@ -38,11 +38,11 @@ type Option = ...@@ -38,11 +38,11 @@ type Option =
, yAxis :: YAxis , yAxis :: YAxis
, series :: Array Series , series :: Array Series
, dataZoom :: Array DataZoom , dataZoom :: Array DataZoom
, children :: R.Children
} }
type Title = type Title =
{ { id :: String -- None by default
id :: String -- None by default
, show :: Boolean -- default True , show :: Boolean -- default True
, text :: String -- default '' , text :: String -- default ''
, link :: String -- default '' , link :: String -- default ''
...@@ -71,11 +71,11 @@ type Title = ...@@ -71,11 +71,11 @@ type Title =
} }
type OptsLoading = type OptsLoading =
{ text :: String, { text :: String
color :: Color, --- color , color :: Color --- color
textColor :: Color, --color , textColor :: Color --color
maskColor :: Color, --color , maskColor :: Color --color
zlevel :: Int , zlevel :: Int
} }
type DataZoom = type DataZoom =
......
src/Gargantext/Components/GraphExplorer/Sigmajs.purs
View file @ 9a6d8cc0
...@@ -2,8 +2,9 @@ module Gargantext.Components.GraphExplorer.Sigmajs where ...@@ -2,8 +2,9 @@ module Gargantext.Components.GraphExplorer.Sigmajs where
import Prelude import Prelude
import Control.Monad.Eff (Eff) import Effect (Effect)
import React (ReactClass, ReactElement, createElement) import Prim.Row (class Union)
import React (Children, ReactClass, ReactElement, createElement, unsafeCreateElement)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
foreign import edgeShapesClass :: forall props. ReactClass props foreign import edgeShapesClass :: forall props. ReactClass props
...@@ -12,51 +13,51 @@ foreign import forceAtlas2Class :: forall props. ReactClass props ...@@ -12,51 +13,51 @@ foreign import forceAtlas2Class :: forall props. ReactClass props
foreign import forceLinkClass :: forall props. ReactClass props foreign import forceLinkClass :: forall props. ReactClass props
foreign import loadGEXFClass :: forall props. ReactClass props foreign import loadGEXFClass :: forall props. ReactClass props
foreign import loadJSONClass :: forall props. ReactClass props foreign import loadJSONClass :: forall props. ReactClass props
foreign import nOverlapClass :: forall props. ReactClass props foreign import nOverlapClass :: ReactClass {children :: Children}
foreign import neoCypherClass :: forall props. ReactClass props foreign import neoCypherClass :: ReactClass {children :: Children}
foreign import neoGraphItemsProducersClass :: forall props. ReactClass props foreign import neoGraphItemsProducersClass :: forall props. ReactClass props
foreign import nodeShapesClass :: forall props. ReactClass props foreign import nodeShapesClass :: ReactClass {children :: Children}
foreign import randomizeNodePositionsClass :: forall props. ReactClass props foreign import randomizeNodePositionsClass :: ReactClass {children :: Children}
foreign import relativeSizeClass :: forall props. ReactClass props 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 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 :: forall o. Optional o NeoCypherOptProps => NeoCypherReqProps o -> ReactElement
neoCypher props = createElement neoCypherClass props [] neoCypher props = unsafeCreateElement neoCypherClass (unsafeCoerce props) []
loadJSON :: forall eff o. Optional o (onGraphLoaded :: Eff eff Unit) => { "path" :: String | o } -> ReactElement loadJSON :: forall o. Optional o (onGraphLoaded :: Effect Unit) => { "path" :: String | o } -> ReactElement
loadJSON props = createElement loadJSONClass props [] loadJSON props = unsafeCreateElement loadJSONClass props []
loadGEXF :: forall eff o. Optional o (onGraphLoaded :: Eff eff Unit) => { "path" :: String | o } -> ReactElement loadGEXF :: forall o. Optional o (onGraphLoaded :: Effect Unit) => { "path" :: String | o } -> ReactElement
loadGEXF props = createElement loadGEXFClass props [] loadGEXF props = unsafeCreateElement loadGEXFClass props []
forceLink :: forall eff o. Optional o (ForceLinkOptProps eff) => { | o} -> ReactElement forceLink :: forall o. Optional o ForceLinkOptProps => { | o} -> ReactElement
forceLink props = createElement forceLinkClass props [] forceLink props = unsafeCreateElement forceLinkClass props []
nOverlap :: forall o. Optional o NOverlapOptProps => { | o } -> ReactElement nOverlap :: forall o. Optional o NOverlapOptProps => { | o } -> ReactElement
nOverlap props = createElement nOverlapClass props [] nOverlap props = unsafeCreateElement nOverlapClass (unsafeCoerce props) []
randomizeNodePositions :: ReactElement randomizeNodePositions :: ReactElement
randomizeNodePositions = createElement randomizeNodePositionsClass {} [] randomizeNodePositions = createElement randomizeNodePositionsClass {} []
relativeSize :: {initialSize :: Number } -> ReactElement 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 :: forall o. Optional o ForceAtlas2OptProps => { | o } -> ReactElement
forceAtlas2 props = createElement forceAtlas2Class props [] forceAtlas2 props = unsafeCreateElement forceAtlas2Class props []
sigma :: forall props eff. Optional props (SigmaProps eff) => { | props} -> Array ReactElement -> ReactElement sigma :: forall props. Optional props SigmaProps => { | props} -> Array ReactElement -> ReactElement
sigma = createElement sigmaClass sigma props children = unsafeCreateElement sigmaClass (unsafeCoerce props) children
sigmaEnableWebGL :: ReactElement sigmaEnableWebGL :: ReactElement
sigmaEnableWebGL = createElement sigmaEnableWebGLClass {} [] sigmaEnableWebGL = createElement sigmaEnableWebGLClass {} []
edgeShapes :: { "default" :: EdgeShape } -> ReactElement edgeShapes :: { "default" :: EdgeShape } -> ReactElement
edgeShapes props = createElement edgeShapesClass props [] edgeShapes props = unsafeCreateElement edgeShapesClass props []
nodeShapes :: { "default" :: NodeShape } -> ReactElement nodeShapes :: { "default" :: NodeShape } -> ReactElement
nodeShapes props = createElement nodeShapesClass props [] nodeShapes props = unsafeCreateElement nodeShapesClass (unsafeCoerce props) []
foreign import data SigmaNode :: Type foreign import data SigmaNode :: Type
...@@ -69,9 +70,9 @@ instance srInstance :: Union r t s => Optional r s ...@@ -69,9 +70,9 @@ instance srInstance :: Union r t s => Optional r s
type NeoCypherOptProps eff = type NeoCypherOptProps =
( producers :: String ( producers :: String
, onGraphLoaded :: Eff eff Unit , onGraphLoaded :: Effect Unit
) )
type NeoCypherReqProps o = type NeoCypherReqProps o =
...@@ -84,7 +85,7 @@ type NeoCypherReqProps o = ...@@ -84,7 +85,7 @@ type NeoCypherReqProps o =
type ForceLinkOptProps eff = type ForceLinkOptProps =
( barnesHutOptimize :: Boolean ( barnesHutOptimize :: Boolean
, barnesHutTheta :: Number , barnesHutTheta :: Number
, adjustSizes :: Boolean , adjustSizes :: Boolean
...@@ -138,7 +139,7 @@ sigmaEasing = ...@@ -138,7 +139,7 @@ sigmaEasing =
, cubicInOut : SigmaEasing "cubicInOut" , cubicInOut : SigmaEasing "cubicInOut"
} }
type ForceAtlas2OptProps eff = type ForceAtlas2OptProps =
( worker :: Boolean ( worker :: Boolean
, barnesHutOptimize :: Boolean , barnesHutOptimize :: Boolean
, barnesHutTheta :: Number , barnesHutTheta :: Number
...@@ -248,17 +249,17 @@ sigmaSettings = unsafeCoerce ...@@ -248,17 +249,17 @@ sigmaSettings = unsafeCoerce
foreign import data SigmaStyle :: Type foreign import data SigmaStyle :: Type
type SigmaProps eff = type SigmaProps =
( renderer :: Renderer ( renderer :: Renderer
, settings :: SigmaSettings , settings :: SigmaSettings
, style :: SigmaStyle , style :: SigmaStyle
, graph :: SigmaGraphData , graph :: SigmaGraphData
, onClickNode :: SigmaNodeEvent -> Unit , onClickNode :: SigmaNodeEvent -> Unit
, onOverNode :: SigmaNodeEvent -> Unit , onOverNode :: SigmaNodeEvent -> Unit
, onOutNode :: SigmaNodeEvent -> Eff eff Unit , onOutNode :: SigmaNodeEvent -> Effect Unit
, onClickEdge :: SigmaEdgeEvent -> Eff eff Unit , onClickEdge :: SigmaEdgeEvent -> Effect Unit
, onOverEdge :: SigmaEdgeEvent -> Eff eff Unit , onOverEdge :: SigmaEdgeEvent -> Effect Unit
, onOutEdge :: SigmaEdgeEvent -> Eff eff Unit , onOutEdge :: SigmaEdgeEvent -> Effect Unit
) )
sStyle :: forall style. { | style } -> SigmaStyle sStyle :: forall style. { | style } -> SigmaStyle
......
src/Gargantext/Components/GraphExplorer/Types.purs
View file @ 9a6d8cc0
...@@ -3,11 +3,8 @@ module Gargantext.Components.GraphExplorer.Types where ...@@ -3,11 +3,8 @@ module Gargantext.Components.GraphExplorer.Types where
import Prelude import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.?)) import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Array (concat, group, head, length, sort, take) import Data.Array (concat, fromFoldable, group, sort, take)
import Data.Maybe (fromJust)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.NonEmpty (NonEmpty(..))
import Partial.Unsafe (unsafePartial)
newtype Node = Node newtype Node = Node
{ id_ :: String { id_ :: String
...@@ -82,10 +79,10 @@ instance ordLegend :: Ord Legend where ...@@ -82,10 +79,10 @@ instance ordLegend :: Ord Legend where
getLegendData :: GraphData -> Array Legend getLegendData :: GraphData -> Array Legend
getLegendData (GraphData {nodes, edges}) = nn getLegendData (GraphData {nodes, edges}) = nn
where 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 n = sort $ map t' nodes
g = group n 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 -> Legend
t' (Node r) = Legend { id_ : clustDefault, label : r.label} 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 ...@@ -2,30 +2,28 @@ module Gargantext.Components.Login where
import Prelude hiding (div) import Prelude hiding (div)
import Control.Monad.Aff (Aff, attempt) import Affjax (defaultRequest, printResponseFormatError, request)
import Control.Monad.Aff.Class (liftAff) import Affjax.RequestBody (RequestBody(..))
import Control.Monad.Aff.Console (log) import Affjax.RequestHeader (RequestHeader(..))
import Control.Monad.Eff (Eff) import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Eff.Class (liftEff) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, stringify, (.?), (:=), (~>))
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 Data.Either (Either(..)) import Data.Either (Either(..))
import Data.HTTP.Method (Method(..)) import Data.HTTP.Method (Method(..))
import Data.Lens (over) import Data.Lens (over)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationJSON) 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 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 (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 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 Thermite (PerformAction, Render, Spec, _render, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce) 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 -- 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 ...@@ -48,19 +46,12 @@ initialState = State
} }
data Action data Action
= NoOp = Login
| Login
| SetUserName String | SetUserName String
| SetPassword String | SetPassword String
performAction :: forall eff props. PerformAction ( console :: CONSOLE performAction :: PerformAction State {} Action
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
performAction NoOp _ _ = void do
modifyState id
performAction (SetUserName usr) _ _ = void do performAction (SetUserName usr) _ _ = void do
modifyState \(State state) -> State $ state { username = usr } modifyState \(State state) -> State $ state { username = usr }
...@@ -71,9 +62,9 @@ performAction (SetPassword pwd) _ _ = void do ...@@ -71,9 +62,9 @@ performAction (SetPassword pwd) _ _ = void do
performAction Login _ (State state) = void do performAction Login _ _ = void do
--lift $ setHash "/search" --lift $ setHash "/search"
liftEff $ modalHide "loginModal" liftEffect $ modalHide "loginModal"
modifyState \(State state) -> State $ state {loginC = true} modifyState \(State state) -> State $ state {loginC = true}
-- res <- lift $ loginReq $ LoginReq { username : state.username, password : state.password } -- res <- lift $ loginReq $ LoginReq { username : state.username, password : state.password }
-- case res of -- case res of
...@@ -85,7 +76,7 @@ performAction Login _ (State state) = void do ...@@ -85,7 +76,7 @@ performAction Login _ (State state) = void do
-- modifyState \(State s) -> State $ s {response = r, errorMessage = ""} -- 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 -> modalSpec sm t = over _render \render d p s c ->
[ div [ _id "loginModal", className $ "modal myModal" <> if sm then "" else " fade" [ div [ _id "loginModal", className $ "modal myModal" <> if sm then "" else " fade"
, role "dialog" , role "dialog"
...@@ -113,13 +104,13 @@ modalSpec sm t = over _render \render d p s c -> ...@@ -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 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 renderSpec = simpleSpec performAction render
where where
render :: Render State props Action render :: Render State {} Action
render dispatch _ (State state) _ = render dispatch _ (State state) _ =
[ [
div [className "row"] div [className "row"]
...@@ -149,13 +140,13 @@ renderSpec = simpleSpec performAction render ...@@ -149,13 +140,13 @@ renderSpec = simpleSpec performAction render
[ input [_type "hidden", [ input [_type "hidden",
name "csrfmiddlewaretoken", name "csrfmiddlewaretoken",
value "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM" ] value "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM" ]
[]
, div [className "form-group"] , div [className "form-group"]
[ p [] [text state.errorMessage] [ 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"] , 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 "clearfix"] []
] ]
, div [className "center"] , div [className "center"]
...@@ -163,8 +154,6 @@ renderSpec = simpleSpec performAction render ...@@ -163,8 +154,6 @@ renderSpec = simpleSpec performAction render
label [] [ label [] [
div [className "checkbox"] div [className "checkbox"]
[ input [_id "terms-accept", _type "checkbox", value "", className "checkbox"] [ input [_id "terms-accept", _type "checkbox", value "", className "checkbox"]
[
]
, text "I accept the terms of uses ", , text "I accept the terms of uses ",
a [href "http://gitlab.iscpif.fr/humanities/tofu/tree/master"] [text "[Read the terms of use]"] 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 ...@@ -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 getDeviseID = do
w <- window w <- window
ls <- localStorage w ls <- localStorage w
getItem "token" ls getItem "token" ls
setToken :: forall e . String -> Eff (dom :: DOM | e) Unit setToken :: String -> Effect Unit
setToken s = do setToken s = do
w <- window w <- window
ls <- localStorage w ls <- localStorage w
...@@ -244,37 +233,37 @@ newtype LoginReq = LoginReq ...@@ -244,37 +233,37 @@ newtype LoginReq = LoginReq
, password :: String , 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 = loginReq encodeData =
let let
setting = setting =
defaultRequest defaultRequest
{ url = "https://dev.gargantext.org/api/auth/token" { url = "https://dev.gargantext.org/api/auth/token"
, method = Left POST , method = Left POST
, responseFormat = ResponseFormat.json
, headers = , headers =
[ ContentType applicationJSON [ ContentType applicationJSON
, Accept applicationJSON , Accept applicationJSON
] ]
, content = Just $ encodeJson encodeData , content = Just $ Json $ encodeJson encodeData
} }
in in
do do
affResp <- liftAff $ attempt $ affjax setting affResp <- request setting
case affResp of case affResp.body of
Left err -> do Left err -> do
liftAff $ log $ show err liftEffect $ log $ printResponseFormatError err
pure $ Left $ show err pure $ Left $ printResponseFormatError err
Right a -> do Right json -> do
liftAff $ log $ "POST method Completed" liftEffect $ log $ "POST method Completed"
liftAff $ log $ "GET /api response: " <> show a.response liftEffect $ log $ "GET /api response: " <> stringify json
let res = decodeJson a.response let obj = decodeJson json
liftAff $ log $ "res: " <> show a.response case obj of
case res of
Left e -> Left e ->
liftAff $ log $ "Error Decoding : " <> show e liftEffect $ log $ "Error Decoding : " <> show e
Right (LoginRes res1) -> Right (LoginRes res1) ->
liftEff $ setToken res1.token liftEffect $ setToken res1.token
pure res pure obj
instance decodeLoginRes :: DecodeJson LoginRes where instance decodeLoginRes :: DecodeJson LoginRes where
decodeJson json = do decodeJson json = do
......
src/Gargantext/Components/Modals/Modal.purs
View file @ 9a6d8cc0
...@@ -2,8 +2,8 @@ module Gargantext.Components.Modals.Modal where ...@@ -2,8 +2,8 @@ module Gargantext.Components.Modals.Modal where
import Prelude (Unit) 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 ...@@ -21,28 +21,29 @@ module Gargantext.Components.RandomText where
import Prelude 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.Array (drop, dropEnd, filter, foldl, head, length, tail, take, takeEnd, (!!))
import Data.Maybe (Maybe(Nothing, Just), fromJust) 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 (crash)
import Partial.Unsafe (unsafePartial) 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 randomSentences ss = case (length (sentences ss)) >= 5 of
true -> foldl (\a b -> a <> "." <> b) "" <$> randomPart (sentences ss) true -> foldl (\a b -> a <> "." <> b) "" <$> randomPart (sentences ss)
_ -> pure ss _ -> pure ss
randomWords :: forall a. String -> Eff ( random :: RANDOM | a ) String randomWords :: String -> Effect String
randomWords ws = case (length (words ws)) >= 5 of randomWords ws = case (length (words ws)) >= 5 of
true -> foldl (\a b -> a <> " " <> b) "" <$> randomPart (words ws) true -> foldl (\a b -> a <> " " <> b) "" <$> randomPart (words ws)
_ -> pure ws _ -> pure ws
randomChars :: forall a. String -> Eff ( random :: RANDOM | a ) String randomChars :: String -> Effect String
randomChars word = case (length (toCharArray word)) >= 5 of randomChars word = case (length (toCharArray word)) >= 5 of
true -> fromCharArray <$> randomPart (toCharArray word) true -> fromCharArray <$> randomPart (toCharArray word)
_ -> pure word _ -> pure word
...@@ -61,7 +62,7 @@ data RandomWheel a = RandomWheel { before :: Array a ...@@ -61,7 +62,7 @@ data RandomWheel a = RandomWheel { before :: Array a
, after :: 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) randomPart array = randomArrayPoly middle >>= \(middle') -> pure ( start <> middle' <> end)
where where
start = take 2 array start = take 2 array
...@@ -69,13 +70,13 @@ randomPart array = randomArrayPoly middle >>= \(middle') -> pure ( start <> midd ...@@ -69,13 +70,13 @@ randomPart array = randomArrayPoly middle >>= \(middle') -> pure ( start <> midd
end = takeEnd 2 array 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 randomArrayPoly wheel = case head wheel of
Nothing -> pure [] Nothing -> pure []
Just wheel' -> randomWheel (RandomWheel { before:wheel, during:wheel', after:[]}) Just wheel' -> randomWheel (RandomWheel { before:wheel, during:wheel', after:[]})
>>= \(RandomWheel rand) -> (pure rand.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}) = randomWheel (RandomWheel {before:[], during:d, after:a}) =
pure (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 ...@@ -84,7 +85,7 @@ randomWheel (RandomWheel {before:b, during:d, after:a}) = do
randomWheel $ RandomWheel {before:b', during:d', after:(a <> [d'])} 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 randomArray array = unsafePartial $ do
n <- randomInt 0 (length array - 1) n <- randomInt 0 (length array - 1)
......
src/Gargantext/Components/Tab.purs
View file @ 9a6d8cc0
...@@ -9,13 +9,13 @@ import Data.Tuple (Tuple(..)) ...@@ -9,13 +9,13 @@ import Data.Tuple (Tuple(..))
import React (ReactElement) import React (ReactElement)
import React.DOM (a, div, nav, text) import React.DOM (a, div, nav, text)
import React.DOM.Props (className, onClick) 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 type State = Int
data Action = ChangeTab 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 -> tabs l p ls = withState \st ->
fold fold
[ focus l p $ simpleSpec performAction (render (activeTab st) ls) [ focus l p $ simpleSpec performAction (render (activeTab st) ls)
...@@ -26,18 +26,17 @@ tabs l p ls = withState \st -> ...@@ -26,18 +26,17 @@ tabs l p ls = withState \st ->
wrapper = over _render \render d p s c -> wrapper = over _render \render d p s c ->
[div [className "tab-content"] $ 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 tab sid iid (Tuple name spec) = over _render tabRender spec
where where
tabRender renderer d p s c = tabRender renderer d p s c =
[div [ className $ "tab-pane " <> if sid ==iid then " show active" else " fade"] $ 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 :: forall props. PerformAction State props Action
performAction (ChangeTab i) _ _ = void do performAction (ChangeTab i) _ _ = void $ modifyState $ const i
cotransform \_ -> 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 = render at ls d p s c =
[ nav [] [ nav []
[ div [className "nav nav-tabs"] [ div [className "nav nav-tabs"]
......
src/Gargantext/Components/Tree.purs
View file @ 9a6d8cc0
...@@ -2,69 +2,83 @@ module Gargantext.Components.Tree where ...@@ -2,69 +2,83 @@ module Gargantext.Components.Tree where
import Prelude hiding (div) import Prelude hiding (div)
import Control.Monad.Aff (Aff, attempt) import Affjax (defaultRequest, printResponseFormatError, request)
import Control.Monad.Aff.Class (liftAff) import Affjax.RequestBody (RequestBody(..))
import Control.Monad.Eff.Class (liftEff) import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Eff.Console (CONSOLE, log) import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, decodeJson, (.?)) import Data.Argonaut (class DecodeJson, Json, decodeJson, encodeJson, (.?))
import Data.Argonaut.Core (Json)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.HTTP.Method (Method(..)) import Data.HTTP.Method (Method(..))
import Data.Tuple (Tuple(..)) import Data.Maybe (Maybe(..))
import Network.HTTP.Affjax (AJAX, affjax, defaultRequest) 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 (ReactElement)
import React.DOM (a, div, i, li, text, ul) import React.DOM (a, div, i, li, text, ul)
import React.DOM.Props (Props, className, href, onClick) 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 Name = String
type Open = Boolean type Open = Boolean
type URL = String type URL = String
type ID = Int 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 type State = FTree
initialState :: State initialState :: State
initialState = NLeaf (Tuple "" "") initialState = NTree (LNode {id : 1, name : "", nodeType : "", open : true}) []
performAction :: PerformAction _ State _ Action performAction :: PerformAction State {} Action
performAction (ToggleFolder i) _ _ = void (cotransform (\td -> toggleNode i td)) performAction (ToggleFolder i) _ _ = void $ modifyState $ toggleNode i
toggleNode :: forall t10. Int -> NTree t10 -> NTree t10 -- performAction Initialize _ _ = void $ do
toggleNode sid (NNode iid open name ary) = -- s <- lift $ loadDefaultNode
NNode iid nopen name $ map (toggleNode sid) ary -- case s of
where -- Left err -> modifyState identity
nopen = if sid == iid then not open else open -- Right d -> modifyState (\state -> d)
toggleNode sid a = a
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 -- Realistic Tree for the UI
exampleTree :: NTree (Tuple String String) exampleTree :: NTree LNode
exampleTree = exampleTree = NTree (LNode {id : 1, name : "", nodeType : "", open : false}) []
NNode 1 true "françois.pineau"
[ annuaire 2 "Annuaire"
, corpus 3 "IMT publications"
]
annuaire :: Int -> String -> NTree (Tuple String String) -- exampleTree :: NTree LNode
annuaire n name = NNode n false name -- exampleTree =
[ NLeaf (Tuple "IMT community" "#/docView") -- NTree 1 true "françois.pineau"
] -- [ --annuaire 2 "Annuaire"
-- --, corpus 3 "IMT publications"
-- ]
corpus :: Int -> String -> NTree (Tuple String String) -- annuaire :: Int -> String -> NTree (Tuple String String)
corpus n name = NNode n false name -- annuaire n name = NTree n false name
[ NLeaf (Tuple "Facets" "#/corpus") -- [ NTree (Tuple "IMT community" "#/docView")
, NLeaf (Tuple "Dashboard" "#/dashboard") -- ]
, NLeaf (Tuple "Graph" "#/graphExplorer")
] -- 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 ...@@ -87,27 +101,32 @@ nodeOptionsView activated = case activated of
false -> [] false -> []
treeview :: Spec _ State _ Action treeview :: Spec State {} Action
treeview = simpleSpec performAction render treeview = simpleSpec performAction render
where where
render :: Render State _ Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[div [className "tree"] [toHtml dispatch state]] [div [className "tree"] [toHtml dispatch state]]
toHtml :: _ -> FTree -> ReactElement toHtml :: (Action -> Effect Unit) -> FTree -> ReactElement
toHtml d (NLeaf (Tuple name link)) = toHtml d (NTree (LNode {id, name, nodeType, open}) []) =
ul []
[
li [] li []
[ a [ href link] [
a [ href (toUrl Front (readNodeType nodeType) id)]
( [ text (name <> " ") ( [ text (name <> " ")
] <> nodeOptionsView false ] <> nodeOptionsView false
) )
] ]
toHtml d (NNode id open name ary) = ]
toHtml d (NTree (LNode {id, name, nodeType, open}) ary) =
ul [ ] ul [ ]
[ li [] $ [ li [] $
( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []] ( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []]
, text $ " " <> name <> " " , a [ href (toUrl Front (readNodeType nodeType) id )]
[ text $ " " <> name <> " " ]
] <> nodeOptionsCorp false <> ] <> nodeOptionsCorp false <>
if open then if open then
map (toHtml d) ary map (toHtml d) ary
...@@ -119,34 +138,133 @@ fldr :: Boolean -> Props ...@@ -119,34 +138,133 @@ fldr :: Boolean -> Props
fldr open = if open then className "fas fa-folder-open" else className "fas fa-folder" 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 instance decodeJsonLNode :: DecodeJson LNode where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
id_ <- obj .? "id" id_ <- obj .? "id"
name <- obj .? "name" name <- obj .? "name"
pure $ LNode {id : id_, name} nodeType <- obj .? "type"
pure $ LNode {id : id_, name, nodeType, open : true}
loadDefaultNode :: forall eff. Aff (ajax :: AJAX, console :: CONSOLE | eff) (Either String (Array LNode)) 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 :: Aff (Either String (NTree LNode))
loadDefaultNode = do loadDefaultNode = do
res <- liftAff $ attempt $ affjax defaultRequest res <- request $ defaultRequest
{ url = "http://localhost:8008/user" { url = toUrl Back Tree defaultRoot
, responseFormat = ResponseFormat.json
, method = Left GET , 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 Left err -> do
_ <- liftEff $ log $ show err _ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ show err pure $ Left $ printResponseFormatError err
Right a -> do Right json -> do
_ <- liftEff $ log $ show a.status --_ <- liftEffect $ log $ show a.status
_ <- liftEff $ log $ show a.headers --_ <- liftEffect $ log $ show a.headers
_ <- liftEff $ log $ show a.response --_ <- liftEffect $ log $ show a.body
let resp = decodeJson a.response let obj = decodeJson json
pure resp 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 -> 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 ...@@ -2,31 +2,30 @@ module Gargantext.Config.REST where
import Prelude import Prelude
import Control.Monad.Aff (Aff, attempt) import Affjax (defaultRequest, printResponseFormatError, request)
import Control.Monad.Aff.Class (liftAff) import Affjax.RequestHeader (RequestHeader(..))
import Control.Monad.Eff.Console (CONSOLE) import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut (class DecodeJson, decodeJson) import Data.Argonaut (class DecodeJson, decodeJson)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.HTTP.Method (Method(..)) import Data.HTTP.Method (Method(..))
import Data.MediaType.Common (applicationJSON) import Data.MediaType.Common (applicationJSON)
import Network.HTTP.Affjax (AJAX, affjax, defaultRequest) import Effect.Aff (Aff)
import Network.HTTP.RequestHeader (RequestHeader(..))
get :: forall eff t2 t31. DecodeJson t31 => String -> get :: forall t31. DecodeJson t31 => String ->
Aff (console :: CONSOLE, ajax :: AJAX| eff) Aff (Either String t31)
(Either String t31)
get url = do get url = do
affResp <- liftAff $ attempt $ affjax defaultRequest affResp <- request defaultRequest
{ method = Left GET { method = Left GET
, url = url , url = url
, responseFormat = ResponseFormat.json
, headers = [ ContentType applicationJSON , headers = [ ContentType applicationJSON
, Accept applicationJSON , Accept applicationJSON
-- , RequestHeader "Authorization" $ "Bearer " <> token -- , RequestHeader "Authorization" $ "Bearer " <> token
] ]
} }
case affResp of case affResp.body of
Left err -> do Left err -> do
pure $ Left $ show err pure $ Left $ printResponseFormatError err
Right a -> do Right a -> do
let res = decodeJson a.response let res = decodeJson a
pure res 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 ...@@ -2,250 +2,58 @@ module Gargantext.Pages.Corpus where
import Prelude hiding (div) import Prelude hiding (div)
import Control.Monad.Aff (Aff, attempt) import Gargantext.Components.Charts.Options.ECharts (chart)
import Control.Monad.Aff.Class (liftAff) import Gargantext.Pages.Corpus.Doc.Facets.Dashboard (globalPublis)
import Control.Monad.Aff.Console (log) import Gargantext.Pages.Corpus.Doc.Facets as Tab
import Control.Monad.Cont.Trans (lift) import React.DOM (div, h3, hr, i, p, text)
import Control.Monad.Eff.Class (liftEff) import React.DOM.Props (className, style)
import Control.Monad.Eff.Console (CONSOLE) import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
import DOM (DOM)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>)) type Corpus = { title :: String
import Data.Either (Either(..)) , desc :: String
import Data.HTTP.Method (Method(..)) , query :: String
import Data.Lens (over) , date :: String
import Data.Maybe (Maybe(Just)) , authors :: String
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"] spec' :: Spec {} {} Void
[ ul [ className "list-group"] ( map fn1 state.response ) ] spec' = corpusSpec <> Tab.pureTab1
, div [className "modal-footer"] corpusSpec :: Spec {} {} Void
[ button [ _type "button" corpusSpec = simpleSpec defaultPerformAction render
, className "btn btn-secondary" where
, _data {dismiss : "modal"} render :: Render {} {} Void
] [ text "GO"] render _ _ _ _ =
[ div [className "row"]
[ div [className "col-md-3"] [ h3 [] [text corpus.title] ]
, 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 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
] ]
where , p [] [ i [className "fa fa-user"] []
fn1 (Response o) = , text corpus.authors
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
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"]
]
] ]
] ]
] ]
, chart globalPublis
] ]
where where
fn1 (Response o) = corpus :: Corpus
li [className "list-group-item justify-content-between"] corpus = { title : "IMT Global Publications"
[ , desc : " Hal Database"
span [] [text o.name] , query : " Query: all publications"
, span [className "badge badge-default badge-pill"] [ text $ show o.count] , date : " June. 26 2018, 10:59 am"
] , authors : " Author(s): françois.pineau"
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
]
, 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 }
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 ...@@ -3,8 +3,8 @@ module Gargantext.Pages.Corpus.Doc.Annotation where
import Prelude hiding (div) import Prelude hiding (div)
import React (ReactElement) import React (ReactElement)
import React.DOM (a, button, div, h4, h6, input, li, nav, option, p, select, span, text, ul) 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 React.DOM.Props (_data, _id, _type, aria, className, href, name, onChange, onInput, placeholder, role, style, value)
import Thermite (PerformAction, Render, Spec, cotransform, modifyState, simpleSpec) import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
...@@ -21,28 +21,25 @@ initialState = ...@@ -21,28 +21,25 @@ initialState =
data Action data Action
= NoOp = ChangeString String
| ChangeString String
| ChangeAnotherString String | ChangeAnotherString String
| SetInput String | SetInput String
performAction :: PerformAction _ State _ Action performAction :: PerformAction State {} Action
performAction NoOp _ _ = pure unit
performAction (ChangeString ps) _ _ = pure unit performAction (ChangeString ps) _ _ = pure unit
performAction (ChangeAnotherString ps) _ _ = pure unit performAction (ChangeAnotherString ps) _ _ = pure unit
performAction (SetInput ps) _ _ = void do 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 docview = simpleSpec performAction render
where where
render :: Render State _ Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ [
div [className "container1"] div [className "container1"]
...@@ -76,7 +73,7 @@ docview = simpleSpec performAction render ...@@ -76,7 +73,7 @@ docview = simpleSpec performAction render
[ [
h6 [] [text "Add a free term to STOPLIST"] h6 [] [text "Add a free term to STOPLIST"]
, div [className "form-group"] , 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"] [] , div [className "clearfix"] []
] ]
, button [className "btn btn-primary", _type "button"] [text "Create and Add"] , 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 module Gargantext.Pages.Corpus.Doc.Facets.Authors where
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Data.Array (fold) import Data.Array (fold)
import Gargantext.Pages.Corpus.Doc.Document as D import Gargantext.Pages.Corpus.Doc.Facets.Documents as D
import Network.HTTP.Affjax (AJAX)
import Prelude hiding (div) import Prelude hiding (div)
import React.DOM (h3, text) import React.DOM (h3, text)
import Thermite (PerformAction, Render, Spec, defaultPerformAction, modifyState, simpleSpec) import Thermite (PerformAction, Render, Spec, defaultPerformAction, simpleSpec)
type State = D.State type State = D.State
initialState :: State initialState :: State
initialState = D.tdata initialState = D.tdata
type Action = D.Action type Action = D.Action
authorSpec :: Spec State {} Action
authorSpec :: forall props eff . Spec ( console :: CONSOLE
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
authorSpec = simpleSpec defaultPerformAction render authorSpec = simpleSpec defaultPerformAction render
where where
render :: Render State props Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ h3 [] [text "AuthorView"]] [ 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] authorspec' = fold [authorSpec, D.layoutDocview]
src/Gargantext/Pages/Corpus/Doc/Facets/Dashboard.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.Doc.Facets.Dashboard where module Gargantext.Pages.Corpus.Doc.Facets.Dashboard where
import Prelude import Prelude hiding (div)
import Data.Array (zip) import Data.Array (zip)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Gargantext.Components.Charts.Options.ECharts import Gargantext.Components.Charts.Options.ECharts
import Gargantext.Components.Charts.Options.Series import Gargantext.Components.Charts.Options.Series
import DOM (DOM) import Gargantext.Components.Charts.Options.Type (Option)
import Data.Unit (Unit) import Data.Unit (Unit)
import Data.Int (toNumber) import Data.Int (toNumber)
import React.DOM (div, h1, text, title) import React.DOM (div, h1, text)
import React.DOM.Props (className) import React.DOM.Props (className)
import Thermite (PerformAction, Render, Spec, simpleSpec) import Thermite (Render, Spec, simpleSpec, defaultPerformAction)
type State = Unit render :: Render {} {} Void
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 dispatch _ state _ = [ render dispatch _ state _ = [
h1 [] [text "IMT DashBoard"] h1 [] [text "IMT DashBoard"]
, div [className "row"] [ div [className "col-md-9 content"] [chart globalPublis] , div [className "row"] [ div [className "col-md-9 content"] [chart globalPublis]
...@@ -33,18 +23,23 @@ render dispatch _ state _ = [ ...@@ -33,18 +23,23 @@ render dispatch _ state _ = [
, div [className "row"] (map (\school -> div [className "col-md-4 content"] [chart $ focus school]) , div [className "row"] (map (\school -> div [className "col-md-4 content"] [chart $ focus school])
[ "Télécom Bretagne", "Mines Nantes", "Eurecom"] [ "Télécom Bretagne", "Mines Nantes", "Eurecom"]
) )
, chart scatterEx
, chart sankeyEx
, chart treeMapEx
, chart treeEx
] ]
where 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 :: String -> Options
focus school = Options { mainTitle : ("Focus " <> school) focus school = Options { mainTitle : ("Focus " <> school)
, subTitle : "Total scientific publications" , subTitle : "Total scientific publications"
, xAxis : xAxis ["2015", "2016", "2017"] , xAxis : xAxis ["2015", "2016", "2017"]
, yAxis : [series Bar "Bar Data" [ {name: "val1", value: 50.0} , yAxis : myData
, {name: "val2", value: 70.0}
, {name: "val3", value: 80.0}
]
]
, yAxisFormat : (YAxisFormat { position : "left" , yAxisFormat : (YAxisFormat { position : "left"
, visible : true , visible : true
}) })
...@@ -52,19 +47,21 @@ render dispatch _ state _ = [ ...@@ -52,19 +47,21 @@ render dispatch _ state _ = [
, addZoom : false , addZoom : false
} }
----------------------------------------------------------------------------------------------------------- -----------------------------------------------------------------------------------------------------------
naturePublis_x :: Array String
naturePublis_x = ["Com","Articles","Thèses","Reports"] naturePublis_x = ["Com","Articles","Thèses","Reports"]
naturePublis_y' :: Array Int
naturePublis_y' = [23901,17417,1188,1176] 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_y = map (\(Tuple n v) -> {name: n, value: toNumber v }) (zip naturePublis_x naturePublis_y')
naturePublis :: Options naturePublis :: Options
naturePublis = Options { mainTitle : "Nature of publications" naturePublis = Options { mainTitle : "Nature of publications"
, subTitle : "Distribution by type" , subTitle : "Distribution by type"
, xAxis : xAxis [] , xAxis : xAxis []
, yAxis : [series Funnel "Funnel Data" naturePublis_y] , yAxis : [SeriesD1 $ series Funnel "Funnel Data" naturePublis_y]
, yAxisFormat : (YAxisFormat { position : "left" , yAxisFormat : (YAxisFormat { position : "left"
, visible : false , visible : false
}) })
...@@ -73,7 +70,9 @@ naturePublis = Options { mainTitle : "Nature of publications" ...@@ -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_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] 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 ...@@ -81,7 +80,7 @@ globalPublis :: Options
globalPublis = (Options { mainTitle : "Global Scientific Publications" globalPublis = (Options { mainTitle : "Global Scientific Publications"
, subTitle : "Distribution of scientific publications by IMT's Schools over time" , subTitle : "Distribution of scientific publications by IMT's Schools over time"
, xAxis : xAxis (map show globalPublis_x) , 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" , yAxisFormat : (YAxisFormat { position : "left"
, visible : true , visible : true
}) })
...@@ -90,6 +89,7 @@ globalPublis = (Options { mainTitle : "Global Scientific Publications" ...@@ -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 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] ,Tuple "Télécom Ecole de Management" 52,Tuple "Mines Albi-Carmaux" 6]
...@@ -97,7 +97,108 @@ distriBySchool :: Options ...@@ -97,7 +97,108 @@ distriBySchool :: Options
distriBySchool = Options { mainTitle : "School production in 2017" distriBySchool = Options { mainTitle : "School production in 2017"
, subTitle : "Distribution by school" , subTitle : "Distribution by school"
, xAxis : xAxis [] , 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 : "" , yAxisFormat : (YAxisFormat { position : ""
, visible : false , visible : false
}) })
...@@ -105,5 +206,5 @@ distriBySchool = Options { mainTitle : "School production in 2017" ...@@ -105,5 +206,5 @@ distriBySchool = Options { mainTitle : "School production in 2017"
} }
layoutDashboard :: forall props eff. Spec (dom :: DOM | eff) State props Action layoutDashboard :: Spec {} {} Void
layoutDashboard = simpleSpec performAction render layoutDashboard = simpleSpec defaultPerformAction render
src/Gargantext/Pages/Corpus/Doc/Facets/Documents.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.Doc.Facets.Documents where module Gargantext.Pages.Corpus.Doc.Facets.Documents where
import Control.Monad.Eff.Console (CONSOLE) import Prelude hiding (div)
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 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 import React (ReactElement)
initialState = "" 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 data Action
, ajax :: AJAX = LoadData Int
, dom :: DOM | ChangePageSize PageSizes
| eff | ChangePage Int
) State props Action
performAction NoOp _ _ = void do
modifyState id
type State = CorpusTableData
type CorpusTableData = TableData CorpusView
publicationSpec :: forall props eff . Spec ( console :: CONSOLE newtype TableData a
, ajax :: AJAX = TableData
, dom :: DOM { rows :: Array { row :: a
| eff , delete :: Boolean
) State props Action }
publicationSpec = simpleSpec performAction render , 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 where
render :: Render State props Action render d p s c = [div [] [ text " Filter "
render dispatch _ state _ = , input []
[ table [ className "table"] ]]
[ thead [ className "thead-dark"]
[ tr [] layoutDocview :: Spec State {} Action
[ th [ scope "col"] [ text "Date" ] layoutDocview = simpleSpec performAction render
, th [ scope "col"] [ text "Description" ] where
, th [ scope "col"] [ text "Projects" ] render :: Render State {} Action
, th [ scope "col"] [ text "Favorite" ] render dispatch _ state@(TableData d) _ =
, th [ scope "col"] [ text "Delete" ] [ 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
] ]
, tbody []
[ tr [] [ td [] [ text "2012/03/06"] optps :: PageSizes -> PageSizes -> ReactElement
, td [] [ text "Big data and text mining"] optps cv val = option [ selected (cv == val), value $ show val ] [text $ show val]
, td [] [ text "European funds"]
, td [] [ text "True"]
, td [] [ text "False"] textDescription :: Int -> PageSizes -> Int -> ReactElement
textDescription currPage pageSize totalRecords
= div [className "row1"]
[ div [className ""]
[ text $ "Showing " <> show start <> " to " <> show end <> " of " <> show totalRecords ]
] ]
, tr [] [ td [] [ text "2013/03/06"] where
, td [] [ text "Cryptography"] start = (currPage - 1) * pageSizes2Int pageSize + 1
, td [] [ text "French funds"] end' = currPage * pageSizes2Int pageSize
, td [] [ text "True"] end = if end' > totalRecords then totalRecords else end'
, td [] [ text "False"]
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 " "
] ]
, tr [] [ td [] [ text "2013/03/06"] next = if cp == tp then
, td [] [ text "Artificial Intelligence"] text " Next "
, td [] [ text "Not found"] else
, td [] [ text "True"] span []
, td [] [ text "False"] [ 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 ...@@ -2,14 +2,11 @@ module Gargantext.Pages.Corpus.Doc.Facets.Graph where
import Prelude hiding (div) import Prelude hiding (div)
import Control.Monad.Aff (Aff, attempt) import Affjax (defaultRequest, printResponseFormatError, request)
import Control.Monad.Aff.Class (liftAff) import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift) import Control.Monad.Cont.Trans (lift)
import Control.Monad.Eff.Class (liftEff) import Data.Argonaut (decodeJson, stringify)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.Unsafe (unsafePerformEff)
import DOM (DOM)
import Data.Argonaut (decodeJson)
import Data.Array (length, mapWithIndex, (!!)) import Data.Array (length, mapWithIndex, (!!))
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.HTTP.Method (Method(..)) import Data.HTTP.Method (Method(..))
...@@ -17,12 +14,13 @@ import Data.Int (toNumber) ...@@ -17,12 +14,13 @@ import Data.Int (toNumber)
import Data.Maybe (Maybe(..), fromJust) import Data.Maybe (Maybe(..), fromJust)
import Data.MediaType.Common (applicationJSON) import Data.MediaType.Common (applicationJSON)
import Data.Newtype (class Newtype) 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.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.Components.GraphExplorer.Types (Cluster(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData)
import Gargantext.Utils (getter) import Gargantext.Utils (getter)
import Math (cos, sin) import Math (cos, sin)
import Network.HTTP.Affjax (AJAX, affjax, defaultRequest)
import Network.HTTP.RequestHeader (RequestHeader(..))
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import React (ReactElement) import React (ReactElement)
import React.DOM (a, br', button, div, form', input, li, li', menu, option, p, select, span, text, ul, ul') 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 ...@@ -30,8 +28,8 @@ import React.DOM.Props (_id, _type, checked, className, href, name, onChange, pl
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec) import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
data Action = NoOp data Action
| LoadGraph String = LoadGraph String
| SelectNode SelectedNode | SelectNode SelectedNode
newtype SelectedNode = SelectedNode {id :: String, label :: String} newtype SelectedNode = SelectedNode {id :: String, label :: String}
...@@ -56,12 +54,12 @@ initialState = State ...@@ -56,12 +54,12 @@ initialState = State
, selectedNode : Nothing , 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 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 performAction (LoadGraph fp) _ _ = void do
_ <- liftEff $ log fp _ <- liftEffect $ log fp
case fp of case fp of
"" -> do "" -> do
modifyState \(State s) -> State s {filePath = fp, graphData = GraphData {nodes : [], edges : []}, sigmaGraphData = Nothing} modifyState \(State s) -> State s {filePath = fp, graphData = GraphData {nodes : [], edges : []}, sigmaGraphData = Nothing}
...@@ -77,10 +75,6 @@ performAction (LoadGraph fp) _ _ = void do ...@@ -77,10 +75,6 @@ performAction (LoadGraph fp) _ _ = void do
performAction (SelectNode node) _ _ = void do performAction (SelectNode node) _ _ = void do
modifyState $ \(State s) -> State s {selectedNode = pure node} modifyState $ \(State s) -> State s {selectedNode = pure node}
performAction NoOp _ _ = void do
modifyState id
convert :: GraphData -> SigmaGraphData convert :: GraphData -> SigmaGraphData
convert (GraphData r) = SigmaGraphData { nodes, edges} convert (GraphData r) = SigmaGraphData { nodes, edges}
where where
...@@ -99,7 +93,7 @@ convert (GraphData r) = SigmaGraphData { nodes, edges} ...@@ -99,7 +93,7 @@ convert (GraphData r) = SigmaGraphData { nodes, edges}
edges = map edgeFn r.edges edges = map edgeFn r.edges
edgeFn (Edge e) = sigmaEdge {id : e.id_, source : e.source, target : e.target} 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 = render d p (State s) c =
[ select [ onChange $ \e -> d $ LoadGraph (unsafeCoerce e).target.value, value s.filePath] [ select [ onChange $ \e -> d $ LoadGraph (unsafeCoerce e).target.value, value s.filePath]
[ option [value ""] [text ""] [ option [value ""] [text ""]
...@@ -122,10 +116,11 @@ render d p (State s) c = ...@@ -122,10 +116,11 @@ render d p (State s) c =
, renderer : canvas , renderer : canvas
, settings : mySettings , settings : mySettings
, style : sStyle { height : "95%"} , style : sStyle { height : "95%"}
, onClickNode : \e -> unsafePerformEff $ do -- , onClickNode : \e -> do
log $ unsafeCoerce e -- log $ unsafeCoerce e
d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label} -- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
pure unit -- pure unit
-- TODO: fix this!
} }
[ sigmaEnableWebGL [ sigmaEnableWebGL
, forceAtlas2 forceAtlas2Config , forceAtlas2 forceAtlas2Config
...@@ -226,23 +221,24 @@ mySettings = sigmaSettings { verbose : true ...@@ -226,23 +221,24 @@ mySettings = sigmaSettings { verbose : true
-- loadJSON {path : "http://localhost:2015/examples/sites_coords.json"} -- 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 getGraphData fp = do
resp <- liftAff $ attempt $ affjax defaultRequest resp <- request defaultRequest
{ url =("http://localhost:2015/examples/" <> fp) { url =("http://localhost:2015/examples/" <> fp)
, method = Left GET , method = Left GET
, responseFormat = ResponseFormat.json
, headers = , headers =
[ ContentType applicationJSON [ ContentType applicationJSON
, Accept applicationJSON , Accept applicationJSON
] ]
} }
case resp of case resp.body of
Left err -> do Left err -> do
liftEff $ log $ show err liftEffect $ log $ printResponseFormatError err
pure $ Left $ show err pure $ Left $ printResponseFormatError err
Right a -> do Right json -> do
liftEff $ log $ show a.response liftEffect $ log $ stringify json
let gd = decodeJson a.response let gd = decodeJson json
pure gd pure gd
...@@ -296,11 +292,11 @@ dispLegend ary = div [] $ map dl ary ...@@ -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 :: Spec State {} Action
specOld = simpleSpec performAction render specOld = simpleSpec performAction render'
where where
render :: Render State props Action render' :: Render State {} Action
render d _ (State st) _ = render' d _ (State st) _ =
[ div [className "row"] [ [ div [className "row"] [
div [className "col-md-12", style {marginTop : "21px", marginBottom : "21px"}] div [className "col-md-12", style {marginTop : "21px", marginBottom : "21px"}]
[ menu [_id "toolbar"] [ menu [_id "toolbar"]
...@@ -319,7 +315,7 @@ specOld = simpleSpec performAction render ...@@ -319,7 +315,7 @@ specOld = simpleSpec performAction render
[ input [_type "file" [ input [_type "file"
, name "file" , name "file"
-- , onChange (\e -> d $ SetFile (getFile e) (unsafeCoerce $ d <<< SetProgress)) -- , onChange (\e -> d $ SetFile (getFile e) (unsafeCoerce $ d <<< SetProgress))
, className "btn btn-primary"] [] , className "btn btn-primary"]
-- , text $ show st.readyState -- , text $ show st.readyState
] ]
...@@ -328,7 +324,7 @@ specOld = simpleSpec performAction render ...@@ -328,7 +324,7 @@ specOld = simpleSpec performAction render
, className "btn btn-warning btn-sm" , className "btn btn-warning btn-sm"
,value "Run Demo" ,value "Run Demo"
-- , onClick \_ -> d SetGraph, disabled (st.readyState /= DONE) -- , onClick \_ -> d SetGraph, disabled (st.readyState /= DONE)
] [] ]
] ]
, li' , li'
...@@ -343,24 +339,24 @@ specOld = simpleSpec performAction render ...@@ -343,24 +339,24 @@ specOld = simpleSpec performAction render
[ span [className "glyphicon glyphicon-search"] [] [ 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"] , 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"] , 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"] , 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"] , 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' , li'
[ button [className "btn btn-primary"] [text "Save"] -- TODO: Implement Save! [ button [className "btn btn-primary"] [text "Save"] -- TODO: Implement Save!
...@@ -395,10 +391,10 @@ specOld = simpleSpec performAction render ...@@ -395,10 +391,10 @@ specOld = simpleSpec performAction render
, renderer : canvas , renderer : canvas
, settings : mySettings , settings : mySettings
, style : sStyle { height : "95%"} , style : sStyle { height : "95%"}
, onClickNode : \e -> unsafePerformEff $ do -- , onClickNode : \e -> do
log $ unsafeCoerce e -- log $ unsafeCoerce e
d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label} -- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
pure unit -- pure unit
} }
[ sigmaEnableWebGL [ sigmaEnableWebGL
, forceAtlas2 forceAtlas2Config , forceAtlas2 forceAtlas2Config
...@@ -414,7 +410,7 @@ specOld = simpleSpec performAction render ...@@ -414,7 +410,7 @@ specOld = simpleSpec performAction render
[ case st.selectedNode of [ case st.selectedNode of
Nothing -> span [] [] Nothing -> span [] []
Just selectedNode -> p [] [text $ "selected Node : " <> getter _.label selectedNode Just selectedNode -> p [] [text $ "selected Node : " <> getter _.label selectedNode
, br' [] , br'
, p [] [button [className "btn btn-primary", style {marginBottom : "18px"}] [text "Remove"]] , p [] [button [className "btn btn-primary", style {marginBottom : "18px"}] [text "Remove"]]
] ]
] ]
...@@ -461,7 +457,7 @@ specOld = simpleSpec performAction render ...@@ -461,7 +457,7 @@ specOld = simpleSpec performAction render
, checked $ true , checked $ true
, title "Mark as completed" , title "Mark as completed"
-- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm)) -- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
] [] ]
] ]
, li [] , li []
...@@ -471,7 +467,7 @@ specOld = simpleSpec performAction render ...@@ -471,7 +467,7 @@ specOld = simpleSpec performAction render
, checked $ false , checked $ false
, title "Mark as completed" , title "Mark as completed"
-- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm)) -- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
] [] ]
] ]
, li [] , li []
[ span [] [text "Patents"] [ span [] [text "Patents"]
...@@ -480,7 +476,7 @@ specOld = simpleSpec performAction render ...@@ -480,7 +476,7 @@ specOld = simpleSpec performAction render
, checked $ false , checked $ false
, title "Mark as completed" , title "Mark as completed"
-- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm)) -- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
] [] ]
] ]
, li [] , li []
[ span [] [text "Others"] [ span [] [text "Others"]
...@@ -489,7 +485,7 @@ specOld = simpleSpec performAction render ...@@ -489,7 +485,7 @@ specOld = simpleSpec performAction render
, checked $ false , checked $ false
, title "Mark as completed" , title "Mark as completed"
-- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm)) -- , 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 module Gargantext.Pages.Corpus.Doc.Facets.Sources where
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Data.Array (fold) import Data.Array (fold)
import Gargantext.Pages.Corpus.Doc.Document as D import Gargantext.Pages.Corpus.Doc.Facets.Documents as D
import Network.HTTP.Affjax (AJAX)
import Prelude hiding (div) import Prelude hiding (div)
import React.DOM (h3, text) import React.DOM (h3, text)
import Thermite (Render, Spec, defaultPerformAction, simpleSpec) import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
...@@ -19,16 +16,12 @@ initialState = D.tdata ...@@ -19,16 +16,12 @@ initialState = D.tdata
type Action = D.Action type Action = D.Action
sourceSpec :: forall props eff . Spec ( console :: CONSOLE sourceSpec :: Spec State {} Action
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
sourceSpec = simpleSpec defaultPerformAction render sourceSpec = simpleSpec defaultPerformAction render
where where
render :: Render State props Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ h3 [] [text "Source view"]] [ 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] 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 module Gargantext.Pages.Corpus.Doc.Facets.Terms where
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Data.Array (fold) import Data.Array (fold)
import Gargantext.Pages.Corpus.Doc.Document as D import Gargantext.Pages.Corpus.Doc.Facets.Documents as D
import Network.HTTP.Affjax (AJAX)
import Prelude hiding (div) import Prelude hiding (div)
import React.DOM (h3, text) 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 ...@@ -20,16 +17,12 @@ initialState = D.tdata
type Action = D.Action type Action = D.Action
termsSpec :: forall props eff . Spec ( console :: CONSOLE termsSpec :: Spec State {} Action
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
termsSpec = simpleSpec defaultPerformAction render termsSpec = simpleSpec defaultPerformAction render
where where
render :: Render State props Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ h3 [] [text "Terms view"]] [ 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] 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 ...@@ -2,20 +2,21 @@ module Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsItem where
import Prelude import Prelude
import Control.Monad.Eff.Console (CONSOLE) import Data.Newtype (class Newtype, unwrap)
import DOM (DOM) import Data.Lens.Iso (re)
import Data.Newtype (class Newtype) import Data.Lens.Iso.Newtype (_Newtype)
import Network.HTTP.Affjax (AJAX)
import React (ReactElement) import React (ReactElement)
import React.DOM (input, span, td, text, tr) import React.DOM (input, span, td, text, tr)
import React.DOM.Props (_type, checked, className, onChange, style, title) 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) import Gargantext.Utils (getter, setter)
newtype State = State newtype State = State
{ term :: Term { term :: Term
} }
derive instance newtypeState :: Newtype State _
initialState :: State initialState :: State
initialState = State {term : Term {id : 10, term : "hello", occurrence : 10, _type : None, children : []}} initialState = State {term : Term {id : 10, term : "hello", occurrence : 10, _type : None, children : []}}
...@@ -36,17 +37,19 @@ data Action ...@@ -36,17 +37,19 @@ data Action
= SetMap Boolean = SetMap Boolean
| SetStop 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 performAction (SetMap b) _ _ = void do
modifyState \(State s) -> State s {term = setter (_{_type = (if b then MapTerm else None)}) s.term} modifyState \(State s) -> State s {term = setter (_{_type = (if b then MapTerm else None)}) s.term}
performAction (SetStop b) _ _ = void do performAction (SetStop b) _ _ = void do
modifyState \(State s) -> State s {term = setter (_{_type = (if b then StopTerm else None)}) s.term} 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 :: Spec {} {} Void
ngramsItemSpec = simpleSpec performAction render ngramsItemSpec = hide (unwrap initialState) $
focusState (re _Newtype) $
simpleSpec performAction render
where where
render :: Render State props Action render :: Render State {} Action
render dispatch _ (State state) _ = render dispatch _ (State state) _ =
[ [
tr [] tr []
...@@ -63,7 +66,7 @@ ngramsItemSpec = simpleSpec performAction render ...@@ -63,7 +66,7 @@ ngramsItemSpec = simpleSpec performAction render
, checked $ getter _._type state.term == MapTerm , checked $ getter _._type state.term == MapTerm
, title "Mark as completed" , title "Mark as completed"
, onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm)) , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
] [] ]
checkbox_stop = checkbox_stop =
input input
[ _type "checkbox" [ _type "checkbox"
...@@ -71,7 +74,7 @@ ngramsItemSpec = simpleSpec performAction render ...@@ -71,7 +74,7 @@ ngramsItemSpec = simpleSpec performAction render
, checked $ getter _._type state.term == StopTerm , checked $ getter _._type state.term == StopTerm
, title "Mark as completed" , title "Mark as completed"
, onChange $ dispatch <<< ( const $ SetStop $ not (getter _._type state.term == StopTerm)) , onChange $ dispatch <<< ( const $ SetStop $ not (getter _._type state.term == StopTerm))
] [] ]
dispTerm :: String -> TermType -> ReactElement 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 module Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable where
import CSS.TextAlign (center, textAlign)
import Control.Monad.Eff.Console (CONSOLE) import Data.Array (filter, toUnfoldable)
import DOM (DOM)
import Data.Array (filter, fold, toUnfoldable)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Newtype (class Newtype, unwrap)
import Data.Lens (Lens', Prism', lens, over, prism) 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.List (List)
import Data.Tuple (Tuple(..), uncurry) 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 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 (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 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) import Unsafe.Coerce (unsafeCoerce)
newtype State = State newtype State = State
{ items :: List NI.State { items :: List {}
, search :: String , search :: String
, selectString :: String , selectString :: String
, totalPages :: Int , totalPages :: Int
...@@ -27,38 +30,39 @@ newtype State = State ...@@ -27,38 +30,39 @@ newtype State = State
, totalRecords :: Int , totalRecords :: Int
} }
derive instance newtypeState :: Newtype State _
initialState :: State initialState :: State
initialState = State { items : toUnfoldable [NI.initialState] initialState = State { items : toUnfoldable [{}]
, search : "" , search : ""
, selectString : "" , selectString : ""
,totalPages : 10 , totalPages : 10
, currentPage : 1 , currentPage : 1
, pageSize : PS10 , pageSize : PS10
, totalRecords : 100 , totalRecords : 100
} }
data Action data Action
= NoOp = ItemAction Int Void
| ItemAction Int NI.Action
| ChangeString String | ChangeString String
| SetInput String | SetInput String
| ChangePageSize PageSizes | ChangePageSize PageSizes
| ChangePage Int | 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 }) _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 -> _ItemAction = prism (uncurry ItemAction) \ta ->
case ta of case ta of
ItemAction i a -> Right (Tuple i a) ItemAction i a -> Right (Tuple i a)
_ -> Left ta _ -> Left ta
performAction :: forall eff props. PerformAction ( console :: CONSOLE , ajax :: AJAX, dom :: DOM | eff ) State props Action type Dispatch = Action -> Effect Unit
performAction _ _ _ = void do
modifyState \(State state) -> State $ state 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 performAction (ChangePage p) _ _ = void do
modifyState \(State state) -> State $ state {currentPage = p} modifyState \(State state) -> State $ state {currentPage = p}
...@@ -72,7 +76,9 @@ performAction (ChangeString c) _ _ = void do ...@@ -72,7 +76,9 @@ performAction (ChangeString c) _ _ = void do
performAction (SetInput s) _ _ = void do performAction (SetInput s) _ _ = void do
modifyState \(State state) -> State $ state { search = s } 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 -> tableSpec = over _render \render dispatch p (State s) c ->
[div [className "container-fluid"] [div [className "container-fluid"]
[ [
...@@ -100,7 +106,7 @@ tableSpec = over _render \render dispatch p (State s) c -> ...@@ -100,7 +106,7 @@ tableSpec = over _render \render dispatch p (State s) c ->
, _type "value" , _type "value"
,value s.search ,value s.search
,onInput \e -> dispatch (SetInput (unsafeEventValue e)) ,onInput \e -> dispatch (SetInput (unsafeEventValue e))
] [] ]
] ]
...@@ -149,14 +155,17 @@ tableSpec = over _render \render dispatch p (State s) c -> ...@@ -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 :: Spec {} {} Void
ngramsTableSpec = container $ fold ngramsTableSpec =
[ tableSpec $ withState \st -> hide (unwrap initialState) $
focusState (re _Newtype) $
container $
tableSpec $
focus _itemsList _ItemAction $ focus _itemsList _ItemAction $
foreach \_ -> NI.ngramsItemSpec foreach $ \ _ ->
] NI.ngramsItemSpec
container :: forall eff state props action. Spec eff state props action -> Spec eff state props action container :: forall state props action. Spec state props action -> Spec state props action
container = over _render \render d p s c -> container = over _render \render d p s c ->
[ div [ className "container-fluid" ] $ [ div [ className "container-fluid" ] $
(render d p s c) (render d p s c)
...@@ -214,7 +223,7 @@ string2PageSize "50" = PS50 ...@@ -214,7 +223,7 @@ string2PageSize "50" = PS50
string2PageSize "100" = PS100 string2PageSize "100" = PS100
string2PageSize _ = PS10 string2PageSize _ = PS10
sizeDD :: PageSizes -> _ -> ReactElement sizeDD :: PageSizes -> Dispatch -> ReactElement
sizeDD ps d sizeDD ps d
= p [] = p []
[ text "Show : " [ text "Show : "
...@@ -237,7 +246,7 @@ textDescription currPage pageSize totalRecords ...@@ -237,7 +246,7 @@ textDescription currPage pageSize totalRecords
end = if end' > totalRecords then totalRecords else end' end = if end' > totalRecords then totalRecords else end'
pagination :: _ -> Int -> Int -> ReactElement pagination :: Dispatch -> Int -> Int -> ReactElement
pagination d tp cp pagination d tp cp
= span [] $ = span [] $
[ text "Pages: " [ text "Pages: "
...@@ -308,7 +317,7 @@ pagination d tp cp ...@@ -308,7 +317,7 @@ pagination d tp cp
lnums = map (\i -> fnmid d i) $ filter (lessthan 1) [cp - 2, cp - 1] 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] rnums = map (\i -> fnmid d i) $ filter (greaterthan tp) [cp + 1, cp + 2]
fnmid :: _ -> Int -> ReactElement fnmid :: Dispatch -> Int -> ReactElement
fnmid d i fnmid d i
= span [] = span []
[ text " " [ text " "
......
src/Gargantext/Pages/Corpus/User/Brevets.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Corpus.User.Brevets where module Gargantext.Pages.Corpus.User.Brevets where
import Prelude
import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
import Control.Monad.Eff.Console (CONSOLE) brevetsSpec :: Spec {} {} Void
import DOM (DOM) brevetsSpec = simpleSpec defaultPerformAction render
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
where where
render :: Render State props Action render :: Render {} {} Void
render dispatch _ state _ = 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 ...@@ -2,36 +2,29 @@ module Gargantext.Pages.Corpus.User.Users.API where
import Prelude 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 Control.Monad.Trans.Class (lift)
import DOM (DOM)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Lens (set) import Data.Lens ((?~))
import Data.Maybe (Maybe(..)) 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 Gargantext.Config.REST (get)
import Network.HTTP.Affjax (AJAX) import Gargantext.Pages.Corpus.User.Users.Types (Action(..), State, User, _user)
import Thermite (PerformAction, modifyState) import Thermite (PerformAction, modifyState)
getUser :: forall eff. Int -> Aff getUser :: Int -> Aff (Either String User)
(console :: CONSOLE, ajax :: AJAX | eff) (Either String User) getUser id = get $ toUrl Back Node id
getUser id = get $ "http://localhost:8008/node/" <> show id
performAction :: forall eff props. PerformAction ( console :: CONSOLE performAction :: PerformAction State {} Action
, ajax :: AJAX performAction (FetchUser userId) _ _ = do
, dom :: DOM
| eff ) State props Action
performAction NoOp _ _ = void do
modifyState id
performAction (FetchUser userId) _ _ = void do
value <- lift $ getUser userId value <- lift $ getUser userId
_ <- case value of _ <- case value of
(Right user) -> modifyState \state -> set _user (Just user) state (Right user) -> void $ modifyState $ _user ?~ user
(Left err) -> do (Left err) -> do
_ <- lift $ log err liftEffect $ log err
modifyState id liftEffect <<< log $ "Fetching user..."
lift <<< log $ "Fetching user..." performAction _ _ _ = pure unit
performAction _ _ _ = void do
modifyState id
src/Gargantext/Pages/Corpus/User/Users/Specs.purs
View file @ 9a6d8cc0
...@@ -5,19 +5,12 @@ module Gargantext.Pages.Corpus.User.Users.Specs ...@@ -5,19 +5,12 @@ module Gargantext.Pages.Corpus.User.Users.Specs
import Gargantext.Pages.Corpus.User.Users.Specs.Renders 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 Thermite (Spec, simpleSpec)
import Gargantext.Pages.Corpus.User.Users.Actions import Gargantext.Pages.Corpus.User.Users.Actions
import Gargantext.Pages.Corpus.User.Users.States import Gargantext.Pages.Corpus.User.Users.States
import Gargantext.Pages.Corpus.User.Users.API (performAction) import Gargantext.Pages.Corpus.User.Users.API (performAction)
layoutUser :: forall props eff . Spec ( console :: CONSOLE layoutUser :: Spec State {} Action
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
layoutUser = simpleSpec performAction render layoutUser = simpleSpec performAction render
publicationSpec :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action 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(..)) ...@@ -11,12 +11,12 @@ import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..), uncurry) import Data.Tuple (Tuple(..), uncurry)
import Prelude (($), (<<<), (<$>)) import Prelude (($), (<<<), (<$>))
import React (ReactElement) 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 React.DOM.Props (_id, className, src)
import Thermite (Render) import Thermite (Render)
render :: forall props. Render State props Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ [
div [className "col-md-12"] div [className "col-md-12"]
...@@ -25,7 +25,7 @@ render dispatch _ state _ = ...@@ -25,7 +25,7 @@ render dispatch _ state _ =
Nothing -> display "User not found" [] Nothing -> display "User not found" []
] ]
display :: forall props. String -> Array ReactElement -> Array ReactElement display :: String -> Array ReactElement -> Array ReactElement
display title elems = display title elems =
[ div [className "container-fluid"] [ div [className "container-fluid"]
[ div [className "row", _id "user-page-header"] [ div [className "row", _id "user-page-header"]
...@@ -37,7 +37,7 @@ display title elems = ...@@ -37,7 +37,7 @@ display title elems =
[ div [className "col-md-12"] [ div [className "col-md-12"]
[ div [className "row"] [ div [className "row"]
[ div [className "col-md-2"] [ 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-1"] []
, div [className "col-md-8"] elems , div [className "col-md-8"] elems
] ]
...@@ -62,11 +62,11 @@ userInfos hyperdata = ...@@ -62,11 +62,11 @@ userInfos hyperdata =
listInfo :: String -> String -> ReactElement listInfo :: String -> String -> ReactElement
listInfo s ss = listElement $ infoRender s ss 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"] listElement = li [className "list-group-item justify-content-between"]
infoRender :: forall props. String -> String -> Array ReactElement infoRender :: Tuple String String -> Array ReactElement
infoRender title content = infoRender (Tuple title content) =
[ span [] [text title] [ span [] [text title]
, span [className "badge badge-default badge-pill"] [text content] , 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 module Gargantext.Pages.Corpus.User.Users.Types
(module Gargantext.Pages.Corpus.User.Users.Types.Types,
import Prelude (bind, pure, ($)) 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.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.List (fromFoldable)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Gargantext.Components.Tab (tabs)
import Control.Monad.Aff.Console (CONSOLE) import Thermite (Render, Spec, focus, noState, defaultPerformAction, simpleSpec)
import DOM (DOM)
import Network.HTTP.Affjax (AJAX) brevetSpec :: Spec State {} Action
import Thermite (Spec, focus) brevetSpec = noState B.brevetsSpec
newtype User = projets :: Spec {} {} Void
User { projets = simpleSpec defaultPerformAction render
id ::Int, where
typename :: Maybe Int, render :: Render {} {} Void
userId ::Int, render dispatch _ state _ =
parentId :: Int, []
name :: String,
date ::Maybe String, projectSpec :: Spec State {} Action
hyperdata :: Maybe HyperData projectSpec = noState projets
}
facets :: Spec State {} Action
instance decodeUser :: DecodeJson User where facets = tabs _tablens _tabAction $ fromFoldable
decodeJson json = do [ Tuple "Publications (12)" publicationSpec
obj <- decodeJson json , Tuple "Brevets (2)" brevetSpec
id <- obj .? "id" , Tuple "Projets IMT (5)" projectSpec
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
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 module Gargantext.Pages.Home.Actions where
import Prelude hiding (div) import Prelude hiding (div)
import Control.Monad.Cont.Trans (lift) import Effect.Class (liftEffect)
import Control.Monad.Eff.Console (CONSOLE) import Gargantext.Pages.Home.States (State)
import DOM (DOM) import Routing.Hash (setHash)
import Thermite (PerformAction)
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)
data Action data Action
= NoOp = Documentation
| Documentation
| Enter | Enter
| Login | Login
| SignUp | SignUp
performAction :: forall eff props. PerformAction ( console :: CONSOLE performAction :: PerformAction State {} Action
, ajax :: AJAX performAction Documentation _ _ = pure unit
, dom :: DOM
| eff
) State props Action
performAction NoOp _ _ = void do
modifyState \state -> state
performAction Documentation _ _ = void do
modifyState \state -> state
performAction Enter _ _ = void do performAction Enter _ _ = void do
lift $ setHash "/search" liftEffect $ setHash "/search"
modifyState \state -> state
performAction Login _ _ = void do performAction Login _ _ = void do
lift $ setHash "/login" liftEffect $ setHash "/login"
modifyState \state -> state
performAction SignUp _ _ = void do
modifyState \state -> state
performAction SignUp _ _ = pure unit
src/Gargantext/Pages/Home/Specs.purs
View file @ 9a6d8cc0
...@@ -2,45 +2,40 @@ module Gargantext.Pages.Home.Specs where ...@@ -2,45 +2,40 @@ module Gargantext.Pages.Home.Specs where
import Prelude hiding (div) import Prelude hiding (div)
import Control.Monad.Cont.Trans (lift) import Data.Lens (re)
import Control.Monad.Eff.Console (CONSOLE) import Data.Lens.Iso.Newtype (_Newtype)
import DOM (DOM) import Data.Newtype (unwrap)
import Gargantext.Components.Lang.Landing.EnUS as En import Gargantext.Components.Lang.Landing.EnUS as En
import Gargantext.Components.Lang.Landing.FrFR as Fr import Gargantext.Components.Lang.Landing.FrFR as Fr
import Gargantext.Components.Data.Landing (BlockText(..), BlockTexts(..), Button(..), LandingData(..)) import Gargantext.Components.Data.Landing (BlockText(..), BlockTexts(..), Button(..), LandingData(..))
import Gargantext.Components.Data.Lang (Lang(..)) import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Pages.Home.States (State(..)) import Gargantext.Pages.Home.States (State, initialState)
import Gargantext.Pages.Home.Actions (Action(..), performAction) import Gargantext.Pages.Home.Actions (Action, performAction)
import Network.HTTP.Affjax (AJAX)
import React (ReactElement) import React (ReactElement)
import React.DOM (a, div, h3, i, img, p, span, text) import React.DOM (a, div, h3, i, img, p, span, text)
import React.DOM.Props (Props, _id, aria, className, href, src, target, title) import React.DOM.Props (Props, _id, aria, className, href, src, target, title)
import Routing.Hash.Aff (setHash) import Thermite (Render, Spec, simpleSpec, hide, focusState)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
-- Layout | -- Layout |
layoutLanding :: forall props eff . Lang -> Spec ( console :: CONSOLE landingData :: Lang -> LandingData
, ajax :: AJAX landingData FR = Fr.landingData
, dom :: DOM landingData EN = En.landingData
| eff
) State props Action layoutLanding :: Lang -> Spec {} {} Void
layoutLanding FR = layoutLanding' Fr.landingData layoutLanding = hide (unwrap initialState)
layoutLanding EN = layoutLanding' En.landingData <<< focusState (re _Newtype)
<<< layoutLanding' <<< landingData
------------------------------------------------------------------------ ------------------------------------------------------------------------
layoutLanding' :: forall props eff . LandingData -> Spec ( console :: CONSOLE layoutLanding' :: LandingData -> Spec State {} Action
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
layoutLanding' hd = simpleSpec performAction render layoutLanding' hd = simpleSpec performAction render
where where
render :: Render State props Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ div [ className "container1" ] [ jumboTitle hd false ] [ div [ className "container1" ] [ jumboTitle hd false ]
, div [ className "container1" ] [] -- put research here , div [ className "container1" ] [] -- put research here
...@@ -83,11 +78,11 @@ jumboTitle :: LandingData -> Boolean -> ReactElement ...@@ -83,11 +78,11 @@ jumboTitle :: LandingData -> Boolean -> ReactElement
jumboTitle (LandingData hd) b = div jumbo jumboTitle (LandingData hd) b = div jumbo
[ div [className "row" ] [ div [className "row" ]
[ div [ className "col-md-8 content"] [ div [ className "col-md-8 content"]
[ p [ className "left" ] [ div [ className "left" ]
[ div [_id "logo-designed" ] [ div [_id "logo-designed" ]
[ img [ src "images/logo.png" [ img [ src "images/logo.png"
, title hd.logoTitle , title hd.logoTitle
] [] ]
] ]
] ]
] ]
...@@ -96,7 +91,7 @@ jumboTitle (LandingData hd) b = div jumbo ...@@ -96,7 +91,7 @@ jumboTitle (LandingData hd) b = div jumbo
, _id "funnyimg" , _id "funnyimg"
, title hd.imageTitle , title hd.imageTitle
] ]
[]
] ]
] ]
] ]
...@@ -113,6 +108,5 @@ imageEnter (LandingData hd) action = div [className "row"] ...@@ -113,6 +108,5 @@ imageEnter (LandingData hd) action = div [className "row"]
, title hd.imageTitle , title hd.imageTitle
, action , action
] ]
[]
] ]
] ]
src/Gargantext/Pages/Home/States.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Home.States where module Gargantext.Pages.Home.States where
import Prelude hiding (div) import Data.Newtype (class Newtype)
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)
newtype State = State newtype State = State
{ userName :: String { userName :: String
, password :: String , password :: String
} }
derive instance newtypeState :: Newtype State _
initialState :: State initialState :: State
initialState = State initialState = State
{userName : "" { userName : ""
, password : "" , password : ""
} }
src/Gargantext/Pages/Layout.purs
View file @ 9a6d8cc0
module Gargantext.Pages.Layout where module Gargantext.Pages.Layout where
import Prelude hiding (div) 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.Layout.Actions (Action(..))
import Gargantext.Pages.Corpus as AC import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Corpus.Doc.Annotation as D -- import Gargantext.Pages.Corpus.Doc.Facets as TV
import Gargantext.Pages.Corpus.Doc.Document as DV -- import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus.Doc.Facets as TV
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG -- import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG
import Gargantext.Pages.Corpus.User.Users as U import Gargantext.Pages.Corpus.User.Users as U
import Gargantext.Pages.Home as L import Gargantext.Pages.Corpus.Annuaire as Annuaire
import Gargantext.Pages.Search as S -- import Gargantext.Pages.Home as L
-- import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Router (Routes(..)) import Gargantext.Router (Routes(..))
dispatchAction :: forall t115 t445 t447. dispatchAction :: forall ignored m.
Bind t445 => Applicative t445 => Monad m =>
(Action -> t445 t447) -> t115 -> Routes -> t445 Unit (Action -> m Unit) -> ignored -> Routes -> m Unit
dispatchAction dispatcher _ Home = do dispatchAction dispatcher _ Home = do
_ <- dispatcher Initialize dispatcher Initialize
_ <- dispatcher $ SetRoute Home dispatcher $ SetRoute Home
_ <- dispatcher $ LandingA L.NoOp -- dispatcher $ LandingA TODO
pure unit
dispatchAction dispatcher _ Login = do dispatchAction dispatcher _ Login = do
_ <- dispatcher Initialize dispatcher Initialize
_ <- dispatcher $ SetRoute Login dispatcher $ SetRoute Login
_ <- dispatcher $ LoginA LN.NoOp -- dispatcher $ LoginA TODO
pure unit
dispatchAction dispatcher _ AddCorpus = do dispatchAction dispatcher _ AddCorpus = do
_ <- dispatcher $ SetRoute AddCorpus dispatcher $ SetRoute AddCorpus
_ <- dispatcher $ AddCorpusA AC.LoadDatabaseDetails dispatcher $ AddCorpusA AC.LoadDatabaseDetails
pure unit
dispatchAction dispatcher _ DocView = do dispatchAction dispatcher _ (DocView n) = do
_ <- dispatcher $ SetRoute $ DocView dispatcher $ SetRoute (DocView n)
_ <- dispatcher $ DocViewA $ DV.LoadData dispatcher $ DocViewA $ DV.LoadData n
pure unit
dispatchAction dispatcher _ SearchView = do dispatchAction dispatcher _ SearchView = do
_ <- dispatcher $ SetRoute $ SearchView dispatcher $ SetRoute SearchView
_ <- dispatcher $ SearchA $ S.NoOp -- dispatcher $ SearchA TODO
pure unit
dispatchAction dispatcher _ (UserPage id) = do dispatchAction dispatcher _ (UserPage id) = do
_ <- dispatcher $ SetRoute $ UserPage id dispatcher $ SetRoute $ UserPage id
_ <- dispatcher $ UserPageA $ U.NoOp -- dispatcher $ UserPageA TODO
_ <- dispatcher $ UserPageA $ U.FetchUser id dispatcher $ UserPageA $ U.FetchUser id
pure unit
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 dispatchAction dispatcher _ (DocAnnotation i) = do
_ <- dispatcher $ SetRoute $ DocAnnotation i dispatcher $ SetRoute $ DocAnnotation i
_ <- dispatcher $ DocAnnotationViewA $ D.NoOp -- dispatcher $ DocAnnotationViewA TODO
pure unit
dispatchAction dispatcher _ Tabview = do dispatchAction dispatcher _ Tabview = do
_ <- dispatcher $ SetRoute $ Tabview dispatcher $ SetRoute Tabview
_ <- dispatcher $ TabViewA $ TV.NoOp -- dispatcher $ TabViewA TODO
pure unit
dispatchAction dispatcher _ CorpusAnalysis = do dispatchAction dispatcher _ CorpusAnalysis = do
_ <- dispatcher $ SetRoute $ CorpusAnalysis dispatcher $ SetRoute CorpusAnalysis
--_ <- dispatcher $ CorpusAnalysisA $ CA.NoOp -- dispatcher $ CorpusAnalysisA TODO
pure unit
dispatchAction dispatcher _ PGraphExplorer = do dispatchAction dispatcher _ PGraphExplorer = do
_ <- dispatcher $ SetRoute $ PGraphExplorer dispatcher $ SetRoute PGraphExplorer
_ <- dispatcher $ GraphExplorerA $ GE.LoadGraph "imtNew.json" dispatcher $ GraphExplorerA $ GE.LoadGraph "imtNew.json"
pure unit
dispatchAction dispatcher _ NGramsTable = do dispatchAction dispatcher _ NGramsTable = do
_ <- dispatcher $ SetRoute $ NGramsTable dispatcher $ SetRoute NGramsTable
_ <- dispatcher $ NgramsA $ NG.NoOp -- dispatcher $ NgramsA TODO
pure unit
dispatchAction dispatcher _ Dashboard = do dispatchAction dispatcher _ Dashboard = do
_ <- dispatcher $ SetRoute $ Dashboard dispatcher $ SetRoute Dashboard
pure unit
src/Gargantext/Pages/Layout/Actions.purs
View file @ 9a6d8cc0
-- | Module Description
module Gargantext.Pages.Layout.Actions where module Gargantext.Pages.Layout.Actions where
import Prelude hiding (div) import Prelude hiding (div)
import Control.Monad.Cont.Trans (lift) 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.Either (Either(..))
import Data.Lens (Lens', Prism', lens, prism) import Data.Lens (Prism', prism)
import Effect.Class (liftEffect)
import Gargantext.Pages.Corpus.Doc.Annotation as D import Effect.Console (log)
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.Login as LN
import Gargantext.Components.Modals.Modal (modalShow) import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Components.Tree as Tree import Gargantext.Components.Tree as Tree
import Gargantext.Pages.Corpus.Doc.Facets.Dashboard as Dsh import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus as AC import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Router (Routes(..))
import Gargantext.Pages.Corpus.User.Users as U
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
import Gargantext.Pages.Home as L import Gargantext.Pages.Corpus.User.Users as U
import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG import Gargantext.Pages.Corpus.Annuaire as Annuaire
import Gargantext.Pages.Search as S import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Corpus.Doc.Facets as TV import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Pages.Layout.States (AppState) import Gargantext.Pages.Layout.States (AppState)
import Gargantext.Pages.Corpus.Doc.Document as DV import Gargantext.Router (Routes)
import Network.HTTP.Affjax (AJAX)
import Thermite (PerformAction, modifyState) import Thermite (PerformAction, modifyState)
------------------------------------------------------------------------
data Action data Action
= Initialize = Initialize
| LandingA L.Action
| LoginA LN.Action | LoginA LN.Action
| SetRoute Routes | SetRoute Routes
| AddCorpusA AC.Action | AddCorpusA AC.Action
...@@ -45,79 +35,74 @@ data Action ...@@ -45,79 +35,74 @@ data Action
| UserPageA U.Action | UserPageA U.Action
| DocAnnotationViewA D.Action | DocAnnotationViewA D.Action
| TreeViewA Tree.Action | TreeViewA Tree.Action
| TabViewA TV.Action
| GraphExplorerA GE.Action | GraphExplorerA GE.Action
| DashboardA Dsh.Action
| Search String | Search String
| AnnuaireAction Annuaire.Action
| Go | Go
| CorpusAnalysisA CA.Action
| ShowLogin | ShowLogin
| ShowAddcorpus | ShowAddcorpus
| NgramsA NG.Action
performAction :: forall eff props. PerformAction ( dom :: DOM performAction :: PerformAction AppState {} Action
, ajax :: AJAX
, console :: CONSOLE
| eff
) AppState props Action
performAction (SetRoute route) _ _ = void do performAction (SetRoute route) _ _ = void do
modifyState $ _ {currentRoute = pure route} modifyState $ _ {currentRoute = pure route}
performAction (Search s) _ _ = void do performAction (Search s) _ _ = void do
modifyState $ _ {search = s} modifyState $ _ {search = s}
performAction (ShowLogin) _ _ = void do performAction (ShowLogin) _ _ = void do
liftEff $ modalShow "loginModal" liftEffect $ modalShow "loginModal"
modifyState $ _ {showLogin = true} modifyState $ _ {showLogin = true}
performAction (ShowAddcorpus) _ _ = void do performAction (ShowAddcorpus) _ _ = void do
liftEff $ modalShow "addCorpus" liftEffect $ modalShow "addCorpus"
modifyState $ _ {showCorpus = true} modifyState $ _ {showCorpus = true}
performAction Go _ _ = void do performAction Go _ _ = void do
liftEff $ modalShow "addCorpus" liftEffect $ modalShow "addCorpus"
modifyState $ _ {showCorpus = true} modifyState $ _ {showCorpus = true}
-- _ <- lift $ setHash "/addCorpus" -- _ <- lift $ setHash "/addCorpus"
--modifyState id --modifyState id
performAction Initialize _ state = void do performAction Initialize _ state = void do
_ <- liftEff $ log "loading Initial nodes" _ <- liftEffect $ log "loading Initial nodes"
case state.initialized of case state.initialized of
false -> do false -> do
lnodes <- lift $ Tree.loadDefaultNode lnodes <- lift $ Tree.loadDefaultNode
case lnodes of case lnodes of
Left err -> do Left err -> do
modifyState id pure unit
Right d -> do Right d -> do
page <- lift $ DV.loadPage _ <- modifyState $ _ { initialized = true, ntreeState = d}
case page of pure unit
Left err -> do -- page <- lift $ DV.loadPage
modifyState id -- case page of
Right docs -> do -- Left err -> do
modifyState $ _ { initialized = true -- pure unit
, ntreeView = if length d > 0 -- Right docs -> void do
then Tree.exampleTree -- modifyState $ _ { initialized = true
--then fnTransform $ unsafePartial $ fromJust $ head d -- , ntreeState = d
else Tree.initialState -- -- if length d > 0
-- -- then Tree.exampleTree
, docViewState = docs -- -- --then fnTransform $ unsafePartial $ fromJust $ head d
} -- -- else Tree.initialState
--
-- , docViewState = docs
-- }
_ -> do _ -> do
modifyState id pure unit
performAction _ _ _ = void do performAction (LoginA _) _ _ = pure unit
modifyState id 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' Action LN.Action
_loginAction = prism LoginA \action -> _loginAction = prism LoginA \action ->
case action of case action of
...@@ -148,10 +133,10 @@ _userPageAction = prism UserPageA \action -> ...@@ -148,10 +133,10 @@ _userPageAction = prism UserPageA \action ->
UserPageA caction -> Right caction UserPageA caction -> Right caction
_-> Left action _-> Left action
_dashBoardAction :: Prism' Action Dsh.Action _annuaireAction :: Prism' Action Annuaire.Action
_dashBoardAction = prism DashboardA \action -> _annuaireAction = prism AnnuaireAction \action ->
case action of case action of
DashboardA caction -> Right caction AnnuaireAction a -> Right a
_ -> Left action _ -> Left action
_docAnnotationViewAction :: Prism' Action D.Action _docAnnotationViewAction :: Prism' Action D.Action
...@@ -166,29 +151,8 @@ _treeAction = prism TreeViewA \action -> ...@@ -166,29 +151,8 @@ _treeAction = prism TreeViewA \action ->
TreeViewA caction -> Right caction TreeViewA caction -> Right caction
_-> Left action _-> 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' Action GE.Action
_graphExplorerAction = prism GraphExplorerA \action -> _graphExplorerAction = prism GraphExplorerA \action ->
case action of case action of
GraphExplorerA caction -> Right caction GraphExplorerA caction -> Right caction
_-> Left action _-> 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 ...@@ -2,100 +2,81 @@ module Gargantext.Pages.Layout.Specs where
import Prelude hiding (div) import Prelude hiding (div)
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Data.Foldable (fold, intercalate) import Data.Foldable (fold, intercalate)
import Data.Lens (over) import Data.Lens (over)
import Data.Maybe (Maybe(Nothing, Just)) import Data.Maybe (Maybe(Nothing, Just))
import Effect (Effect)
import Gargantext.Components.Data.Lang (Lang(..)) import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Components.Login as LN import Gargantext.Components.Login as LN
import Gargantext.Components.Tree as Tree import Gargantext.Components.Tree as Tree
import Gargantext.Pages.Corpus.Annuaire as A
-- | [Naming] metrics indicator: reduce spaces between "," and "_" import Gargantext.Folder as F
import Gargantext.Pages.Layout.States ( _addCorpusState import Gargantext.Pages.Corpus as CA
, _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.Pages.Corpus.Doc.Annotation as D 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 as TV
import Gargantext.Pages.Corpus.Doc.Facets.Dashboard as Dsh 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.Graph as GE
import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG
import Gargantext.Pages.Corpus.User.Users as U import Gargantext.Pages.Corpus.User.Users as U
import Gargantext.Pages.Home as L import Gargantext.Pages.Home as L
import Gargantext.Pages.Layout.Actions (Action(..), performAction) import Gargantext.Pages.Layout.Actions (Action(..), _addCorpusAction, _docAnnotationViewAction, _docViewAction, _graphExplorerAction, _loginAction, _searchAction, _treeAction, _userPageAction, performAction, _annuaireAction)
import Gargantext.Pages.Layout.States (AppState, E) import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Search as S 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 Gargantext.Router (Routes(..))
import Network.HTTP.Affjax (AJAX)
import React (ReactElement) 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 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) 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 = pagesComponent s =
case s.currentRoute of case s.currentRoute of
Just route -> selectSpec route Just route -> selectSpec route
Nothing -> selectSpec Home Nothing -> selectSpec Home
where where
selectSpec :: Routes -> Spec ( ajax :: AJAX selectSpec :: Routes -> Spec AppState {} Action
, console :: CONSOLE selectSpec CorpusAnalysis = layout0 $ noState CA.spec'
, dom :: DOM
| eff
) AppState props Action
selectSpec CorpusAnalysis = layout0 $ focus _corpusState _corpusAction CA.spec'
selectSpec Login = focus _loginState _loginAction LN.renderSpec 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 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 (UserPage i) = layout0 $ focus _userPageState _userPageAction U.layoutUser
selectSpec (DocAnnotation i) = layout0 $ focus _docAnnotationViewState _docAnnotationViewAction D.docview 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 -- To be removed
selectSpec SearchView = layout0 $ focus _searchState _searchAction S.searchSpec 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 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 -- 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 routingSpec = simpleSpec performAction defaultRender
layout0 :: forall eff props. Spec (E eff) AppState props Action layout0 :: Spec AppState {} Action
-> Spec (E eff) AppState props Action -> Spec AppState {} Action
layout0 layout = layout0 layout =
fold fold
[ layoutSidebar divSearchBar [ layoutSidebar divSearchBar
...@@ -104,7 +85,7 @@ layout0 layout = ...@@ -104,7 +85,7 @@ layout0 layout =
] ]
where where
outerLayout1 = simpleSpec defaultPerformAction defaultRender outerLayout1 = simpleSpec defaultPerformAction defaultRender
outerLayout :: Spec (E eff) AppState props Action outerLayout :: Spec AppState {} Action
outerLayout = outerLayout =
cont $ fold cont $ fold
[ withState \st -> [ withState \st ->
...@@ -120,8 +101,8 @@ layout0 layout = ...@@ -120,8 +101,8 @@ layout0 layout =
bs = innerLayout $ layout bs = innerLayout $ layout
innerLayout :: Spec (E eff) AppState props Action innerLayout :: Spec AppState {} Action
-> Spec (E eff) AppState props Action -> Spec AppState {} Action
innerLayout = over _render \render d p s c -> innerLayout = over _render \render d p s c ->
[ div [_id "page-wrapper"] [ div [_id "page-wrapper"]
[ [
...@@ -129,8 +110,8 @@ layout0 layout = ...@@ -129,8 +110,8 @@ layout0 layout =
] ]
] ]
layoutSidebar :: forall props eff. Spec (E eff) AppState props Action layoutSidebar :: Spec AppState {} Action
-> Spec (E eff) AppState props Action -> Spec AppState {} Action
layoutSidebar = over _render \render d p s c -> layoutSidebar = over _render \render d p s c ->
[ div [ _id "dafixedtop" [ div [ _id "dafixedtop"
, className "navbar navbar-inverse navbar-fixed-top" , className "navbar navbar-inverse navbar-fixed-top"
...@@ -153,7 +134,7 @@ divLogo = a [ className "navbar-brand logoSmall" ...@@ -153,7 +134,7 @@ divLogo = a [ className "navbar-brand logoSmall"
, href "#/" , href "#/"
] [ img [ src "images/logoSmall.png" ] [ img [ src "images/logoSmall.png"
, title "Back to home." , title "Back to home."
] [] ]
] ]
divDropdownLeft :: ReactElement divDropdownLeft :: ReactElement
...@@ -264,10 +245,10 @@ liNav (LiNav { title : title' ...@@ -264,10 +245,10 @@ liNav (LiNav { title : title'
] ]
-- TODO put the search form in the center of the navBar -- 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 divSearchBar = simpleSpec performAction render
where where
render :: Render AppState props Action render :: Render AppState {} Action
render dispatch _ state _ = [div [ className "" ] [ searchbar']] render dispatch _ state _ = [div [ className "" ] [ searchbar']]
where where
searchbar' = ul [ className "nav navbar-nav col-md-6 col-md-offset-3" searchbar' = ul [ className "nav navbar-nav col-md-6 col-md-offset-3"
...@@ -280,13 +261,13 @@ divSearchBar = simpleSpec performAction render ...@@ -280,13 +261,13 @@ divSearchBar = simpleSpec performAction render
, width: "400px" , width: "400px"
} }
, onChange \e -> dispatch $ Search (unsafeCoerce e).target.value , onChange \e -> dispatch $ Search (unsafeCoerce e).target.value
] [] ]
, button [onClick \e -> dispatch Go, className "btn btn-primary"] [text "Enter"] , button [onClick \e -> dispatch Go, className "btn btn-primary"] [text "Enter"]
] ]
] ]
--divDropdownRight :: Render AppState props Action --divDropdownRight :: Render AppState {} Action
divDropdownRight :: _ -> ReactElement divDropdownRight :: (Action -> Effect Unit) -> ReactElement
divDropdownRight d = divDropdownRight d =
ul [className "nav navbar-nav pull-right"] ul [className "nav navbar-nav pull-right"]
[ [
...@@ -308,11 +289,11 @@ divDropdownRight d = ...@@ -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 layoutFooter = simpleSpec performAction render
where where
render :: Render AppState props Action render :: Render AppState {} Action
render dispatch _ state _ = [div [ className "container1" ] [ hr [] [], footerLegalInfo']] render dispatch _ state _ = [div [ className "container1" ] [ hr', footerLegalInfo']]
where where
footerLegalInfo' = footer [] [ p [] [ text "Gargantext " footerLegalInfo' = footer [] [ p [] [ text "Gargantext "
, span [className "glyphicon glyphicon-registration-mark" ] [] , span [className "glyphicon glyphicon-registration-mark" ] []
...@@ -333,18 +314,3 @@ layoutFooter = simpleSpec performAction render ...@@ -333,18 +314,3 @@ layoutFooter = simpleSpec performAction render
, text "." , 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 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 Effect.Class (liftEffect)
import Routing.Hash.Aff (setHash) 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 Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Pages.Home as L
type State = type State =
{ {
...@@ -21,49 +18,38 @@ type State = ...@@ -21,49 +18,38 @@ type State =
initialState :: State initialState :: State
initialState = initialState =
{ {
query : "" query : "empty query"
} }
data Action data Action
= NoOp = GO
| GO
| SetQuery String | SetQuery String
performAction :: forall eff props. PerformAction (console :: CONSOLE, ajax :: AJAX,dom::DOM | eff) State props Action performAction :: PerformAction State {} Action
performAction NoOp _ _ = void do
modifyState id
performAction (SetQuery q) _ _ = void do performAction (SetQuery q) _ _ = void do
modifyState \( state) -> state { query = q } modifyState $ _ { query = q }
performAction GO _ _ = void do performAction GO _ _ = void do
lift $ setHash "/addCorpus" liftEffect $ setHash "/addCorpus"
modifyState id
unsafeEventValue :: forall event. event -> String unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value unsafeEventValue e = (unsafeCoerce e).target.value
searchSpec :: forall props eff . Spec ( console :: CONSOLE searchSpec :: Spec State {} Action
, ajax :: AJAX
, dom :: DOM
| eff
) State props Action
searchSpec = simpleSpec performAction render searchSpec = simpleSpec performAction render
where where
render :: Render State props Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ div [className "container1"] [] [ div [className "container1"] []
, div [className "container1"] , div [className "container1"]
[ div [className "jumbotron" ] [ div [className "jumbotron" ]
[ div [className "row" ] [ div [className "row" ]
[ div [className "col-md-10" ] [ div [className "col-md-10" ]
[ br' [] [ br'
, br' [] , br'
, div [ className "form-group"] , div [ className "form-group"]
[ input [ className "form-control" [ input [ className "form-control"
, _id "id_password" , _id "id_password"
...@@ -72,16 +58,16 @@ searchSpec = simpleSpec performAction render ...@@ -72,16 +58,16 @@ searchSpec = simpleSpec performAction render
, _type "text" , _type "text"
, value state.query , value state.query
, onInput \e -> dispatch (SetQuery (unsafeEventValue e)) , onInput \e -> dispatch (SetQuery (unsafeEventValue e))
] [] ]
, br'[] , br'
] ]
] ]
, div [ className "col-md-2"] , div [ className "col-md-2"]
[ br' [] [ br'
, br' [] , br'
, button [onClick \_ -> dispatch GO] [text "GO"] , 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 ...@@ -2,83 +2,55 @@ module Gargantext.Pages.Layout.States where
import Prelude hiding (div) import Prelude hiding (div)
import Control.Monad.Cont.Trans (lift) import Data.Lens (Lens', lens)
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 Data.Maybe (Maybe(Just))
import Gargantext.Components.Login as LN import Gargantext.Components.Login as LN
import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Components.Tree as Tree 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.Annotation as D
import Gargantext.Pages.Corpus.Doc.Body as CA import Gargantext.Pages.Corpus.Annuaire as Annuaire
import Gargantext.Pages.Corpus.Doc.Document as DV import Gargantext.Pages.Corpus.Doc.Facets.Documents 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.Graph as GE
import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG
import Gargantext.Pages.Corpus.User.Users as U import Gargantext.Pages.Corpus.User.Users as U
import Gargantext.Pages.Home as L import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Search as S import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Router (Routes(..)) import Gargantext.Router (Routes(..))
import Network.HTTP.Affjax (AJAX)
import Thermite (PerformAction, modifyState)
type E e = (dom :: DOM, ajax :: AJAX, console :: CONSOLE | e)
type AppState = type AppState =
{ currentRoute :: Maybe Routes { currentRoute :: Maybe Routes
, landingState :: L.State
, loginState :: LN.State , loginState :: LN.State
, addCorpusState :: AC.State , addCorpusState :: AC.State
, docViewState :: DV.State , docViewState :: DV.State
, searchState :: S.State , searchState :: S.State
, userPage :: U.State , userPageState :: U.State
, docAnnotationView :: D.State , docAnnotationState :: D.State
, ntreeView :: Tree.State , annuaireState :: Annuaire.State
, tabview :: TV.State , ntreeState :: Tree.State
, search :: String , search :: String
, corpusAnalysis :: CA.State
, showLogin :: Boolean , showLogin :: Boolean
, showCorpus :: Boolean , showCorpus :: Boolean
, graphExplorer :: GE.State , graphExplorerState :: GE.State
, initialized :: Boolean , initialized :: Boolean
, ngState :: NG.State
, dashboard :: Dsh.State
} }
initAppState :: AppState initAppState :: AppState
initAppState = initAppState =
{ currentRoute : Just Home { currentRoute : Just Home
, landingState : L.initialState
, loginState : LN.initialState , loginState : LN.initialState
, addCorpusState : AC.initialState , addCorpusState : AC.initialState
, docViewState : DV.tdata , docViewState : DV.tdata
, searchState : S.initialState , searchState : S.initialState
, userPage : U.initialState , userPageState : U.initialState
, docAnnotationView : D.initialState , docAnnotationState : D.initialState
, ntreeView : Tree.exampleTree , ntreeState : Tree.exampleTree
, tabview : TV.initialState , annuaireState : Annuaire.initialState
, search : "" , search : ""
, corpusAnalysis : CA.initialState
, showLogin : false , showLogin : false
, showCorpus : false , showCorpus : false
, graphExplorer : GE.initialState , graphExplorerState : GE.initialState
, initialized : false , 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' AppState LN.State
_loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss}) _loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss})
...@@ -92,27 +64,16 @@ _searchState :: Lens' AppState S.State ...@@ -92,27 +64,16 @@ _searchState :: Lens' AppState S.State
_searchState = lens (\s -> s.searchState) (\s ss -> s{searchState = ss}) _searchState = lens (\s -> s.searchState) (\s ss -> s{searchState = ss})
_userPageState :: Lens' AppState U.State _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' 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' AppState Tree.State
_treeState = lens (\s -> s.ntreeView) (\s ss -> s {ntreeView = ss}) _treeState = lens (\s -> s.ntreeState) (\s ss -> s {ntreeState = 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})
_graphExplorerState :: Lens' AppState GE.State _graphExplorerState :: Lens' AppState GE.State
_graphExplorerState = lens (\s -> s.graphExplorer) (\s ss -> s{graphExplorer = ss}) _graphExplorerState = lens (\s -> s.graphExplorerState) (\s ss -> s{graphExplorerState = ss})
_ngState :: Lens' AppState NG.State
_ngState = lens (\s -> s.ngState) (\s ss -> s{ngState = ss})
src/Gargantext/Router.purs
View file @ 9a6d8cc0
...@@ -3,23 +3,21 @@ module Gargantext.Router where ...@@ -3,23 +3,21 @@ module Gargantext.Router where
import Prelude import Prelude
import Control.Alt ((<|>)) 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.Int (floor)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Routing.Match (Match) import Effect (Effect)
import Routing.Match.Class (lit, num) 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 data Routes
= Home = Home
| Login | Login
| AddCorpus | AddCorpus
| DocView | DocView Int
| SearchView | SearchView
| UserPage Int | UserPage Int
| DocAnnotation Int | DocAnnotation Int
...@@ -28,20 +26,24 @@ data Routes ...@@ -28,20 +26,24 @@ data Routes
| PGraphExplorer | PGraphExplorer
| NGramsTable | NGramsTable
| Dashboard | Dashboard
| Annuaire Int
| Folder Int
instance showRoutes :: Show Routes where instance showRoutes :: Show Routes where
show Login = "Login" show Login = "Login"
show AddCorpus = "AddCorpus" show AddCorpus = "AddCorpus"
show DocView = "DocView" show (DocView i) = "DocView"
show SearchView = "SearchView" show SearchView = "Search"
show (UserPage i) = "UserPage" show (UserPage i) = "User"
show (DocAnnotation i)= "DocumentView" show (DocAnnotation i)= "Document"
show Tabview = "Tabview" show Tabview = "Tabview"
show CorpusAnalysis = "corpus" show CorpusAnalysis = "Corpus"
show PGraphExplorer = "graphExplorer" show PGraphExplorer = "graphExplorer"
show NGramsTable = "NGramsTable" show NGramsTable = "NGramsTable"
show Dashboard = "Dashboard" show Dashboard = "Dashboard"
show (Annuaire i) = "Annuaire"
show (Folder i) = "Folder"
show Home = "Home" show Home = "Home"
int :: Match Int int :: Match Int
...@@ -51,40 +53,33 @@ routing :: Match Routes ...@@ -51,40 +53,33 @@ routing :: Match Routes
routing = routing =
Login <$ route "login" Login <$ route "login"
<|> Tabview <$ route "tabview" <|> Tabview <$ route "tabview"
<|> DocAnnotation <$> (route "documentView" *> int) <|> DocAnnotation <$> (route "document" *> int)
<|> UserPage <$> (route "user" *> int) <|> UserPage <$> (route "user" *> int)
<|> SearchView <$ route "search" <|> SearchView <$ route "search"
<|> DocView <$ route "docView" <|> DocView <$> (route "docView" *> int)
<|> AddCorpus <$ route "addCorpus" <|> AddCorpus <$ route "addCorpus"
<|> CorpusAnalysis <$ route "corpus" <|> CorpusAnalysis <$ route "corpus"
<|> PGraphExplorer <$ route "graphExplorer" <|> PGraphExplorer <$ route "graph"
<|> NGramsTable <$ route "ngrams" <|> NGramsTable <$ route "ngrams"
<|> Dashboard <$ route "dashboard" <|> Dashboard <$ route "dashboard"
<|> Annuaire <$> (route "annuaire" *> int)
<|> Folder <$> (route "folder" *> int)
<|> Home <$ lit "" <|> Home <$ lit ""
where where
route str = lit "" *> lit str route str = lit "" *> lit str
routeHandler :: forall e. ( Maybe Routes -> Routes -> Eff routeHandler :: (Maybe Routes -> Routes -> Effect Unit) -> Maybe Routes -> Routes -> Effect Unit
( dom :: DOM
, console :: CONSOLE
| e
) Unit
) -> Maybe Routes -> Routes -> Eff
( dom :: DOM
, console :: CONSOLE
| e
) Unit
routeHandler dispatchAction old new = do routeHandler dispatchAction old new = do
liftEff $ log $ "change route : " <> show new liftEffect $ log $ "change route : " <> show new
w <- window w <- window
ls <- localStorage w ls <- localStorage w
token <- getItem "accessToken" ls token <- getItem "accessToken" ls
let tkn = token let tkn = token
liftEff $ log $ "JWToken : " <> show tkn liftEffect $ log $ "JWToken : " <> show tkn
case tkn of case tkn of
Nothing -> do Nothing -> do
dispatchAction old new dispatchAction old new
liftEff $ log $ "called SignIn Route :" liftEffect $ log $ "called SignIn Route :"
Just t -> do Just t -> do
dispatchAction old new 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 ...@@ -2,16 +2,22 @@ module Gargantext.Utils.DecodeMaybe where
import Prelude import Prelude
import Data.Argonaut (class DecodeJson, JObject, getFieldOptional) import Data.Argonaut (class DecodeJson, Json, getFieldOptional)
import Data.Either (Either) import Data.Either (Either)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..), fromMaybe)
import Foreign.Object (Object)
foreign import isNull :: forall a. a -> Boolean 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 getFieldOptional' o s = (case _ of
Just v -> if isNull v then Nothing else v Just v -> if isNull v then Nothing else v
Nothing -> Nothing Nothing -> Nothing
) <$> (getFieldOptional o s) ) <$> (getFieldOptional o s)
infix 7 getFieldOptional' as .?| 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 ...@@ -2,42 +2,40 @@ module Main where
import Prelude 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 Data.Maybe (fromJust)
import Effect (Effect)
import Gargantext.Pages.Layout (dispatchAction) import Gargantext.Pages.Layout (dispatchAction)
import Gargantext.Pages.Layout.Specs (layoutSpec) import Gargantext.Pages.Layout.Specs (layoutSpec)
import Gargantext.Pages.Layout.States (initAppState) import Gargantext.Pages.Layout.States (initAppState)
import Gargantext.Router (routeHandler, routing) import Gargantext.Router (routeHandler, routing)
import Network.HTTP.Affjax (AJAX)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import React as R import React as R
import ReactDOM as RDOM import ReactDOM as RDOM
import Routing (matches) import Record.Unsafe (unsafeSet)
import Routing.Hash (getHash, setHash) import Routing.Hash (getHash, matches, setHash)
import Thermite as T 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 main = do
case T.createReactSpec layoutSpec initAppState of case T.createReactSpec layoutSpec initAppState of
{ spec, dispatcher } -> void $ do { spec, dispatcher } -> void $ do
let setRouting this = void $ do let setRouting this = void $ do
matches routing (routeHandler (dispatchAction (dispatcher this))) matches routing (routeHandler (dispatchAction (dispatcher this)))
spec' = spec { componentWillMount = setRouting } spec' this = setUnsafeComponentWillMount (setRouting this) <$> (spec this)
document <- DOM.window >>= DOM.document document <- window >>= document
container <- unsafePartial (fromJust <$> DOM.querySelector (QuerySelector "#app") (DOM.htmlDocumentToParentNode document)) container <- unsafePartial (fromJust <$> querySelector (QuerySelector "#app") (toParentNode document))
h <- getHash h <- getHash
case h of case h of
"" -> setHash "/" "" -> setHash "/"
_ -> do _ -> do
setHash "/" setHash "/"
setHash h 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 module Test.Main where
import Prelude import Prelude
import Control.Monad.Eff (Eff) --import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log) --import Control.Monad.Eff.Console (CONSOLE, log)
main :: forall e. Eff (console :: CONSOLE | e) Unit --main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do --main = do
log "You should add some tests." -- 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