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