diff --git a/servant-py.cabal b/servant-py.cabal index a8cd658..9475203 100644 --- a/servant-py.cabal +++ b/servant-py.cabal @@ -26,6 +26,7 @@ library exposed-modules: Servant.PY , Servant.PY.Requests , Servant.PY.Internal + , Servant.PY.Treq , Servant.PY.Python build-depends: base >= 4.7 && < 5 , aeson @@ -73,6 +74,7 @@ test-suite servant-py-test other-modules: Servant.PYSpec Servant.PY.InternalSpec + Servant.PY.TreqSpec build-depends: base , servant-py , aeson diff --git a/src/Servant/PY.hs b/src/Servant/PY.hs index 8131135..d079fc3 100644 --- a/src/Servant/PY.hs +++ b/src/Servant/PY.hs @@ -18,6 +18,8 @@ module Servant.PY ( -- * Generating python code from an API type -- Requests library , requests + -- Treq library + , treq , -- * Function renamers concatCase @@ -39,7 +41,7 @@ import Servant.Foreign import Servant.PY.Internal import Servant.PY.Python import Servant.PY.Requests - +import Servant.PY.Treq (treq) -- | Generate the data necessary to generate Python code -- for all the endpoints of an API, as ':<|>'-separated values -- of type 'PyRequest'. @@ -57,7 +59,7 @@ pythonTyped p = foreignFor (Proxy :: Proxy Python) (Proxy :: Proxy Text) p defRe -- a file or integrate it in a page, for example. pyForAPI :: (HasForeign NoTypes NoContent api, GenerateList NoContent (Foreign NoContent api)) => Proxy api -- ^ proxy for your API type - -> PythonGenerator -- ^ python code generator to use (requests is the only one for now) + -> PythonGenerator -- ^ python code generator to use (requests or treq) -> Text -- ^ a text that you can embed in your pages or write to a file pyForAPI p gen = gen (UnTypedPythonRequest <$> listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy NoContent) p) @@ -66,7 +68,7 @@ pyForAPI p gen = gen (UnTypedPythonRequest <$> listFromAPI (Proxy :: Proxy NoTyp -- and write the resulting code to a file at the given path. writePythonForAPI :: (HasForeign NoTypes NoContent api, GenerateList NoContent (Foreign NoContent api)) => Proxy api -- ^ proxy for your API type - -> PythonGenerator -- ^ python code generator to use (requests is the only one for now) + -> PythonGenerator -- ^ python code generator to use (requests or treq) -> FilePath -- ^ path to the file you want to write the resulting javascript code into -> IO () writePythonForAPI p gen fp = writeFile fp (T.unpack $ pyForAPI p gen) @@ -77,14 +79,14 @@ writePythonForAPI p gen fp = writeFile fp (T.unpack $ pyForAPI p gen) -- a file or integrate it in a page, for example. pyTypedForAPI :: (HasForeign Python T.Text api, GenerateList T.Text (Foreign T.Text api)) => Proxy api -- ^ proxy for your API type - -> PythonGenerator -- ^ python code generator to use (requests is the only one for now) + -> PythonGenerator -- ^ python code generator to use (requests or treq) -> Text -- ^ a text that you can embed in your pages or write to a file pyTypedForAPI p gen = gen (TypedPythonRequest <$> listFromAPI (Proxy :: Proxy Python) (Proxy :: Proxy T.Text) p) writeTypedPythonForAPI :: (HasForeign Python T.Text api, GenerateList T.Text (Foreign T.Text api)) => Proxy api -- ^ proxy for your API type - -> PythonGenerator -- ^ python code generator to use (requests is the only one for now) + -> PythonGenerator -- ^ python code generator to use (requests or treq) -> FilePath -- ^ path to the file you want to write the resulting javascript code into -> IO () writeTypedPythonForAPI p gen fp = writeFile fp (T.unpack $ pyTypedForAPI p gen) diff --git a/src/Servant/PY/Internal.hs b/src/Servant/PY/Internal.hs index eb6eecb..8d347b6 100644 --- a/src/Servant/PY/Internal.hs +++ b/src/Servant/PY/Internal.hs @@ -262,15 +262,14 @@ makePyUrl opts (TypedPythonRequest req) offset = makePyUrl' opts req offset makePyUrl opts (UnTypedPythonRequest req) offset = makePyUrl' opts req offset makePyUrl' :: forall f. CommonGeneratorOptions -> Req f -> Text -> Text -makePyUrl' opts req offset = "\"" <> url <> "\"" +makePyUrl' opts req offset = "\"" <> url <> "\"" <> withFormattedCaptures offset pathParts where url = urlPrefix opts <> "/" <> getSegments pathParts - <> withFormattedCaptures offset pathParts pathParts = req ^.. reqUrl.path.traverse getSegments :: forall f. [Segment f] -> Text getSegments segments = if null segments then "" - else T.intercalate "/" (map segmentToStr segments) <> "\"" + else T.intercalate "/" (map segmentToStr segments) withFormattedCaptures :: Text -> [Segment f] -> Text withFormattedCaptures offset segments = formattedCaptures (capturesToFormatArgs segments) @@ -306,7 +305,7 @@ buildDocString (UnTypedPythonRequest req) opts returnVal = buildDocString' req o where args = capturesToFormatArgs $ req ^.. reqUrl.path.traverse buildDocString' :: forall f. Req f -> CommonGeneratorOptions -> [Text] -> Text -> Text -buildDocString' req opts args returnVal = T.toUpper method <> " \"" <> url <> "\n" +buildDocString' req opts args returnVal = T.toUpper method <> " /" <> url <> "\n" <> includeArgs <> "\n\n" <> indent' <> "Returns:\n" <> indent' <> indent' <> returnVal diff --git a/src/Servant/PY/Treq.hs b/src/Servant/PY/Treq.hs new file mode 100644 index 0000000..f97294a --- /dev/null +++ b/src/Servant/PY/Treq.hs @@ -0,0 +1,105 @@ +module Servant.PY.Treq + ( treq + ) where + +import Data.Monoid + ( (<>) + ) +import Data.Proxy + (Proxy + ) +import Data.Text + ( Text + ) + +import qualified Data.Text as T + +import Servant.PY.Internal + ( PythonRequest + , PythonGenerator + , CommonGeneratorOptions(returnMode, indentation, requestBody) + , ReturnStyle(DangerMode, RawResponse) + , Indent + , PyRequestArgs(PyRequestArgs) + , defCommonGeneratorOptions + , functionName + , buildDocString + , makePyUrl + , indent + , hasBody + , getHeaderDict + , getParams + , remainingReqCall + , getMethod + , paramNames + , retrieveHeaders + , toValidFunctionName + , captures + ) + +-- | Generate python functions that use the treq library. +-- Uses 'defCommonGeneratorOptions' for the generator options. +treq :: PythonGenerator +treq reqs = defPyImports <> mconcat (map treqWithDef reqs) + +defPyImports :: Text +defPyImports = + T.unlines + [ "try: from urllib import parse" -- Python 3 + , "except: import urllib as parse" -- Python 2 + , "" + , "from twisted.internet.defer import inlineCallbacks, returnValue" + ] + +treqWithDef :: PythonRequest -> Text +treqWithDef = generatePyTreqWith defCommonGeneratorOptions + +generatePyTreqWith :: CommonGeneratorOptions -> PythonRequest -> Text +generatePyTreqWith opts req = + "\n" + <> "@inlineCallbacks\n" + <> "def " <> functionName opts req <> "(" <> argsStr <> "):\n" + <> indent' <> docStringMarker + <> indent' <> buildDocString req opts returnVal <> "\n" + <> indent' <> docStringMarker + <> indent' <> "url = " <> makePyUrl opts req (indent' <> indent') <> "\n\n" + <> headerDef + <> paramDef + <> requestBuilder <> "(url" <> remaining (T.length requestBuilder + 1) <> "\n" + <> functionReturn (returnMode opts) (indentation opts) + <> "\n\n" + where argsStr = T.intercalate ", " args + args = [ "treq" ] + ++ captures req + ++ qparams + ++ body + ++ map (toValidFunctionName + . (<>) "header" + ) hs + hs = retrieveHeaders req + qparams = paramNames req + method = T.toLower $ getMethod req + remaining = remainingReqCall $ PyRequestArgs (not . null $ hs) (not . null $ qparams) (hasBody req) + paramDef + | null qparams = "" + | otherwise = indent' <> "params = " <> getParams (indent' <> indent') req <> "\n" + headerDef + | null hs = "" + | otherwise = indent' <> "headers = " <> getHeaderDict req <> "\n" + requestBuilder = indent' <> "resp = yield treq." <> method + body = [requestBody opts | hasBody req] + indent' = indentation opts indent + docStringMarker = "\"\"\"\n" + returnVal = case returnMode opts of + DangerMode -> "JSON response from the endpoint" + RawResponse -> "response (IResponse) from issuing the request" + +functionReturn :: ReturnStyle -> (Proxy Indent -> T.Text) -> T.Text +functionReturn DangerMode pyindenter = + indent' <> "if resp.code < 200 or resp.code > 299:\n" + <> indent' <> indent' <> "raise Exception(resp)\n" + <> indent' <> "returnValue((yield resp.json_content()))\n" + where indent' = pyindenter indent + +functionReturn RawResponse pyindenter = indent' <> "returnValue(resp)" + where indent' = pyindenter indent diff --git a/test/Servant/PY/InternalSpec.hs b/test/Servant/PY/InternalSpec.hs index 20cc19c..7da10df 100644 --- a/test/Servant/PY/InternalSpec.hs +++ b/test/Servant/PY/InternalSpec.hs @@ -102,14 +102,14 @@ internalSpec = describe "Internal" $ do describe "functions that operate on Req objects" $ do let captureList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy NoContent) captureApi - -- it "should correctly find captures" $ do - -- let captured = captures . head $ captureList - -- captured `shouldBe` ["id", "Name", "hungrig"] + it "should correctly find captures" $ do + let captured = captures . head $ map UnTypedPythonRequest captureList + captured `shouldBe` ["id", "Name", "hungrig"] - -- let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy NoContent) testApi - -- it "should not incorrectly find captures" $ do - -- let captured = captures . head $ reqList - -- captured `shouldBe` [] + let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy NoContent) testApi + it "should not incorrectly find captures" $ do + let captured = captures . head $ map UnTypedPythonRequest reqList + captured `shouldBe` [] let req = head captureList let pathParts = req ^.. reqUrl.path.traverse @@ -126,18 +126,18 @@ internalSpec = describe "Internal" $ do it "should build a formatted val that ends with parens" $ property $ \s -> T.isSuffixOf (T.pack s <> "))") $ formatBuilder $ T.pack s - -- it "should build urls properly with / separator" $ do - -- let pyUrl = makePyUrl customOptions req " " - -- pyUrl `shouldBe` "\"urlForRequesting:9000/login-with-path-var-and-header/{id}/{Name}/{hungrig}\"" - -- <> withFormattedCaptures " " pathParts + it "should build urls properly with / separator" $ do + let pyUrl = makePyUrl customOptions (UnTypedPythonRequest req) " " + pyUrl `shouldBe` "\"urlForRequesting:9000/login-with-path-var-and-header/{id}/{Name}/{hungrig}\"" + <> withFormattedCaptures " " pathParts it "should do segment-to-str as a plain string for Static" $ segmentToStr (head pathParts) == "login-with-path-var-and-header" it "should do segment-to-str in formatting braces for a capture" $ segmentToStr (last pathParts) == "{hungrig}" - -- it "should build a doctstring that looks like a regular Python docstring" $ do - -- let docstring = buildDocString req customOptions - -- docstring `shouldContain` "POST" - -- docstring `shouldContain` makePyUrl' pathParts - -- docstring `shouldContain` "Args:" - -- docstring `shouldContain` "Returns:" + it "should build a doctstring that looks like a regular Python docstring" $ do + let docstring = buildDocString (UnTypedPythonRequest req) customOptions "" + docstring `shouldContain` "POST" + docstring `shouldContain` "/login-with-path-var-and-header/{id}/{Name}/{hungrig}" + docstring `shouldContain` "Args:" + docstring `shouldContain` "Returns:" diff --git a/test/Servant/PY/TreqSpec.hs b/test/Servant/PY/TreqSpec.hs new file mode 100644 index 0000000..f983972 --- /dev/null +++ b/test/Servant/PY/TreqSpec.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Servant.PY.TreqSpec + ( spec + ) where + +import Data.Proxy + ( Proxy(Proxy) + ) + +import Servant.API + ( NoContent + ) + +import Servant.Foreign + ( listFromAPI + ) + +import Servant.PY + ( NoTypes + ) + +import Servant.PY.Internal + ( PythonRequest(UnTypedPythonRequest) + ) + +import Servant.PY.Treq + ( treq + ) + +import Servant.PY.InternalSpec + ( testApi + , captureApi + , shouldContain + ) + +import Test.Hspec + ( Spec + , describe + , it + ) + +spec :: Spec +spec = describe "Servant.PY.Treq" treqSpec + +treqSpec :: Spec +treqSpec = describe "Treq" $ do + describe "treq" $ do + describe "without captures" $ + let + reqs = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy NoContent) testApi + pyReqs = map UnTypedPythonRequest reqs + source = treq pyReqs + in do + it "Must import this infrastructure stuff" $ + source `shouldContain` "\nfrom twisted.internet.defer import inlineCallbacks, returnValue\n" + it "A function signature should look about like this" $ + source `shouldContain` "\n@inlineCallbacks\ndef post_counterreqheader(treq):\n" + it "The actual request is basically like this" $ + source `shouldContain` "\n resp = yield treq.post(url)\n" + it "If there are headers, we should pass them." $ do + source `shouldContain` "headers = {\"Some-Header\": headerSomeHeader}" + source `shouldContain` " headers=headers" + it "If there are params, we should pass them." $ do + source `shouldContain` "params = {\"sortby\": sortby}" + source `shouldContain` "params=params" + describe "with captures" $ + let + reqs = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy NoContent) captureApi + pyReqs = map UnTypedPythonRequest reqs + source = treq pyReqs + in do + it "A function signature needs parameters for the captures." $ + source `shouldContain` "\n@inlineCallbacks\ndef post_loginwithpathvarandheader_by_id_by_Name_by_hungrig(treq, id, Name, hungrig, data):\n" + it "Captures should be quoted into the url" $ + source `shouldContain` "id=parse.quote(str(id))," + it "Payload should be passed along as well." $ + source `shouldContain` "json=data"