Fix top-level raw code-gen issue.
This commit is contained in:
parent
fb153d4e08
commit
8dfb3294b8
2 changed files with 19 additions and 6 deletions
|
@ -6,7 +6,9 @@
|
|||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Servant.JQuery.Internal where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Lens
|
||||
import Data.Char (toLower)
|
||||
import Data.Monoid
|
||||
import Data.Proxy
|
||||
import GHC.TypeLits
|
||||
|
@ -28,7 +30,7 @@ captureArg (Cap s) = s
|
|||
captureArg _ = error "captureArg called on non capture"
|
||||
|
||||
jsSegments :: [Segment] -> String
|
||||
jsSegments [] = ""
|
||||
jsSegments [] = "/'"
|
||||
jsSegments [x] = "/" ++ segmentToStr x False
|
||||
jsSegments (x:xs) = "/" ++ segmentToStr x True ++ jsSegments xs
|
||||
|
||||
|
@ -196,7 +198,8 @@ instance HasJQ Raw where
|
|||
type JQ Raw = Method -> AjaxReq
|
||||
|
||||
jqueryFor Proxy req method =
|
||||
req & reqMethod .~ method
|
||||
req & funcName %~ ((toLower <$> method) <>)
|
||||
& reqMethod .~ method
|
||||
|
||||
instance HasJQ sublayout => HasJQ (ReqBody a :> sublayout) where
|
||||
type JQ (ReqBody a :> sublayout) = JQ sublayout
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
module Servant.JQuerySpec where
|
||||
|
||||
|
@ -16,14 +17,23 @@ POST /simple String -> Bool
|
|||
GET /has.extension Bool
|
||||
|]
|
||||
|
||||
type TopLevelRawAPI = "something" :> Get Int
|
||||
:<|> Raw
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Servant.JQuery"
|
||||
generateJSSpec
|
||||
|
||||
generateJSSpec :: Spec
|
||||
generateJSSpec = describe "generateJS" $
|
||||
it "should always generate valid javascript" $ do
|
||||
generateJSSpec = describe "generateJS" $ do
|
||||
it "should generate valid javascript" $ do
|
||||
let (postSimple :<|> getHasExtension ) = jquery (Proxy :: Proxy TestAPI)
|
||||
parseFromString (generateJS postSimple) `shouldSatisfy` isRight
|
||||
parseFromString (generateJS getHasExtension) `shouldSatisfy` isRight
|
||||
print $ generateJS getHasExtension
|
||||
|
||||
it "should use non-empty function names" $ do
|
||||
let (_ :<|> topLevel) = jquery (Proxy :: Proxy TopLevelRawAPI)
|
||||
print $ generateJS $ topLevel "GET"
|
||||
parseFromString (generateJS $ topLevel "GET") `shouldSatisfy` isRight
|
||||
|
||||
|
|
Loading…
Reference in a new issue