Commit 44aa294d authored by Mael NICOLAS's avatar Mael NICOLAS

new formating

parent 59fff972
......@@ -9,7 +9,8 @@ import Control.Monad.Aff.Console (CONSOLE)
import DOM (DOM)
import Network.HTTP.Affjax (AJAX)
import Thermite (Spec, simpleSpec)
import Gargantext.Pages.Corpus.User.Users.Types (Action, State)
import Gargantext.Pages.Corpus.User.Users.Actions
import Gargantext.Pages.Corpus.User.Users.States
import Gargantext.Pages.Corpus.User.Users.API (performAction)
layoutUser :: forall props eff . Spec ( console :: CONSOLE
......@@ -18,3 +19,19 @@ layoutUser :: forall props eff . Spec ( console :: CONSOLE
| eff
) State props Action
layoutUser = simpleSpec performAction render
publicationSpec :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
publicationSpec = focus _publens _pubAction P.publicationSpec
brevetSpec :: forall eff props. Spec (dom :: DOM, console::CONSOLE, ajax :: AJAX | eff) State props Action
brevetSpec = focus _brevetslens _brevetsAction B.brevetsSpec
projectSpec :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
projectSpec = focus _projectslens _projectsAction PS.projets
facets :: forall eff props. Spec ( dom :: DOM, console :: CONSOLE, ajax :: AJAX| eff) State props Action
facets = tabs _tablens _tabAction $ fromFoldable
[ Tuple "Publications (12)" publicationSpec
, Tuple "Brevets (2)" brevetSpec
, Tuple "Projets IMT (5)" projectSpec
]
module Gargantext.Pages.Corpus.User.Users.Specs.Renders
where
import Gargantext.Pages.Corpus.User.Users.Actions
import Gargantext.Pages.Corpus.User.Users.States
import Gargantext.Pages.Corpus.User.Users.Types
import Data.List (List, toUnfoldable, zip)
......
module Gargantext.Pages.Corpus.User.Users.Types
(module Gargantext.Pages.Corpus.User.Users.Types.Types,
module Gargantext.Pages.Corpus.User.Users.Types.Lens,
module Gargantext.Pages.Corpus.User.Users.Types.States,
brevetSpec,
projectSpec,
facets
)
where
import Prelude (($))
import Gargantext.Pages.Corpus.User.Users.Types.Lens
import Gargantext.Pages.Corpus.User.Users.Types.Types
import Gargantext.Pages.Corpus.User.Users.Types.States
module Gargantext.Pages.Corpus.User.Users.Types where
import Prelude (bind, pure, ($))
import Gargantext.Pages.Corpus.User.Brevets as B
import Control.Monad.Aff.Console (CONSOLE)
import DOM (DOM)
import Gargantext.Pages.Folder as PS
import Gargantext.Components.Tab (tabs)
import Gargantext.Utils.DecodeMaybe ((.?|))
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Map (Map, fromFoldable)
import Data.Maybe (Maybe)
import Data.List (fromFoldable)
import Data.Tuple (Tuple(..))
import Control.Monad.Aff.Console (CONSOLE)
import DOM (DOM)
import Network.HTTP.Affjax (AJAX)
import Gargantext.Pages.Folder as PS
import Gargantext.Components.Tab (tabs)
import Thermite (Spec, focus)
brevetSpec :: forall eff props. Spec (dom :: DOM, console::CONSOLE, ajax :: AJAX | eff) State props Action
brevetSpec = focus _brevetslens _brevetsAction B.brevetsSpec
newtype User =
User {
id ::Int,
typename :: Maybe Int,
userId ::Int,
parentId :: Int,
name :: String,
date ::Maybe String,
hyperdata :: Maybe HyperData
}
projectSpec :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
projectSpec = focus _projectslens _projectsAction PS.projets
instance decodeUser :: DecodeJson User where
decodeJson json = do
obj <- decodeJson json
id <- obj .? "id"
typename <- obj .?| "typename"
userId <- obj .? "userId"
parentId <- obj .? "parentId"
name <- obj .? "name"
date <- obj .?| "date"
hyperdata <- obj .?| "hyperdata"
pure $ User {id, typename, userId, parentId, name, date, hyperdata}
newtype HyperData = HyperData (Map String String)
facets :: forall eff props. Spec ( dom :: DOM, console :: CONSOLE, ajax :: AJAX| eff) State props Action
facets = tabs _tablens _tabAction $ fromFoldable
[ Tuple "Publications (12)" publicationSpec
, Tuple "Brevets (2)" brevetSpec
, Tuple "Projets IMT (5)" projectSpec
]
instance decodeHyperData :: DecodeJson HyperData where
decodeJson json = do
obj <- decodeJObject json
pure <<< HyperData $ fromFoldable obj
module Gargantext.Pages.Corpus.User.Users.Types.Lens where
import Gargantext.Pages.Corpus.User.Brevets as B
import Control.Monad.Aff.Console (CONSOLE)
import DOM (DOM)
import Data.Either (Either(..))
import Data.Lens (Lens', Prism', lens, prism)
import Data.Maybe (Maybe)
import Gargantext.Pages.Corpus.User.Users.Types.States (Action(..), State)
import Gargantext.Pages.Corpus.User.Users.Types.Types (User)
import Network.HTTP.Affjax (AJAX)
import Gargantext.Pages.Folder as PS
import Gargantext.Pages.Corpus.Doc.Facets.Documents as P
import Gargantext.Components.Tab as Tab
import Thermite (Spec, focus)
_user :: Lens' State (Maybe User)
_user = lens (\s -> s.user) (\s ss -> s{user = ss})
_tablens :: Lens' State Tab.State
_tablens = lens (\s -> s.activeTab) (\s ss -> s {activeTab = ss})
_tabAction :: Prism' Action Tab.Action
_tabAction = prism TabA \ action ->
case action of
TabA laction -> Right laction
_-> Left action
_publens :: Lens' State P.State
_publens = lens (\s -> s.publications) (\s ss -> s { publications= ss})
_pubAction :: Prism' Action P.Action
_pubAction = prism PublicationA \ action ->
case action of
PublicationA laction -> Right laction
_-> Left action
publicationSpec :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
publicationSpec = focus _publens _pubAction P.publicationSpec
_brevetslens :: Lens' State B.State
_brevetslens = lens (\s -> s.brevets) (\s ss -> s {brevets = ss})
_brevetsAction :: Prism' Action B.Action
_brevetsAction = prism BrevetsA \ action ->
case action of
BrevetsA laction -> Right laction
_-> Left action
_projectslens :: Lens' State PS.State
_projectslens = lens (\s -> s.projects) (\s ss -> s {projects = ss})
_projectsAction :: Prism' Action PS.Action
_projectsAction = prism ProjectsA \ action ->
case action of
ProjectsA laction -> Right laction
_-> Left action
module Gargantext.Pages.Corpus.User.Users.Types.States where
import Gargantext.Pages.Corpus.User.Brevets as B
import Data.Maybe (Maybe(..))
import Gargantext.Pages.Corpus.User.Users.Types.Types (User)
import Gargantext.Pages.Folder as PS
import Gargantext.Pages.Corpus.Doc.Facets.Documents as P
import Gargantext.Components.Tab as Tab
data Action
= NoOp
| PublicationA P.Action
| BrevetsA B.Action
| ProjectsA PS.Action
| TabA Tab.Action
| FetchUser Int
type State =
{ activeTab :: Int
, publications :: P.State
, brevets :: B.State
, projects :: PS.State
, user :: Maybe User
}
initialState :: State
initialState =
{ activeTab : 0
, publications : P.initialState
, brevets : B.initialState
, projects : PS.initialState
, user: Nothing
}
module Gargantext.Users.Types.Types where
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Map (Map, fromFoldable)
import Data.Maybe (Maybe)
import DecodeMaybe ((.?|))
import Prelude (bind, pure, ($))
newtype User =
User {
id ::Int,
typename :: Maybe Int,
userId ::Int,
parentId :: Int,
name :: String,
date ::Maybe String,
hyperdata :: Maybe HyperData
}
instance decodeUser :: DecodeJson User where
decodeJson json = do
obj <- decodeJson json
id <- obj .? "id"
typename <- obj .?| "typename"
userId <- obj .? "userId"
parentId <- obj .? "parentId"
name <- obj .? "name"
date <- obj .?| "date"
hyperdata <- obj .?| "hyperdata"
pure $ User {id, typename, userId, parentId, name, date, hyperdata}
newtype HyperData = HyperData (Map String String)
instance decodeHyperData :: DecodeJson HyperData where
decodeJson json = do
obj <- decodeJObject json
pure <<< HyperData $ fromFoldable obj
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