1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
-- | Those things at the end of urls
module Gargantext.Ends
-- ( )
where
import Prelude (class Eq, class Show, identity, show, ($), (<>), bind, pure, (<<<), (==))
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, (:=), (~>), jsonEmptyObject, (.:))
import Data.Foldable (foldMap)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe, maybe)
import Gargantext.Routes as R
import Gargantext.Types
( ApiVersion, Limit, NodePath, NodeType(..), Offset, TabType(..)
, TermSize(..), nodePath, nodeTypePath, showTabType')
-- | A means of generating a url to visit, a destination
class ToUrl conf p where
toUrl :: conf -> p -> String
url :: forall conf p. ToUrl conf p => conf -> p -> String
url = toUrl
-- | Encapsulates the data we need to talk to a backend server
newtype Backend = Backend
{ name :: String
, baseUrl :: String
, prePath :: String
, version :: ApiVersion }
backend :: ApiVersion -> String -> String -> String -> Backend
backend version prePath baseUrl name = Backend { name, version, prePath, baseUrl }
-- | Creates a backend url from a backend and the path as a string
backendUrl :: Backend -> String -> String
backendUrl (Backend b) path = b.baseUrl <> b.prePath <> show b.version <> "/" <> path
derive instance genericBackend :: Generic Backend _
instance eqBackend :: Eq Backend where
eq = genericEq
instance showBackend :: Show Backend where
show (Backend {name}) = name
instance toUrlBackendString :: ToUrl Backend String where
toUrl = backendUrl
-- JSON instances
instance encodeJsonBackend :: EncodeJson Backend where
encodeJson (Backend {name, baseUrl, prePath, version})
= "name" := name
~> "baseUrl" := baseUrl
~> "prePath" := prePath
~> "version" := show version
~> jsonEmptyObject
instance decodeJsonBackend :: DecodeJson Backend where
decodeJson json = do
obj <- decodeJson json
name <- obj .: "name"
baseUrl <- obj .: "baseUrl"
prePath <- obj .: "prePath"
version <- obj .: "version"
pure $ Backend {name, baseUrl, prePath, version}
-- | Encapsulates the data needed to construct a url to a frontend
-- | server (either for the app or static content)
newtype Frontend = Frontend
{ name :: String
, baseUrl :: String
, prePath :: String }
derive instance genericFrontend :: Generic Frontend _
instance eqFrontend :: Eq Frontend where
eq = genericEq
instance toUrlFrontendNodePath :: ToUrl Frontend NodePath where
toUrl front np = frontendUrl front (nodePath np)
-- | Creates a frontend
frontend :: String -> String -> String -> Frontend
frontend baseUrl prePath name = Frontend { name, baseUrl, prePath }
-- | Creates a url from a frontend and the path as a string
frontendUrl :: Frontend -> String -> String
frontendUrl (Frontend f) path = f.baseUrl <> f.prePath <> path
instance showFrontend :: Show Frontend where
show (Frontend {name}) = name
instance toUrlFrontendString :: ToUrl Frontend String where
toUrl = frontendUrl
instance toUrlFrontendAppRoute :: ToUrl Frontend R.AppRoute where
toUrl f r = frontendUrl f (R.appPath r)
-- | The currently selected App and Static configurations
newtype Frontends = Frontends { app :: Frontend, static :: Frontend }
instance toUrlFrontendsRoutes :: ToUrl Frontends R.AppRoute where
toUrl f r = appUrl f (R.appPath r)
instance toUrlFrontendsNodePath :: ToUrl Frontends NodePath where
toUrl (Frontends {app}) np = frontendUrl app (nodePath np)
-- | Creates an app url from a Frontends and the path as a string
appUrl :: Frontends -> String -> String
appUrl (Frontends {app}) = frontendUrl app
-- | Creates a static url from a Frontends and the path as a string
staticUrl :: Frontends -> String -> String
staticUrl (Frontends {static}) = frontendUrl static
sessionPath :: R.SessionRoute -> String
sessionPath (R.Tab t i) = sessionPath (R.NodeAPI Node i (showTabType' t))
sessionPath (R.Children n o l s i) = sessionPath (R.NodeAPI Node i ("children?type=" <> show n <> offsetUrl o <> limitUrl l <> orderUrl s))
sessionPath (R.NodeAPI Phylo pId p) = "phyloscape?nodeId=" <> (show $ maybe 0 identity pId) <> p
sessionPath (R.GetNgrams opts i) =
base opts.tabType
$ "ngrams?ngramsType="
<> showTabType' opts.tabType
<> offsetUrl opts.offset
<> limitUrl opts.limit
<> orderByUrl opts.orderBy
<> foldMap (\x -> "&list=" <> show x) opts.listIds
<> foldMap (\x -> "&listType=" <> show x) opts.termListFilter
<> foldMap termSizeFilter opts.termSizeFilter
<> search opts.searchQuery
where
base (TabCorpus _) = sessionPath <<< R.NodeAPI Node i
base _ = sessionPath <<< R.NodeAPI Url_Document i
termSizeFilter MonoTerm = "&minTermSize=0&maxTermSize=1"
termSizeFilter MultiTerm = "&minTermSize=2"
search "" = ""
search s = "&search=" <> s
sessionPath (R.ListDocument lId dId) =
sessionPath $ R.NodeAPI NodeList lId ("document/" <> (show $ maybe 0 identity dId))
sessionPath (R.PutNgrams t listId termList i) =
sessionPath $ R.NodeAPI Node i
$ "ngrams?ngramsType="
<> showTabType' t
<> maybe "" (\x -> "&list=" <> show x) listId
<> foldMap (\x -> "&listType=" <> show x) termList
sessionPath (R.NodeAPI nt i p) = nodeTypePath nt
<> (maybe "" (\i' -> "/" <> show i') i)
<> (if p == "" then "" else "/" <> p)
sessionPath (R.Search {listId,limit,offset,orderBy} i) =
sessionPath $ R.NodeAPI Corpus i
$ "search?list_id=" <> show listId
<> offsetUrl offset
<> limitUrl limit
<> orderUrl orderBy
sessionPath (R.CorpusMetrics {tabType, listId, limit} i) =
sessionPath $ R.NodeAPI Corpus i
$ "metrics"
<> "?ngrams=" <> show listId
<> "&ngramsType=" <> showTabType' tabType
<> maybe "" (\x -> "&limit=" <> show x) limit
-- TODO fix this url path
sessionPath (R.Chart {chartType, tabType} i) =
sessionPath $ R.NodeAPI Corpus i
$ show chartType
<> "?ngramsType=" <> showTabType' tabType
<> "&listType=GraphTerm" -- <> show listId
-- <> maybe "" (\x -> "&limit=" <> show x) limit
------- misc routing stuff
limitUrl :: Limit -> String
limitUrl l = "&limit=" <> show l
offsetUrl :: Offset -> String
offsetUrl o = "&offset=" <> show o
orderUrl :: forall a. Show a => Maybe a -> String
orderUrl = maybe "" (\x -> "&order=" <> show x)
orderByUrl :: forall a. Show a => Maybe a -> String
orderByUrl = maybe "" (\x -> "&orderBy=" <> show x)
-- nodeTypePath :: NodeType -> Path
-- nodeTypePath = NodeAPI
-- instance toUrlNodeType :: ToUrl NodeType where
-- toUrl ec e nt i = toUrl ec e (NodeAPI nt) i
-- instance toUrlPath :: ToUrl Path where
-- toUrl ec e p i = doUrl base path params
-- where
-- base = endBaseUrl e ec
-- path = endPathUrl e ec p i
-- params = ""
------------------------------------------------------------