Config.purs 8.68 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 13
import Prelude
import Data.Argonaut (class DecodeJson, decodeJson)
14 15
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
16 17
import Data.Map (Map)
import Data.Map as DM
18
import Data.Maybe (Maybe(..), maybe)
19 20
import Data.Tuple (Tuple(..))

21 22
import Gargantext.Types

23 24 25 26
endConfig :: EndConfig
endConfig = endConfig' V10

endConfig' :: ApiVersion -> EndConfig
27
endConfig' v = { front : frontRelative
Sudhir Kumar's avatar
Sudhir Kumar committed
28
               , back  : backDev v  }
29 30

------------------------------------------------------------------------
31 32 33 34 35
frontRelative :: Config
frontRelative = { baseUrl: ""
                , prePath: "/#/"
                }

36
frontCaddy :: Config
37 38
frontCaddy = { baseUrl: "http://localhost:2015"
             , prePath: "/#/"
39 40 41
             }

frontHaskell :: Config
42 43
frontHaskell = { baseUrl: "http://localhost:8008"
               , prePath: "/#/"
44 45
               }

46 47 48 49 50
frontDev :: Config
frontDev = { baseUrl: "https://dev.gargantext.org"
           , prePath: "/#/"
           }

51
frontProd :: Config
52 53
frontProd = { baseUrl: "https://gargantext.org"
            , prePath: "/#/"
54 55 56 57
            }

------------------------------------------------------------------------

58 59 60 61 62
backLocal :: ApiVersion -> Config
backLocal v = { baseUrl: "http://localhost:8008"
              , prePath: "/api/" <> show v <> "/"
              }

63
backDev :: ApiVersion -> Config
64 65
backDev v = { baseUrl: "https://dev.gargantext.org"
            , prePath: "/api/" <> show v <> "/"
66 67 68
            }

backProd :: ApiVersion -> Config
69 70 71
backProd v = { baseUrl: "https://gargantext.org"
             , prePath: "/api/" <> show v <> "/"
             }
72 73 74 75 76 77
------------------------------------------------------------------------

type EndConfig = { front :: Config
                 , back  :: Config
                 }

78 79
type Config = { baseUrl :: String
              , prePath :: String
80
              }
81

82 83 84 85 86
------------------------------------------------------------
type UrlBase  = String
type UrlPath  = String
type UrlParam = String
type Url      = String
87

88 89
doUrl :: UrlBase -> UrlPath -> UrlParam -> Url
doUrl b p ps = b <> p <> ps
Nicolas Pouillard's avatar
Nicolas Pouillard committed
90 91 92 93 94

endOf :: forall cfg. End -> { front :: cfg, back :: cfg } -> cfg
endOf Back  = _.back
endOf Front = _.front

95
endBaseUrl :: End -> EndConfig -> UrlBase
Nicolas Pouillard's avatar
Nicolas Pouillard committed
96 97
endBaseUrl end c = (endOf end c).baseUrl

98 99
endPathUrl :: End -> EndConfig -> Path -> Maybe Id -> UrlPath
endPathUrl end = pathUrl <<< endOf end
100

101 102 103 104
tabTypeDocs :: TabType -> UrlPath
tabTypeDocs (TabCorpus  t) = "table?view="   <> show t
tabTypeDocs (TabPairing t) = "pairing?view=" <> show t

105 106 107 108 109 110
limitUrl :: Limit -> UrlPath
limitUrl l = "&limit=" <> show l

offsetUrl :: Offset -> UrlPath
offsetUrl o = "&offset=" <> show o

111 112 113 114
tabTypeNgrams :: TabType -> UrlPath
tabTypeNgrams (TabCorpus  t) = "listGet?ngramsType=" <> show t
tabTypeNgrams (TabPairing t) = "listGet?ngramsType=" <> show t -- TODO

115 116 117
pathUrl :: Config -> Path -> Maybe Id -> UrlPath
pathUrl c (Tab t o l s) i =
    pathUrl c (NodeAPI Node) i <>
118
      "/" <> tabTypeDocs t <> offsetUrl o <> limitUrl l <> os
119 120
  where
    os = maybe "" (\x -> "&order=" <> show x) s
121 122
pathUrl c (Children n o l s) i =
    pathUrl c (NodeAPI Node) i <>
123
      "/" <> "children?type=" <> show n <> offsetUrl o <> limitUrl l <> os
124 125
  where
    os = maybe "" (\x -> "&order=" <> show x) s
126 127 128
pathUrl c (Ngrams t o l listid) i =
    pathUrl c (NodeAPI Node) i <> "/" <> tabTypeNgrams t
      <> offsetUrl o <> limitUrl l <> listid'
129
  where
130 131 132 133
    listid' = maybe "" (\x -> "&list=" <> show x) listid
pathUrl c Auth Nothing = c.prePath <> "auth"
pathUrl c Auth (Just _) = "impossible" -- TODO better types
pathUrl c (NodeAPI nt) i = c.prePath <> nodeTypeUrl nt <> (maybe "" (\i' -> "/" <> show i') i)
134 135 136



137 138 139 140 141 142 143 144 145 146 147 148 149 150
------------------------------------------------------------

class ToUrl a where
  toUrl :: End -> a -> Maybe Id -> Url

instance toUrlNodeType :: ToUrl NodeType where
  toUrl e nt i = toUrl e (NodeAPI nt) i

instance toUrlPath :: ToUrl Path where
  toUrl e p i = doUrl base path params
    where
      base   = endBaseUrl e endConfig
      path   = endPathUrl e endConfig p i
      params = ""
