Commit c7304e4d authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[purty] purty-fied the whole src tree

Also, added 'yarn purty-format' command.
parent e2a6b681
......@@ -8,7 +8,8 @@
"sass": "sass dist/styles/",
"dev": "webpack-dev-server --env dev --mode development",
"repl": "pulp --psc-package repl",
"clean": "rm -Rf output"
"clean": "rm -Rf output",
"purty-format": "find src -iname '*.purs' -exec yarn run purty {} --write \\;"
},
"dependencies": {
"@babel/polyfill": "^7.0.0",
......@@ -17,8 +18,10 @@
"echarts": "^4.1.0",
"echarts-for-react": "^2.0.14",
"prop-types": "15.6.2",
"purty": "^4.5.1",
"react": "^16.10",
"react-dom": "^16.10",
"sass": "^1.22.9",
"sigma": "git://github.com/jjl/sigma.js#garg"
},
"eslintConfig": {
......
module Gargantext.BootstrapNative where
import Effect (Effect)
import Gargantext.Prelude
foreign import createDropdown :: String -> Effect Unit
......@@ -12,61 +12,64 @@
module Gargantext.Components.Annotation.AnnotatedField where
import Prelude
import Data.Maybe ( Maybe(..), maybe )
import Data.Tuple ( Tuple(..) )
import Data.Tuple.Nested ( (/\) )
import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import DOM.Simple.Event as DE
import Effect ( Effect )
import Effect.Uncurried ( mkEffectFn1 )
import Effect (Effect)
import Effect.Uncurried (mkEffectFn1)
import Reactix as R
import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E
import Gargantext.Types (CTabNgramType(..), TermList)
import Gargantext.Components.Annotation.Utils ( termBootstrapClass )
import Gargantext.Components.Annotation.Utils (termBootstrapClass)
import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams)
import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, MenuType(..) )
import Gargantext.Components.Annotation.Menu (AnnotationMenu, annotationMenu, MenuType(..))
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Selection as Sel
type Props =
( ngrams :: NgramsTable
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
, text :: Maybe String
)
type MouseEvent = E.SyntheticEvent DE.MouseEvent
type Props
= ( ngrams :: NgramsTable
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
, text :: Maybe String
)
type MouseEvent
= E.SyntheticEvent DE.MouseEvent
-- UNUSED
-- defaultProps :: Record Props
-- defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing, setTermList: \_ _ _ -> pure unit }
annotatedField :: Record Props -> R.Element
annotatedField p = R.createElement annotatedFieldComponent p []
annotatedFieldComponent :: R.Component Props
annotatedFieldComponent = R.hooksComponent "AnnotatedField" cpt
where
cpt {ngrams,setTermList,text} _ = do
menu /\ setMenu <- R.useState $ const Nothing
let wrapperProps =
{ className: "annotated-field-wrapper" }
cpt { ngrams, setTermList, text } _ = do
menu /\ setMenu <- R.useState $ const Nothing
let
wrapperProps = { className: "annotated-field-wrapper" }
onSelect _ Nothing event = maybeShowMenu setMenu setTermList ngrams event
onSelect _ Nothing event = maybeShowMenu setMenu setTermList ngrams event
onSelect text' (Just list) event = do
let x = E.clientX event
y = E.clientY event
setList t = do
setTermList text' (Just list) t
setMenu (const Nothing)
setMenu (const $ Just {x, y, list: Just list, menuType: SetTermListItem, setList} )
onSelect text' (Just list) event = do
let
x = E.clientX event
mapCompile (Tuple t l) = {text: t, list: l, onSelect}
compiled = map mapCompile $ compile ngrams text
y = E.clientY event
runs =
HTML.div { className: "annotated-field-runs" } $ map annotateRun compiled
pure $ HTML.div wrapperProps [maybeAddMenu setMenu runs menu]
setList t = do
setTermList text' (Just list) t
setMenu (const Nothing)
setMenu (const $ Just { x, y, list: Just list, menuType: SetTermListItem, setList })
mapCompile (Tuple t l) = { text: t, list: l, onSelect }
compiled = map mapCompile $ compile ngrams text
runs = HTML.div { className: "annotated-field-runs" } $ map annotateRun compiled
pure $ HTML.div wrapperProps [ maybeAddMenu setMenu runs menu ]
-- forall e. IsMouseEvent e => R2.Setter (Maybe AnnotationMenu) -> R2.Setter ? -> ? -> e -> Effect Unit
maybeShowMenu setMenu setTermList ngrams event = do
......@@ -76,34 +79,38 @@ maybeShowMenu setMenu setTermList ngrams event = do
case Sel.selectionToString sel of
"" -> pure unit
sel' -> do
let x = E.clientX event
y = E.clientY event
list = findNgramTermList CTabTerms ngrams sel'
setList t = do
setTermList sel' list t
setMenu (const Nothing)
let
x = E.clientX event
y = E.clientY event
list = findNgramTermList CTabTerms ngrams sel'
setList t = do
setTermList sel' list t
setMenu (const Nothing)
E.preventDefault event
setMenu (const $ Just { x, y, list, menuType: NewNgram, setList })
Nothing -> pure unit
maybeAddMenu
:: R2.Setter (Maybe AnnotationMenu)
-> R.Element
-> Maybe AnnotationMenu
-> R.Element
maybeAddMenu ::
R2.Setter (Maybe AnnotationMenu) ->
R.Element ->
Maybe AnnotationMenu ->
R.Element
maybeAddMenu setMenu e (Just props) = annotationMenu setMenu props <> e
maybeAddMenu _ e _ = e
compile :: NgramsTable -> Maybe String -> Array (Tuple String (Maybe TermList))
compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
-- Runs
type Run =
( text :: String
, list :: (Maybe TermList)
, onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit
)
type Run
= ( text :: String
, list :: (Maybe TermList)
, onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit
)
annotateRun :: Record Run -> R.Element
annotateRun p = R.createElement annotatedRunComponent p []
......@@ -111,13 +118,13 @@ annotateRun p = R.createElement annotatedRunComponent p []
annotatedRunComponent :: R.Component Run
annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt
where
cpt { text, list: Nothing, onSelect } _ =
HTML.span { onMouseUp: mkEffectFn1 $ \e -> onSelect text Nothing e } [ HTML.text text ]
cpt { text, list: (Just list), onSelect } _ =
HTML.span { className: className list
, onClick: mkEffectFn1 $ \e -> onSelect text (Just list) e} [ HTML.text text ]
where
className list' = "annotation-run bg-" <> termBootstrapClass list'
cpt { text, list: Nothing, onSelect } _ = HTML.span { onMouseUp: mkEffectFn1 $ \e -> onSelect text Nothing e } [ HTML.text text ]
cpt { text, list: (Just list), onSelect } _ =
HTML.span
{ className: className list
, onClick: mkEffectFn1 $ \e -> onSelect text (Just list) e
}
[ HTML.text text ]
where
className list' = "annotation-run bg-" <> termBootstrapClass list'
-- | A ContextMenU that allows you to add terms to a list
module Gargantext.Components.Annotation.Menu where
import Prelude (Unit, pure, ($), (<>), (==))
import Data.Array as A
import Data.Maybe (Maybe(..))
......@@ -9,45 +8,52 @@ import Effect (Effect)
import Effect.Uncurried (mkEffectFn1)
import Reactix as R
import Reactix.DOM.HTML as HTML
import Gargantext.Types (TermList(..), termListName)
import Gargantext.Components.Annotation.Utils (termBootstrapClass)
import Gargantext.Components.ContextMenu.ContextMenu as CM
import Gargantext.Utils.Reactix as R2
data MenuType = NewNgram | SetTermListItem
data MenuType
= NewNgram
| SetTermListItem
type Props =
( list :: Maybe TermList
, menuType :: MenuType
, setList :: TermList -> Effect Unit -- not a state hook setter
)
type Props
= ( list :: Maybe TermList
, menuType :: MenuType
, setList :: TermList -> Effect Unit -- not a state hook setter
)
type AnnotationMenu = { x :: Number, y :: Number | Props }
type AnnotationMenu
= { x :: Number, y :: Number | Props }
-- | An Annotation Menu is parameterised by a Maybe Termlist of the
-- | TermList the currently selected text belongs to
annotationMenu :: R2.Setter (Maybe AnnotationMenu) -> AnnotationMenu -> R.Element
annotationMenu setMenu { x,y,list,menuType,setList } =
CM.contextMenu { x,y,setMenu } [
R.createElement annotationMenuCpt {list,menuType,setList} []
]
annotationMenu setMenu { x, y, list, menuType, setList } =
CM.contextMenu { x, y, setMenu }
[ R.createElement annotationMenuCpt { list, menuType, setList } []
]
annotationMenuCpt :: R.Component Props
annotationMenuCpt = R.hooksComponent "Annotation.Menu" cpt
where
cpt props _ = pure $ R.fragment $ children props
children props = A.mapMaybe (addToList props) [ GraphTerm, CandidateTerm, StopTerm ]
cpt props _ = pure $ R.fragment $ children props
children props = A.mapMaybe (addToList props) [ GraphTerm, CandidateTerm, StopTerm ]
-- | Given the TermList to render the item for zand the Maybe TermList the item may belong to, possibly render the menuItem
addToList :: Record Props -> TermList -> Maybe R.Element
addToList {list: Just t'} t
| t == t' = Nothing
addToList {menuType, setList} t = Just $ CM.contextMenuItem [ link ]
addToList { list: Just t' } t
| t == t' = Nothing
addToList { menuType, setList } t = Just $ CM.contextMenuItem [ link ]
where
link = HTML.a { onClick: click, className: className } [ HTML.text (label menuType) ]
label NewNgram = "Add to " <> termListName t
label SetTermListItem = "Change to " <> termListName t
className = "list-group-item list-group-item-" <> (termBootstrapClass t)
click = mkEffectFn1 $ \_ -> setList t
link = HTML.a { onClick: click, className: className } [ HTML.text (label menuType) ]
label NewNgram = "Add to " <> termListName t
label SetTermListItem = "Change to " <> termListName t
className = "list-group-item list-group-item-" <> (termBootstrapClass t)
click = mkEffectFn1 $ \_ -> setList t
module Gargantext.Components.Annotation.Utils where
import Gargantext.Types ( TermList(..) )
import Gargantext.Types (TermList(..))
termClass :: TermList -> String
termClass GraphTerm = "graph-term"
termClass StopTerm = "stop-term"
termClass CandidateTerm = "candidate-term"
termBootstrapClass :: TermList -> String
termBootstrapClass GraphTerm = "success"
termBootstrapClass StopTerm = "danger"
termBootstrapClass CandidateTerm = "warning"
This diff is collapsed.
......@@ -9,31 +9,38 @@ import Gargantext.Prelude
import Effect (Effect)
import Effect.Timer (IntervalId, setInterval, clearInterval)
data Action = Update
data Action
= Update
type PropsRow =
( duration :: Int
, effect :: Effect Unit
)
type PropsRow
= ( duration :: Int
, effect :: Effect Unit
)
type Props = { | PropsRow }
type Props
= { | PropsRow }
type State = { intervalId :: Maybe IntervalId }
type State
= { intervalId :: Maybe IntervalId }
autoUpdateClass :: ReactClass { children :: Children | PropsRow }
autoUpdateClass =
React.component "AutoUpdate"
(\this -> do
pure { state: {intervalId: Nothing}
, render: pure $ div' []
, componentDidMount: do
{duration,effect} <- React.getProps this
intervalId <- setInterval duration effect
React.setState this {intervalId: Just intervalId}
, componentWillUnmount: do
{intervalId} <- React.getState this
traverse_ clearInterval intervalId
})
( \this -> do
pure
{ state: { intervalId: Nothing }
, render: pure $ div' []
, componentDidMount:
do
{ duration, effect } <- React.getProps this
intervalId <- setInterval duration effect
React.setState this { intervalId: Just intervalId }
, componentWillUnmount:
do
{ intervalId } <- React.getState this
traverse_ clearInterval intervalId
}
)
autoUpdateElt :: Props -> ReactElement
autoUpdateElt props = React.createElement autoUpdateClass props []
module Gargantext.Components.Charts.Options.Color
( Color
, stringColor
, cssColor
, transparent
, red
, blue
, magenta
, violet
, black
, grey
, green
) where
( Color
, stringColor
, cssColor
, transparent
, red
, blue
, magenta
, violet
, black
, grey
, green
) where
import Prelude
import CSS as CSS
import Color (rgba)
import Unsafe.Coerce (unsafeCoerce)
......@@ -34,8 +33,8 @@ red = stringColor "red"
blue :: Color
blue = cssColor $ rgba 100 150 200 0.0
-- stringColor "blue"
-- stringColor "blue"
magenta :: Color
magenta = stringColor "magenta"
......
......@@ -5,43 +5,48 @@ import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Types (class Optional)
import Gargantext.Components.Charts.Options.Font (TextStyle, Icon, ItemStyle)
type DataLegend =
{ name :: String
, icon :: Icon
, textStyle :: TextStyle
}
type DataLegend
= { name :: String
, icon :: Icon
, textStyle :: TextStyle
}
type DataAxis
= Array String
type DataAxis = Array String
{- value :: String
{- value :: String
, textStyle :: TextStyle
-}
type RequiredData v o =
{ value :: v
| o
}
type OptionalData =
( name :: String
, symbolSize :: Number
, itemStyle :: ItemStyle
type RequiredData v o
= { value :: v
| o
}
type OptionalData
= ( name :: String
, symbolSize :: Number
, itemStyle :: ItemStyle
-- ^ the style setting about single data point(bubble).
, label :: { show :: Boolean }
)
, label :: { show :: Boolean }
)
type DataSerie v = RequiredData v OptionalData
type DataSerie v
= RequiredData v OptionalData
dataSerie :: forall v o. Optional o OptionalData => RequiredData v o -> DataSerie v
dataSerie = unsafeCoerce
dataSerieV :: forall v. v -> DataSerie v
dataSerieV value = dataSerie {value}
dataSerieV value = dataSerie { value }
type DataD1
= DataSerie Number
type DataD1 = DataSerie Number
type DataD2 = DataSerie (Array Number)
type DataD2
= DataSerie (Array Number)
dataD1 :: forall o. Optional o OptionalData => Record o -> Number -> DataD1
dataD1 o x = unsafeCoerce (unsafeSet "value" x o)
dataD2 :: forall o. Optional o OptionalData => Record o -> Number -> Number -> DataD2
dataD2 o x y = unsafeCoerce (unsafeSet "value" [x,y] o)
dataD2 o x y = unsafeCoerce (unsafeSet "value" [ x, y ] o)
module Gargantext.Components.Charts.Options.ECharts where
import Prelude
import CSS (italic)
import CSS.Common (normal)
import Gargantext.Components.Charts.Options.Color (transparent, violet, black)
......@@ -24,189 +23,201 @@ chart = echarts <<< chartWith <<< opts
chartWith :: Option -> Echarts
chartWith option =
{ option
--, className : Nothing
--, style : Nothing
--, theme : Nothing
--, group : Nothing
--, initOpts : Nothing
--, notMerge : Nothing
--, lazyUpdate: Nothing
--, loading : Nothing
--, optsLoading: Nothing
--, onReady : Nothing
--, resizable : Nothing
--, onEvents : Nothing
--, className : Nothing
--, style : Nothing
--, theme : Nothing
--, group : Nothing
--, initOpts : Nothing
--, notMerge : Nothing
--, lazyUpdate: Nothing
--, loading : Nothing
--, optsLoading: Nothing
--, onReady : Nothing
--, resizable : Nothing
--, onEvents : Nothing
}
echarts :: Echarts -> R.Element
echarts c = R2.buff $ unsafeCreateElementDynamic (unsafeCoerce eChartsClass) c []
type MainTitle = String
type SubTitle = String
type MainTitle
= String
type SubTitle
= String
title :: MainTitle -> SubTitle -> Title
title mainTitle subTitle =
{
id: ""
,show: true
,text: mainTitle
,link: ""
,target: "blank"
,textStyle: textStyle
,subtext: subTitle
,sublink: ""
,subtarget: "blank"
,subtextStyle: textStyle2
,padding: 10.0
,itemGap: 0.0
,zlevel: 2.0
,z: 2.0
,left: relativePosition (Relative RightPos)
,top: relativePosition (Relative Top)
,right: numberPosition 60.0
,bottom: percentPosition 40.0
,backgroundColor: transparent
,borderColor: transparent
,borderWidth: 0.0
,borderRadius: 0.0
,shadowBlur: 0.0
,shadowColor: transparent
,shadowOffsetX: 0.0
,shadowOffsetY: 0.0
{ id: ""
, show: true
, text: mainTitle
, link: ""
, target: "blank"
, textStyle: textStyle
, subtext: subTitle
, sublink: ""
, subtarget: "blank"
, subtextStyle: textStyle2
, padding: 10.0
, itemGap: 0.0
, zlevel: 2.0
, z: 2.0
, left: relativePosition (Relative RightPos)
, top: relativePosition (Relative Top)
, right: numberPosition 60.0
, bottom: percentPosition 40.0
, backgroundColor: transparent
, borderColor: transparent
, borderWidth: 0.0
, borderRadius: 0.0
, shadowBlur: 0.0
, shadowColor: transparent
, shadowOffsetX: 0.0
, shadowOffsetY: 0.0
}
legend :: Legend
legend =
{
id: "Muda"
,"type": legendType Plain
, show: true
, zlevel: 0.0
, z: 2.0
, left: relativePosition Auto
, top: relativePosition Auto
, right: relativePosition Auto
, bottom: relativePosition Auto
, width: relativePosition Auto
, height: relativePosition Auto
, orient: orient Horizontal
, align: relativePosition Auto
, padding: 5.0
, itemGap: 10.0
, itemWidth: 25.0
, itemHeight: 14.0
--, formatter: Nothing
, selectedMode: selectedMode $ Bool true
, inactiveColor: violet
--- selected: Nothing
, textStyle: textStyle
, "data": [data1]
{ id: "Muda"
, "type": legendType Plain
, show: true
, zlevel: 0.0
, z: 2.0
, left: relativePosition Auto
, top: relativePosition Auto
, right: relativePosition Auto
, bottom: relativePosition Auto
, width: relativePosition Auto
, height: relativePosition Auto
, orient: orient Horizontal
, align: relativePosition Auto
, padding: 5.0
, itemGap: 10.0
, itemWidth: 25.0
, itemHeight: 14.0
--, formatter: Nothing
, selectedMode: selectedMode $ Bool true
, inactiveColor: violet
--- selected: Nothing
, textStyle: textStyle
, "data": [ data1 ]
}
data1 :: DataLegend
data1 = {name: "Map terms coverage", icon: icon $ Shape Circle, textStyle: textStyle'}
data1 = { name: "Map terms coverage", icon: icon $ Shape Circle, textStyle: textStyle' }
data2 :: DataLegend
data2 = {name: "Favorites", icon: icon $ Shape Circle, textStyle: textStyle'}
data2 = { name: "Favorites", icon: icon $ Shape Circle, textStyle: textStyle' }
data3 :: DataLegend
data3 = {name: "Test", icon: icon $ Shape Diamond, textStyle: textStyle'}
data3 = { name: "Test", icon: icon $ Shape Diamond, textStyle: textStyle' }
yAxisVoid :: YAxis
yAxisVoid = yAxis
{ "type": ""
, name: ""
, min: 0
, position: ""
, axisLabel: {formatter: ""}
, show: false
}
yAxisVoid =
yAxis
{ "type": ""
, name: ""
, min: 0
, position: ""
, axisLabel: { formatter: "" }
, show: false
}
xAxis' :: Array String -> XAxis
xAxis' [] = unsafeCoerce {show:false}
xAxis' xs = xAxis
{ "data": xs
, "type": "category"
, axisTick: {alignWithLabel: true}
, show: true
, axisLabel: {formatter: "{value}"}
}
xAxis' [] = unsafeCoerce { show: false }
xAxis' xs =
xAxis
{ "data": xs
, "type": "category"
, axisTick: { alignWithLabel: true }
, show: true
, axisLabel: { formatter: "{value}" }
}
-- TODO try to use Optional
yAxis' :: { position :: String
, show :: Boolean
, min :: Int
} -> YAxis
yAxis' {position, show, min} = yAxis
{ "type": "value"
, name: ""
, min: min
, axisLabel: {formatter: "{value}"}
, position
, show
}
yAxis' ::
{ position :: String
, show :: Boolean
, min :: Int
} ->
YAxis
yAxis' { position, show, min } =
yAxis
{ "type": "value"
, name: ""
, min: min
, axisLabel: { formatter: "{value}" }
, position
, show
}
data Options = Options
{ mainTitle :: MainTitle
, subTitle :: SubTitle
, xAxis :: XAxis
, yAxis :: YAxis
, series :: Array Series
, addZoom :: Boolean
, tooltip :: Tooltip
}
data Options
= Options
{ mainTitle :: MainTitle
, subTitle :: SubTitle
, xAxis :: XAxis
, yAxis :: YAxis
, series :: Array Series
, addZoom :: Boolean
, tooltip :: Tooltip
}
tooltipTriggerAxis :: Tooltip
tooltipTriggerAxis = mkTooltip { trigger: "axis"}
tooltipTriggerAxis = mkTooltip { trigger: "axis" }
opts :: Options -> Option
opts (Options { mainTitle
, subTitle
, xAxis
, yAxis
, series
, tooltip
, addZoom
}) =
opts ( Options
{ mainTitle
, subTitle
, xAxis
, yAxis
, series
, tooltip
, addZoom
}
) =
{ title: title mainTitle subTitle
, legend
, tooltip
, grid: {containLabel: true}
, grid: { containLabel: true }
, series
, xAxis
, yAxis
, dataZoom: if addZoom then [zoom Slider, zoom Inside] else []
, children : unsafeCoerce [] -- TODO
, dataZoom: if addZoom then [ zoom Slider, zoom Inside ] else []
, children: unsafeCoerce [] -- TODO
, toolbox: mkToolBox
}
data Zoom = Slider | Inside
data Zoom
= Slider
| Inside
instance showZoom :: Show Zoom where
show Slider = "slider"
show Inside = "inside"
zoom :: Zoom -> DataZoom
zoom z = {
"type": show z
,xAxisIndex: 0
,filterMode: "empty"
,start: 0
,end: 100
zoom z =
{ "type": show z
, xAxisIndex: 0
, filterMode: "empty"
, start: 0
, end: 100
}
seriesPie :: Series
seriesPie = seriesPieD1
{ name: "Pie name" }
(dataSerie <$> [ {name: "t1", value: 50.0}
, {name: "t2", value: 45.0}
, {name: "t3", value: 65.0}
, {name: "t4", value: 15.0}
, {name: "t5", value: 23.0}
])
seriesPie =
seriesPieD1
{ name: "Pie name" }
( dataSerie
<$> [ { name: "t1", value: 50.0 }
, { name: "t2", value: 45.0 }
, { name: "t3", value: 65.0 }
, { name: "t4", value: 15.0 }
, { name: "t5", value: 23.0 }
]
)
textStyle2 :: TextStyle
textStyle2 =
......
......@@ -28,7 +28,6 @@ module Gargantext.Components.Charts.Options.Font
) where
import Prelude (Unit, ($), (<<<), (<>))
import Data.Generic.Rep
import Data.Generic.Rep.Show (genericShow)
import CSS (FontStyle(..), FontWeight(..), Prefixed(..), Value(..))
......@@ -38,63 +37,78 @@ import Gargantext.Components.Charts.Options.Position (LeftRelativePosition, Posi
import Gargantext.Types (class Optional)
import Unsafe.Coerce (unsafeCoerce)
type TextStyle =
{ color :: Color
, fontStyle :: ChartFontStyle
, fontWeight :: ChartFontWeight
, fontFamily :: String
, fontSize :: Int
, align :: Position LeftRelativePosition
, verticalAlign :: Position TopRelativePosition
, lineHeight :: Position Unit
, width :: Position Unit
, height :: Position Unit
, textBorderColor :: Color
, textBorderWidth :: Number
, textShadowColor :: Color
, textShadowBlur :: Color
, textShadowOffsetX :: Number
, textShadowOffsetY :: Number
}
newtype ChartFontStyle = ChartFontStyle String
type TextStyle
= { color :: Color
, fontStyle :: ChartFontStyle
, fontWeight :: ChartFontWeight
, fontFamily :: String
, fontSize :: Int
, align :: Position LeftRelativePosition
, verticalAlign :: Position TopRelativePosition
, lineHeight :: Position Unit
, width :: Position Unit
, height :: Position Unit
, textBorderColor :: Color
, textBorderWidth :: Number
, textShadowColor :: Color
, textShadowBlur :: Color
, textShadowOffsetX :: Number
, textShadowOffsetY :: Number
}
newtype ChartFontStyle
= ChartFontStyle String
chartFontStyle :: FontStyle -> ChartFontStyle
chartFontStyle (FontStyle (Value (Plain "italic"))) = ChartFontStyle "italic"
chartFontStyle (FontStyle (Value (Plain "oblique"))) = ChartFontStyle "oblique"
chartFontStyle _ = ChartFontStyle "normal"
chartFontStyle _ = ChartFontStyle "normal"
newtype ChartFontWeight = ChartFontWeight String
newtype ChartFontWeight
= ChartFontWeight String
chartFontWeight :: FontWeight -> ChartFontWeight
chartFontWeight (FontWeight (Value (Plain "bold"))) = ChartFontWeight "bold"
chartFontWeight (FontWeight (Value (Plain "bolder"))) = ChartFontWeight "bolder"
chartFontWeight (FontWeight (Value (Plain "lighter"))) = ChartFontWeight "lighter"
chartFontWeight _ = ChartFontWeight "normal"
chartFontWeight _ = ChartFontWeight "normal"
newtype Icon
= Icon String
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 _
data IconOptions = Shape Shape | Image ImageURL
data IconOptions
= Shape Shape
| Image ImageURL
icon :: IconOptions -> Icon
icon (Shape s) = Icon <<< toLower $ genericShow s
icon (Image (ImageURL url)) = Icon $ "image://" <> url
icon (Image (ImageURL url)) = Icon $ "image://" <> url
data ItemStyle
type ItemStyleOptional =
( color :: Color
)
type ItemStyleOptional
= ( color :: Color
)
itemStyle :: forall o. Optional o ItemStyleOptional => Record o -> ItemStyle
itemStyle = unsafeCoerce
......@@ -105,63 +119,73 @@ templateFormatter :: String -> Formatter
templateFormatter = unsafeCoerce
-- TODO callbackFormatter :: (...) -> Formatter
data Tooltip
type TooltipOptional =
( trigger :: String
type TooltipOptional
= ( trigger :: String
-- ^ Not all tooltips support triggers.
-- Grid and legend tooltips : yes
-- Series : no
, show :: Boolean
, formatter :: Formatter
)
, show :: Boolean
, formatter :: Formatter
)
-----------------------------------------------------------------
-- | ToolBox
mkToolBox :: ToolBox
mkToolBox = { feature: { dataView : { show: true, readOnly : false, title : "Data"}
, saveAsImage : { show : true, pixelRatio : 10, title : "Image"}
--, magicType : { show : true, "type" : ["line", "bar", "pie", "stack", "tiled"], title : "Type"}
--, restore : {show : true, title : "Restore"}
--, brush : {"type" : ["rect", "polygon", "lineX", "lineY", "keep", "clear"]}
}
, orient : "vertical"
}
mkToolBox =
{ feature:
{ dataView: { show: true, readOnly: false, title: "Data" }
, saveAsImage: { show: true, pixelRatio: 10, title: "Image" }
--, magicType : { show : true, "type" : ["line", "bar", "pie", "stack", "tiled"], title : "Type"}
--, restore : {show : true, title : "Restore"}
--, brush : {"type" : ["rect", "polygon", "lineX", "lineY", "keep", "clear"]}
}
, orient: "vertical"
}
---------------------------------------
type ToolBox = { feature :: Feature
, orient :: String}
type Feature = { dataView :: DataView
, saveAsImage :: Save
--, magicType :: MagicType
--, restore :: Restore
--, brush :: Brush
}
type ToolBox
= { feature :: Feature
, orient :: String
}
type Feature
= { dataView :: DataView
, saveAsImage :: Save
--, magicType :: MagicType
--, restore :: Restore
--, brush :: Brush
}
---------------------------------------
type Save = { show :: Boolean
, pixelRatio :: Int
, title :: String
}
type Restore = { show :: Boolean
, title :: String}
type MagicType = { show :: Boolean
, "type" :: Array String -- TODO use line bar types
, title :: String
}
type Save
= { show :: Boolean
, pixelRatio :: Int
, title :: String
}
type Restore
= { show :: Boolean
, title :: String
}
type MagicType
= { show :: Boolean
, "type" :: Array String -- TODO use line bar types
, title :: String
}
---------------------------------------
type DataView
= { show :: Boolean
, readOnly :: Boolean
, title :: String
}
type DataView = { show :: Boolean
, readOnly :: Boolean
, title :: String
}
type Brush
= { "type" :: Array String }
type Brush = { "type" :: Array String }
---------------------------------------
mkTooltip :: forall o. Optional o TooltipOptional => Record o -> Tooltip
mkTooltip = unsafeCoerce
module Gargantext.Components.Charts.Options.Legend
(
LegendType(..),
PlainOrScroll(..),
legendType,
Orient(),
Orientation(..),
orient,
SelectedMode(),
LegendMode(..),
selectedMode
) where
( LegendType(..)
, PlainOrScroll(..)
, legendType
, Orient()
, Orientation(..)
, orient
, SelectedMode()
, LegendMode(..)
, selectedMode
) where
import Prelude (class Show, show, (<<<))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show
import Data.String (toLower)
import Unsafe.Coerce (unsafeCoerce)
newtype LegendType = LegendType String
newtype LegendType
= LegendType String
data PlainOrScroll
= Plain
| Scroll
data PlainOrScroll = Plain | Scroll
instance showPlainOrScroll :: Show PlainOrScroll where
show (Plain) = "plain"
show (Scroll) = "scroll"
......@@ -28,22 +30,30 @@ instance showPlainOrScroll :: Show PlainOrScroll where
legendType :: PlainOrScroll -> LegendType
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 _
orient :: Orientation -> Orient
orient = Orient <<< toLower <<< genericShow
foreign import data SelectedMode :: Type
data LegendMode = Bool Boolean | Single | Multiple
data LegendMode
= Bool Boolean
| Single
| Multiple
derive instance genericLegendMode :: Generic LegendMode _
selectedMode :: LegendMode -> SelectedMode
selectedMode (Bool b) = unsafeCoerce b
selectedMode (Single) = unsafeCoerce "single"
selectedMode (Multiple) = unsafeCoerce "multiple"
module Gargantext.Components.Charts.Options.Position
(
Position(),
numberPosition,
percentPosition,
relativePosition,
Align(..),
TopRelativePosition(..),
LeftRelativePosition(..)
) where
( Position()
, numberPosition
, percentPosition
, relativePosition
, Align(..)
, TopRelativePosition(..)
, LeftRelativePosition(..)
) where
import Prelude
import Unsafe.Coerce (unsafeCoerce)
-- | The type `Position` is made to render a css position.
......@@ -29,18 +27,29 @@ percentPosition n = unsafeCoerce $ (show n) <> "%"
-- | Smart constructor to build a JS String giving position's detail ("top", "left", ...)
relativePosition :: forall a. Show a => Align a -> Position a
relativePosition (Auto) = unsafeCoerce "auto"
relativePosition (Relative r) = unsafeCoerce $ show r
data Align p = Auto | Relative p
data TopRelativePosition = Top | Middle | Bottom
instance showTopRelativePosition :: Show TopRelativePosition
where show (Top) = "top"
show (Middle) = "middle"
show (Bottom) = "bottom"
relativePosition (Relative r) = unsafeCoerce $ show r
data LeftRelativePosition = LeftPos | Center | RightPos
instance showLeftRelativePosition :: Show LeftRelativePosition
where show (LeftPos) = "left"
show (Center) = "center"
show (RightPos) = "right"
data Align p
= Auto
| Relative p
data TopRelativePosition
= Top
| Middle
| Bottom
instance showTopRelativePosition :: Show TopRelativePosition where
show (Top) = "top"
show (Middle) = "middle"
show (Bottom) = "bottom"
data LeftRelativePosition
= LeftPos
| Center
| RightPos
instance showLeftRelativePosition :: Show LeftRelativePosition where
show (LeftPos) = "left"
show (Center) = "center"
show (RightPos) = "right"
......@@ -10,69 +10,71 @@ import Gargantext.Types (class Optional)
import Gargantext.Components.Charts.Options.Font (ItemStyle, Tooltip)
import Gargantext.Components.Charts.Options.Data (DataD1, DataD2)
newtype SeriesType = SeriesType String
type SeriesName = String
data Chart = Line
| Bar | PictorialBar
| Pie
| Scatter | EffectScatter
| Radar
| Trees
| Sunburst
| Boxplot
| Candlestick
| Heatmap
| Map
| Parallel
| Lines
| Graph
| Sankey
| Funnel
| Gauge
| ThemeRiver
-- Trees
newtype SeriesType
= SeriesType String
type SeriesName
= String
data Chart
= Line
| Bar
| PictorialBar
| Pie
| Scatter
| EffectScatter
| Radar
| Trees
| Sunburst
| Boxplot
| Candlestick
| Heatmap
| Map
| Parallel
| Lines
| Graph
| Sankey
| Funnel
| Gauge
| ThemeRiver
-- Trees
instance showChart :: Show Chart where
show Bar = "bar"
show Bar = "bar"
show EffectScatter = "effectScatter" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter-effect
show Funnel = "funnel"
show Heatmap = "heatmap"
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 Funnel = "funnel"
show Heatmap = "heatmap"
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"
show _ = "not implemented yet: should throw error here"
seriesType :: Chart -> SeriesType
seriesType = SeriesType <<< show
-- | Scatter Dimension 2 data
type OptionalSeries =
( name :: String
, symbolSize :: Number
, itemStyle :: ItemStyle
type OptionalSeries
= ( name :: String
, symbolSize :: Number
, itemStyle :: ItemStyle
-- ^ Graphic style of, *emphasis* is the style when it is highlighted, like being hovered by mouse, or highlighted via legend connect.
-- https://ecomfe.github.io/echarts-doc/public/en/option.html#series-scatter.itemStyle
, tooltip :: Tooltip
-- many more...
)
, tooltip :: Tooltip
-- many more...
)
data Series
unsafeSeries :: forall o. Record o -> Series
unsafeSeries = unsafeCoerce
type RequiredSeriesD1 o =
{ "type" :: SeriesType
, "data" :: Array DataD1
| o
}
type RequiredSeriesD1 o
= { "type" :: SeriesType
, "data" :: Array DataD1
| o
}
seriesD1 :: forall o. Optional o OptionalSeries => RequiredSeriesD1 o -> Series
seriesD1 = unsafeSeries
......@@ -86,36 +88,38 @@ seriesBarD1 o ds = unsafeSeries (unsafeSet "data" ds (unsafeSet "type" (seriesTy
seriesPieD1 :: forall o. Optional o OptionalSeries => Record o -> Array DataD1 -> Series
seriesPieD1 o ds = unsafeSeries (unsafeSet "data" ds (unsafeSet "type" (seriesType Pie) o))
type RequiredSeriesD2 o =
{ "data" :: Array DataD2
, "type" :: SeriesType
| o
}
type RequiredSeriesD2 o
= { "data" :: Array DataD2
, "type" :: SeriesType
| o
}
seriesD2 :: forall o. Optional o OptionalSeries => RequiredSeriesD2 o -> Series
seriesD2 = unsafeSeries
seriesScatterD2 :: forall o. Optional o OptionalSeries => Record o -> Array DataD2 -> Series
seriesScatterD2 o ds =
unsafeCoerce (unsafeSet "data" ds (unsafeSet "type" (seriesType Scatter) o))
seriesScatterD2 o ds = unsafeCoerce (unsafeSet "data" ds (unsafeSet "type" (seriesType Scatter) o))
type Node
= { name :: String }
type Node = { name :: String}
type Link = { source :: String
, target :: String
, value :: Number
}
type Link
= { source :: String
, target :: String
, value :: Number
}
-- | Sankey Chart
-- https://ecomfe.github.io/echarts-examples/public/editor.html?c=sankey-simple
type RequiredSankey o =
{ "data" :: Array Node
, links :: Array Link
| o
}
type RequiredSankey o
= { "data" :: Array Node
, links :: Array Link
| o
}
type OptionalSankey =
( layout :: String
)
type OptionalSankey
= ( layout :: String
)
seriesSankey :: forall o. Optional o OptionalSankey => RequiredSankey o -> Series
seriesSankey o = unsafeSeries ((unsafeCoerce o) { "type" = seriesType Sankey })
......@@ -123,70 +127,72 @@ seriesSankey o = unsafeSeries ((unsafeCoerce o) { "type" = seriesType Sankey })
-- | * 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
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
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 RequiredTree o
= { "type" :: SeriesType
, "data" :: Array TreeNode
| o
}
type RequiredTree o =
{ "type" :: SeriesType
, "data" :: Array TreeNode
| o
}
type OptionalTree =
( layout :: String
)
type OptionalTree
= ( layout :: String
)
seriesTree :: forall o. Optional o OptionalTree => RequiredTree o -> Series
seriesTree = unsafeSeries
mkTree :: Trees -> Array TreeNode -> Series
mkTree t ts = seriesTree { "type" : SeriesType (show t)
, "data" : map (toJsTree Nothing) ts
, layout : layout
}
where
layout = case t of
TreeRadial -> "radial"
_ -> "none"
mkTree t ts =
seriesTree
{ "type": SeriesType (show t)
, "data": map (toJsTree Nothing) ts
, layout: layout
}
where
layout = case t of
TreeRadial -> "radial"
_ -> "none"
-- ** Data Structure of the Trees
data TreeData = Array TreeNode
data TreeData
= Array TreeNode
treeValue :: TreeNode -> Int
treeValue (TreeNode x) = foldl (+) 0 $ [x.value] <> map treeValue x.children
treeValue (TreeNode x) = foldl (+) 0 $ [ x.value ] <> map treeValue x.children
toJsTree :: Maybe String -> TreeNode -> TreeNode
toJsTree maybeSurname (TreeNode x) =
unsafeCoerce { name : name
, value : foldl (+) 0 $ [x.value] <> map treeValue x.children
, children : (map (toJsTree (Just name)) x.children)
}
where
name = maybe "" (\x' -> x' <> ">") maybeSurname <> x.name
data TreeNode = TreeNode { name :: String
, value :: Int
, children :: Array TreeNode
}
unsafeCoerce
{ name: name
, value: foldl (+) 0 $ [ x.value ] <> map treeValue x.children
, children: (map (toJsTree (Just name)) x.children)
}
where
name = maybe "" (\x' -> x' <> ">") maybeSurname <> x.name
data TreeNode
= TreeNode
{ name :: String
, value :: Int
, children :: Array TreeNode
}
instance decodeTreeNode :: DecodeJson TreeNode where
decodeJson json = do
......@@ -194,18 +200,11 @@ instance decodeTreeNode :: DecodeJson TreeNode where
name <- obj .: "label"
value <- obj .: "value"
children <- obj .: "children"
pure $ TreeNode {name, value, children}
pure $ TreeNode { name, value, children }
treeNode :: String -> Int -> Array TreeNode -> TreeNode
treeNode n v ts = TreeNode {name : n, value:v, children:ts}
treeNode n v ts = TreeNode { name: n, value: v, children: ts }
treeLeaf :: String -> Int -> TreeNode
treeLeaf n v = TreeNode { name : n, value : v, children : []}
-- | 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
treeLeaf n v = TreeNode { name: n, value: v, children: [] }
-- | 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
\ No newline at end of file
module Gargantext.Components.Charts.Options.Type where
import Prelude
import Gargantext.Components.Charts.Options.Color (Color)
import Gargantext.Components.Charts.Options.Data (DataLegend)
import Gargantext.Components.Charts.Options.Font (TextStyle, Tooltip, ToolBox)
......@@ -12,151 +11,151 @@ import Gargantext.Types (class Optional)
import React as R
import Unsafe.Coerce (unsafeCoerce)
newtype ChartAlign = ChartAlign String
newtype ChartAlign
= ChartAlign String
-- TODO: Maybe is not working here => use Optional
type Echarts =
{ option :: Option -- PropTypes.object.isRequired,
--, className :: Maybe String
--, style :: Maybe String -- objealect-black-altdarkmincnaquadahherry-blossomect,
--, theme :: Maybe String
--, group :: Maybe String
--, initOpts :: Maybe String -- PropTypes.object,
--, notMerge :: Maybe Boolean
--, lazyUpdate :: Maybe Boolean
--, loading :: Maybe Boolean
--, optsLoading :: Maybe OptsLoading -- PropTypes.object,
--, onReady :: Maybe String -- PropTypes.func,
--, resizable :: Maybe Boolean -- PropTypes.bool,
--, onEvents :: Maybe String -- PropTypes.object
}
type Option =
{ title :: Title
, legend :: Legend
, tooltip :: Tooltip
, grid :: Grid
, xAxis :: XAxis
, yAxis :: YAxis
, series :: Array Series
, dataZoom :: Array DataZoom
, children :: R.Children
, toolbox :: ToolBox
}
type Title =
{ id :: String -- None by default
, show :: Boolean -- default True
, text :: String -- default ''
, link :: String -- default ''
, target :: String -- default 'blank'
, textStyle :: TextStyle
, subtext :: String -- default ''
, sublink :: String -- default ''
, subtarget :: String -- default 'blank'
, subtextStyle :: TextStyle
, padding :: Number -- default '5'
, itemGap :: Number -- default '10'
, zlevel :: Number -- default '0'
, z :: Number -- default '2'
, left :: Position LeftRelativePosition -- default 'auto'
, top :: Position TopRelativePosition -- default 'auto'
, right :: Position Unit -- default 'auto'
, bottom :: Position Unit -- default 'auto'
, backgroundColor :: Color -- default 'transparent''
, borderColor :: Color -- default '#ccc'
, borderWidth :: Number -- default '1'
, borderRadius :: Number -- default 0; data NumberOrArray = Number | Array Number
, shadowBlur :: Number
, shadowColor :: Color
, shadowOffsetX :: Number
, shadowOffsetY :: Number
}
type OptsLoading =
{ text :: String
, color :: Color --- color
, textColor :: Color --color
, maskColor :: Color --color
, zlevel :: Int
}
type DataZoom =
{"type" :: String
, xAxisIndex :: Int
, filterMode :: String
, start :: Int
, end :: Int
}
type Grid =
{containLabel :: Boolean
}
type Legend =
{
id :: String
, "type" :: LegendType
, show :: Boolean
, zlevel :: Number
, z :: Number
, left :: Position LeftRelativePosition -- default 'auto
, top :: Position TopRelativePosition
, right :: Position Unit
, bottom :: Position Unit
, width :: Position Unit
, height :: Position Unit
, orient :: Orient
, align :: Position LeftRelativePosition
, padding :: Number
, itemGap :: Number
, itemWidth :: Number
, itemHeight :: Number
--, formatter :: Maybe String
, selectedMode :: SelectedMode
, inactiveColor :: Color
--, selected :: Maybe String -- object
, textStyle :: TextStyle
, "data" :: Array DataLegend
}
type AxisTick =
{ alignWithLabel :: Boolean
}
type Echarts
= { option :: Option -- PropTypes.object.isRequired,
--, className :: Maybe String
--, style :: Maybe String -- objealect-black-altdarkmincnaquadahherry-blossomect,
--, theme :: Maybe String
--, group :: Maybe String
--, initOpts :: Maybe String -- PropTypes.object,
--, notMerge :: Maybe Boolean
--, lazyUpdate :: Maybe Boolean
--, loading :: Maybe Boolean
--, optsLoading :: Maybe OptsLoading -- PropTypes.object,
--, onReady :: Maybe String -- PropTypes.func,
--, resizable :: Maybe Boolean -- PropTypes.bool,
--, onEvents :: Maybe String -- PropTypes.object
}
type Option
= { title :: Title
, legend :: Legend
, tooltip :: Tooltip
, grid :: Grid
, xAxis :: XAxis
, yAxis :: YAxis
, series :: Array Series
, dataZoom :: Array DataZoom
, children :: R.Children
, toolbox :: ToolBox
}
type Title
= { id :: String -- None by default
, show :: Boolean -- default True
, text :: String -- default ''
, link :: String -- default ''
, target :: String -- default 'blank'
, textStyle :: TextStyle
, subtext :: String -- default ''
, sublink :: String -- default ''
, subtarget :: String -- default 'blank'
, subtextStyle :: TextStyle
, padding :: Number -- default '5'
, itemGap :: Number -- default '10'
, zlevel :: Number -- default '0'
, z :: Number -- default '2'
, left :: Position LeftRelativePosition -- default 'auto'
, top :: Position TopRelativePosition -- default 'auto'
, right :: Position Unit -- default 'auto'
, bottom :: Position Unit -- default 'auto'
, backgroundColor :: Color -- default 'transparent''
, borderColor :: Color -- default '#ccc'
, borderWidth :: Number -- default '1'
, borderRadius :: Number -- default 0; data NumberOrArray = Number | Array Number
, shadowBlur :: Number
, shadowColor :: Color
, shadowOffsetX :: Number
, shadowOffsetY :: Number
}
type OptsLoading
= { text :: String
, color :: Color --- color
, textColor :: Color --color
, maskColor :: Color --color
, zlevel :: Int
}
type DataZoom
= { "type" :: String
, xAxisIndex :: Int
, filterMode :: String
, start :: Int
, end :: Int
}
type Grid
= { containLabel :: Boolean
}
type Legend
= { id :: String
, "type" :: LegendType
, show :: Boolean
, zlevel :: Number
, z :: Number
, left :: Position LeftRelativePosition -- default 'auto
, top :: Position TopRelativePosition
, right :: Position Unit
, bottom :: Position Unit
, width :: Position Unit
, height :: Position Unit
, orient :: Orient
, align :: Position LeftRelativePosition
, padding :: Number
, itemGap :: Number
, itemWidth :: Number
, itemHeight :: Number
--, formatter :: Maybe String
, selectedMode :: SelectedMode
, inactiveColor :: Color
--, selected :: Maybe String -- object
, textStyle :: TextStyle
, "data" :: Array DataLegend
}
type AxisTick
= { alignWithLabel :: Boolean
}
data XAxis
type XAxisOptional =
( "data" :: Array String -- DataAxis
, "type" :: String
, axisTick :: AxisTick
, name :: String
, min :: Int
, position :: String
, axisLabel :: AxisLabel
, show :: Boolean
)
type XAxisOptional
= ( "data" :: Array String -- DataAxis
, "type" :: String
, axisTick :: AxisTick
, name :: String
, min :: Int
, position :: String
, axisLabel :: AxisLabel
, show :: Boolean
)
xAxis :: forall o. Optional o XAxisOptional => Record o -> XAxis
xAxis = unsafeCoerce
data YAxis
type YAxisOptional =
( "type" :: String
, name :: String
, min :: Int
, position :: String
, axisLabel :: AxisLabel
, show :: Boolean
)
type YAxisOptional
= ( "type" :: String
, name :: String
, min :: Int
, position :: String
, axisLabel :: AxisLabel
, show :: Boolean
)
yAxis :: forall o. Optional o YAxisOptional => Record o -> YAxis
yAxis = unsafeCoerce
type AxisLabel =
{ formatter :: String -- string or function
}
type AxisLabel
= { formatter :: String -- string or function
}
type Rich = {}
type Rich
= {}
-- | The ContextMenu component renders a generic context menu
module Gargantext.Components.ContextMenu.ContextMenu where
-- (MenuProps, Action(..), separator) where
-- (MenuProps, Action(..), separator) where
import Prelude hiding (div)
import Data.Maybe ( Maybe(..) )
import Data.Nullable ( Nullable, null, toMaybe )
import Data.Tuple.Nested ( (/\) )
import Data.Traversable ( traverse_ )
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, null, toMaybe)
import Data.Tuple.Nested ((/\))
import Data.Traversable (traverse_)
import DOM.Simple as DOM
import DOM.Simple.Event as DE
import DOM.Simple.EventListener ( Callback, callback )
import DOM.Simple.EventListener (Callback, callback)
import DOM.Simple.Element as Element
import DOM.Simple.Window ( window )
import DOM.Simple.Document ( document )
import DOM.Simple.Types ( DOMRect )
import DOM.Simple.Window (window)
import DOM.Simple.Document (document)
import DOM.Simple.Types (DOMRect)
import Effect (Effect)
import FFI.Simple ((..))
import Reactix as R
import Reactix.DOM.HTML as HTML
import Gargantext.Utils.Reactix as R2
type Props t = ( x :: Number, y :: Number, setMenu :: R2.Setter (Maybe t) )
type Props t
= ( x :: Number, y :: Number, setMenu :: R2.Setter (Maybe t) )
contextMenu :: forall t. Record (Props t) -> Array R.Element -> R.Element
contextMenu = R.createElement contextMenuCpt
......@@ -29,96 +29,94 @@ contextMenu = R.createElement contextMenuCpt
contextMenuCpt :: forall t. R.Component (Props t)
contextMenuCpt = R.hooksComponent "ContextMenu" cpt
where
cpt menu children = do
host <- R2.getPortalHost
root <- R.useRef null
rect /\ setRect <- R.useState $ \_ -> Nothing
R.useLayoutEffect1 (R.readRef root) $ do
traverse_
(\r -> setRect (\_ -> Just (Element.boundingRect r)))
(toMaybe $ R.readRef root)
pure $ pure unit
R.useLayoutEffect2 root rect (contextMenuEffect menu.setMenu root)
let cs = [
HTML.div { className: "popover-content" }
cpt menu children = do
host <- R2.getPortalHost
root <- R.useRef null
rect /\ setRect <- R.useState $ \_ -> Nothing
R.useLayoutEffect1 (R.readRef root)
$ do
traverse_
(\r -> setRect (\_ -> Just (Element.boundingRect r)))
(toMaybe $ R.readRef root)
pure $ pure unit
R.useLayoutEffect2 root rect (contextMenuEffect menu.setMenu root)
let
cs =
[ HTML.div { className: "popover-content" }
[ HTML.div { className: "panel panel-default" }
[ HTML.ul { className: "list-group" }
children
]
[ HTML.ul { className: "list-group" }
children
]
]
]
pure $ R.createPortal [ elems root menu rect $ cs ] host
elems ref menu (Just rect) = HTML.div
{ ref
, className: "context-menu"
, style: position menu rect
, data: {toggle: "popover", placement: "right"}
}
elems ref _ _ = HTML.div
{ ref
, className: "context-menu"
, data: {toggle: "popover", placement: "right"}
}
contextMenuEffect
:: forall t
. R2.Setter (Maybe t)
-> R.Ref (Nullable DOM.Element)
-> Effect (Effect Unit)
contextMenuEffect setMenu rootRef =
case R.readNullableRef rootRef of
Just root -> do
let onClick = documentClickHandler setMenu root
let onScroll = documentScrollHandler setMenu
DOM.addEventListener document "click" onClick
DOM.addEventListener document "scroll" onScroll
pure $ do
DOM.removeEventListener document "click" onClick
DOM.removeEventListener document "scroll" onScroll
Nothing -> pure R.nothing
]
pure $ R.createPortal [ elems root menu rect $ cs ] host
elems ref menu (Just rect) =
HTML.div
{ ref
, className: "context-menu"
, style: position menu rect
, data: { toggle: "popover", placement: "right" }
}
elems ref _ _ =
HTML.div
{ ref
, className: "context-menu"
, data: { toggle: "popover", placement: "right" }
}
contextMenuEffect ::
forall t.
R2.Setter (Maybe t) ->
R.Ref (Nullable DOM.Element) ->
Effect (Effect Unit)
contextMenuEffect setMenu rootRef = case R.readNullableRef rootRef of
Just root -> do
let
onClick = documentClickHandler setMenu root
let
onScroll = documentScrollHandler setMenu
DOM.addEventListener document "click" onClick
DOM.addEventListener document "scroll" onScroll
pure
$ do
DOM.removeEventListener document "click" onClick
DOM.removeEventListener document "scroll" onScroll
Nothing -> pure R.nothing
documentClickHandler :: forall t. R2.Setter (Maybe t) -> DOM.Element -> Callback DE.MouseEvent
documentClickHandler hide menu =
R2.named "hideMenuOnClickOutside" $ callback $ \e ->
if Element.contains menu (DE.target e)
then pure unit
else hide (const Nothing)
R2.named "hideMenuOnClickOutside" $ callback
$ \e ->
if Element.contains menu (DE.target e) then
pure unit
else
hide (const Nothing)
documentScrollHandler :: forall t. R2.Setter (Maybe t) -> Callback DE.MouseEvent
documentScrollHandler hide =
R2.named "hideMenuOnScroll" $ callback $ \e -> hide (const Nothing)
documentScrollHandler hide = R2.named "hideMenuOnScroll" $ callback $ \e -> hide (const Nothing)
position :: forall t. Record (Props t) -> DOMRect -> { left :: Number, top :: Number }
position mouse {width: menuWidth, height: menuHeight} = {left, top}
where left = if isRight then mouse.x else mouse.x - menuWidth
top = if isAbove then mouse.y else mouse.y - menuHeight
isRight = screenWidth - mouse.x > menuWidth -- is there enough space to show above
isAbove = screenHeight - mouse.y > menuHeight -- is there enough space to show to the right?
screenWidth = window .. "innerWidth"
screenHeight = window .. "innerHeight"
contextMenuItem :: Array R.Element -> R.Element
contextMenuItem = R.createElement contextMenuItemCpt {}
contextMenuItemCpt :: R.Component ()
contextMenuItemCpt = R.hooksComponent "ContextMenuItem" cpt
position mouse { width: menuWidth, height: menuHeight } = { left, top }
where
cpt _props children = pure $ HTML.li { className: "context-menu-item" } children
left = if isRight then mouse.x else mouse.x - menuWidth
-- -- CSS Classes
top = if isAbove then mouse.y else mouse.y - menuHeight
-- menuClass :: String
-- menuClass = "context-menu"
isRight = screenWidth - mouse.x > menuWidth -- is there enough space to show above
-- menuShownClass :: String
-- menuShownClass = "context-menu-shown"
isAbove = screenHeight - mouse.y > menuHeight -- is there enough space to show to the right?
-- menuHiddenClass :: String
-- menuHiddenClass = "context-menu-hidden"
screenWidth = window .. "innerWidth"
-- itemClass :: String
-- itemClass = "context-menu-item"
screenHeight = window .. "innerHeight"
-- separatorClass :: String
-- separatorClass = "context-menu-item"
contextMenuItem :: Array R.Element -> R.Element
contextMenuItem = R.createElement contextMenuItemCpt {}
contextMenuItemCpt :: R.Component ()
contextMenuItemCpt = R.hooksComponent "ContextMenuItem" cpt
where
cpt _props children = pure $ HTML.li { className: "context-menu-item" } children
-- -- CSS Classes -- menuClass :: String -- menuClass = "context-menu" -- menuShownClass :: String -- menuShownClass = "context-menu-shown" -- menuHiddenClass :: String -- menuHiddenClass = "context-menu-hidden" -- itemClass :: String -- itemClass = "context-menu-item" -- separatorClass :: String -- separatorClass = "context-menu-item"
\ No newline at end of file
-- | The SimpleItem is a simple context menu item consisting of a link
-- | It handles automatically closing the context menu for you
module Gargantext.Component.ContextMenu.SimpleItem where
-- (MenuProps, Action(..), separator) where
-- (MenuProps, Action(..), separator) where
import Prelude hiding (div)
-- separator :: ReactElement
-- separator = div [ className "context-menu-separator" ] []
-- type State' = { open :: Boolean }
-- newtype State = State State'
-- defaultState :: State
-- defaultState = State { open: false }
-- type MenuProps = { classes :: String }
-- type ItemProps p = { hideMenu :: Effect () | p }
-- data Action = Show | Hide
-- menuClass :: String
-- menuClass = "context-menu"
-- menuShownClass :: String
-- menuShownClass = "context-menu-shown"
-- menuHiddenClass :: String
-- menuHiddenClass = "context-menu-hidden"
-- itemClass :: String
-- itemClass = "context-menu-item"
-- contextMenu :: MenuProps -> Array ReactElement -> ReactElement
-- contextMenu = createElement contextMenuClass
-- -- TODO: register callbacks
-- componentDidMount :: Effect Unit
-- componentDidMount = pure unit
-- -- TODO: unregister callbacks
-- componentWillUnmount :: Effect Unit
-- componentWillUnmount = pure unit
-- --
-- childRender :: forall s p a. Spec s p a -> Spec s p a
-- childRender = over _render (\c -> wrapItem <<< c)
-- -- | Wraps an item in an li tag with the item classname
-- wrapItem :: ReactElement -> ReactElement
-- wrapItem = wrap $ li [ className itemClass ]
-- renderMenuItem :: Render State MenuItem Action MenuItem
-- renderMenuItem _ Separator _ _ = li [ className "menu-item-separator" ]
-- renderMenuItem d (MenuItem i) _ _ = wrap outer inner
-- where outer = li [ className "context-menu-item" ]
-- inner = a [ onClick callback, style i.style ] [text i.label]
-- callback _ = d Hide *> i.callback
-- -- TODO: Aria and accessibility
-- renderMenu :: Render State MenuProps Action
-- renderMenu d m s c = pure $ wrap outer $ ul' inner
-- where outer = div [className (classes s.open m.classes)]
-- inner = map (\i -> renderMenuItem d i ) c
-- visibilityClass :: Boolean -> String
-- visibilityClass true = contextMenuShown
-- visibilityClass false = contextMenuHidden
-- classes :: Boolean -> String -> String
-- classes visible user = joinWith " " [menuClass, visibilityClass visible, user]
-- -- Class
-- contextMenuClass :: ReactClass (WithChildren State')
-- contextMenuClass = component "ContextMenu" createContextMenuClass
-- createContextMenuClass ::
-- forall given snapshot spec.
-- ReactComponentSpec MenuProps State snapshot given spec
-- => ReactClassConstructor MenuProps State given
-- -> ReactClass MenuProps
-- createContextMenuClass this = pure
-- { state: defaultState
-- , render: renderMenu
-- , componentDidMount: componentDidMount
-- , componentWillUnmount: componentWillUnmount
-- }
-- type Label = String
-- type ClassName = String
-- -- Items
-- simpleItem :: Label -> ClassName -> Effect Unit -> Effect Unit -> ReactElement
-- simpleItem label cls cb hide = a [ onClick (hide *> cb), className cls ] [ text label ]
-- separator :: ReactElement
-- separator = li [ className "menu-item-separator" ] []
-- separator :: ReactElement -- separator = div [ className "context-menu-separator" ] [] -- type State' = { open :: Boolean } -- newtype State = State State' -- defaultState :: State -- defaultState = State { open: false } -- type MenuProps = { classes :: String } -- type ItemProps p = { hideMenu :: Effect () | p } -- data Action = Show | Hide -- menuClass :: String -- menuClass = "context-menu" -- menuShownClass :: String -- menuShownClass = "context-menu-shown" -- menuHiddenClass :: String -- menuHiddenClass = "context-menu-hidden" -- itemClass :: String -- itemClass = "context-menu-item" -- contextMenu :: MenuProps -> Array ReactElement -> ReactElement -- contextMenu = createElement contextMenuClass -- -- TODO: register callbacks -- componentDidMount :: Effect Unit -- componentDidMount = pure unit -- -- TODO: unregister callbacks -- componentWillUnmount :: Effect Unit -- componentWillUnmount = pure unit -- -- -- childRender :: forall s p a. Spec s p a -> Spec s p a -- childRender = over _render (\c -> wrapItem <<< c) -- -- | Wraps an item in an li tag with the item classname -- wrapItem :: ReactElement -> ReactElement -- wrapItem = wrap $ li [ className itemClass ] -- renderMenuItem :: Render State MenuItem Action MenuItem -- renderMenuItem _ Separator _ _ = li [ className "menu-item-separator" ] -- renderMenuItem d (MenuItem i) _ _ = wrap outer inner -- where outer = li [ className "context-menu-item" ] -- inner = a [ onClick callback, style i.style ] [text i.label] -- callback _ = d Hide *> i.callback -- -- TODO: Aria and accessibility -- renderMenu :: Render State MenuProps Action -- renderMenu d m s c = pure $ wrap outer $ ul' inner -- where outer = div [className (classes s.open m.classes)] -- inner = map (\i -> renderMenuItem d i ) c -- visibilityClass :: Boolean -> String -- visibilityClass true = contextMenuShown -- visibilityClass false = contextMenuHidden -- classes :: Boolean -> String -> String -- classes visible user = joinWith " " [menuClass, visibilityClass visible, user] -- -- Class -- contextMenuClass :: ReactClass (WithChildren State') -- contextMenuClass = component "ContextMenu" createContextMenuClass -- createContextMenuClass :: -- forall given snapshot spec. -- ReactComponentSpec MenuProps State snapshot given spec -- => ReactClassConstructor MenuProps State given -- -> ReactClass MenuProps -- createContextMenuClass this = pure -- { state: defaultState -- , render: renderMenu -- , componentDidMount: componentDidMount -- , componentWillUnmount: componentWillUnmount -- } -- type Label = String -- type ClassName = String -- -- Items -- simpleItem :: Label -> ClassName -> Effect Unit -> Effect Unit -> ReactElement -- simpleItem label cls cb hide = a [ onClick (hide *> cb), className cls ] [ text label ] -- separator :: ReactElement -- separator = li [ className "menu-item-separator" ] []
\ No newline at end of file
This diff is collapsed.
This diff is collapsed.
......@@ -4,15 +4,14 @@ import Reactix as R
import Reactix.DOM.HTML as H
-- TODO : get REST informations
folder :: {} -> R.Element
folder props = R.createElement folderCpt props []
folderCpt :: R.Component ()
folderCpt = R.staticComponent "G.C.Folder.folder" cpt
where
cpt _ _ =
R.fragment
cpt _ _ =
R.fragment
[ H.h1 {} [ H.text "Folder" ]
, H.text "Some description of the folder here" ]
, H.text "Some description of the folder here"
]
......@@ -10,37 +10,39 @@ import Gargantext.Sessions (Session(..), Sessions, unSessions)
import Gargantext.Components.Tree (treeView)
import Gargantext.Utils.Reactix as R2
type Props =
( sessions :: Sessions
, route :: AppRoute
, frontends :: Frontends
, showLogin :: R2.Setter Boolean
)
type Props
= ( sessions :: Sessions
, route :: AppRoute
, frontends :: Frontends
, showLogin :: R2.Setter Boolean
)
forest :: Record Props -> R.Element
forest props = R.createElement forestCpt props []
forestCpt :: R.Component Props
forestCpt = R.staticComponent "G.C.Forest.forest" cpt where
cpt {sessions, route, frontends, showLogin} _ =
R.fragment [ plus showLogin, trees ]
forestCpt = R.staticComponent "G.C.Forest.forest" cpt
where
cpt { sessions, route, frontends, showLogin } _ = R.fragment [ plus showLogin, trees ]
where
trees =
case unSessions sessions of
Nothing -> R.fragment []
Just s@(Session {treeId}) ->
R.fragment
[ treeView { root: treeId
, frontends
, mCurrentRoute: Just route
, session: s }
]
trees = case unSessions sessions of
Nothing -> R.fragment []
Just s@(Session { treeId }) ->
R.fragment
[ treeView
{ root: treeId
, frontends
, mCurrentRoute: Just route
, session: s
}
]
plus :: R2.Setter Boolean -> R.Element
plus showLogin = H.button {on: {click}}
[ H.i { className: "glyphicon glyphicon-log-in"}
[]
]
plus showLogin =
H.button { on: { click } }
[ H.i { className: "glyphicon glyphicon-log-in" }
[]
]
where
click _ = do
showLogin (const true)
click _ = do
showLogin (const true)
......@@ -4,19 +4,19 @@ import Reactix as R
import Reactix.DOM.HTML as H
clearfix :: {} -> R.Element
clearfix _ = H.div {className: "clearfix"} []
clearfix _ = H.div { className: "clearfix" } []
formGroup :: Array R.Element -> R.Element
formGroup = H.div {className: "form-group"}
formGroup = H.div { className: "form-group" }
center :: Array R.Element -> R.Element
center = H.div {className: "center"}
center = H.div { className: "center" }
card :: Array R.Element -> R.Element
card = H.div {className: "card"}
card = H.div { className: "card" }
cardBlock :: Array R.Element -> R.Element
cardBlock = H.div {className: "card-block"}
cardBlock = H.div { className: "card-block" }
cardGroup :: Array R.Element -> R.Element
cardGroup = H.div {className: "card-group"}
cardGroup = H.div { className: "card-group" }
This diff is collapsed.
......@@ -10,14 +10,13 @@ import DOM.Simple.Console (log2)
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
type Props = (
onClick :: forall e. e -> Effect Unit
, text :: String
)
type Props
= ( onClick :: forall e. e -> Effect Unit
, text :: String
)
simpleButton :: Record Props -> R.Element
simpleButton props = R.createElement simpleButtonCpt props []
......@@ -25,22 +24,24 @@ simpleButton props = R.createElement simpleButtonCpt props []
simpleButtonCpt :: R.Component Props
simpleButtonCpt = R.hooksComponent "SimpleButton" cpt
where
cpt {onClick, text} _ = do
pure $
H.span {}
[
H.button
{ className: "btn btn-primary", on: {click: onClick} }
cpt { onClick, text } _ = do
pure
$ H.span {}
[ H.button
{ className: "btn btn-primary", on: { click: onClick } }
[ H.text text ]
]
centerButton :: R.Ref (Maybe Sigmax.Sigma) -> R.Element
centerButton sigmaRef = simpleButton {
onClick: \_ -> do
let mSigma = Sigmax.readSigma <$> R.readRef sigmaRef
log2 "[centerButton] mSigma" mSigma
case mSigma of
Just (Just s) -> Sigma.goToAllCameras s {x: 0.0, y: 0.0, ratio: 1.0, angle: 0.0}
_ -> pure unit
, text: "Center"
}
centerButton sigmaRef =
simpleButton
{ onClick:
\_ -> do
let
mSigma = Sigmax.readSigma <$> R.readRef sigmaRef
log2 "[centerButton] mSigma" mSigma
case mSigma of
Just (Just s) -> Sigma.goToAllCameras s { x: 0.0, y: 0.0, ratio: 1.0, angle: 0.0 }
_ -> pure unit
, text: "Center"
}
module Gargantext.Components.GraphExplorer.Controls
( Controls
, controlsToSigmaSettings
, useGraphControls
, controls
, controlsCpt
, getShowTree, setShowTree
, getShowControls, setShowControls
, getShowSidePanel, setShowSidePanel
, getCursorSize, setCursorSize
, getMultiNodeSelect, setMultiNodeSelect
) where
( Controls
, controlsToSigmaSettings
, useGraphControls
, controls
, controlsCpt
, getShowTree
, setShowTree
, getShowControls
, setShowControls
, getShowSidePanel
, setShowSidePanel
, getCursorSize
, setCursorSize
, getMultiNodeSelect
, setMultiNodeSelect
) where
import Data.Maybe (Maybe)
import Data.Tuple.Nested ((/\))
......@@ -17,7 +22,6 @@ import Effect (Effect)
import Prelude
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Components.Graph as Graph
import Gargantext.Components.GraphExplorer.Button (centerButton)
import Gargantext.Components.GraphExplorer.RangeControl (edgeSizeControl, nodeSizeControl)
......@@ -27,26 +31,25 @@ import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2
type Controls =
( cursorSize :: R.State Number
, multiNodeSelect :: R.Ref Boolean
, showControls :: R.State Boolean
, showSidePanel :: R.State Boolean
, showTree :: R.State Boolean
, sigmaRef :: R.Ref (Maybe Sigmax.Sigma)
)
type Controls
= ( cursorSize :: R.State Number
, multiNodeSelect :: R.Ref Boolean
, showControls :: R.State Boolean
, showSidePanel :: R.State Boolean
, showTree :: R.State Boolean
, sigmaRef :: R.Ref (Maybe Sigmax.Sigma)
)
controlsToSigmaSettings :: Record Controls -> Record Graph.SigmaSettings
controlsToSigmaSettings { cursorSize: (cursorSize /\ _)} = Graph.sigmaSettings
controlsToSigmaSettings { cursorSize: (cursorSize /\ _) } = Graph.sigmaSettings
type LocalControls =
( edgeSize :: R.State Range.NumberRange
, labelSize :: R.State Number
, nodeSize :: R.State Range.NumberRange
, pauseForceAtlas :: R.State Boolean
, showEdges :: R.State Boolean
)
type LocalControls
= ( edgeSize :: R.State Range.NumberRange
, labelSize :: R.State Number
, nodeSize :: R.State Range.NumberRange
, pauseForceAtlas :: R.State Boolean
, showEdges :: R.State Boolean
)
initialLocalControls :: R.Hooks (Record LocalControls)
initialLocalControls = do
......@@ -55,14 +58,13 @@ initialLocalControls = do
nodeSize <- R.useState' $ Range.Closed { min: 5.0, max: 10.0 }
pauseForceAtlas <- R.useState' true
showEdges <- R.useState' true
pure $ {
edgeSize
, labelSize
, nodeSize
, pauseForceAtlas
, showEdges
}
pure
$ { edgeSize
, labelSize
, nodeSize
, pauseForceAtlas
, showEdges
}
controls :: Record Controls -> R.Element
controls props = R.createElement controlsCpt props []
......@@ -70,77 +72,77 @@ controls props = R.createElement controlsCpt props []
controlsCpt :: R.Component Controls
controlsCpt = R.hooksComponent "GraphControls" cpt
where
cpt props _ = do
localControls <- initialLocalControls
pure $ case getShowControls props of
false -> RH.div {} []
true -> RH.div { className: "col-md-12", style: { paddingBottom: "10px" } }
[ R2.menu { id: "toolbar" }
[ RH.ul {}
[ -- change type button (?)
RH.li {} [ centerButton props.sigmaRef ]
, RH.li {} [ pauseForceAtlasButton props.sigmaRef localControls.pauseForceAtlas ] -- spatialization (pause ForceAtlas2)
, RH.li {} [ edgesToggleButton props.sigmaRef localControls.showEdges ]
, RH.li {} [ edgeSizeControl props.sigmaRef localControls.edgeSize ] -- edge size : 0-3
-- change level
-- file upload
-- run demo
-- search button
-- search topics
, RH.li {} [ cursorSizeButton props.cursorSize ] -- cursor size: 0-100
, RH.li {} [ labelSizeButton props.sigmaRef localControls.labelSize ] -- labels size: 1-4
, RH.li {} [ nodeSizeControl props.sigmaRef localControls.nodeSize ] -- node size : 5-15
-- zoom: 0 -100 - calculate ratio
-- toggle multi node selection
-- save button
]
cpt props _ = do
localControls <- initialLocalControls
pure
$ case getShowControls props of
false -> RH.div {} []
true ->
RH.div { className: "col-md-12", style: { paddingBottom: "10px" } }
[ R2.menu { id: "toolbar" }
[ RH.ul {}
[ -- change type button (?) RH.li {} [ centerButton props.sigmaRef ]
, RH.li {} [ pauseForceAtlasButton props.sigmaRef localControls.pauseForceAtlas ] -- spatialization (pause ForceAtlas2)
, RH.li {} [ edgesToggleButton props.sigmaRef localControls.showEdges ]
, RH.li {} [ edgeSizeControl props.sigmaRef localControls.edgeSize ] -- edge size : 0-3
-- change level
-- file upload
-- run demo
-- search button
-- search topics
, RH.li {} [ cursorSizeButton props.cursorSize ] -- cursor size: 0-100
, RH.li {} [ labelSizeButton props.sigmaRef localControls.labelSize ] -- labels size: 1-4
, RH.li {} [ nodeSizeControl props.sigmaRef localControls.nodeSize ] -- node size : 5-15
-- zoom: 0 -100 - calculate ratio
-- toggle multi node selection
-- save button
]
]
]
]
useGraphControls :: R.Hooks (Record Controls)
useGraphControls = do
cursorSize <- R.useState' 10.0
cursorSize <- R.useState' 10.0
multiNodeSelect <- R.useRef false
showControls <- R.useState' false
showSidePanel <- R.useState' false
showControls <- R.useState' false
showSidePanel <- R.useState' false
showTree <- R.useState' false
sigmaRef <- R2.nothingRef
pure { cursorSize
, multiNodeSelect
, showControls
, showSidePanel
, showTree
, sigmaRef
}
pure
{ cursorSize
, multiNodeSelect
, showControls
, showSidePanel
, showTree
, sigmaRef
}
getShowControls :: Record Controls -> Boolean
getShowControls { showControls: ( should /\ _ ) } = should
getShowControls { showControls: (should /\ _) } = should
getShowSidePanel :: Record Controls -> Boolean
getShowSidePanel { showSidePanel: ( should /\ _ ) } = should
getShowSidePanel { showSidePanel: (should /\ _) } = should
getShowTree :: Record Controls -> Boolean
getShowTree { showTree: ( should /\ _ ) } = should
getShowTree { showTree: (should /\ _) } = should
getCursorSize :: Record Controls -> Number
getCursorSize { cursorSize: ( size /\ _ ) } = size
getCursorSize { cursorSize: (size /\ _) } = size
getMultiNodeSelect :: Record Controls -> Boolean
getMultiNodeSelect { multiNodeSelect } = R.readRef multiNodeSelect
setShowControls :: Record Controls -> Boolean -> Effect Unit
setShowControls { showControls: ( _ /\ set ) } v = set $ const v
setShowControls { showControls: (_ /\ set) } v = set $ const v
setShowSidePanel :: Record Controls -> Boolean -> Effect Unit
setShowSidePanel { showSidePanel: ( _ /\ set ) } v = set $ const v
setShowSidePanel { showSidePanel: (_ /\ set) } v = set $ const v
setShowTree :: Record Controls -> Boolean -> Effect Unit
setShowTree { showTree: ( _ /\ set ) } v = set $ not <<< const v
setShowTree { showTree: (_ /\ set) } v = set $ not <<< const v
setCursorSize :: Record Controls -> Number -> Effect Unit
setCursorSize { cursorSize: ( _ /\ setSize ) } v = setSize $ const v
setCursorSize { cursorSize: (_ /\ setSize) } v = setSize $ const v
setMultiNodeSelect :: Record Controls -> Boolean -> Effect Unit
setMultiNodeSelect { multiNodeSelect } = R.setRef multiNodeSelect
......@@ -7,7 +7,8 @@ import Prelude
import Reactix as R
import Reactix.DOM.HTML as H
type Props = ( state :: R.State Boolean )
type Props
= ( state :: R.State Boolean )
controlsToggleButton :: Record Props -> R.Element
controlsToggleButton props = R.createElement controlsToggleButtonCpt props []
......@@ -15,11 +16,14 @@ controlsToggleButton props = R.createElement controlsToggleButtonCpt props []
controlsToggleButtonCpt :: R.Component Props
controlsToggleButtonCpt = R.hooksComponent "GraphControlsToggleButton" cpt
where
cpt {state} _ = do
let (open /\ setOpen) = state
pure $
H.button
{ className: "btn btn-primary", on: {click: \_ -> setOpen not } }
cpt { state } _ = do
let
(open /\ setOpen) = state
pure
$ H.button
{ className: "btn btn-primary", on: { click: \_ -> setOpen not } }
[ H.text (text open) ]
text true = "Hide Controls"
text false = "Show Controls"
text true = "Hide Controls"
text false = "Show Controls"
......@@ -3,14 +3,14 @@ module Gargantext.Components.GraphExplorer.Legend
) where
import Prelude hiding (map)
import Data.Sequence (Seq)
import Data.Traversable (foldMap)
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Components.GraphExplorer.Types (Legend(..), intColor)
type Props = ( items :: Seq Legend )
type Props
= ( items :: Seq Legend )
legend :: Record Props -> R.Element
legend props = R.createElement legendCpt props []
......@@ -18,11 +18,11 @@ legend props = R.createElement legendCpt props []
legendCpt :: R.Component Props
legendCpt = R.hooksComponent "Legend" cpt
where
cpt {items} _ = pure $ RH.div {} [foldMap entry items]
cpt { items } _ = pure $ RH.div {} [ foldMap entry items ]
entry :: Legend -> R.Element
entry (Legend {id_, label}) =
entry (Legend { id_, label }) =
RH.p {}
[ RH.span { style: { width: 10, height: 10, backgroundColor: intColor id_, display: "inline-block" } } []
, RH.text $ " " <> label
]
[ RH.span { style: { width: 10, height: 10, backgroundColor: intColor id_, display: "inline-block" } } []
, RH.text $ " " <> label
]
......@@ -10,16 +10,15 @@ import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.RangeSlider as RS
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Utils.Range as Range
type Props = (
caption :: String
, sliderProps :: Record RS.Props
)
type Props
= ( caption :: String
, sliderProps :: Record RS.Props
)
rangeControl :: Record Props -> R.Element
rangeControl props = R.createElement rangeControlCpt props []
......@@ -27,55 +26,61 @@ rangeControl props = R.createElement rangeControlCpt props []
rangeControlCpt :: R.Component Props
rangeControlCpt = R.hooksComponent "RangeButton" cpt
where
cpt {caption, sliderProps} _ = do
pure $
H.span {className: "range text-center"}
cpt { caption, sliderProps } _ = do
pure
$ H.span { className: "range text-center" }
[ H.label {} [ H.text caption ]
, RS.rangeSlider sliderProps
]
edgeSizeControl :: R.Ref (Maybe Sigmax.Sigma) -> R.State Range.NumberRange -> R.Element
edgeSizeControl sigmaRef (state /\ setState) =
rangeControl {
caption: "Edge Size"
, sliderProps: {
bounds: Range.Closed { min: 0.0, max: 3.0 }
rangeControl
{ caption: "Edge Size"
, sliderProps:
{ bounds: Range.Closed { min: 0.0, max: 3.0 }
, initialValue: state
, epsilon: 0.1
, step: 1.0
, width: 10.0
, height: 5.0
, onChange: \range@(Range.Closed {min, max}) -> do
let mSigma = Sigmax.readSigma <$> R.readRef sigmaRef
, onChange:
\range@(Range.Closed { min, max }) -> do
let
mSigma = Sigmax.readSigma <$> R.readRef sigmaRef
case mSigma of
Just (Just s) -> Sigma.setSettings s {
minEdgeSize: min
, maxEdgeSize: max
}
_ -> pure unit
Just (Just s) ->
Sigma.setSettings s
{ minEdgeSize: min
, maxEdgeSize: max
}
_ -> pure unit
setState $ const range
}
}
nodeSizeControl :: R.Ref (Maybe Sigmax.Sigma) -> R.State Range.NumberRange -> R.Element
nodeSizeControl sigmaRef (state /\ setState) =
rangeControl {
caption: "Node Size"
, sliderProps: {
bounds: Range.Closed { min: 5.0, max: 15.0 }
rangeControl
{ caption: "Node Size"
, sliderProps:
{ bounds: Range.Closed { min: 5.0, max: 15.0 }
, initialValue: state
, epsilon: 0.1
, step: 1.0
, width: 10.0
, height: 5.0
, onChange: \range@(Range.Closed {min, max}) -> do
let mSigma = Sigmax.readSigma <$> R.readRef sigmaRef
, onChange:
\range@(Range.Closed { min, max }) -> do
let
mSigma = Sigmax.readSigma <$> R.readRef sigmaRef
case mSigma of
Just (Just s) -> Sigma.setSettings s {
minNodeSize: min
, maxNodeSize: max
}
_ -> pure unit
Just (Just s) ->
Sigma.setSettings s
{ minNodeSize: min
, maxNodeSize: max
}
_ -> pure unit
setState $ const range
}
}
module Gargantext.Components.GraphExplorer.Sidebar
(Props, sidebar)
where
module Gargantext.Components.GraphExplorer.Sidebar (Props, sidebar) where
import Prelude
import Reactix as R
import Reactix.DOM.HTML as RH
type Props = ( showSidePanel :: Boolean )
type Props
= ( showSidePanel :: Boolean )
sidebar :: Record Props -> R.Element
sidebar props = R.createElement sidebarCpt props []
......@@ -14,48 +13,66 @@ sidebar props = R.createElement sidebarCpt props []
sidebarCpt :: R.Component Props
sidebarCpt = R.hooksComponent "Sidebar" cpt
where
cpt {showSidePanel: false} _children = do
pure $ RH.div {} []
cpt props _children = do
pure $
RH.div { id: "sp-container", className: "col-md-2" }
[ RH.div {}
[ RH.div { className: "row" }
[ RH.div { className: "col-md-12" }
[ RH.ul { id: "myTab", className: "nav nav-tabs", role: "tablist"}
[ RH.li { className: "nav-item" }
[ RH.a { id: "home-tab"
, className: "nav-link active"
, data: {toggle: "tab"}
, href: "#home"
, role: "tab"
, aria: {controls: "home", selected: "true"}}
[ RH.text "Neighbours" ] ] ]
, RH.div { className: "tab-content", id: "myTabContent" }
[ RH.div { className: "", id: "home", role: "tabpanel" }
(badge <$> badges) ] ]
, RH.div { className: "col-md-12", id: "horizontal-checkbox" }
[ RH.ul {}
[ checkbox "Pubs"
, checkbox "Projects"
, checkbox "Patents"
, checkbox "Others" ] ] ] ] ]
badge text =
RH.a { className: "badge badge-light" } [ RH.text text ]
checkbox text =
RH.li {}
cpt { showSidePanel: false } _children = do
pure $ RH.div {} []
cpt props _children = do
pure
$ RH.div { id: "sp-container", className: "col-md-2" }
[ RH.div {}
[ RH.div { className: "row" }
[ RH.div { className: "col-md-12" }
[ RH.ul { id: "myTab", className: "nav nav-tabs", role: "tablist" }
[ RH.li { className: "nav-item" }
[ RH.a
{ id: "home-tab"
, className: "nav-link active"
, data: { toggle: "tab" }
, href: "#home"
, role: "tab"
, aria: { controls: "home", selected: "true" }
}
[ RH.text "Neighbours" ]
]
]
, RH.div { className: "tab-content", id: "myTabContent" }
[ RH.div { className: "", id: "home", role: "tabpanel" }
(badge <$> badges)
]
]
, RH.div { className: "col-md-12", id: "horizontal-checkbox" }
[ RH.ul {}
[ checkbox "Pubs"
, checkbox "Projects"
, checkbox "Patents"
, checkbox "Others"
]
]
]
]
]
badge text = RH.a { className: "badge badge-light" } [ RH.text text ]
checkbox text =
RH.li {}
[ RH.span {} [ RH.text text ]
, RH.input { type: "checkbox"
, className: "checkbox"
, checked: true
, title: "Mark as completed" } ]
badges =
[ "objects"
, "evaluation"
, "dynamics"
, "virtual environments"
, "virtual reality"
, "performance analysis"
, "software engineering"
, "complex systems"
, "wireless communications" ]
, RH.input
{ type: "checkbox"
, className: "checkbox"
, checked: true
, title: "Mark as completed"
}
]
badges =
[ "objects"
, "evaluation"
, "dynamics"
, "virtual environments"
, "virtual reality"
, "performance analysis"
, "software engineering"
, "complex systems"
, "wireless communications"
]
module Gargantext.Components.Data.Lang where
data Lang = EN | FR
data Lang
= EN
| FR
This diff is collapsed.
......@@ -3,7 +3,8 @@ module Gargantext.Components.LoadingSpinner where
import Reactix as R
import Reactix.DOM.HTML as H
type Props = ()
type Props
= ()
loadingSpinner :: Record Props -> R.Element
loadingSpinner props = R.createElement loadingSpinnerCpt props []
......@@ -11,4 +12,4 @@ loadingSpinner props = R.createElement loadingSpinnerCpt props []
loadingSpinnerCpt :: R.Component Props
loadingSpinnerCpt = R.staticComponent "LoadingSpinner" cpt
where
cpt _ _ = H.span {} [H.text "[Loading]"]
cpt _ _ = H.span {} [ H.text "[Loading]" ]
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
module Gargantext.Components.Modals.Modal where
import Prelude (Unit)
import Effect (Effect)
foreign import modalShow :: String -> Effect Unit
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -13,4 +13,3 @@ useHashRouter routes init = do
route@(_ /\ setRoute) <- R.useState' init
R.useEffectOnce $ matches routes $ \_old new -> setRoute (const new)
pure route
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -16,4 +16,5 @@ main = paint $ toMaybe (document ... "getElementById" $ [ "app" ])
paint :: Maybe Element -> Effect Unit
paint Nothing = log "[main] Container not found"
paint (Just c) = R2.render (app {}) c
This diff is collapsed.
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