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 8
import Data.Foldable (foldMap)
import Data.Generic.Rep (class Generic)
9
import Data.Eq.Generic (genericEq)
10
import Data.Maybe (Maybe(..), maybe, fromMaybe)
11
import Data.Newtype (class Newtype)
12
import Prelude (class Eq, class Show,  show, ($), (/=), (<<<), (<>), (==), (<$>))
13 14
import Simple.JSON as JSON

15
import Gargantext.Routes as R
16
import Gargantext.Types (ApiVersion, ChartType(..), Limit, NodePath, NodeType(..), Offset, TabType(..), TermSize(..), nodePath, nodeTypePath, showTabType', TermList(MapTerm))
17
import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParam, queryParam, queryParamS)
18 19 20 21 22 23 24 25

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

26

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

43 44 45
type BaseUrl = String
type PrePath = String
type Name    = String
46 47 48 49
type BackendType = String

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

-- | 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
60 61
  , prePath :: String
  }
62

63
derive instance Generic Frontend _
64 65 66 67 68
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)
69

70 71 72 73 74 75 76 77 78 79 80
-- | 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 }

81
derive instance Eq Frontends
82 83
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
84

85 86 87 88 89 90 91 92 93
-- | 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
94
sessionPath (R.Tab t i)             = sessionPath (R.NodeAPI Node i (showTabType' t))
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
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 ]
131
sessionPath (R.GraphAPI gId p)      = "graph/" <> (show gId) <> "/" <> p
132
sessionPath (R.GetNgrams opts i)    =
133
  base opts.tabType $ "ngrams" <> qs
134
  where
135 136
    base (TabCorpus _) = sessionPath <<< R.NodeAPI Node i
    base _             = sessionPath <<< R.NodeAPI Url_Document i
137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152

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

223 224
------- misc routing stuff

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

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

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

235 236


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

252
-- instance ToUrl NodeType where
253 254
--   toUrl ec e nt i = toUrl ec e (NodeAPI nt) i

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