Config.purs 14.3 KB
Newer Older
1 2 3 4 5
{- | Main Configuration of Gargantext Front-End

The main function to use for internal link in the Front-End
developpement is : toUrl.

6 7 8
* Example usage (depending on your Config):
toUrl Back  Corpus 1 == "http://localhost:8008/api/v1.0/corpus/1"
toUrl Front Corpus 1 == "http://localhost:2015/#/corpus/1"
9
-}
10 11
module Gargantext.Config where

12
import Prelude
James Laver's avatar
James Laver committed
13
import Control.Plus (empty)
14
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), jsonEmptyObject)
15
import Data.Array (filter, head)
James Laver's avatar
James Laver committed
16 17
import Data.NonEmpty (NonEmpty, (:|))
import Data.NonEmpty as NonEmpty
18
import Data.Foldable (foldMap)
19 20
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
21 22
import Data.Maybe (Maybe(..), maybe, fromJust)
import Partial.Unsafe (unsafePartial)
23

24
import Gargantext.Router as R
25
import Gargantext.Types (TermList, TermSize(..))
26

James Laver's avatar
James Laver committed
27
data PathType = BackendPath | FrontendPath | StaticPath
Alexandre Delanoë's avatar
Alexandre Delanoë committed
28

James Laver's avatar
James Laver committed
29 30 31
class Path t where
  pathType :: t -> PathType
  path :: t -> String
32

James Laver's avatar
James Laver committed
33 34
url :: forall t. Path t => Ends -> t -> String
url e p = h (pathType p)
35
  where
James Laver's avatar
James Laver committed
36 37 38 39 40 41 42 43 44
    h BackendPath = back e.backend (path p)
    h FrontendPath = front e.frontend (path p)
    h StaticPath = front e.static (path p)
    back e path = e.baseUrl <> e.prePath <> show e.version <> "/" <> path
    front e path = e.baseUrl <> e.prePath <> path

type Backend =
  { name :: String,    version :: ApiVersion
  , prePath :: String, baseUrl :: String
45 46
  }

James Laver's avatar
James Laver committed
47 48
backendKey :: Backend -> String
backendKey {prePath, baseUrl} = prePath <> baseUrl
49

James Laver's avatar
James Laver committed
50
type Frontend = { name :: String, baseUrl :: String, prePath :: String }
51

James Laver's avatar
James Laver committed
52 53
backend :: ApiVersion -> String -> String -> String -> Backend
backend version baseUrl prePath name = { name, version, prePath, baseUrl }
Nicolas Pouillard's avatar
Nicolas Pouillard committed
54

James Laver's avatar
James Laver committed
55 56
frontend :: String -> String -> String -> Frontend
frontend baseUrl prePath name = { name, baseUrl, prePath }
Nicolas Pouillard's avatar
Nicolas Pouillard committed
57

James Laver's avatar
James Laver committed
58 59 60 61 62 63 64
defaultBackends :: NonEmpty Array Backend
defaultBackends = prod :| [dev, demo, local]
  where
    prod = backend V10 "http://gargantext.org" "/api/" "gargantext.org"
    dev = backend V10 "http://dev.gargantext.org" "/api/" "gargantext.org (dev)"
    demo = backend V10 "http://demo.gargantext.org" "/api/" "gargantext.org (demo)"
    local = backend V10 "http://localhost:8008" "/api/" "local"
65

James Laver's avatar
James Laver committed
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
defaultFrontends :: NonEmpty Array Frontend
defaultFrontends = relative :| [prod, dev, demo, haskell, caddy]
  where
    relative = frontend "" "/" "Relative"
    prod = frontend "https://gargantext.org" "/#/" "gargantext.org"
    dev = frontend "https://dev.gargantext.org" "/#/" "gargantext.org (dev)"
    demo = frontend "https://demo.gargantext.org" "/#/" "gargantext.org (demo)"
    haskell = frontend "http://localhost:8008" "/#/" "local (gargantext)"
    python = frontend "http://localhost:8000" "/#/" "local (python)"
    caddy = frontend "http://localhost:2015" "/#/" "local (caddy)"

