Added support for matrix parameters.
This commit is contained in:
parent
84f8f814c7
commit
9e5bed268e
3 changed files with 102 additions and 11 deletions
17
.gitignore
vendored
Normal file
17
.gitignore
vendored
Normal 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
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in a new issue