eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Merge pull request #4 from haskell-servant/jkarni/issue2

Browse source 
Fix top-level raw code-gen issue.
This commit is contained in:
Julian Arni 2015-01-02 10:58:24 +01:00
commit 7f1792be62
2 changed files with 19 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
src/Servant/JQuery/Internal.hs
View file

@ -6,7 +6,9 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
module Servant.JQuery.Internal where module Servant.JQuery.Internal where
import Control.Applicative
import Control.Lens import Control.Lens
import Data.Char (toLower)
import Data.Monoid import Data.Monoid
import Data.Proxy import Data.Proxy
import GHC.TypeLits import GHC.TypeLits
@ -28,7 +30,7 @@ captureArg (Cap s) = s
captureArg _ = error "captureArg called on non capture" captureArg _ = error "captureArg called on non capture"
jsSegments :: [Segment] -> String jsSegments :: [Segment] -> String
jsSegments [] = "" jsSegments [] = "/'"
jsSegments [x] = "/" ++ segmentToStr x False jsSegments [x] = "/" ++ segmentToStr x False
jsSegments (x:xs) = "/" ++ segmentToStr x True ++ jsSegments xs jsSegments (x:xs) = "/" ++ segmentToStr x True ++ jsSegments xs
@ -196,7 +198,8 @@ instance HasJQ Raw where
type JQ Raw = Method -> AjaxReq type JQ Raw = Method -> AjaxReq
jqueryFor Proxy req method = jqueryFor Proxy req method =
req & reqMethod .~ method req & funcName %~ ((toLower <$> method) <>)
& reqMethod .~ method
instance HasJQ sublayout => HasJQ (ReqBody a :> sublayout) where instance HasJQ sublayout => HasJQ (ReqBody a :> sublayout) where
type JQ (ReqBody a :> sublayout) = JQ sublayout type JQ (ReqBody a :> sublayout) = JQ sublayout

18
test/Servant/JQuerySpec.hs
View file

@ -1,5 +1,6 @@
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.JQuerySpec where module Servant.JQuerySpec where
@ -16,14 +17,23 @@ POST /simple String -> Bool
GET /has.extension Bool GET /has.extension Bool
|] |]
type TopLevelRawAPI = "something" :> Get Int
:<|> Raw
spec :: Spec spec :: Spec
spec = describe "Servant.JQuery" spec = describe "Servant.JQuery"
generateJSSpec generateJSSpec
generateJSSpec :: Spec generateJSSpec :: Spec
generateJSSpec = describe "generateJS" $ generateJSSpec = describe "generateJS" $ do
it "should always generate valid javascript" $ do it "should generate valid javascript" $ do
let (postSimple :<|> getHasExtension) = jquery (Proxy :: Proxy TestAPI) let (postSimple :<|> getHasExtension ) = jquery (Proxy :: Proxy TestAPI)
parseFromString (generateJS postSimple) `shouldSatisfy` isRight parseFromString (generateJS postSimple) `shouldSatisfy` isRight
parseFromString (generateJS getHasExtension) `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