Commit 8a19618a authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-renaming' into dev-merge

parents 410205dc b63c157a
......@@ -16,15 +16,15 @@ import Gargantext.Components.Login (login)
-- import Gargantext.Components.Search.Types (allDatabases)
import Gargantext.Config (defaultFrontends, defaultBackends)
import Gargantext.Components.Folder (folder)
import Gargantext.Components.Nodes.Annuaire (annuaireLayout)
import Gargantext.Components.Nodes.Annuaire.User.Contacts (userLayout)
import Gargantext.Components.Nodes.Corpus (corpusLayout)
import Gargantext.Components.Nodes.Corpus.Document (documentLayout)
import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout)
import Gargantext.Components.Nodes.Lists (listsLayout)
import Gargantext.Components.Nodes.Texts (textsLayout)
import Gargantext.Components.Nodes.Home (homeLayout)
import Gargantext.Ends (Frontends)
import Gargantext.Pages.Annuaire (annuaireLayout)
import Gargantext.Pages.Annuaire.User.Contacts (userLayout)
import Gargantext.Pages.Corpus (corpusLayout)
import Gargantext.Pages.Corpus.Document (documentLayout)
import Gargantext.Pages.Corpus.Dashboard (dashboardLayout)
import Gargantext.Pages.Lists (listsLayout)
import Gargantext.Pages.Texts (textsLayout)
import Gargantext.Pages.Home (homeLayout)
import Gargantext.Router (router)
import Gargantext.Routes (AppRoute(..))
import Gargantext.Hooks.Router (useHashRouter)
......
module Gargantext.Pages.Annuaire where
module Gargantext.Components.Nodes.Annuaire where
import Prelude (bind, const, identity, pure, ($), (<$>), (<>))
import Prelude (bind, identity, pure, ($), (<$>), (<>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Array (head)
import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), HyperdataContact(..), ContactWhere(..))
import Gargantext.Components.Table as T
import Gargantext.Ends (url)
import Gargantext.Routes (SessionRoute(..))
......@@ -14,9 +17,6 @@ import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (NodePath(..), NodeType(..))
import Gargantext.Config.REST (get)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Pages.Annuaire.User.Contacts.Types (Contact(..), HyperdataContact(..), ContactWhere(..))
import Reactix as R
import Reactix.DOM.HTML as H
newtype IndividuView =
CorpusView
......@@ -108,8 +108,8 @@ pageCpt = R.staticComponent "LoadedAnnuairePage" cpt
rows = (\c -> {row: contactCells session c, delete: false}) <$> annuaireTable
container = T.defaultContainer { title: "Annuaire" } -- TODO
colNames = T.ColumnName <$> [ "", "Name", "Company", "Service", "Role"]
setParams f = snd pagePath $ \{nodeId, params} ->
{params: f params, nodeId: fst annuairePath}
setParams f = snd pagePath $ \{nodeId, params: ps} ->
{params: f ps, nodeId: fst annuairePath}
params = T.initialParams /\ setParams
contactCells :: Session -> Maybe Contact -> Array R.Element
......
module Gargantext.Pages.Annuaire.User.Contacts
( module Gargantext.Pages.Annuaire.User.Contacts.Types
module Gargantext.Components.Nodes.Annuaire.User.Contacts
( module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
, userLayout )
where
......@@ -16,10 +16,10 @@ import Reactix.DOM.HTML as H
import Gargantext.Config.REST (get)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Pages.Annuaire.User.Contacts.Types
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
( Contact(..), ContactData, ContactTouch(..), ContactWhere(..)
, ContactWho(..), HyperData(..), HyperdataContact(..) )
import Gargantext.Pages.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeType(..))
......
-- TODO copy of Gargantext.Pages.Corpus.Tabs.Specs
module Gargantext.Pages.Annuaire.User.Contacts.Tabs where
-- TODO copy of Gargantext.Components.Nodes.Corpus.Tabs.Specs
module Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs where
import Prelude hiding (div)
import Data.Generic.Rep (class Generic)
......@@ -11,7 +11,7 @@ import Reactix as R
import Gargantext.Components.DocsTable as DT
import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.Tab as Tab
import Gargantext.Pages.Annuaire.User.Contacts.Types (ContactData)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData)
import Gargantext.Sessions (Session)
import Gargantext.Types (TabType(..), TabSubType(..), CTabNgramType(..), PTabNgramType(..))
......
module Gargantext.Pages.Annuaire.User.Contacts.Types where
module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where
import Prelude
......
module Gargantext.Pages.Corpus where
module Gargantext.Components.Nodes.Corpus where
import Reactix as R
import Reactix.DOM.HTML as H
......
module Gargantext.Pages.Corpus.Chart.Histo where
module Gargantext.Components.Nodes.Corpus.Chart.Histo where
import Prelude (bind, map, pure, ($))
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
......@@ -14,7 +14,7 @@ import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, template
import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Pages.Corpus.Chart.Utils as U
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session)
import Gargantext.Types (ChartType(..), TabType)
......
module Gargantext.Pages.Corpus.Chart.Metrics where
module Gargantext.Components.Nodes.Corpus.Chart.Metrics where
import Prelude (bind, negate, pure, ($), (<$>), (<>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
......@@ -18,7 +18,7 @@ import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, template
import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Pages.Corpus.Chart.Utils as U
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session)
import Gargantext.Types (TabType, TermList(..))
......
module Gargantext.Pages.Corpus.Chart.Pie where
module Gargantext.Components.Nodes.Corpus.Chart.Pie where
import Prelude (bind, map, pure, ($), (>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
......@@ -18,7 +18,7 @@ import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, template
import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Pages.Corpus.Chart.Utils as U
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session)
import Gargantext.Types (ChartType(..), TabType)
......
module Gargantext.Pages.Corpus.Chart.Tree where
module Gargantext.Components.Nodes.Corpus.Chart.Tree where
import Prelude (bind, pure, ($))
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
......@@ -13,7 +13,7 @@ import Gargantext.Components.Charts.Options.Series (TreeNode, Trees(..), mkTree)
import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Pages.Corpus.Chart.Utils as U
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session)
import Gargantext.Types (ChartType(..), TabType)
......
module Gargantext.Pages.Corpus.Chart.Utils where
module Gargantext.Components.Nodes.Corpus.Chart.Utils where
import Data.Tuple.Nested ((/\))
import Effect.Uncurried (mkEffectFn1)
......
module Gargantext.Pages.Corpus.Dashboard where
module Gargantext.Components.Nodes.Corpus.Dashboard where
import Prelude (map, show, ($), (<$>), (<>))
import Data.Array (zipWith)
......
module Gargantext.Pages.Corpus.Document where
module Gargantext.Components.Nodes.Corpus.Document where
import Prelude (class Show, bind, identity, mempty, pure, ($), (<<<))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
......
module Gargantext.Pages.Corpus.Graph.Tabs where
module Gargantext.Components.Nodes.Corpus.Graph.Tabs where
import Prelude hiding (div)
import Data.Array (fromFoldable)
......
module Gargantext.Pages.Home where
module Gargantext.Components.Nodes.Home where
import Prelude
import Data.Newtype (class Newtype)
......
module Gargantext.Pages.Lists where
module Gargantext.Components.Nodes.Lists where
import Prelude ((<<<))
import Data.Array (head)
......@@ -13,7 +13,7 @@ import Gargantext.Components.Table as Table
import Gargantext.Config.REST (get)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Pages.Lists.Tabs as Tabs
import Gargantext.Components.Nodes.Lists.Tabs as Tabs
import Gargantext.Routes (SessionRoute(NodeAPI, Children))
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeType(..))
......
module Gargantext.Pages.Lists.Tabs where
module Gargantext.Components.Nodes.Lists.Tabs where
import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.??))
......@@ -10,9 +10,9 @@ import Reactix as R
import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Tab as Tab
import Gargantext.Pages.Corpus.Chart.Metrics (metrics)
import Gargantext.Pages.Corpus.Chart.Pie (pie, bar)
import Gargantext.Pages.Corpus.Chart.Tree (tree)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), TabType(..), TabSubType(..))
......
module Gargantext.Pages.Texts where
module Gargantext.Components.Nodes.Texts where
import Prelude ((<<<))
import Data.Array (head)
......@@ -16,8 +16,8 @@ import Gargantext.Components.Table as Table
import Gargantext.Config.REST (get)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Pages.Texts.Tabs (CorpusData, CorpusInfo(..))
import Gargantext.Pages.Texts.Tabs as Tabs
import Gargantext.Components.Nodes.Texts.Tabs (CorpusData, CorpusInfo(..))
import Gargantext.Components.Nodes.Texts.Tabs as Tabs
import Gargantext.Routes (SessionRoute(NodeAPI, Children))
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeType(..))
......
module Gargantext.Pages.Texts.Tabs where
module Gargantext.Components.Nodes.Texts.Tabs where
--------------------------------------------------------
import Prelude (class Eq, class Show, bind, pure, ($))
......@@ -13,7 +13,7 @@ import Reactix.DOM.HTML as H
import Gargantext.Components.DocsTable as DT
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Tab as Tab
import Gargantext.Pages.Corpus.Chart.Histo (histo)
import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))
......
......@@ -103,8 +103,7 @@ instance encodeJsonSessions :: EncodeJson Sessions where
~> jsonEmptyObject
where
encodeSessions :: Seq Session -> Json
encodeSessions ss = fromArray $ encodeJson <$> (Seq.toUnfoldable ss)
encodeSessions ss2 = fromArray $ encodeJson <$> (Seq.toUnfoldable ss2)
unSessions :: Sessions -> Array Session
unSessions (Sessions s) = A.fromFoldable s
......
......@@ -22,7 +22,6 @@ import Reactix.DOM.HTML (ElemFactory, text)
import Reactix.React (react, createDOMElement)
import Reactix.SyntheticEvent as RE
import Reactix.Utils (currySecond, hook, tuple)
import Thermite (Spec, simpleSpec, Render, defaultPerformAction)
import Unsafe.Coerce (unsafeCoerce)
newtype Point = Point { x :: Number, y :: Number }
......@@ -42,30 +41,17 @@ buff = unsafeCoerce
scuff :: R.Element -> ReactElement
scuff = unsafeCoerce
class ToElement a where
toElement :: a -> R.Element
-- class ToElement a where
-- toElement :: a -> R.Element
instance toElementElement :: ToElement R.Element where
toElement = identity
-- instance toElementElement :: ToElement R.Element where
-- toElement = identity
instance toElementReactElement :: ToElement ReactElement where
toElement = buff
-- instance toElementReactElement :: ToElement ReactElement where
-- toElement = buff
instance toElementArray :: ToElement a => ToElement (Array a) where
toElement = R.fragment <<< map toElement
{-
instance isReactElementElement :: IsReactElement R.Element where
toElement = scuff
-}
elSpec :: forall component props
. R.IsComponent component props (Array R.Element)
=> component -> Spec {} (Record props) Void
elSpec cpt = simpleSpec defaultPerformAction render
where
render :: Render {} (Record props) Void
render _ props _ children = [scuff $ R.createElement cpt props (buff <$> children)]
-- instance toElementArray :: ToElement a => ToElement (Array a) where
-- toElement = R.fragment <<< map toElement
createElement' :: forall required given
. ReactPropFields required given
......
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