defaultStatics :: NonEmpty Array Frontend
defaultStatics = relative :| []
  where
    relative = frontend "" "/" "relative"

type Ends =
  { backend  :: Backend
  , frontend :: Frontend
  , static   :: Frontend }

type Ends' =
  { backend  :: NonEmpty Array Backend
  , frontend :: NonEmpty Array Frontend
  , static   :: NonEmpty Array Frontend }

defaultEnds :: Ends
defaultEnds =
  { backend:  NonEmpty.head defaultBackends
  , frontend: NonEmpty.head defaultFrontends
  , static:   NonEmpty.head defaultStatics }

defaultEnds' :: Ends'
defaultEnds' =
  { backend:  defaultBackends
  , frontend: defaultFrontends
  , static:   defaultStatics }

limitUrl :: Limit -> String
105 106
limitUrl l = "&limit=" <> show l

James Laver's avatar
James Laver committed
107
offsetUrl :: Offset -> String
108 109
offsetUrl o = "&offset=" <> show o

James Laver's avatar
James Laver committed
110
orderUrl :: forall a. Show a => Maybe a -> String
111 112
orderUrl = maybe "" (\x -> "&order=" <> show x)

James Laver's avatar
James Laver committed
113
orderByUrl :: forall a. Show a => Maybe a -> String
114 115
orderByUrl = maybe "" (\x -> "&orderBy=" <> show x)

116
showTabType' :: TabType -> String
117 118
showTabType' (TabCorpus   t) = show t
showTabType' (TabDocument t) = show t
119 120
showTabType' (TabPairing t) = show t

121 122 123
data TabPostQuery = TabPostQuery {
    offset :: Int
  , limit :: Int
124
  , orderBy :: OrderBy
125
  , tabType :: TabType
126
  , query :: String
127 128 129 130 131 132 133 134
  }

instance encodeJsonTabPostQuery :: EncodeJson TabPostQuery where
  encodeJson (TabPostQuery post) =
        "view"       := showTabType' post.tabType
     ~> "offset"     := post.offset
     ~> "limit"      := post.limit
     ~> "orderBy"    := show post.orderBy
135
     ~> "query"      := post.query
136 137
     ~> jsonEmptyObject

138

139 140
------------------------------------------------------------

James Laver's avatar
James Laver committed
141 142 143 144
instance pathRoutes :: Path R.Routes where
  pathType _ = FrontendPath
  path = routesPath

145
routesPath :: R.Routes -> String
146 147 148 149
routesPath R.Home = ""
routesPath R.Login = "login"
routesPath (R.Folder i) = "folder/" <> show i
routesPath (R.Corpus i) = "corpus/" <> show i
150
routesPath (R.CorpusDocument c l i) = "corpus/" <> show c <> "/list/" <> show l <> "/document/" <> show i
151 152
routesPath (R.Document l i) = "list/" <> show l <> "/document/" <> show i
routesPath (R.PGraphExplorer i) = "#/"
153 154
routesPath (R.Texts i) = "texts/" <> show i
routesPath (R.Lists i) = "lists/" <> show i
155 156 157 158 159
routesPath R.Dashboard = "dashboard"
routesPath (R.Annuaire i) = "annuaire/" <> show i
routesPath (R.UserPage i) = "user/" <> show i
routesPath (R.ContactPage i) = "contact/" <> show i

James Laver's avatar
James Laver committed
160 161
-- nodeTypePath :: NodeType -> Path
-- nodeTypePath = NodeAPI
162

James Laver's avatar
James Laver committed
163 164
-- instance toUrlNodeType :: ToUrl NodeType where
--   toUrl ec e nt i = toUrl ec e (NodeAPI nt) i
165

