Added support for matrix parameters.

This commit is contained in:
Daniel Larsson 2015-01-03 18:52:18 +01:00 committed by Julian K. Arni
parent 84f8f814c7
commit 9e5bed268e
3 changed files with 102 additions and 11 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

@ -34,7 +34,7 @@ library
build-depends: base >=4.5 && <5 build-depends: base >=4.5 && <5
, charset , charset
, lens >= 4 , lens >= 4
, servant >= 0.2.1 , servant >= 0.2.2
, text , text
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
@ -54,9 +54,9 @@ executable counter
aeson aeson
, base , base
, filepath , filepath
, servant >= 0.2.1 , servant >= 0.2.2
, servant-server >= 0.2.1 , servant-server >= 0.2.3
, servant-jquery >= 0.2.1 , servant-jquery >= 0.2.2
, stm , stm
, transformers , transformers
, warp , warp

View file

@ -24,10 +24,12 @@ import Servant.API
type Arg = String type Arg = String
data Segment = Static String -- ^ a static path segment. like "/foo" data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] }
| Cap Arg -- ^ a capture. like "/:userid"
deriving (Eq, Show) 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 :: Segment -> Bool
isCapture (Cap _) = True isCapture (Cap _) = True
@ -113,6 +115,8 @@ toValidFunctionName (x:xs) = [setFirstChar x] <> filter remainder xs
, Set.connectorPunctuation ] , Set.connectorPunctuation ]
toValidFunctionName [] = "_" toValidFunctionName [] = "_"
type MatrixArg = QueryArg
data Url = Url data Url = Url
{ _path :: Path { _path :: Path
, _queryStr :: [QueryArg] , _queryStr :: [QueryArg]
@ -133,13 +137,52 @@ data AjaxReq = AjaxReq
} deriving (Eq, Show) } deriving (Eq, Show)
makeLenses ''QueryArg makeLenses ''QueryArg
makeLenses ''Segment
makeLenses ''Url makeLenses ''Url
makeLenses ''AjaxReq 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 :: [QueryArg] -> String
jsParams [] = "" jsParams = jsGParams "&"
jsParams [x] = paramToStr x False
jsParams (x:xs) = paramToStr x True ++ "&" ++ jsParams xs jsMParams :: [MatrixArg] -> String
jsMParams [] = ""
jsMParams xs = ";" ++ jsGParams ";" xs
paramToStr :: QueryArg -> Bool -> String paramToStr :: QueryArg -> Bool -> String
paramToStr qarg notTheEnd = paramToStr qarg notTheEnd =
@ -184,7 +227,7 @@ instance (KnownSymbol sym, HasJQ sublayout)
jqueryFor Proxy req = jqueryFor Proxy req =
jqueryFor (Proxy :: Proxy sublayout) $ jqueryFor (Proxy :: Proxy sublayout) $
req & reqUrl.path <>~ [Cap str] req & reqUrl.path <>~ [Segment (Cap str) []]
where str = symbolVal (Proxy :: Proxy sym) where str = symbolVal (Proxy :: Proxy sym)
@ -256,6 +299,37 @@ instance (KnownSymbol sym, HasJQ sublayout)
where str = symbolVal (Proxy :: Proxy sym) 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 instance HasJQ Raw where
type JQ Raw = Method -> AjaxReq type JQ Raw = Method -> AjaxReq
@ -276,7 +350,7 @@ instance (KnownSymbol path, HasJQ sublayout)
jqueryFor Proxy req = jqueryFor Proxy req =
jqueryFor (Proxy :: Proxy sublayout) $ jqueryFor (Proxy :: Proxy sublayout) $
req & reqUrl.path <>~ [Static str] req & reqUrl.path <>~ [Segment (Static str) []]
& funcName %~ (str <>) & funcName %~ (str <>)
where str = map (\c -> if c == '.' then '_' else c) $ symbolVal (Proxy :: Proxy path) where str = map (\c -> if c == '.' then '_' else c) $ symbolVal (Proxy :: Proxy path)