Routes.purs 7.79 KB
Newer Older
1 2 3
module Gargantext.Routes where

import Prelude
4

5
import Data.Maybe (Maybe(..))
6
import Data.UUID (UUID)
Karen Konou's avatar
Karen Konou committed
7
import Data.Map as M
8
import Gargantext.Types (ChartOpts, ChartType, CorpusMetricOpts, CTabNgramType, Id, Limit, ListId, DocId, NgramsGetOpts, NgramsGetTableAllOpts, NodeType, Offset, OrderBy, SearchOpts, SessionId, TabSubType, TabType, TermList)
9
import Gargantext.Types as GT
10 11

data AppRoute
12
  = Annuaire       SessionId Int
13
  | ContactPage    SessionId Int Int
14
  | Corpus         SessionId Int
15
  | CorpusCode     SessionId Int
16 17 18
  | CorpusDocument SessionId Int Int Int
  | Dashboard      SessionId Int
  | Document       SessionId Int Int
19 20 21 22
  | Folder         SessionId Int
  | FolderPrivate  SessionId Int
  | FolderPublic   SessionId Int
  | FolderShared   SessionId Int
23 24 25
  | Home
  | Lists          SessionId Int
  | Login
26
  | TreeFlat        SessionId Int String
27
  | PGraphExplorer  SessionId Int
28
  | PhyloExplorer   SessionId Int
29
  | RouteFile       SessionId Int
30
  | RouteFrameCalc  SessionId Int
31
  | RouteFrameCode  SessionId Int
32
  | RouteFrameWrite SessionId Int
33
  | RouteFrameVisio SessionId Int
34
  | Team            SessionId Int
35
  | NodeTexts       SessionId Int
36
  | UserPage        SessionId Int
Karen Konou's avatar
Karen Konou committed
37
  | ForgotPassword  (M.Map String String)
38

39
derive instance Eq AppRoute
40

41
instance Show AppRoute where
42 43
  show Home                     = "Home"
  show Login                    = "Login"
44
  show (TreeFlat    s i _)      = "treeflat"       <> show i <> " (" <> show s <> ")"
Karen Konou's avatar
Karen Konou committed
45
  show (ForgotPassword  u)      = "ForgotPassword" <> show u
46 47 48 49 50 51
  show (Folder        s i)      = "Folder"         <> show i <> " (" <> show s <> ")"
  show (FolderPrivate s i)      = "FolderPrivate"  <> show i <> " (" <> show s <> ")"
  show (FolderPublic  s i)      = "FolderPublic"   <> show i <> " (" <> show s <> ")"
  show (FolderShared  s i)      = "FolderShared"   <> show i <> " (" <> show s <> ")"
  show (Team          s i)      = "Team"           <> show i <> " (" <> show s <> ")"
  show (Corpus        s i)      = "Corpus"         <> show i <> " (" <> show s <> ")"
52
  show (CorpusCode    s i)      = "CorpusCode"     <> show i <> " (" <> show s <> ")"
53
  show (Document    _ s i)      = "Document"       <> show i <> " (" <> show s <> ")"
54
  show (CorpusDocument s _ _ i) = "CorpusDocument" <> show i <> " (" <> show s <> ")"
55
  show (PGraphExplorer s i)     = "graphExplorer"  <> show i <> " (" <> show s <> ")"
56
  show (PhyloExplorer  s i)     = "phyloExplorer"  <> show i <> " (" <> show s <> ")"
57
  show (Dashboard      s i)     = "Dashboard"      <> show i <> " (" <> show s <> ")"
58
  show (NodeTexts      s i)     = "texts"          <> show i <> " (" <> show s <> ")"
59 60 61 62
  show (Lists          s i)     = "lists"          <> show i <> " (" <> show s <> ")"
  show (Annuaire       s i)     = "Annuaire"       <> show i <> " (" <> show s <> ")"
  show (UserPage       s i)     = "User"           <> show i <> " (" <> show s <> ")"
  show (ContactPage  s a i)     = "Contact"        <> show a <> "::" <> show i <> " (" <> show s <> ")"
63 64
  show (RouteFrameWrite s i)    = "write"          <> show i <> " (" <> show s <> ")"
  show (RouteFrameCalc  s i)    = "calc"           <> show i <> " (" <> show s <> ")"
65
  show (RouteFrameCode  s i)    = "code"           <> show i <> " (" <> show s <> ")"
66
  show (RouteFrameVisio s i)    = "visio"          <> show i <> " (" <> show s <> ")"
67
  show (RouteFile       s i)    = "file"           <> show i <> " (" <> show s <> ")"
68

69 70