James Laver's avatar
James Laver committed
166 167 168 169 170 171
-- 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 = ""
172
------------------------------------------------------------
173

Alexandre Delanoë's avatar
Alexandre Delanoë committed
174 175
data NodeType = NodeUser
              | Annuaire
176
              | NodeContact
Alexandre Delanoë's avatar
Alexandre Delanoë committed
177
              | Corpus
178
              | Url_Document
179
              | CorpusV3
Alexandre Delanoë's avatar
Alexandre Delanoë committed
180
              | Dashboard
181
              | Error
Alexandre Delanoë's avatar
Alexandre Delanoë committed
182 183
              | Folder
              | Graph
184
              | Phylo
Alexandre Delanoë's avatar
Alexandre Delanoë committed
185
              | Individu
186
              | Node
187
              | Nodes
Alexandre Delanoë's avatar
Alexandre Delanoë committed
188
              | Tree
189
              | NodeList
190
              | Texts
191

192 193
derive instance eqNodeType :: Eq NodeType

194 195 196
instance showNodeType :: Show NodeType where
  show NodeUser      = "NodeUser"
  show Annuaire      = "Annuaire"
197
  show NodeContact   = "NodeContact"
198 199 200
  show Corpus        = "NodeCorpus"
  show CorpusV3      = "NodeCorpusV3"
  show Dashboard     = "NodeDashboard"
201
  show Url_Document  = "NodeDocument"
202 203 204
  show Error         = "NodeError"
  show Folder        = "NodeFolder"
  show Graph         = "NodeGraph"
205
  show Phylo         = "NodePhylo"
206 207 208 209
  show Individu      = "NodeIndividu"
  show Node          = "Node"
  show Nodes         = "Nodes"
  show Tree          = "NodeTree"
210
  show NodeList      = "NodeList"
211
  show Texts         = "NodeTexts"
212

213 214 215 216 217 218
readNodeType :: String -> NodeType
readNodeType "NodeAnnuaire"  = Annuaire
readNodeType "NodeDashboard" = Dashboard
readNodeType "Document"      = Url_Document
readNodeType "NodeFolder"    = Folder
readNodeType "NodeGraph"     = Graph
219
readNodeType "NodePhylo"     = Phylo
220 221 222 223 224 225 226 227 228
readNodeType "Individu"      = Individu
readNodeType "Node"          = Node
readNodeType "Nodes"         = Nodes
readNodeType "NodeCorpus"    = Corpus
readNodeType "NodeCorpusV3"  = CorpusV3
readNodeType "NodeUser"      = NodeUser
readNodeType "NodeContact"   = NodeContact
readNodeType "Tree"          = Tree
readNodeType "NodeList"      = NodeList
229
readNodeType "NodeTexts"     = Texts
230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247
readNodeType _               = Error
{-
------------------------------------------------------------
instance ordNodeType :: Ord NodeType where
  compare n1 n2 = compare (show n1) (show n2)

instance eqNodeType :: Eq NodeType where
  eq n1 n2  = eq (show n1) (show n2)
-}
------------------------------------------------------------
instance decodeJsonNodeType :: DecodeJson NodeType where
  decodeJson json = do
    obj <- decodeJson json
    pure $ readNodeType obj

instance encodeJsonNodeType :: EncodeJson NodeType where
  encodeJson nodeType = encodeJson $ show nodeType

James Laver's avatar
James Laver committed
248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265
nodeTypePath :: NodeType -> String
nodeTypePath Annuaire  = "annuaire"
nodeTypePath Corpus    = "corpus"
nodeTypePath CorpusV3  = "corpus"
nodeTypePath Dashboard = "dashboard"
nodeTypePath Url_Document  = "document"
nodeTypePath Error     = "ErrorNodeType"
nodeTypePath Folder    = "folder"
nodeTypePath Graph     = "graph"
nodeTypePath Phylo     = "phylo"
nodeTypePath Individu  = "individu"
nodeTypePath Node      = "node"
nodeTypePath Nodes     = "nodes"
nodeTypePath NodeUser  = "user"
nodeTypePath NodeContact = "contact"
nodeTypePath Tree      = "tree"
nodeTypePath NodeList  = "lists"
nodeTypePath Texts     = "texts"
266 267
------------------------------------------------------------

