Commit 4151742f authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Config] Front or Back sugar toUrl function.

parent 69d93c2b
...@@ -26,103 +26,138 @@ import Data.Map as DM ...@@ -26,103 +26,138 @@ import Data.Map as DM
import Data.Maybe (maybe) import Data.Maybe (maybe)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
------------------------------------------------------------ endConfig :: EndConfig
-- | Versions will used later after the release endConfig = endConfig' V10
data ApiVersion = V10 | V11
endConfig' :: ApiVersion -> EndConfig
endConfig' v = { front : frontCaddy
, back : backDev v }
------------------------------------------------------------------------
frontCaddy :: Config
frontCaddy = { proto : "http://"
, port : 2015
, domain : "localhost"
, prePath : "/#/"
}
instance showApiVersion :: Show ApiVersion where frontHaskell :: Config
show V10 = "v1.0" frontHaskell = { proto : "http://"
show V11 = "v1.1" , port : 8008
, domain : "localhost"
, prePath : "/index.html#/"
}
data End = Back | Front frontProd :: Config
frontProd = { proto : "https://"
, port : 8080
, domain : "gargantext.org"
, prePath : "/index.html#/"
}
-- | Main options of the configuration ------------------------------------------------------------------------
data Mode = Mock | Dev | Prod
config :: FrontEndConfig backDev :: ApiVersion -> Config
config = mkConfig Dev V10 backDev v = { proto : "http://"
, port : 8008
, domain : "localhost"
, prePath : "/api/" <> show v <> "/"
}
mkAdress :: Mode -> String backProd :: ApiVersion -> Config
mkAdress Mock = "localhost" backProd v = { proto : "https://"
mkAdress Dev = "localhost" , port : 8080
mkAdress Prod = "gargantext.org" , domain : "gargantext.org"
, prePath : "/api/" <> show v <> "/"
}
------------------------------------------------------------------------
mkPort :: Mode -> Int
mkPort Mock = 2015
mkPort Dev = 8008
mkPort Prod = 8080
mkProto :: Mode -> String type EndConfig = { front :: Config
mkProto Mock = "http://" , back :: Config
mkProto Dev = "http://" }
mkProto Prod = "https://"
------------------------------------------------------------ type Config = { proto :: String
urlConfig :: Map NodeType Url
urlConfig = DM.fromFoldable [ Tuple UserPage "user"
, easy Corpus
, easy Project
, easy Document
, easy Annuaire
, easy Individu
, easy Tree
]
where
easy :: NodeType -> Tuple NodeType Url
easy n = Tuple n (show n)
------------------------------------------------------------
type FrontEndConfig = { proto :: String
, port :: Int , port :: Int
, address :: String , domain :: String
, apiVersion :: ApiVersion , prePath :: String
, urls :: Map NodeType Url
}
mkConfig :: Mode -> ApiVersion -> FrontEndConfig
mkConfig mode v = { proto : mkProto mode
, address : mkAdress mode
, port : mkPort mode
, apiVersion : v
, urls : urlConfig
} }
------------------------------------------------------------
type UrlBase = String
type UrlPath = String
type UrlParam = String
type Url = String
doUrl :: UrlBase -> UrlPath -> UrlParam -> Url
doUrl b p ps = b <> p <> ps
------------------------------------------------------------ ------------------------------------------------------------
endBaseUrl :: End -> EndConfig -> UrlBase
endBaseUrl Back c = baseUrl c.back
endBaseUrl Front c = baseUrl c.front
baseUrl :: Config -> UrlBase
baseUrl conf = conf.proto <> conf.domain <> ":" <> show conf.port
------------------------------------------------------------ ------------------------------------------------------------
-- | Main function to use in the Front-End developpement
-- for more complex urls, use urlConfig and smart constructors endPathUrl :: End -> EndConfig -> NodeType -> Id -> UrlPath
endPathUrl Back c nt i = pathUrl c.back nt i
endPathUrl Front c nt i = pathUrl c.front nt i
pathUrl :: Config -> NodeType -> Id -> UrlPath
pathUrl c nt i = c.prePath <> urlConfig nt <> "/" <> show i
------------------------------------------------------------
toUrl :: End -> NodeType -> Id -> Url toUrl :: End -> NodeType -> Id -> Url
toUrl end nt i = config.proto <> config.address <> ":" <> show config.port <> end' <> path toUrl e nt i = doUrl base path params
where where
end' = case end of base = endBaseUrl e endConfig
Back -> "/api/" <> show config.apiVersion <> "/" path = endPathUrl e endConfig nt i
Front -> "/" params = ""
path = subPath <> "/" <> show i
subPath = maybe "errorSubPath" identity (DM.lookup nt config.urls)
------------------------------------------------------------ ------------------------------------------------------------
type Url = String data NodeType = UserPage | Folder | Corpus | Document | Annuaire | Individu | Project | Tree | Error
data End = Back | Front
type Id = Int type Id = Int
------------------------------------------------------------ ------------------------------------------------------------
data NodeType = UserPage | Corpus | Document | Annuaire | Individu | Project | Tree | Error data ApiVersion = V10 | V11
instance showApiVersion :: Show ApiVersion where
show V10 = "v1.0"
show V11 = "v1.1"
------------------------------------------------------------
------------------------------------------------------------
urlConfig :: NodeType -> Url
urlConfig UserPage = "user"
urlConfig Corpus = show Corpus
urlConfig Project = show Project
urlConfig Project = show Project
urlConfig Document = show Document
urlConfig Annuaire = show Annuaire
urlConfig Individu = show Individu
urlConfig Tree = show Tree
urlConfig _ = "error Url Config with That Node Type"
------------------------------------------------------------ ------------------------------------------------------------
instance showNodeType :: Show NodeType where instance showNodeType :: Show NodeType where
show UserPage = "user" show UserPage = "user"
show Project = "project"
show Folder = "folder"
show Corpus = "corpus" show Corpus = "corpus"
show Document = "document" show Document = "document"
show Annuaire = "annuaire" show Annuaire = "annuaire"
show Individu = "individu" show Individu = "individu"
show Project = "project"
show Tree = "tree" show Tree = "tree"
show Error = "errNodeType" show Error = "errNodeType"
readNodeType :: String -> NodeType readNodeType :: String -> NodeType
readNodeType "NodeUser" = UserPage readNodeType "NodeUser" = UserPage
readNodeType "Project" = Project
readNodeType "Folder" = Folder
readNodeType "NodeCorpus" = Corpus readNodeType "NodeCorpus" = Corpus
readNodeType "Document" = Document readNodeType "Document" = Document
readNodeType "Annuaire" = Annuaire readNodeType "Annuaire" = Annuaire
readNodeType "Individu" = Individu readNodeType "Individu" = Individu
readNodeType "Project" = Project
readNodeType "Tree" = Tree readNodeType "Tree" = Tree
readNodeType _ = Error readNodeType _ = Error
------------------------------------------------------------
instance ordNodeType :: Ord NodeType where instance ordNodeType :: Ord NodeType where
compare n1 n2 = compare (show n1) (show n2) compare n1 n2 = compare (show n1) (show n2)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment