Skip to content

P
purescript-gargantext
Commit cb59d47b authored by Sudhir Kumar's avatar Sudhir Kumar
Browse files
Options

main.purs needs fixing

parent 37e654f2
Hide whitespace changes
Inline Side-by-side
Showing with 217 additions and 227 deletions
src/Gargantext/Components/Charts/Options/ECharts.purs
View file @ cb59d47b
......@@ -13,7 +13,9 @@ import Gargantext.Components.Charts.Options.Legend (legendType, LegendMode(..),
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.Type (DataZoom, Echarts, Legend, Option, Title, Tooltip, XAxis, YAxis)
import React (unsafeCreateElementDynamic)
import React as R
import Unsafe.Coerce (unsafeCoerce)
foreign import eChartsClass :: R.ReactClass Echarts
......@@ -21,7 +23,6 @@ foreign import eChartsClass :: R.ReactClass Echarts
chart :: Options -> R.ReactElement
chart = echarts <<< chartWith <<< opts
chartWith :: Option -> Echarts
chartWith opts = { className: Nothing
, style: Nothing
......@@ -39,7 +40,7 @@ chartWith opts = { className: Nothing
}
echarts :: Echarts -> R.ReactElement
echarts chart = R.createElementDynamic eChartsClass chart []
echarts chart = unsafeCreateElementDynamic (unsafeCoerce eChartsClass) chart []
type MainTitle = String
type SubTitle = String
......@@ -196,6 +197,7 @@ opts (Options { mainTitle : mainTitle
, show: visible
}
,dataZoom: if addZoom then [zoom Slider, zoom Inside] else []
, children : unsafeCoerce []
}
......
src/Gargantext/Components/GraphExplorer/Sigmajs.purs
View file @ cb59d47b
......@@ -4,7 +4,7 @@ import Prelude
import Effect (Effect)
import Prim.Row (class Union)
import React (ReactClass, ReactElement, createElement)
import React (Children, ReactClass, ReactElement, createElement, unsafeCreateElement)
import Unsafe.Coerce (unsafeCoerce)
foreign import edgeShapesClass :: forall props. ReactClass props
......@@ -13,51 +13,51 @@ foreign import forceAtlas2Class :: forall props. ReactClass props
foreign import forceLinkClass :: forall props. ReactClass props
foreign import loadGEXFClass :: forall props. ReactClass props
foreign import loadJSONClass :: forall props. ReactClass props
foreign import nOverlapClass :: forall props. ReactClass props
foreign import neoCypherClass :: forall props. ReactClass props
foreign import nOverlapClass :: ReactClass {children :: Children}
foreign import neoCypherClass :: ReactClass {children :: Children}
foreign import neoGraphItemsProducersClass :: forall props. ReactClass props
foreign import nodeShapesClass :: forall props. ReactClass props
foreign import randomizeNodePositionsClass :: forall props. ReactClass props
foreign import nodeShapesClass :: ReactClass {children :: Children}
foreign import randomizeNodePositionsClass :: ReactClass {children :: Children}
foreign import relativeSizeClass :: forall props. ReactClass props
foreign import sigmaClass :: forall props. ReactClass props
foreign import sigmaClass :: ReactClass {children :: Children}
foreign import sigmaEnableSVGClass :: forall props. ReactClass props
foreign import sigmaEnableWebGLClass :: forall props. ReactClass props
foreign import sigmaEnableWebGLClass :: ReactClass {children :: Children}
neoCypher :: forall o. Optional o NeoCypherOptProps => NeoCypherReqProps o -> ReactElement
neoCypher props = createElement neoCypherClass props []
neoCypher props = unsafeCreateElement neoCypherClass (unsafeCoerce props) []
loadJSON :: forall o. Optional o (onGraphLoaded :: Effect Unit) => { "path" :: String | o } -> ReactElement
loadJSON props = createElement loadJSONClass props []
loadJSON props = unsafeCreateElement loadJSONClass props []
loadGEXF :: forall o. Optional o (onGraphLoaded :: Effect Unit) => { "path" :: String | o } -> ReactElement
loadGEXF props = createElement loadGEXFClass props []
loadGEXF props = unsafeCreateElement loadGEXFClass props []
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 props = createElement nOverlapClass props []
nOverlap props = unsafeCreateElement nOverlapClass (unsafeCoerce props) []
randomizeNodePositions :: ReactElement
randomizeNodePositions = createElement randomizeNodePositionsClass {} []
relativeSize :: {initialSize :: Number } -> ReactElement
relativeSize props = createElement randomizeNodePositionsClass props []
relativeSize props = unsafeCreateElement randomizeNodePositionsClass (unsafeCoerce props) []
forceAtlas2 :: forall o. Optional o ForceAtlas2OptProps => { | o } -> ReactElement
forceAtlas2 props = createElement forceAtlas2Class props []
forceAtlas2 props = unsafeCreateElement forceAtlas2Class props []
sigma :: forall props. Optional props SigmaProps => { | props} -> Array ReactElement -> ReactElement
sigma = createElement sigmaClass
sigma props children = unsafeCreateElement sigmaClass (unsafeCoerce props) children
sigmaEnableWebGL :: ReactElement
sigmaEnableWebGL = createElement sigmaEnableWebGLClass {} []
edgeShapes :: { "default" :: EdgeShape } -> ReactElement
edgeShapes props = createElement edgeShapesClass props []
edgeShapes props = unsafeCreateElement edgeShapesClass props []
nodeShapes :: { "default" :: NodeShape } -> ReactElement
nodeShapes props = createElement nodeShapesClass props []
nodeShapes props = unsafeCreateElement nodeShapesClass (unsafeCoerce props) []
foreign import data SigmaNode :: Type
......
src/Gargantext/Components/GraphExplorer/Types.purs
View file @ cb59d47b
......@@ -3,11 +3,8 @@ module Gargantext.Components.GraphExplorer.Types where
import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Array (concat, group, head, length, sort, take)
import Data.Maybe (fromJust)
import Data.Array (concat, fromFoldable, group, sort, take)
import Data.Newtype (class Newtype)
import Data.NonEmpty (NonEmpty(..))
import Partial.Unsafe (unsafePartial)
newtype Node = Node
{ id_ :: String
......@@ -82,10 +79,10 @@ instance ordLegend :: Ord Legend where
getLegendData :: GraphData -> Array Legend
getLegendData (GraphData {nodes, edges}) = nn
where
mp (NonEmpty a ary) = [a] <> (if length ary > 0 then [unsafePartial $ fromJust $ head ary] else [])
--mp (NonEmptyArray a ary) = [a] <> (if length ary > 0 then [unsafePartial $ fromJust $ head ary] else [])
n = sort $ map t' nodes
g = group n
nn = take 5 $ concat $ map mp g
nn = take 5 $ concat $ map fromFoldable g -- TODO: fix this after checking the output
t' :: Node -> Legend
t' (Node r) = Legend { id_ : clustDefault, label : r.label}
......
src/Gargantext/Components/Login.purs
View file @ cb59d47b
......@@ -2,17 +2,18 @@ module Gargantext.Components.Login where
import Prelude hiding (div)
import Affjax (defaultRequest, request)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.RequestHeader (RequestHeader(..))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, stringify, (.?), (:=), (~>))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Lens (over)
import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationJSON)
import Effect (Effect)
import Effect.Aff (Aff, attempt)
import Effect.Aff.Class (liftAff)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.Modals.Modal (modalHide)
......@@ -64,7 +65,7 @@ performAction (SetPassword pwd) _ _ = void do
performAction Login _ (State state) = void do
performAction Login _ _ = void do
--lift $ setHash "/search"
liftEffect $ modalHide "loginModal"
modifyState \(State state) -> State $ state {loginC = true}
......@@ -242,30 +243,30 @@ loginReq encodeData =
defaultRequest
{ url = "https://dev.gargantext.org/api/auth/token"
, method = Left POST
, responseFormat = ResponseFormat.json
, headers =
[ ContentType applicationJSON
, Accept applicationJSON
]
, content = Just $ encodeJson encodeData
, content = Just $ Json $ encodeJson encodeData
}
in
do
affResp <- liftAff $ attempt $ request setting
case affResp of
affResp <- request setting
case affResp.body of
Left err -> do
liftAff $ log $ show err
pure $ Left $ show err
Right a -> do
liftAff $ log $ "POST method Completed"
liftAff $ log $ "GET /api response: " <> show a.response
let res = decodeJson a.response
liftAff $ log $ "res: " <> show a.response
case res of
liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
liftEffect $ log $ "POST method Completed"
liftEffect $ log $ "GET /api response: " <> stringify json
let obj = decodeJson json
case obj of
Left e ->
liftAff $ log $ "Error Decoding : " <> show e
liftEffect $ log $ "Error Decoding : " <> show e
Right (LoginRes res1) ->
liftEffect $ setToken res1.token
pure res
pure obj
instance decodeLoginRes :: DecodeJson LoginRes where
decodeJson json = do
......
src/Gargantext/Components/Tree.purs
View file @ cb59d47b
......@@ -2,13 +2,14 @@ module Gargantext.Components.Tree where
import Prelude hiding (div)
import Affjax (defaultRequest, request)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Tuple (Tuple(..))
import Effect.Aff (Aff, attempt)
import Effect.Aff.Class (liftAff)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import React (ReactElement)
......@@ -32,7 +33,7 @@ type State = FTree
initialState :: State
initialState = NLeaf (Tuple "" "")
performAction :: PerformAction State _ Action
performAction :: forall props. PerformAction State props Action
performAction (ToggleFolder i) _ _ = void $
cotransform (\td -> toggleNode i td)
......@@ -88,15 +89,15 @@ nodeOptionsView activated = case activated of
false -> []
treeview :: Spec State _ Action
treeview :: forall props. Spec State props Action
treeview = simpleSpec performAction render
where
render :: Render State _ Action
render :: Render State props Action
render dispatch _ state _ =
[div [className "tree"] [toHtml dispatch state]]
toHtml :: _ -> FTree -> ReactElement
toHtml :: (Action -> Effect Unit) -> FTree -> ReactElement
toHtml d (NLeaf (Tuple name link)) =
li []
[ a [ href link]
......@@ -133,20 +134,22 @@ instance decodeJsonLNode :: DecodeJson LNode where
loadDefaultNode :: Aff (Either String (Array LNode))
loadDefaultNode = do
res <- liftAff $ attempt $ request defaultRequest
res <- request $ defaultRequest
{ url = "http://localhost:8008/user"
, responseFormat = ResponseFormat.json
, method = Left GET
, headers = []
}
case res of
case res.body of
Left err -> do
_ <- liftEffect $ log $ show err
pure $ Left $ show err
Right a -> do
_ <- liftEffect $ log $ show a.status
_ <- liftEffect $ log $ show a.headers
_ <- liftEffect $ log $ show a.body
let resp = decodeJson a.body
pure resp
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
fnTransform :: LNode -> FTree
......
src/Gargantext/Config/REST.purs
View file @ cb59d47b
......@@ -2,29 +2,30 @@ module Gargantext.Config.REST where
import Prelude
import Affjax (defaultRequest, request)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut (class DecodeJson, decodeJson)
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.MediaType.Common (applicationJSON)
import Effect.Aff (Aff, attempt)
import Effect.Aff.Class (liftAff)
import Effect.Aff (Aff)
get :: forall t31. DecodeJson t31 => String ->
Aff (Either String t31)
get url = do
affResp <- liftAff $ attempt $ request defaultRequest
affResp <- request defaultRequest
{ method = Left GET
, url = url
, responseFormat = ResponseFormat.json
, headers = [ ContentType applicationJSON
, Accept applicationJSON
-- , RequestHeader "Authorization" $ "Bearer " <> token
-- , RequestHeader "Authorization" $ "Bearer " <> token
]
}
case affResp of
case affResp.body of
Left err -> do
pure $ Left $ show err
pure $ Left $ printResponseFormatError err
Right a -> do
let res = decodeJson a.body
let res = decodeJson a
pure res
src/Gargantext/Pages/Corpus.purs
View file @ cb59d47b
......@@ -36,7 +36,7 @@ corpusSpec = simpleSpec defaultPerformAction render
render dispatch _ state _ =
[ 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 "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"]
......
src/Gargantext/Pages/Corpus/Doc/Facets/Documents.purs
View file @ cb59d47b
module Gargantext.Pages.Corpus.Doc.Facets.Documents where
import Prelude
import Prelude hiding (div)
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Array (filter)
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.Charts.Charts (p'')
import Gargantext.Config.REST (get)
import React (ReactElement)
......@@ -67,10 +74,10 @@ newtype Corpus
derive instance genericCorpus :: Generic Corpus
derive instance genericCorpus :: Generic Corpus _
instance showCorpus :: Show Corpus where
show = gShow
show = genericShow
newtype Response = Response
......@@ -130,21 +137,21 @@ filterSpec :: forall props. Spec State props Action
filterSpec = simpleSpec defaultPerformAction render
where
render d p s c = [div [] [ text " Filter "
, input [] []
, input []
]]
layoutDocview :: Spec State _ Action
layoutDocview :: forall props. Spec State props Action
layoutDocview = simpleSpec performAction render
where
render :: Render State _ Action
render :: Render State props Action
render dispatch _ state@(TableData d) _ =
[ div [className "container1"]
[ div [className "row"]
[
div [className "col-md-12"]
[ p''
, div [] [ text " Filter ", input [] []]
, br' []
, 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]
......@@ -170,7 +177,7 @@ layoutDocview = simpleSpec performAction render
]
performAction :: PerformAction State _ Action
performAction :: forall props. PerformAction State props Action
performAction (ChangePageSize ps) _ _ = void (cotransform (\state -> changePageSize ps state ))
performAction (ChangePage p) _ _ = void (cotransform (\(TableData td) -> TableData $ td { currentPage = p} ))
......@@ -188,12 +195,12 @@ loadPage = do
-- res <- get "http://localhost:8008/corpus/472764/facet/documents/table?offset=0&limit=10"
case res of
Left err -> do
_ <- liftEff $ log $ show err
_ <- liftEffect $ 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"
_ <- liftEffect $ log $ show $ map (\({ row: r, delete :_}) -> show r) ((\(TableData docs') -> docs'.rows) docs)
_ <- liftEffect $ log $ show "loading"
pure $ Right docs
where
res2corpus :: Array Response -> Array Corpus
......@@ -201,8 +208,8 @@ loadPage = do
Corpus { _id : r.cid
, url : ""
, date : r.created
, title : (\(Hyperdata r) -> r.title) r.hyperdata
, source : (\(Hyperdata r) -> r.source) r.hyperdata
, title : (\(Hyperdata hr) -> hr.title) r.hyperdata
, source : (\(Hyperdata hr) -> hr.source) r.hyperdata
, fav : r.favorite
, ngramCount : r.ngramCount
}) rs
......@@ -241,6 +248,7 @@ sdata :: Array { row :: Corpus, delete :: Boolean }
sdata = data' sampleData
tdata :: TableData Corpus
tdata = TableData
{ rows : sdata
, totalPages : 10
......@@ -260,7 +268,7 @@ showRow {row : (Corpus c), delete} =
, 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"] []]
, td [] [input [ _type "checkbox"]]
]
where
fa = case c.fav of
......@@ -306,7 +314,7 @@ string2PageSize "50" = PS50
string2PageSize "100" = PS100
string2PageSize _ = PS10
sizeDD :: PageSizes -> _ -> ReactElement
sizeDD :: PageSizes -> (Action -> Effect Unit) -> ReactElement
sizeDD ps d
= span []
[ text "Show : "
......@@ -329,7 +337,7 @@ textDescription currPage pageSize totalRecords
end = if end' > totalRecords then totalRecords else end'
pagination :: _ -> Int -> Int -> ReactElement
pagination :: (Action -> Effect Unit) -> Int -> Int -> ReactElement
pagination d tp cp
= span [] $
[ text "Pages: ", prev, first, ldots]
......@@ -393,7 +401,7 @@ pagination d tp cp
lnums = map (\i -> fnmid d i) $ filter (lessthan 1) [cp - 2, cp - 1]
rnums = map (\i -> fnmid d i) $ filter (greaterthan tp) [cp + 1, cp + 2]
fnmid :: _ -> Int -> ReactElement
fnmid :: (Action -> Effect Unit) -> Int -> ReactElement
fnmid d i
= span []
[ text " "
......
src/Gargantext/Pages/Corpus/Doc/Facets/Graph.purs
View file @ cb59d47b
......@@ -2,7 +2,11 @@ module Gargantext.Pages.Corpus.Doc.Facets.Graph where
import Prelude hiding (div)
import Data.Argonaut (decodeJson)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (decodeJson, stringify)
import Data.Array (length, mapWithIndex, (!!))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
......@@ -10,6 +14,9 @@ import Data.Int (toNumber)
import Data.Maybe (Maybe(..), fromJust)
import Data.MediaType.Common (applicationJSON)
import Data.Newtype (class Newtype)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.GraphExplorer.Sigmajs (Color(Color), SigmaEasing, SigmaGraphData(SigmaGraphData), SigmaNode, SigmaSettings, canvas, edgeShape, edgeShapes, forceAtlas2, sStyle, sigma, sigmaEasing, sigmaEdge, sigmaEnableWebGL, sigmaNode, sigmaSettings)
import Gargantext.Components.GraphExplorer.Types (Cluster(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData)
import Gargantext.Utils (getter)
......@@ -52,7 +59,7 @@ graphSpec = simpleSpec performAction render
performAction :: forall props. PerformAction State props Action
performAction (LoadGraph fp) _ _ = void do
_ <- liftEff $ log fp
_ <- liftEffect $ log fp
case fp of
"" -> do
modifyState \(State s) -> State s {filePath = fp, graphData = GraphData {nodes : [], edges : []}, sigmaGraphData = Nothing}
......@@ -69,7 +76,7 @@ performAction (SelectNode node) _ _ = void do
modifyState $ \(State s) -> State s {selectedNode = pure node}
performAction NoOp _ _ = void do
modifyState id
modifyState identity
convert :: GraphData -> SigmaGraphData
......@@ -113,10 +120,11 @@ render d p (State s) c =
, renderer : canvas
, settings : mySettings
, style : sStyle { height : "95%"}
, onClickNode : \e -> unsafePerformEff $ do
log $ unsafeCoerce e
d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
pure unit
-- , onClickNode : \e -> do
-- log $ unsafeCoerce e
-- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
-- pure unit
-- TODO: fix this!
}
[ sigmaEnableWebGL
, forceAtlas2 forceAtlas2Config
......@@ -219,21 +227,22 @@ mySettings = sigmaSettings { verbose : true
-- loadJSON {path : "http://localhost:2015/examples/sites_coords.json"}
getGraphData :: String -> Aff (Either String GraphData)
getGraphData fp = do
resp <- liftAff $ attempt $ affjax defaultRequest
resp <- request defaultRequest
{ url =("http://localhost:2015/examples/" <> fp)
, method = Left GET
, responseFormat = ResponseFormat.json
, headers =
[ ContentType applicationJSON
, Accept applicationJSON
]
}
case resp of
case resp.body of
Left err -> do
liftEff $ log $ show err
pure $ Left $ show err
Right a -> do
liftEff $ log $ show a.response
let gd = decodeJson a.response
liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
liftEffect $ log $ stringify json
let gd = decodeJson json
pure gd
......@@ -288,10 +297,10 @@ dispLegend ary = div [] $ map dl ary
specOld :: forall props. Spec State props Action
specOld = simpleSpec performAction render
specOld = simpleSpec performAction render'
where
render :: Render State props Action
render d _ (State st) _ =
render' :: Render State props Action
render' d _ (State st) _ =
[ div [className "row"] [
div [className "col-md-12", style {marginTop : "21px", marginBottom : "21px"}]
[ menu [_id "toolbar"]
......@@ -310,7 +319,7 @@ specOld = simpleSpec performAction render
[ input [_type "file"
, name "file"
-- , onChange (\e -> d $ SetFile (getFile e) (unsafeCoerce $ d <<< SetProgress))
, className "btn btn-primary"] []
, className "btn btn-primary"]
-- , text $ show st.readyState
]
......@@ -319,7 +328,7 @@ specOld = simpleSpec performAction render
, className "btn btn-warning btn-sm"
,value "Run Demo"
-- , onClick \_ -> d SetGraph, disabled (st.readyState /= DONE)
] []
]
]
, li'
......@@ -334,24 +343,24 @@ specOld = simpleSpec performAction render
[ span [className "glyphicon glyphicon-search"] []
]
]
,input [_type "text", className "form-control", placeholder "select topics"] []
,input [_type "text", className "form-control", placeholder "select topics"]
]
]
]
]
, li [className "col-md-2"]
[ span [] [text "selector size"],input [_type "range", _id "myRange", value "90"] []
[ span [] [text "selector size"],input [_type "range", _id "myRange", value "90"]
]
, li [className "col-md-2"]
[ span [] [text "label size"],input [_type "range", _id "myRange", value "90"] []
[ span [] [text "label size"],input [_type "range", _id "myRange", value "90"]
]
, li [className "col-md-2"]
[ span [] [text "Nodes"],input [_type "range", _id "myRange", value "90"] []
[ span [] [text "Nodes"],input [_type "range", _id "myRange", value "90"]
]
, li [className "col-md-2"]
[ span [] [text "Edges"],input [_type "range", _id "myRange", value "90"] []
[ span [] [text "Edges"],input [_type "range", _id "myRange", value "90"]
]
, li'
[ button [className "btn btn-primary"] [text "Save"] -- TODO: Implement Save!
......@@ -386,10 +395,10 @@ specOld = simpleSpec performAction render
, renderer : canvas
, settings : mySettings
, style : sStyle { height : "95%"}
, onClickNode : \e -> unsafePerformEff $ do
log $ unsafeCoerce e
d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
pure unit
-- , onClickNode : \e -> do
-- log $ unsafeCoerce e
-- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
-- pure unit
}
[ sigmaEnableWebGL
, forceAtlas2 forceAtlas2Config
......@@ -405,7 +414,7 @@ specOld = simpleSpec performAction render
[ case st.selectedNode of
Nothing -> span [] []
Just selectedNode -> p [] [text $ "selected Node : " <> getter _.label selectedNode
, br' []
, br'
, p [] [button [className "btn btn-primary", style {marginBottom : "18px"}] [text "Remove"]]
]
]
......@@ -452,7 +461,7 @@ specOld = simpleSpec performAction render
, checked $ true
, title "Mark as completed"
-- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
] []
]
]
, li []
......@@ -462,7 +471,7 @@ specOld = simpleSpec performAction render
, checked $ false
, title "Mark as completed"
-- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
] []
]
]
, li []
[ span [] [text "Patents"]
......@@ -471,7 +480,7 @@ specOld = simpleSpec performAction render
, checked $ false
, title "Mark as completed"
-- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
] []
]
]
, li []
[ span [] [text "Others"]
......@@ -480,7 +489,7 @@ specOld = simpleSpec performAction render
, checked $ false
, title "Mark as completed"
-- , onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
] []
]
]
]
......
src/Gargantext/Pages/Corpus/User/Users/API.purs
View file @ cb59d47b
......@@ -2,12 +2,15 @@ module Gargantext.Pages.Corpus.User.Users.API where
import Prelude
import Gargantext.Pages.Corpus.User.Users.Types (Action(..), State, User, _user)
import Control.Monad.Trans.Class (lift)
import Data.Either (Either(..))
import Data.Lens (set)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Config.REST (get)
import Gargantext.Pages.Corpus.User.Users.Types (Action(..), State, User, _user)
import Thermite (PerformAction, modifyState)
getUser :: Int -> Aff (Either String User)
......@@ -16,14 +19,14 @@ getUser id = get $ "http://localhost:8008/node/" <> show id
performAction :: forall props. PerformAction State props Action
performAction NoOp _ _ = void do
modifyState id
modifyState identity
performAction (FetchUser userId) _ _ = void do
value <- lift $ getUser userId
_ <- case value of
(Right user) -> modifyState \state -> set _user (Just user) state
(Left err) -> do
_ <- lift $ log err
modifyState id
lift <<< log $ "Fetching user..."
_ <- liftEffect $ log err
modifyState identity
liftEffect <<< log $ "Fetching user..."
performAction _ _ _ = void do
modifyState id
modifyState identity
src/Gargantext/Pages/Layout/Actions.purs
View file @ cb59d47b
......@@ -2,31 +2,31 @@ module Gargantext.Pages.Layout.Actions where
import Prelude hiding (div)
import Control.Monad.Cont.Trans (lift)
import Data.Array (length)
import Data.Either (Either(..))
import Data.Lens (Prism', prism)
import Gargantext.Components.Login as LN
import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Components.Tree as Tree
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus as CA
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets as TV
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.Login as LN
import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Components.Tree as Tree
import Gargantext.Pages.Corpus as CA
import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus.Doc.Facets as TV
import Gargantext.Pages.Corpus.Doc.Facets.Dashboard as Dsh
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG
import Gargantext.Pages.Corpus.User.Users as U
import Gargantext.Pages.Home as L
import Gargantext.Pages.Corpus.User.Users as U
import Gargantext.Pages.Home as L
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Pages.Layout.States (AppState)
import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Router (Routes)
import Gargantext.Router (Routes)
import Thermite (PerformAction, modifyState)
data Action
= Initialize
| LandingA L.Action
......@@ -56,21 +56,21 @@ performAction (Search s) _ _ = void do
modifyState $ _ {search = s}
performAction (ShowLogin) _ _ = void do
liftEff $ modalShow "loginModal"
liftEffect $ modalShow "loginModal"
modifyState $ _ {showLogin = true}
performAction (ShowAddcorpus) _ _ = void do
liftEff $ modalShow "addCorpus"
liftEffect $ modalShow "addCorpus"
modifyState $ _ {showCorpus = true}
performAction Go _ _ = void do
liftEff $ modalShow "addCorpus"
liftEffect $ modalShow "addCorpus"
modifyState $ _ {showCorpus = true}
-- _ <- lift $ setHash "/addCorpus"
--modifyState id
performAction Initialize _ state = void do
_ <- liftEff $ log "loading Initial nodes"
_ <- liftEffect $ log "loading Initial nodes"
case state.initialized of
false -> do
......@@ -78,12 +78,12 @@ performAction Initialize _ state = void do
case lnodes of
Left err -> do
modifyState id
modifyState identity
Right d -> do
page <- lift $ DV.loadPage
case page of
Left err -> do
modifyState id
modifyState identity
Right docs -> do
modifyState $ _ { initialized = true
, ntreeState = if length d > 0
......@@ -94,10 +94,10 @@ performAction Initialize _ state = void do
, docViewState = docs
}
_ -> do
modifyState id
modifyState identity
performAction _ _ _ = void do
modifyState id
modifyState identity
----------------------------------------------------------
......
src/Gargantext/Pages/Layout/Specs.purs
View file @ cb59d47b
......@@ -5,58 +5,26 @@ import Prelude hiding (div)
import Data.Foldable (fold, intercalate)
import Data.Lens (over)
import Data.Maybe (Maybe(Nothing, Just))
import Effect (Effect)
import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Components.Login as LN
import Gargantext.Components.Tree as Tree
-- | [Naming] metrics indicator: reduce spaces between "," and "_"
import Gargantext.Pages.Layout.States ( _addCorpusState
, _corpusState
, _dashBoardSate
, _docAnnotationViewState
, _docViewState
, _graphExplorerState
, _landingState
, _loginState
, _ngramState
, _searchState
, _tabviewState
, _treeState
, _userPageState
)
-- | [Naming] metrics indicator: reduce spaces between "," and "_"
import Gargantext.Pages.Layout.Actions ( _addCorpusAction
, _corpusAction
, _dashBoardAction
, _docAnnotationViewAction
, _docViewAction
, _graphExplorerAction
, _LandingA
, _loginAction
, _NgramsA
, _searchAction
, _tabviewAction
, _treeAction
, _userPageAction
)
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus as CA
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus.Doc.Facets as TV
import Gargantext.Pages.Corpus.Doc.Facets.Dashboard as Dsh
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG
import Gargantext.Pages.Corpus.User.Users as U
import Gargantext.Pages.Home as L
import Gargantext.Pages.Layout.Actions (Action(..), performAction)
import Gargantext.Pages.Layout.States (AppState, E)
import Gargantext.Pages.Layout.Actions (Action(..), _LandingA, _NgramsA, _addCorpusAction, _corpusAction, _dashBoardAction, _docAnnotationViewAction, _docViewAction, _graphExplorerAction, _loginAction, _searchAction, _tabviewAction, _treeAction, _userPageAction, performAction)
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Pages.Layout.States (AppState, _addCorpusState, _corpusState, _dashBoardSate, _docAnnotationViewState, _docViewState, _graphExplorerState, _landingState, _loginState, _ngramState, _searchState, _tabviewState, _treeState, _userPageState)
import Gargantext.Router (Routes(..))
import React (ReactElement)
import React.DOM (a, button, div, footer, hr, img, input, li, p, span, text, ul)
import React.DOM (a, button, div, footer, hr', img, input, li, p, span, text, ul)
import React.DOM.Props (_data, _id, _type, aria, className, href, onChange, onClick, placeholder, role, src, style, tabIndex, target, title)
import Thermite (Render, Spec, _render, defaultPerformAction, defaultRender, focus, simpleSpec, withState)
import Unsafe.Coerce (unsafeCoerce)
......@@ -113,7 +81,7 @@ layout0 layout =
]
where
outerLayout1 = simpleSpec defaultPerformAction defaultRender
outerLayout :: Spec (E eff) AppState props Action
outerLayout :: Spec AppState props Action
outerLayout =
cont $ fold
[ withState \st ->
......@@ -139,7 +107,7 @@ layout0 layout =
]
layoutSidebar :: forall props. Spec AppState props Action
-> Spec (E eff) AppState props Action
-> Spec AppState props Action
layoutSidebar = over _render \render d p s c ->
[ div [ _id "dafixedtop"
, className "navbar navbar-inverse navbar-fixed-top"
......@@ -162,7 +130,7 @@ divLogo = a [ className "navbar-brand logoSmall"
, href "#/"
] [ img [ src "images/logoSmall.png"
, title "Back to home."
] []
]
]
divDropdownLeft :: ReactElement
......@@ -289,13 +257,13 @@ divSearchBar = simpleSpec performAction render
, width: "400px"
}
, onChange \e -> dispatch $ Search (unsafeCoerce e).target.value
] []
]
, button [onClick \e -> dispatch Go, className "btn btn-primary"] [text "Enter"]
]
]
--divDropdownRight :: Render AppState props Action
divDropdownRight :: _ -> ReactElement
divDropdownRight :: (Action -> Effect Unit) -> ReactElement
divDropdownRight d =
ul [className "nav navbar-nav pull-right"]
[
......@@ -321,7 +289,7 @@ layoutFooter :: forall props. Spec AppState props Action
layoutFooter = simpleSpec performAction render
where
render :: Render AppState props Action
render dispatch _ state _ = [div [ className "container1" ] [ hr [] [], footerLegalInfo']]
render dispatch _ state _ = [div [ className "container1" ] [ hr', footerLegalInfo']]
where
footerLegalInfo' = footer [] [ p [] [ text "Gargantext "
, span [className "glyphicon glyphicon-registration-mark" ] []
......
src/Gargantext/Pages/Layout/Specs/AddCorpus/Actions.purs
View file @ cb59d47b
module Gargantext.Pages.Layout.Specs.AddCorpus.Actions where
import Gargantext.Pages.Layout.Specs.AddCorpus.States
import Prelude hiding (div)
import Affjax (defaultRequest, request)
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, (:=), (~>))
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, attempt)
import Effect.Aff.Class (liftAff)
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)
......@@ -45,7 +45,7 @@ performAction (LoadDatabaseDetails) _ _ = void do
modifyState $ \(state) -> state {response = resData}
performAction GO _ _ = void do
lift $ setHash "/corpus"
_ <- liftEffect $ setHash "/corpus"
_ <- liftEffect $ modalHide "addCorpus"
modifyState identity
......@@ -72,29 +72,25 @@ instance encodeJsonQueryString :: EncodeJson QueryString where
~> "query_name" := obj.query_name
~> jsonEmptyObject
getDatabaseDetails :: QueryString -> Aff (Either String (Array Response))
getDatabaseDetails reqBody = do
let token = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE1MTk5OTg1ODMsInVzZXJfaWQiOjUsImVtYWlsIjoiYWxleGFuZHJlLmRlbGFub2VAaXNjcGlmLmZyIiwidXNlcm5hbWUiOiJkZXZlbG9wZXIifQ.Os-3wuFNSmRIxCZi98oFNBu2zqGc0McO-dgDayozHJg"
affResp <- liftAff $ attempt $ request $ defaultRequest
affResp <- request $ defaultRequest
{ method = Left POST
, url ="http://localhost:8009/count"
, headers = [ ContentType applicationJSON
, responseFormat = ResponseFormat.json
, url = "http://localhost:8009/count"
, headers = [ ContentType applicationJSON
, Accept applicationJSON
-- , RequestHeader "Authorization" $ "Bearer " <> token
]
-- , RequestHeader "Authorization" $ "Bearer " <> token
]
, content = Just $ Json $ encodeJson reqBody
}
case affResp of
case affResp.body of
Left err -> do
liftEffect $ log $ "error" <> show err
pure $ Left $ show err
Right a -> do
liftEffect $ log $ "error" <> printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
liftEffect $ log $ "POST method Completed"
liftEffect $ log $ "GET /api response: " <> show a.body
res <- case a.body of
Left err -> []
Right d -> decodeJson d
pure res
liftEffect $ log $ "GET /api response: " <> stringify json
let obj = decodeJson json
pure obj
src/Main.purs
View file @ cb59d47b
......@@ -2,20 +2,22 @@ module Main where
import Prelude
import Effect (Effect)
import Data.Maybe (fromJust)
import Gargantext.Pages.Layout (dispatchAction)
import Gargantext.Pages.Layout.Specs (layoutSpec)
import Effect (Effect)
import Gargantext.Pages.Layout (dispatchAction)
import Gargantext.Pages.Layout.Specs (layoutSpec)
import Gargantext.Pages.Layout.States (initAppState)
import Gargantext.Router (routeHandler, routing)
import Partial.Unsafe (unsafePartial)
import React (ReactThis)
import React as R
import ReactDOM as RDOM
import Routing (matches)
import Routing.Hash (getHash, setHash)
import Routing.Hash (getHash, matches, setHash)
import Thermite (createClass)
import Thermite as T
import Web.DOM.ParentNode (QuerySelector(..), querySelector)
import Web.HTML (window)
import Web.HTML.Window (document)
main :: Effect Unit
main = do
......@@ -24,12 +26,12 @@ main = do
let setRouting this = void $ do
matches routing (routeHandler (dispatchAction (dispatcher this)))
spec' = spec { componentWillMount = setRouting }
document <- DOM.window >>= DOM.document
container <- unsafePartial (fromJust <$> DOM.querySelector (QuerySelector "#app") (DOM.htmlDocumentToParentNode document))
document <- window >>= document
container <- unsafePartial (fromJust <$> querySelector (QuerySelector "#app") (document))
h <- getHash
case h of
"" -> setHash "/"
_ -> do
setHash "/"
setHash h
RDOM.render (R.createFactory (R.createClass spec') {}) container
RDOM.render (R.unsafeCreateElement (createClass spec') {}) container
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