268
type ListId = Int
269

James Laver's avatar
James Laver committed
270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304
type NgramsGetOpts =
  { tabType        :: TabType
  , offset         :: Offset
  , limit          :: Limit
  , orderBy        :: Maybe OrderBy
  , listIds        :: Array ListId
  , termListFilter :: Maybe TermList
  , termSizeFilter :: Maybe TermSize
  , searchQuery    :: String
  }

type SearchOpts =
  { {-id :: Int
    , query    :: Array String
    ,-}
    listId   :: Int
  , limit    :: Limit
  , offset   :: Offset
  , orderBy  :: Maybe OrderBy
  }

type CorpusMetricOpts =
  { tabType :: TabType
  , listId  :: ListId
  , limit   :: Maybe Limit
  }

type ChartOpts =
  { chartType :: ChartType
  , tabType   :: TabType
  -- , listId  :: ListId
  -- , limit   :: Maybe Limit
  }

data BackendRoute
305
  = Auth
James Laver's avatar
James Laver committed
306 307 308 309
  | Tab TabType (Maybe Id)
  | Children NodeType Offset Limit (Maybe OrderBy) (Maybe Id)
  | GetNgrams NgramsGetOpts (Maybe Id)
  | PutNgrams TabType (Maybe ListId) (Maybe TermList) (Maybe Id)
310
  -- ^ The name is not good. In particular this URL is used both in PUT and POST.
James Laver's avatar
James Laver committed
311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377
  | NodeAPI NodeType (Maybe Id)
  | ListDocument (Maybe ListId) (Maybe Id)
  | Search SearchOpts (Maybe Id)
  | CorpusMetrics CorpusMetricOpts  (Maybe Id)
  | Chart ChartOpts (Maybe Id)

instance pathBackendRoute :: Path BackendRoute where
  pathType _ = BackendPath
  path = backendPath

backendPath :: BackendRoute -> String
backendPath (Tab t i) = backendPath (NodeAPI Node i) <> "/" <> showTabType' t
backendPath (Children n o l s i) = root <> "children?type=" <> show n <> offsetUrl o <> limitUrl l <> orderUrl s
  where root = backendPath (NodeAPI Node i) <> "/"
backendPath (NodeAPI Phylo pId) = "phyloscape?nodeId=" <> (show $ maybe 0 identity pId)
backendPath (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 _) = backendPath (NodeAPI Node i)
    base _ = backendPath (NodeAPI Url_Document i)
    termSizeFilter MonoTerm = "&minTermSize=0&maxTermSize=1"
    termSizeFilter MultiTerm = "&minTermSize=2"
    search "" = ""
    search s = "&search=" <> s
backendPath (ListDocument lId dId) =
  backendPath (NodeAPI NodeList lId) <> "/document/" <> (show $ maybe 0 identity dId)
backendPath (PutNgrams t listId termList i) =
    backendPath (NodeAPI Node i)
    <> "/ngrams?ngramsType="
    <> showTabType' t
    <> maybe "" (\x -> "&list=" <> show x) listId
    <> foldMap (\x -> "&listType=" <> show x) termList
backendPath Auth = "auth"
backendPath (NodeAPI nt i) = nodeTypePath nt <> (maybe "" (\i' -> "/" <> show i') i)
backendPath (Search {listId,limit,offset,orderBy} i) =
    backendPath (NodeAPI Corpus i)
    <> "/search?list_id=" <> show listId
    <> offsetUrl offset
    <> limitUrl limit
    <> orderUrl orderBy
