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

6
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, (:=), (~>), jsonEmptyObject, (.:))
7 8 9
import Data.Foldable (foldMap)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
10
import Data.Maybe (Maybe(..), maybe)
11
import Gargantext.Routes as R
12 13
import Gargantext.Types (ApiVersion, Limit, NodePath, NodeType(..), Offset, TabType(..), TermSize(..), nodePath, nodeTypePath, showTabType')
import Prelude (class Eq, class Show, identity, show, ($), (<>), bind, pure, (<<<), (==))
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

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

47 48 49 50 51 52 53 54 55 56 57 58
-- 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
59
    name <- obj .: "name"
60 61 62 63 64
    baseUrl <- obj .: "baseUrl"
    prePath <- obj .: "prePath"
    version <- obj .: "version"
    pure $ Backend {name, baseUrl, prePath, version}

65 66 67 68 69 70 71 72 73 74 75 76
-- | 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

77 78 79
instance toUrlFrontendNodePath :: ToUrl Frontend NodePath where
  toUrl front np = frontendUrl front (nodePath np)

80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
-- | 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 }

100 101
derive instance eqFrontends :: Eq Frontends

James Laver's avatar
James Laver committed
102 103 104 105 106 107
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)

108 109 110 111 112 113 114 115 116
-- | 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
117 118 119
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
120
sessionPath (R.GraphAPI gId p)      = "graph/" <> (show gId) <> "/" <> p
121
sessionPath (R.GetNgrams opts i)    =
122
  base opts.tabType
123 124 125 126 127 128 129 130
     $ "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
131
    <> "&scoreType=" <> show opts.scoreType
132
    <> search opts.searchQuery
133
  where
134 135
    base (TabCorpus _) = sessionPath <<< R.NodeAPI Node i
    base _             = sessionPath <<< R.NodeAPI Url_Document i
136 137 138 139
    termSizeFilter MonoTerm = "&minTermSize=0&maxTermSize=1"
    termSizeFilter MultiTerm = "&minTermSize=2"
    search "" = ""
    search s = "&search=" <> s
140 141 142 143 144 145
sessionPath (R.GetNgramsTableAll opts i) =
  sessionPath $ R.NodeAPI Node i
     $ "ngrams?ngramsType="
    <> showTabType' opts.tabType
    <> foldMap (\x -> "&list=" <> show x) opts.listIds
    <> limitUrl 100000
146
sessionPath (R.ListDocument lId dId) =
147
  sessionPath $ R.NodeAPI NodeList lId ("document/" <> (show $ maybe 0 identity dId))
148
sessionPath (R.ListsRoute lId) = "lists/" <> show lId
149
sessionPath (R.PutNgrams t listId termList i) =
150 151 152 153 154 155 156 157
  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)
158 159 160 161 162 163 164 165
sessionPath (R.Search {listId, limit, offset, orderBy} Nothing) =
  sessionPath $ R.NodeAPI Corpus Nothing
     $ "search?list_id=" <> show listId
    <> offsetUrl offset
    <> limitUrl limit
    <> orderUrl orderBy
sessionPath (R.Search {listId, limit, offset, orderBy} (Just corpusId)) =
  sessionPath $ R.NodeAPI Corpus (Just corpusId)
166
     $ "search?list_id=" <> show listId
167 168 169
    <> offsetUrl offset
    <> limitUrl limit
    <> orderUrl orderBy
170 171 172 173 174
-- sessionPath (R.Search {listId, limit, offset, orderBy} (Just corpusId)) =
--     "search/" <> (show corpusId) <> "/list/" <> (show listId) <> "?"
--     <> offsetUrl offset
--     <> limitUrl limit
--     <> orderUrl orderBy
175
sessionPath (R.CorpusMetrics {tabType, listId, limit} i) =
176 177 178 179
  sessionPath $ R.NodeAPI Corpus i
     $ "metrics"
    <> "?ngrams=" <> show listId
    <> "&ngramsType=" <> showTabType' tabType
Nicolas Pouillard's avatar
Nicolas Pouillard committed
180
    <> maybe "" limitUrl limit
181 182
-- TODO fix this url path
sessionPath (R.Chart {chartType, tabType} i) =
183 184 185 186
  sessionPath $ R.NodeAPI Corpus i
     $ show chartType
    <> "?ngramsType=" <> showTabType' tabType
    <> "&listType=GraphTerm" -- <> show listId
Nicolas Pouillard's avatar
Nicolas Pouillard committed
187
    -- <> maybe "" limitUrl limit
188
-- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i
189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216

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