151
------------------------------------------------------------
152

Alexandre Delanoë's avatar
Alexandre Delanoë committed
153 154
data NodeType = NodeUser
              | Annuaire
155
                | NodeContact
Alexandre Delanoë's avatar
Alexandre Delanoë committed
156
              | Corpus
157
--                | NodeDocument
158
              | CorpusV3
Alexandre Delanoë's avatar
Alexandre Delanoë committed
159
              | Dashboard
160
              | Url_Document
161
              | Error
Alexandre Delanoë's avatar
Alexandre Delanoë committed
162 163 164
              | Folder
              | Graph
              | Individu
165
              | Node
166
              | Nodes
Alexandre Delanoë's avatar
Alexandre Delanoë committed
167
              | Tree
168

169 170 171 172

instance showNodeType :: Show NodeType where
  show NodeUser      = "NodeUser"
  show Annuaire      = "Annuaire"
173
  show NodeContact   = "NodeContact"
174 175 176
  show Corpus        = "NodeCorpus"
  show CorpusV3      = "NodeCorpusV3"
  show Dashboard     = "NodeDashboard"
177
  show Url_Document  = "NodeDocument"
178 179 180 181 182 183 184 185 186
  --show NodeDocument  = "NodeDocument"
  show Error         = "NodeError"
  show Folder        = "NodeFolder"
  show Graph         = "NodeGraph"
  show Individu      = "NodeIndividu"
  show Node          = "Node"
  show Nodes         = "Nodes"
  show Tree          = "NodeTree"

187 188
data Path
  = Auth
189 190
  | Tab      TabType  Offset Limit (Maybe OrderBy)
  | Children NodeType Offset Limit (Maybe OrderBy)
191
  | Ngrams   TabType  Offset Limit (Maybe TermList)
192 193
  | NodeAPI NodeType

194
data End = Back | Front
195
type Id  = Int
196 197 198

type Limit  = Int
type Offset = Int
199 200 201 202 203 204 205 206
data OrderBy = DateAsc  | DateDesc
             | TitleAsc | TitleDesc
             | FavDesc  | FavAsc

derive instance genericOrderBy :: Generic OrderBy _

instance showOrderBy :: Show OrderBy where
  show = genericShow
207

208
------------------------------------------------------------
209 210 211 212 213
data ApiVersion = V10 | V11
instance showApiVersion :: Show ApiVersion where
  show V10 = "v1.0"
  show V11 = "v1.1"
------------------------------------------------------------
214

215 216
data CTabNgramType = CTabTerms | CTabSources | CTabAuthors | CTabInstitutes

217 218
derive instance eqCTabNgramType :: Eq CTabNgramType

219 220 221 222 223 224 225 226
instance showCTabNgramType :: Show CTabNgramType where
  show CTabTerms      = "Terms"
  show CTabSources    = "Sources"
  show CTabAuthors    = "Authors"
  show CTabInstitutes = "Institutes"

data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication

227 228
derive instance eqPTabNgramType :: Eq PTabNgramType

229 230 231 232 233 234 235
instance showPTabNgramType :: Show PTabNgramType where
  show PTabPatents       = "Patents"
  show PTabBooks         = "Books"
  show PTabCommunication = "Communication"

data TabSubType a = TabDocs | TabNgramType a | TabTrash

236 237
derive instance eqTabSubType :: Eq a => Eq (TabSubType a)

238 239 240 241
instance showTabSubType :: Show a => Show (TabSubType a) where
  show TabDocs          = "Docs"
  show (TabNgramType a) = show a
  show TabTrash         = "Trash"
242

243 244 245
data TabType
  = TabCorpus  (TabSubType CTabNgramType)
  | TabPairing (TabSubType PTabNgramType)
246

247 248
derive instance eqTabType :: Eq TabType

249 250
derive instance genericTabType :: Generic TabType _

251
instance showTabType :: Show TabType where
252
  show = genericShow
253

254
------------------------------------------------------------
255 256 257 258 259 260 261 262 263 264 265 266 267
nodeTypeUrl :: NodeType -> Url
nodeTypeUrl Annuaire  = "annuaire"
nodeTypeUrl Corpus    = "corpus"
nodeTypeUrl CorpusV3  = "corpus"
nodeTypeUrl Dashboard = "dashboard"
nodeTypeUrl Url_Document  = "document"
nodeTypeUrl Error     = "ErrorNodeType"
nodeTypeUrl Folder    = "folder"
nodeTypeUrl Graph     = "graph"
nodeTypeUrl Individu  = "individu"
nodeTypeUrl Node      = "node"
nodeTypeUrl Nodes      = "nodes"
nodeTypeUrl NodeUser  = "user"
268
nodeTypeUrl NodeContact = "contact"
269
nodeTypeUrl Tree      = "tree"
270

271
readNodeType :: String -> NodeType
272 273 274 275 276 277 278 279 280 281 282 283 284 285
readNodeType "NodeAnnuaire"  = Annuaire
readNodeType "NodeDashboard" = Dashboard
readNodeType "Document"      = Url_Document
readNodeType "NodeFolder"    = Folder
readNodeType "NodeGraph"     = Graph
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 _               = Error
286
{-
287
------------------------------------------------------------
288 289 290 291 292
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)
293
-}
294
------------------------------------------------------------
295 296 297 298
instance decodeJsonNodeType :: DecodeJson NodeType where
  decodeJson json = do
    obj <- decodeJson json
    pure $ readNodeType obj