Ends.purs 10.9 KB
Newer Older
1 2 3 4 5
-- | Those things at the end of urls
module Gargantext.Ends
  -- ( )
  where

6
import Data.Array (filter)
7
import Data.Eq.Generic (genericEq)
8
import Data.Generic.Rep (class Generic)
9
import Data.Maybe (Maybe(..), maybe, fromMaybe)
10
import Data.Newtype (class Newtype)
11
import Gargantext.Routes as R
12
import Gargantext.Types (ApiVersion, ChartType(..), Limit, NodePath, NodeType(..), Offset, TabType(..), TermSize(..), nodePath, nodeTypePath, showTabType', TermList(MapTerm))
13
import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParam, queryParam, queryParamS)
14 15
import Prelude (class Eq, class Show,  show, ($), (/=), (<<<), (<>), (==), (<$>))
import Simple.JSON as JSON
16 17 18 19 20 21 22 23

-- | 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

24

25 26 27 28 29
-- | Encapsulates the data we need to talk to a backend server
newtype Backend = Backend
  { name    :: String
  , baseUrl :: String
  , prePath :: String
30
  , version :: ApiVersion
31
  , backendType :: String
32
  }
33 34 35 36
derive instance Generic Backend _
derive instance Newtype Backend _
derive newtype instance JSON.ReadForeign Backend
derive newtype instance JSON.WriteForeign Backend
37 38 39
instance Eq Backend where eq = genericEq
instance Show Backend where show (Backend {name}) = name
instance ToUrl Backend String where toUrl = backendUrl
40

41 42 43
type BaseUrl = String
type PrePath = String
type Name    = String
44 45 46 47
type BackendType = String

backend :: BackendType -> Name -> ApiVersion -> PrePath -> BaseUrl -> Backend
backend backendType name version prePath baseUrl = Backend { name, version, prePath, baseUrl, backendType}
48 49 50 51 52 53 54 55 56 57

-- | 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

-- | 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
58 59
  , prePath :: String
  }
60

61
derive instance Generic Frontend _
62 63 64 65 66
instance Eq Frontend where eq = genericEq
instance ToUrl Frontend NodePath where toUrl front np = frontendUrl front (nodePath np)
instance Show Frontend where show (Frontend {name}) = name
instance ToUrl Frontend String where toUrl = frontendUrl
instance ToUrl Frontend R.AppRoute where toUrl f r = frontendUrl f (R.appPath r)
67

68 69 70 71 72 73 74 75 76 77 78
-- | 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

-- | The currently selected App and Static configurations
newtype Frontends = Frontends { app :: Frontend, static :: Frontend }

79
derive instance Eq Frontends
80 81
instance ToUrl Frontends R.AppRoute where toUrl f r = appUrl f (R.appPath r)
instance ToUrl Frontends NodePath where toUrl (Frontends {app}) np = frontendUrl app (nodePath np)
James Laver's avatar
James Laver committed
82