backendPath (CorpusMetrics {tabType, listId, limit} i) =
    backendPath (NodeAPI Corpus i) <> "/metrics"
      <> "?ngrams=" <> show listId
      <> "&ngramsType=" <> showTabType' tabType
      <> maybe "" (\x -> "&limit=" <> show x) limit
-- TODO fix this url path
backendPath (Chart {chartType, tabType} i) =
    backendPath (NodeAPI Corpus i) <> "/" <> show chartType
      <> "?ngramsType=" <> showTabType' tabType
      <> "&listType=GraphTerm" -- <> show listId
      -- <> maybe "" (\x -> "&limit=" <> show x) limit

data NodePath = NodePath NodeType (Maybe Id)

instance pathNodePath :: Path NodePath where
  pathType _ = FrontendPath
  path (NodePath nt i) = nodeTypePath nt <> id
    where id = maybe "" (\i' -> "/" <> show i') i
378

379
data ChartType = Histo | Scatter | ChartPie | ChartTree
380 381 382 383 384 385

instance showChartType :: Show ChartType
  where
    show Histo    = "chart"
    show Scatter  = "scatter"
    show ChartPie = "pie"
386
    show ChartTree = "tree"
387

388
type Id  = Int
389 390
type Limit  = Int
type Offset = Int
391 392
data OrderBy = DateAsc  | DateDesc
             | TitleAsc | TitleDesc
Nicolas Pouillard's avatar
Nicolas Pouillard committed
393 394
             | ScoreAsc | ScoreDesc
             | TermAsc  | TermDesc
395
             | SourceAsc | SourceDesc
396 397 398 399 400

derive instance genericOrderBy :: Generic OrderBy _

instance showOrderBy :: Show OrderBy where
  show = genericShow
401

402
------------------------------------------------------------
403 404 405 406 407
data ApiVersion = V10 | V11
instance showApiVersion :: Show ApiVersion where
  show V10 = "v1.0"
  show V11 = "v1.1"
------------------------------------------------------------
408

James Laver's avatar
James Laver committed
409 410 411 412 413
instance eqApiVersion :: Eq ApiVersion where
  eq V10 V10 = true
  eq V11 V11 = true
  eq _ _ = false

414 415
data CTabNgramType = CTabTerms | CTabSources | CTabAuthors | CTabInstitutes

416 417
derive instance eqCTabNgramType :: Eq CTabNgramType

418 419 420 421 422 423 424 425
instance showCTabNgramType :: Show CTabNgramType where
  show CTabTerms      = "Terms"
  show CTabSources    = "Sources"
  show CTabAuthors    = "Authors"
  show CTabInstitutes = "Institutes"

data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication

426 427
derive instance eqPTabNgramType :: Eq PTabNgramType

428 429 430 431 432
instance showPTabNgramType :: Show PTabNgramType where
  show PTabPatents       = "Patents"
  show PTabBooks         = "Books"
  show PTabCommunication = "Communication"

433
data TabSubType a = TabDocs | TabNgramType a | TabTrash | TabMoreLikeFav | TabMoreLikeTrash
434

435 436
derive instance eqTabSubType :: Eq a => Eq (TabSubType a)

437 438 439 440
instance showTabSubType :: Show a => Show (TabSubType a) where
  show TabDocs          = "Docs"
  show (TabNgramType a) = show a
  show TabTrash         = "Trash"
441 442
  show TabMoreLikeFav   = "MoreFav"
  show TabMoreLikeTrash = "MoreTrash"
443

444
data TabType
445 446 447
  = TabCorpus   (TabSubType CTabNgramType)
  | TabPairing  (TabSubType PTabNgramType)
  | TabDocument (TabSubType CTabNgramType)
448

449 450
derive instance eqTabType :: Eq TabType

451 452
derive instance genericTabType :: Generic TabType _

453
instance showTabType :: Show TabType where
454
  show = genericShow
455