From 9e5bed268e966e4f913fae22e2ac2f47bad454e1 Mon Sep 17 00:00:00 2001 From: Daniel Larsson Date: Sat, 3 Jan 2015 18:52:18 +0100 Subject: [PATCH 1/4] Added support for matrix parameters. --- .gitignore | 17 +++++++ servant-jquery.cabal | 8 ++-- src/Servant/JQuery/Internal.hs | 88 +++++++++++++++++++++++++++++++--- 3 files changed, 102 insertions(+), 11 deletions(-) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 00000000..0855a79b --- /dev/null +++ b/.gitignore @@ -0,0 +1,17 @@ +dist +cabal-dev +*.o +*.hi +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.virtualenv +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +cabal.config +*.prof +*.aux +*.hp diff --git a/servant-jquery.cabal b/servant-jquery.cabal index de237791..d21d4862 100644 --- a/servant-jquery.cabal +++ b/servant-jquery.cabal @@ -34,7 +34,7 @@ library build-depends: base >=4.5 && <5 , charset , lens >= 4 - , servant >= 0.2.1 + , servant >= 0.2.2 , text hs-source-dirs: src default-language: Haskell2010 @@ -54,9 +54,9 @@ executable counter aeson , base , filepath - , servant >= 0.2.1 - , servant-server >= 0.2.1 - , servant-jquery >= 0.2.1 + , servant >= 0.2.2 + , servant-server >= 0.2.3 + , servant-jquery >= 0.2.2 , stm , transformers , warp diff --git a/src/Servant/JQuery/Internal.hs b/src/Servant/JQuery/Internal.hs index 6df155a0..24d811f9 100644 --- a/src/Servant/JQuery/Internal.hs +++ b/src/Servant/JQuery/Internal.hs @@ -24,10 +24,12 @@ import Servant.API type Arg = String -data Segment = Static String -- ^ a static path segment. like "/foo" - | Cap Arg -- ^ a capture. like "/:userid" +data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] } deriving (Eq, Show) +data SegmentType = Static String -- ^ a static path segment. like "/foo" + | Cap Arg -- ^ a capture. like "/:userid" + deriving (Eq, Show) isCapture :: Segment -> Bool isCapture (Cap _) = True @@ -113,6 +115,8 @@ toValidFunctionName (x:xs) = [setFirstChar x] <> filter remainder xs , Set.connectorPunctuation ] toValidFunctionName [] = "_" +type MatrixArg = QueryArg + data Url = Url { _path :: Path , _queryStr :: [QueryArg] @@ -133,13 +137,52 @@ data AjaxReq = AjaxReq } deriving (Eq, Show) makeLenses ''QueryArg +makeLenses ''Segment makeLenses ''Url makeLenses ''AjaxReq +isCapture :: Segment -> Bool +isCapture (Segment (Cap _) _) = True +isCapture _ = False + +hasMatrixArgs :: Segment -> Bool +hasMatrixArgs (Segment _ (_:_)) = True +hasMatrixArgs _ = False + +hasArgs :: Segment -> Bool +hasArgs s = isCapture s || hasMatrixArgs s + +matrixArgs :: Segment -> [MatrixArg] +matrixArgs (Segment _ ms) = ms + +captureArg :: Segment -> Arg +captureArg (Segment (Cap s) _) = s +captureArg _ = error "captureArg called on non capture" + +jsSegments :: [Segment] -> String +jsSegments [] = "" +jsSegments [x] = "/" ++ segmentToStr x False +jsSegments (x:xs) = "/" ++ segmentToStr x True ++ jsSegments xs + +segmentToStr :: Segment -> Bool -> String +segmentToStr (Segment st ms) notTheEnd = + segmentTypeToStr st ++ jsMParams ms ++ if notTheEnd then "" else "'" + +segmentTypeToStr :: SegmentType -> String +segmentTypeToStr (Static s) = s +segmentTypeToStr (Cap s) = "' + encodeURIComponent(" ++ s ++ ") + '" + +jsGParams :: String -> [QueryArg] -> String +jsGParams _ [] = "" +jsGParams _ [x] = paramToStr x False +jsGParams s (x:xs) = paramToStr x True ++ s ++ jsGParams s xs + jsParams :: [QueryArg] -> String -jsParams [] = "" -jsParams [x] = paramToStr x False -jsParams (x:xs) = paramToStr x True ++ "&" ++ jsParams xs +jsParams = jsGParams "&" + +jsMParams :: [MatrixArg] -> String +jsMParams [] = "" +jsMParams xs = ";" ++ jsGParams ";" xs paramToStr :: QueryArg -> Bool -> String paramToStr qarg notTheEnd = @@ -184,7 +227,7 @@ instance (KnownSymbol sym, HasJQ sublayout) jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $ - req & reqUrl.path <>~ [Cap str] + req & reqUrl.path <>~ [Segment (Cap str) []] where str = symbolVal (Proxy :: Proxy sym) @@ -256,6 +299,37 @@ instance (KnownSymbol sym, HasJQ sublayout) where str = symbolVal (Proxy :: Proxy sym) +instance (KnownSymbol sym, HasJQ sublayout) + => HasJQ (MatrixParam sym a :> sublayout) where + type JQ (MatrixParam sym a :> sublayout) = JQ sublayout + + jqueryFor Proxy req = + jqueryFor (Proxy :: Proxy sublayout) $ + req & reqUrl.path._last.matrix <>~ [QueryArg str Normal] + + where str = symbolVal (Proxy :: Proxy sym) + strArg = str ++ "Value" + +instance (KnownSymbol sym, HasJQ sublayout) + => HasJQ (MatrixParams sym a :> sublayout) where + type JQ (MatrixParams sym a :> sublayout) = JQ sublayout + + jqueryFor Proxy req = + jqueryFor (Proxy :: Proxy sublayout) $ + req & reqUrl.path._last.matrix <>~ [QueryArg str List] + + where str = symbolVal (Proxy :: Proxy sym) + +instance (KnownSymbol sym, HasJQ sublayout) + => HasJQ (MatrixFlag sym :> sublayout) where + type JQ (MatrixFlag sym :> sublayout) = JQ sublayout + + jqueryFor Proxy req = + jqueryFor (Proxy :: Proxy sublayout) $ + req & reqUrl.path._last.matrix <>~ [QueryArg str Flag] + + where str = symbolVal (Proxy :: Proxy sym) + instance HasJQ Raw where type JQ Raw = Method -> AjaxReq @@ -276,7 +350,7 @@ instance (KnownSymbol path, HasJQ sublayout) jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $ - req & reqUrl.path <>~ [Static str] + req & reqUrl.path <>~ [Segment (Static str) []] & funcName %~ (str <>) where str = map (\c -> if c == '.' then '_' else c) $ symbolVal (Proxy :: Proxy path) From 8ee9b60a5048077c3d0436d275ef14b1dec25f30 Mon Sep 17 00:00:00 2001 From: Daniel Larsson Date: Sat, 3 Jan 2015 18:52:18 +0100 Subject: [PATCH 2/4] Added support for matrix parameters. --- src/Servant/JQuery/Internal.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Servant/JQuery/Internal.hs b/src/Servant/JQuery/Internal.hs index 24d811f9..a2cab3ca 100644 --- a/src/Servant/JQuery/Internal.hs +++ b/src/Servant/JQuery/Internal.hs @@ -117,6 +117,8 @@ toValidFunctionName [] = "_" type MatrixArg = QueryArg +type MatrixArg = QueryArg + data Url = Url { _path :: Path , _queryStr :: [QueryArg] From 467df6dd6612cb98b53d6fa59f24040ada18cf20 Mon Sep 17 00:00:00 2001 From: "Julian K. Arni" Date: Thu, 19 Mar 2015 17:16:44 +0100 Subject: [PATCH 3/4] Rebase fix --- src/Servant/JQuery/Internal.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/Servant/JQuery/Internal.hs b/src/Servant/JQuery/Internal.hs index a2cab3ca..24d811f9 100644 --- a/src/Servant/JQuery/Internal.hs +++ b/src/Servant/JQuery/Internal.hs @@ -117,8 +117,6 @@ toValidFunctionName [] = "_" type MatrixArg = QueryArg -type MatrixArg = QueryArg - data Url = Url { _path :: Path , _queryStr :: [QueryArg] From ad900cda513b5016e9a80a1253de4d1dbb9f41e1 Mon Sep 17 00:00:00 2001 From: "Julian K. Arni" Date: Fri, 27 Mar 2015 10:27:27 +0100 Subject: [PATCH 4/4] More PR5 fixes --- CHANGELOG.md | 1 + src/Servant/JQuery.hs | 5 +++-- src/Servant/JQuery/Internal.hs | 21 +-------------------- test/Servant/JQuerySpec.hs | 1 - 4 files changed, 5 insertions(+), 23 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 093c93aa..ceac30d4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ --- * Extend `HeaderArg` to support more advanced HTTP header handling (https://github.com/haskell-servant/servant-jquery/pull/6) * Support content-type aware combinators (but require that endpoints support JSON) +* Add support for Matrix params (https://github.com/haskell-servant/servant-jquery/pull/11) 0.2.2 ----- diff --git a/src/Servant/JQuery.hs b/src/Servant/JQuery.hs index 38ff92d8..d979755d 100644 --- a/src/Servant/JQuery.hs +++ b/src/Servant/JQuery.hs @@ -46,7 +46,7 @@ generateJS req = "\n" <> ++ body ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs ++ ["onSuccess", "onError"] - + captures = map captureArg . filter isCapture $ req ^. reqUrl.path @@ -76,7 +76,8 @@ generateJS req = "\n" <> fname = req ^. funcName method = req ^. reqMethod - url = "'" + url = if url' == "'" then "'/'" else url' + url' = "'" ++ urlArgs ++ queryArgs diff --git a/src/Servant/JQuery/Internal.hs b/src/Servant/JQuery/Internal.hs index 24d811f9..738acd7e 100644 --- a/src/Servant/JQuery/Internal.hs +++ b/src/Servant/JQuery/Internal.hs @@ -31,25 +31,6 @@ data SegmentType = Static String -- ^ a static path segment. like "/foo" | Cap Arg -- ^ a capture. like "/:userid" deriving (Eq, Show) -isCapture :: Segment -> Bool -isCapture (Cap _) = True -isCapture _ = False - -captureArg :: Segment -> Arg -captureArg (Cap s) = s -captureArg _ = error "captureArg called on non capture" - -jsSegments :: [Segment] -> String -jsSegments [] = "/'" -jsSegments [x] = "/" ++ segmentToStr x False -jsSegments (x:xs) = "/" ++ segmentToStr x True ++ jsSegments xs - -segmentToStr :: Segment -> Bool -> String -segmentToStr (Static s) notTheEnd = - if notTheEnd then s else s ++ "'" -segmentToStr (Cap s) notTheEnd = - "' + encodeURIComponent(" ++ s ++ if notTheEnd then ") + '" else ")" - type Path = [Segment] data ArgType = @@ -305,7 +286,7 @@ instance (KnownSymbol sym, HasJQ sublayout) jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $ - req & reqUrl.path._last.matrix <>~ [QueryArg str Normal] + req & reqUrl.path._last.matrix <>~ [QueryArg strArg Normal] where str = symbolVal (Proxy :: Proxy sym) strArg = str ++ "Value" diff --git a/test/Servant/JQuerySpec.hs b/test/Servant/JQuerySpec.hs index ce06e98f..077b9b87 100644 --- a/test/Servant/JQuerySpec.hs +++ b/test/Servant/JQuerySpec.hs @@ -13,7 +13,6 @@ import Language.ECMAScript3.Parser (parseFromString) import Test.Hspec import Servant.API -import Servant.API.ContentTypes import Servant.JQuery import Servant.JQuerySpec.CustomHeaders