Merge branch 'master' into canonical-types

This commit is contained in:
Alp Mestanogullari 2015-04-19 10:35:24 +02:00
commit 504793b3b3
6 changed files with 106 additions and 33 deletions

17
.gitignore vendored Normal file
View File

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

View File

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

View File

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

View File

@ -48,7 +48,7 @@ generateJS req = "\n" <>
++ body
++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
++ ["onSuccess", "onError"]
captures = map captureArg
. filter isCapture
$ req ^. reqUrl.path
@ -78,7 +78,8 @@ generateJS req = "\n" <>
fname = req ^. funcName
method = req ^. reqMethod
url = "'"
url = if url' == "'" then "'/'" else url'
url' = "'"
++ urlArgs
++ queryArgs

View File

@ -24,29 +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)
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 ")"
data SegmentType = Static String -- ^ a static path segment. like "/foo"
| Cap Arg -- ^ a capture. like "/:userid"
deriving (Eq, Show)
type Path = [Segment]
@ -113,6 +96,8 @@ toValidFunctionName (x:xs) = [setFirstChar x] <> filter remainder xs
, Set.connectorPunctuation ]
toValidFunctionName [] = "_"
type MatrixArg = QueryArg
data Url = Url
{ _path :: Path
, _queryStr :: [QueryArg]
@ -133,13 +118,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 =
@ -186,7 +210,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)
@ -258,6 +282,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 strArg 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
@ -278,7 +333,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)

View File

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