appPath :: AppRoute -> String
71 72
appPath Home                     = ""
appPath Login                    = "login"
73
appPath (TreeFlat _ i q)           = "treeflat/"       <> show i <> "?query=" <> q
Karen Konou's avatar
Karen Konou committed
74 75 76 77 78 79
appPath (ForgotPassword u)       = "forgotPassword/" <> show u
appPath (Folder s i)             = "folder/"         <> show s <> "/" <> show i
appPath (FolderPrivate s i)      = "folderPrivate/"  <> show s <> "/" <> show i
appPath (FolderPublic s i)       = "folderPublic/"   <> show s <> "/" <> show i
appPath (FolderShared s i)       = "folderShared/"   <> show s <> "/" <> show i
appPath (Team s i)               = "team/"           <> show s <> "/" <> show i
80
appPath (CorpusDocument s c l i) = "corpus/" <> show s <> "/" <> show c <> "/list/" <> show l <> "/document/" <> show i
81
appPath (Corpus s i)             = "corpus/"     <> show s <> "/" <> show i
82
appPath (CorpusCode s i)         = "corpusCode/" <> show s <> "/" <> show i
83 84 85
appPath (Document s l i)         = "list/"       <> show s <> "/" <> show l <> "/document/" <> show i
appPath (Dashboard s i)          = "dashboard/"  <> show s <> "/" <> show i
appPath (PGraphExplorer s i)     = "graph/"      <> show s <> "/" <> show i
86
appPath (PhyloExplorer  s i)     = "phylo/"      <> show s <> "/" <> show i
87
appPath (NodeTexts s i)          = "texts/"      <> show s <> "/" <> show i
88 89 90 91 92
appPath (Lists s i)              = "lists/"      <> show s <> "/" <> show i
appPath (Annuaire s i)           = "annuaire/"   <> show s <> "/" <> show i
appPath (UserPage s i)           = "user/"       <> show s <> "/" <> show i
appPath (ContactPage s a i)      = "annuaire/"   <> show s <> "/" <> show a <> "/contact/" <> show i
appPath (RouteFrameWrite s i)    = "write/"     <> show s <> "/" <> show i
93 94 95
appPath (RouteFrameCalc  s i)     = "calc/"      <> show s <> "/" <> show i
appPath (RouteFrameCode  s i)     = "code/"      <> show s <> "/" <> show i
appPath (RouteFrameVisio s i)     = "visio/"      <> show s <> "/" <> show i
96
appPath (RouteFile s i)          = "file/"      <> show s <> "/" <> show i
97

98
nodeTypeAppRoute :: NodeType -> SessionId -> Int -> Maybe AppRoute
Karen Konou's avatar
Karen Konou committed
99 100 101 102 103 104 105 106
nodeTypeAppRoute GT.Annuaire s i       = Just $ Annuaire s i
nodeTypeAppRoute GT.Corpus s i         = Just $ Corpus s i
nodeTypeAppRoute GT.Dashboard s i      = Just $ Dashboard s i
nodeTypeAppRoute GT.Folder s i         = Just $ Folder s i
nodeTypeAppRoute GT.FolderPrivate s i  = Just $ FolderPrivate s i
nodeTypeAppRoute GT.FolderPublic s i   = Just $ FolderPublic s i
nodeTypeAppRoute GT.FolderShared s i   = Just $ FolderShared s i
nodeTypeAppRoute GT.Graph s i          = Just $ PGraphExplorer s i
107
nodeTypeAppRoute GT.Phylo s i          = Just $ PhyloExplorer  s i
Karen Konou's avatar
Karen Konou committed
108 109 110 111 112
nodeTypeAppRoute GT.NodeContact s i    = Just $ Annuaire s i
nodeTypeAppRoute GT.NodeFile s i       = Just $ RouteFile s i
nodeTypeAppRoute GT.NodeList s i       = Just $ Lists s i
nodeTypeAppRoute GT.NodeUser s i       = Just $ UserPage s i
nodeTypeAppRoute GT.Team s i           = Just $ Team s i
113
nodeTypeAppRoute GT.NodeTexts s i      = Just $ NodeTexts s i
114
nodeTypeAppRoute GT.NodeFrameWrite s i = Just $ RouteFrameWrite s i
115
nodeTypeAppRoute GT.NodeFrameCalc  s i = Just $ RouteFrameCalc  s i
116
nodeTypeAppRoute GT.NodeFrameVisio s i = Just $ RouteFrameVisio s i
Karen Konou's avatar
Karen Konou committed
117
nodeTypeAppRoute _ _ _                 = Nothing
118 119


120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145
data SessionRoute
  = Tab TabType (Maybe Id)
  | Children NodeType Offset Limit (Maybe OrderBy) (Maybe Id)
  | GetNgrams NgramsGetOpts (Maybe Id)
  | GetNgramsTableAll NgramsGetTableAllOpts (Maybe Id)
  | GetNgramsTableVersion { listId :: ListId, tabType :: TabType } (Maybe Id)
  | PutNgrams TabType (Maybe ListId) (Maybe TermList) (Maybe Id)
  | PostNgramsChartsAsync (Maybe Id)
  -- ^ This name is not good. In particular this URL is used both in PUT and POST.
  | RecomputeNgrams   (TabSubType CTabNgramType) Id ListId
  | RecomputeListChart ChartType  CTabNgramType  Id ListId
  | NodeAPI       NodeType (Maybe Id) String
  | TreeFirstLevel (Maybe Id) String
  | GraphAPI      Id String
  | ListsRoute    ListId
  | ListDocument (Maybe ListId) (Maybe DocId)
  | Search        SearchOpts (Maybe Id)
  | CorpusMetrics CorpusMetricOpts  (Maybe Id)
  | CorpusMetricsHash { listId :: ListId, tabType :: TabType }  (Maybe Id)
  | Chart ChartOpts (Maybe Id)
  | ChartHash { chartType :: ChartType, listId :: Maybe ListId, tabType :: TabType } (Maybe Id)
  -- | AnnuaireContact AnnuaireId DocId
  | PhyloAPI Id
  | Members


146 147 148 149 150 151
------------------------------------------------------

type Tile =
  ( id    :: UUID
  , route :: AppRoute
  )