83 84 85 86 87 88 89 90 91
-- | 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
92
sessionPath (R.Tab t i)             = sessionPath (R.NodeAPI Node i (showTabType' t))
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
sessionPath (R.Children n o l s i)  = sessionPath (R.NodeAPI Node i ("children" <> qs))
  where
    qs = joinQueryStrings [ queryParam "type" n
                          , queryParam "offset" o
                          , queryParam "limit" l
                          , queryParam "order" s ]

sessionPath (R.RecomputeNgrams nt nId lId)      = "node/" <> (show nId) <> "/ngrams/recompute" <> qs
  where
    qs = joinQueryStrings [ queryParam "list" lId
                          , queryParam "ngramsType" nt ]
sessionPath (R.RecomputeListChart ChartBar nt nId lId)   = "node/" <> (show nId) <> "/pie" <> qs
  where
    qs = joinQueryStrings [ queryParam "list" lId
                          , queryParam "ngramsType" nt ]
sessionPath (R.RecomputeListChart ChartPie nt nId lId)   = "node/" <> (show nId) <> "/pie" <> qs
  where
    qs = joinQueryStrings [ queryParam "list" lId
                          , queryParam "ngramsType" nt ]
sessionPath (R.RecomputeListChart ChartTree nt nId lId)  = "node/" <> (show nId) <> "/tree" <> qs
  where
    qs = joinQueryStrings [ queryParam "list" lId
                          , queryParam "ngramsType" nt
                          , queryParam "listType" MapTerm ]
sessionPath (R.RecomputeListChart Histo nt nId lId)      = "node/" <> (show nId) <> "/chart" <> qs
  where
    qs = joinQueryStrings [ queryParam "list" lId
                          , queryParam "ngramsType" nt ]
sessionPath (R.RecomputeListChart Scatter nt nId lId)    = "node/" <> (show nId) <> "/metrics" <> qs
  where
    qs = joinQueryStrings [ queryParam "list" lId
                          , queryParam "ngramsType" nt ]
sessionPath (R.RecomputeListChart _ nt nId lId)          = "node/" <> (show nId) <> "/recompute-chart" <> qs
  where
    qs = joinQueryStrings [ queryParam "list" lId
                          , queryParam "ngramsType" nt ]
129
sessionPath (R.GraphAPI gId p)      = "graph/" <> (show gId) <> "/" <> p
130
sessionPath (R.GetNgrams opts i)    =
131
  base opts.tabType $ "ngrams" <> qs
132
  where
133 134
    base (TabCorpus _) = sessionPath <<< R.NodeAPI Node i
    base _             = sessionPath <<< R.NodeAPI Url_Document i
135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150

    qs = joinQueryStrings ( [ queryParamS "ngramsType" $ showTabType' opts.tabType
                            , queryParam "limit" opts.limit
                            , mQueryParam "orderBy" opts.orderBy
                            , mQueryParam "offset" opts.offset
                            , mQueryParam "listType" opts.termListFilter ]
                            <> listIds
                            <> termSizeFilter opts.termSizeFilter
                            <> search opts.searchQuery )

    listIds = (queryParam "list") <$> filter (_ /= 0) opts.listIds
    termSizeFilter Nothing = []
    termSizeFilter (Just MonoTerm) = [ queryParam "minTermSize" 0, queryParam "maxTermSize" 1 ]
    termSizeFilter (Just MultiTerm) = [ queryParam "minTermSize" 2 ]
    search "" = []
    search s = [ queryParamS "search" s ]
151
sessionPath (R.GetNgramsTableAll opts i) =
152 153 154 155 156
  sessionPath $ R.NodeAPI Node i $ "ngrams" <> qs
  where
    qs = joinQueryStrings ([ queryParamS "ngramsType" $ showTabType' opts.tabType
                           , queryParam "limit" 100000 ] <> list)
    list = (queryParam "list") <$> opts.listIds
157
sessionPath (R.GetNgramsTableVersion opts i) =
158
  sessionPath $ R.NodeAPI Node i $ "ngrams/version" <> qs
159 160
    --  $ "ngrams/version?"
    -- <> "list=" <> show opts.listId
161 162 163
  where
    qs = joinQueryStrings [ queryParamS "ngramsType" $ showTabType' opts.tabType
                          , queryParam "list" opts.listId ]
164
sessionPath (R.ListDocument lId dId) =
165
  sessionPath $ R.NodeAPI NodeList lId ("document/" <> (show $ fromMaybe 0 dId))
166
sessionPath (R.ListsRoute lId) = "lists/" <> show lId
167
sessionPath (R.PutNgrams t listId termList i) =
168 169 170 171 172
  sessionPath $ R.NodeAPI Node i $ "ngrams" <> qs
  where
    qs = joinQueryStrings [ queryParamS "ngramsType" $ showTabType' t
                          , mQueryParam "list" listId
                          , mQueryParam "listType" termList ]
173 174
sessionPath (R.PostNgramsChartsAsync i) =
  sessionPath $ R.NodeAPI Node i $ "ngrams/async/charts/update"
175 176 177
sessionPath (R.NodeAPI nt i p) = nodeTypePath nt
                              <> (maybe "" (\i' -> "/" <> show i') i)
                              <> (if p == "" then "" else "/" <> p)
178 179
sessionPath (R.TreeFirstLevel nId p) = nodeTypePath Tree
                                    <> (maybe "" (\nId' -> "/" <> show nId') nId) <> "/first-level" <> p
180
sessionPath (R.Search {listId, limit, offset, orderBy} mCorpusId) =
181 182 183 184 185 186
  sessionPath $ R.NodeAPI Corpus mCorpusId $ "search" <> qs
  where
    qs = joinQueryStrings [ queryParam "list_id" listId
                          , queryParam "offset" offset
                          , queryParam "limit" limit
                          , mQueryParam "orderBy" orderBy ]
187 188 189 190 191
-- sessionPath (R.Search {listId, limit, offset, orderBy} (Just corpusId)) =
--     "search/" <> (show corpusId) <> "/list/" <> (show listId) <> "?"
--     <> offsetUrl offset
--     <> limitUrl limit
--     <> orderUrl orderBy
192
sessionPath (R.CorpusMetrics { listId, limit, tabType} i) =
193 194 195 196 197
  sessionPath $ R.NodeAPI Corpus i $ "metrics" <> qs
  where
    qs = joinQueryStrings [ queryParam "ngrams" listId
                          , queryParamS "ngramsType" $ showTabType' tabType
                          , mQueryParam "limit" limit ]
198
sessionPath (R.CorpusMetricsHash { listId, tabType} i) =
199 200 201 202
  sessionPath $ R.NodeAPI Corpus i $ "metrics/hash" <> qs
  where
    qs = joinQueryStrings [ queryParam "ngrams" listId
                          , queryParamS "ngramsType" $ showTabType' tabType ]
203
-- TODO fix this url path
204
sessionPath (R.Chart {chartType, listId, tabType} i) =
205
  sessionPath $ R.NodeAPI Corpus i $ show chartType <> qs
206
    where
207 208 209
      qs = joinQueryStrings [ queryParamS "ngramsType" $ showTabType' tabType
                            , queryParam "listType" MapTerm
                            , mQueryParam "list" listId ]
Nicolas Pouillard's avatar
Nicolas Pouillard committed
210
    -- <> maybe "" limitUrl limit
211
sessionPath (R.ChartHash { chartType, listId, tabType } i) =
212 213 214 215 216
  sessionPath $ R.NodeAPI Corpus i $ show chartType <> "/hash" <> qs
  where
    qs = joinQueryStrings [ queryParamS "ngramsType" $ showTabType' tabType
                          , queryParam "listType" MapTerm
                          , mQueryParam "list" listId ]
217
-- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i
218
sessionPath (R.PhyloAPI nId) = "node/" <> show nId <> "/phylo"
219
sessionPath R.Members = "members"
220

221 222
------- misc routing stuff

223 224 225 226 227 228
defaultList :: Int -> String
defaultList n = if n == 0 then "" else ("list=" <> show n)

defaultListAdd :: Int -> String
defaultListAdd n = "&" <> defaultList n

229 230 231 232
defaultListAddMaybe :: Maybe Int -> String
defaultListAddMaybe Nothing = ""
defaultListAddMaybe (Just l) = "&list=" <> show l

233 234


235 236 237 238 239 240 241 242 243 244 245 246 247 248 249
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

250
-- instance ToUrl NodeType where
251 252
--   toUrl ec e nt i = toUrl ec e (NodeAPI nt) i

253
-- instance ToUrl Path where
254 255 256 257 258 259
--   toUrl ec e p i = doUrl base path params
--     where
--       base   = endBaseUrl e ec
--       path   = endPathUrl e ec p i
--       params = ""
------------------------------------------------------------