diff --git a/examples/Main.hs b/examples/Main.hs index d971a18..770d0bb 100644 --- a/examples/Main.hs +++ b/examples/Main.hs @@ -1,32 +1,53 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeOperators #-} module Main where import Data.Aeson import qualified Data.ByteString.Char8 as B -import Data.Proxy +import Data.Data import qualified Data.Text as T import GHC.Generics import Servant +import Servant.Foreign import System.FilePath import Servant.PY +import Servant.PY.Python -- * A simple Counter data type newtype Counter = Counter { value :: Int } - deriving (Generic, Show, Num) + deriving (Generic, Show, Num, Data, Typeable) instance ToJSON Counter +-- instance HasForeignType Python T.Text Counter where +-- typeFor _ _ _ = "{\"value\": int}" data LoginForm = LoginForm - { username :: !T.Text - , password :: !T.Text + { username :: !T.Text + , password :: !T.Text , otherMissing :: Maybe T.Text - } deriving (Eq, Show, Generic) + } deriving (Eq, Show, Generic, Typeable, Data) instance ToJSON LoginForm +-- You could provide a direct instance of your types to represent them as strings +-- instance HasForeignType Python T.Text LoginForm where +-- typeFor _ _ _ = "{\"username\": str, \"password\": str, \"otherMissing\": Maybe Text}" + + +-- Alternately, if you make your instance derive Typeable and Data, and +-- you enable the pragma DeriveDataTypeable, +-- then you can use recordToDict to automatically derive your records +instance HasForeignType Python T.Text LoginForm where + typeFor _ _ _ = recordToDict (undefined :: LoginForm) LoginForm + +instance HasForeignType Python T.Text Counter where + typeFor _ _ _ = recordToDict (undefined :: Counter) Counter + -- * Our API type type TestApi = "counter-req-header" :> Post '[JSON] Counter :<|> "counter-queryparam" @@ -51,4 +72,6 @@ result :: FilePath result = "examples" main :: IO () -main = writePythonForAPI testApi requests (result </> "api.py") +main = do + writePythonForAPI testApi requests (result </> "api.py") + writeTypedPythonForAPI testApi requests (result </> "api_typed.py") diff --git a/servant-py.cabal b/servant-py.cabal index 7b48f68..45cbf6e 100644 --- a/servant-py.cabal +++ b/servant-py.cabal @@ -26,8 +26,10 @@ library exposed-modules: Servant.PY , Servant.PY.Requests , Servant.PY.Internal + , Servant.PY.Python build-depends: base >= 4.7 && < 5 , aeson + , bytestring , charset , lens , servant-foreign @@ -55,6 +57,7 @@ executable servant-py-exe , aeson , wai , servant + , servant-foreign , servant-server , servant-blaze , text diff --git a/src/Servant/PY.hs b/src/Servant/PY.hs index 8c506dd..8131135 100644 --- a/src/Servant/PY.hs +++ b/src/Servant/PY.hs @@ -4,11 +4,14 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeOperators #-} -module Servant.PY ( -- * Generating javascript code from an API type - pyForAPI +module Servant.PY ( -- * Generating python code from an API type + PythonGenerator + , python + , pythonTyped , writePythonForAPI - , PythonGenerator - + , pyForAPI + , pyTypedForAPI + , writeTypedPythonForAPI , -- * Options common to all generators CommonGeneratorOptions(..) , defCommonGeneratorOptions @@ -16,7 +19,6 @@ module Servant.PY ( -- * Generating javascript code from an API type -- Requests library , requests - , -- * Function renamers concatCase , snakeCase @@ -24,18 +26,18 @@ module Servant.PY ( -- * Generating javascript code from an API type , -- * Misc. listFromAPI - , python , NoTypes , GenerateList(..) , FunctionName(..) ) where -import Data.Proxy +import Data.Proxy import Data.Text (Text) import qualified Data.Text as T import Servant.Foreign import Servant.PY.Internal +import Servant.PY.Python import Servant.PY.Requests -- | Generate the data necessary to generate Python code @@ -44,6 +46,12 @@ import Servant.PY.Requests python :: HasForeign NoTypes NoContent api => Proxy api -> Foreign NoContent api python p = foreignFor (Proxy :: Proxy NoTypes) (Proxy :: Proxy NoContent) p defReq +-- | Generate the data necessary to generate Python code +-- for all the endpoints of an API, but try to get as much type-information +-- into Python docstrings, in order to aid discoverability of client functions. +pythonTyped :: HasForeign Python Text api => Proxy api -> Foreign Text api +pythonTyped p = foreignFor (Proxy :: Proxy Python) (Proxy :: Proxy Text) p defReq + -- | Directly generate all the Python functions for your API -- from a 'Proxy' for your API type. You can then write it to -- a file or integrate it in a page, for example. @@ -51,7 +59,7 @@ pyForAPI :: (HasForeign NoTypes NoContent api, GenerateList NoContent (Foreign N => Proxy api -- ^ proxy for your API type -> PythonGenerator -- ^ python code generator to use (requests is the only one for now) -> Text -- ^ a text that you can embed in your pages or write to a file -pyForAPI p gen = gen (listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy NoContent) p) +pyForAPI p gen = gen (UnTypedPythonRequest <$> listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy NoContent) p) -- | Directly generate all the Python functions for your API -- from a 'Proxy' for your API type using the given generator @@ -62,3 +70,21 @@ writePythonForAPI :: (HasForeign NoTypes NoContent api, GenerateList NoContent ( -> 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) + + +-- | Directly generate all the Python functions for your API +-- from a 'Proxy' for your API type. You can then write it to +-- 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) + -> 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) + -> 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 a6afc39..8b9ee0d 100644 --- a/src/Servant/PY/Internal.hs +++ b/src/Servant/PY/Internal.hs @@ -1,14 +1,15 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} module Servant.PY.Internal ( PythonGenerator , ReturnStyle(..) + , PythonRequest(..) + , PyRequestArgs(..) , CommonGeneratorOptions(..) , defCommonGeneratorOptions - , PyRequest , defaultPyIndent , indent , Indent @@ -18,10 +19,18 @@ module Servant.PY.Internal , segmentToStr , capturesToFormatArgs , toValidFunctionName + , functionName , toPyHeader + , retrieveHeaders + , getHeaderDict + , retrieveHeaderText , toPyDict , toPyParams + , getParams + , paramNames , captures + , getMethod + , hasBody , withFormattedCaptures , buildDocString , buildHeaderDict @@ -62,20 +71,23 @@ module Servant.PY.Internal import Control.Lens hiding (List) import qualified Data.CharSet as Set import qualified Data.CharSet.Unicode.Category as Set +import Data.Data import Data.Maybe (isJust) import Data.Monoid -import Data.Proxy import Data.Text (Text) import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8) +import Data.Text.Encoding (decodeUtf8) import GHC.TypeLits import Servant.Foreign -- A 'PythonGenerator' just takes the data found in the API type -- for each endpoint and generates Python code as Text. -type PythonGenerator = [PyRequest] -> Text -type PyRequest = Req NoContent +-- There are `NoContent` requests and Text requests with typing information. +type PythonGenerator = [PythonRequest] -> Text +data PythonRequest = TypedPythonRequest (Req Text) + | UnTypedPythonRequest (Req NoContent) + deriving (Eq, Show) -- We'd like to encode at the type-level that indentation -- is some multiplication of whitespace (sorry: never tabs!) @@ -85,6 +97,7 @@ indent :: Proxy Indent indent = Proxy -- The defaultPyIndent function is 4 spaces. +-- You can create a different indentation width by passing a different Int to indenter. defaultPyIndent :: Proxy Indent -> Text defaultPyIndent = indenter 4 @@ -99,6 +112,13 @@ indenter width space = mconcat $ width `replicate` (T.pack . symbolVal) space data ReturnStyle = DangerMode -- Throw caution to the wind and return JSON | RawResponse -- Return response object itself + +data PyRequestArgs = PyRequestArgs { + hasHeaders :: Bool + , hasParams :: Bool + , hasData :: Bool + } deriving (Show) + -- | This structure is used by specific implementations to let you -- customize the output data CommonGeneratorOptions = CommonGeneratorOptions @@ -111,7 +131,7 @@ data CommonGeneratorOptions = CommonGeneratorOptions , urlPrefix :: Text -- ^ a prefix we should add to the Url in the codegen , indentation :: Proxy Indent -> Text - -- ^ indentation to use for Python codeblocks + -- ^ indentation to use for Python codeblocks. Create this function by passing an Int to indenter. , returnMode :: ReturnStyle -- ^ whether the generated functions return the raw response or content } @@ -169,7 +189,11 @@ toValidFunctionName t = , Set.connectorPunctuation ]) --- Javascript identifiers can only contain codepoints in the Basic Multilingual Plane +functionName :: CommonGeneratorOptions -> PythonRequest -> Text +functionName opts (TypedPythonRequest req) = toValidFunctionName (functionNameBuilder opts $ req ^. reqFuncName) +functionName opts (UnTypedPythonRequest req) = toValidFunctionName (functionNameBuilder opts $ req ^. reqFuncName) + +-- Identifiers can only contain codepoints in the Basic Multilingual Plane -- that is, codepoints that can be encoded in UTF-16 without a surrogate pair (UCS-2) -- that is, codepoints that can fit in 16-bits, up to 0xffff (65535) filterBmpChars :: Set.CharSet -> Set.CharSet @@ -187,11 +211,22 @@ toPyDict offset dict -- Query params are passed into the function that makes the request, so we make -- a python dict out of them. +getParams :: Text -> PythonRequest -> Text +getParams offset (TypedPythonRequest req) = toPyParams offset $ req ^.. reqUrl.queryStr.traverse +getParams offset (UnTypedPythonRequest req) = toPyParams offset $ req ^.. reqUrl.queryStr.traverse + toPyParams :: Text -> [QueryArg f] -> Text toPyParams _ [] = "" toPyParams offset qargs = toPyDict offset paramList where paramList = fmap (\qarg -> qarg ^. queryArgName.argName._PathSegment) qargs +-- We also need to make sure we can retrieve just the param names for function args. +paramNames :: PythonRequest -> [Text] +paramNames (TypedPythonRequest req) = map (view $ queryArgName . argPath) $ req ^.. reqUrl.queryStr.traverse +paramNames (UnTypedPythonRequest req) = map (view $ queryArgName . argPath) $ req ^.. reqUrl.queryStr.traverse + +-- Request headers are also passed into the function that makes the request, so we make +-- a python dict out of them. toPyHeader :: HeaderArg f -> Text toPyHeader (HeaderArg n) = toValidFunctionName ("header" <> n ^. argName . _PathSegment) @@ -206,11 +241,6 @@ toPyHeader (ReplaceHeaderArg n p) pn = "{" <> n ^. argName . _PathSegment <> "}" rp = T.replace pn "" p -captures :: Req NoContent -> [T.Text] -captures req = map (view argPath . captureArg) - . filter isCapture - $ req ^. reqUrl.path - buildHeaderDict :: [HeaderArg f] -> Text buildHeaderDict [] = "" buildHeaderDict hs = "{" <> headers <> "}" @@ -218,15 +248,23 @@ buildHeaderDict hs = "{" <> headers <> "}" headerStr header = "\"" <> header ^. headerArg . argPath <> "\": " <> toPyHeader header -functionArguments :: PyRequest -> T.Text +getHeaderDict :: PythonRequest -> Text +getHeaderDict (TypedPythonRequest req) = buildHeaderDict $ req ^. reqHeaders +getHeaderDict (UnTypedPythonRequest req) = buildHeaderDict $ req ^. reqHeaders + +retrieveHeaders :: PythonRequest -> [T.Text] +retrieveHeaders (TypedPythonRequest req) = retrieveHeaderText <$> req ^. reqHeaders +retrieveHeaders (UnTypedPythonRequest req) = retrieveHeaderText <$> req ^. reqHeaders + +retrieveHeaderText :: forall f. HeaderArg f -> T.Text +retrieveHeaderText header = header ^. headerArg . argPath + + +functionArguments :: forall f. Req f -> T.Text functionArguments req = mconcat [ T.intercalate ", " args] where - args = captures' ++ qparam ++ body ++ headers - - captures' = map (view argPath . captureArg) - $ filter isCapture - $ req ^. reqUrl . path + args = captures' req ++ qparam ++ body ++ headers qparam = map ((<>) "param_" . view (queryArgName . argPath)) queryParams @@ -238,17 +276,31 @@ functionArguments req = . view (headerArg . argPath) ) $ req ^. reqHeaders +captures :: PythonRequest -> [T.Text] +captures (TypedPythonRequest req) = captures' req +captures (UnTypedPythonRequest req) = captures' req -makePyUrl :: forall f. CommonGeneratorOptions -> Req f -> Text -> Text -makePyUrl opts req offset = if url' == "\"" then "\"/\"" else url' + +captures' :: forall f. Req f -> [T.Text] +captures' req = map (view argPath . captureArg) + . filter isCapture + $ req ^. reqUrl.path + +makePyUrl :: CommonGeneratorOptions -> PythonRequest -> Text -> Text +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 = if url' == "\"" then "\"/\"" else url' where url' = "\"" <> urlPrefix opts <> "/" - <> makePyUrl' pathParts + <> getSegments pathParts <> withFormattedCaptures offset pathParts pathParts = req ^.. reqUrl.path.traverse -makePyUrl' :: [Segment f] -> Text -makePyUrl' [] = "" -makePyUrl' segments = T.intercalate "/" (map segmentToStr segments) <> "\"" +getSegments :: forall f. [Segment f] -> T.Text +getSegments segments = if null segments + then "" + else T.intercalate "/" (map segmentToStr segments) <> "\"" withFormattedCaptures :: Text -> [Segment f] -> Text withFormattedCaptures offset segments = formattedCaptures (capturesToFormatArgs segments) @@ -267,21 +319,42 @@ segmentToStr (Segment (Cap s)) = "{" <> s ^. argName . _PathSegment <> "}" capturesToFormatArgs :: [Segment f] -> [Text] capturesToFormatArgs segments = map getSegment $ filter isCapture segments where getSegment (Segment (Cap a)) = getCapture a - getSegment _ = "" + getSegment _ = "" getCapture s = s ^. argName . _PathSegment -buildDocString :: PyRequest -> CommonGeneratorOptions -> T.Text -buildDocString req opts = T.toUpper method <> " \"" <> url <> "\n" +captureArgsWithTypes :: [Segment Text] -> [Text] +captureArgsWithTypes segments = map getSegmentArgType (filter isCapture segments) + where getSegmentArgType (Segment (Cap a)) = pathPart a <> " (" <> a ^. argType <> ")" + getSegmentArgType _ = "" + pathPart s = s ^. argName . _PathSegment + + +buildDocString :: PythonRequest -> CommonGeneratorOptions -> T.Text +buildDocString (TypedPythonRequest req) opts = buildDocString' req opts args + where args = captureArgsWithTypes $ req ^.. reqUrl.path.traverse +buildDocString (UnTypedPythonRequest req) opts = buildDocString' req opts args + where args = capturesToFormatArgs $ req ^.. reqUrl.path.traverse + +buildDocString' :: forall f. Req f -> CommonGeneratorOptions -> [T.Text] -> T.Text +buildDocString' req opts args = T.toUpper method <> " \"" <> url <> "\n" <> includeArgs <> "\n\n" <> indent' <> "Returns: " <> "\n" <> indent' <> indent' <> returnVal - where args = capturesToFormatArgs $ req ^.. reqUrl.path.traverse - method = decodeUtf8 $ req ^. reqMethod - url = makePyUrl' $ req ^.. reqUrl.path.traverse + where method = decodeUtf8 $ req ^. reqMethod + url = getSegments $ req ^.. reqUrl.path.traverse includeArgs = if null args then "" else argDocs argDocs = indent' <> "Args: " <> "\n" <> indent' <> indent' <> T.intercalate ("\n" <> indent' <> indent') args + indent' = indentation opts indent returnVal = case returnMode opts of DangerMode -> "JSON response from the endpoint" RawResponse -> "response (requests.Response) from issuing the request" + +getMethod :: PythonRequest -> Text +getMethod (TypedPythonRequest req) = decodeUtf8 $ req ^. reqMethod +getMethod (UnTypedPythonRequest req) = decodeUtf8 $ req ^. reqMethod + +hasBody :: PythonRequest -> Bool +hasBody (TypedPythonRequest req) = isJust (req ^. reqBody) +hasBody (UnTypedPythonRequest req) = isJust (req ^. reqBody) diff --git a/src/Servant/PY/Python.hs b/src/Servant/PY/Python.hs new file mode 100644 index 0000000..034ef8c --- /dev/null +++ b/src/Servant/PY/Python.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +module Servant.PY.Python where + +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy as LB +import Data.Data +import Data.Monoid ((<>)) +import Data.Text (Text) +import qualified Data.Text as T +import GHC.TypeLits +import Servant.Foreign + +data Python + +getFieldsForInstance :: forall a. Data a => a -> [Text] +getFieldsForInstance = map T.pack . mconcat . map constrFields . getConstr + where getConstr = dataTypeConstrs . dataTypeOf + +getFieldTypesForType :: forall a. Typeable a => a -> [Text] +getFieldTypesForType = init . T.splitOn " -> " . T.pack . show . typeOf + +recordToDict :: forall a b. (Data a, Typeable b) => a -> b -> T.Text +recordToDict fieldsInstance fieldsType = "{" <> T.intercalate ", " (map printPair fieldPairs) <> "}" + where printPair (c, d) = "\"" <> c <> "\": " <> d + fieldPairs = zip fieldNames fieldTypes + fieldNames = getFieldsForInstance fieldsInstance + fieldTypes = getFieldTypesForType fieldsType + +instance HasForeignType Python Text NoContent where + typeFor _ _ _ = "None" + +instance HasForeignType Python Text Int where + typeFor _ _ _ = "int" + +instance HasForeignType Python Text Bool where + typeFor _ _ _ = "bool" + +instance HasForeignType Python Text String where + typeFor _ _ _ = "str" + +instance HasForeignType Python Text Text where + typeFor _ _ _ = "str" + +instance HasForeignType Python Text LB.ByteString where + typeFor _ _ _ = "str" + +instance HasForeignType Python Text B.ByteString where + typeFor _ _ _ = "str" + +instance HasForeignType Python Text JSON where + typeFor _ _ _ = "dict" + +instance HasForeignType Python T.Text (a :: Symbol) where + typeFor _ _ _ = "str" + +instance HasForeignType Python Text a => HasForeignType Python Text (Header a) where + typeFor lang ftype _ = "dict" <> typeFor lang ftype (Proxy :: Proxy a) + +instance HasForeignType Python Text a => HasForeignType Python Text (Headers '[Header a b] c) where + typeFor lang ftype _ = "dict" <> typeFor lang ftype (Proxy :: Proxy a) + +instance HasForeignType Python Text a => HasForeignType Python Text [Header a b] where + typeFor lang ftype _ = "[dict of " <> typeFor lang ftype (Proxy :: Proxy a) <> "]" + +instance HasForeignType Python Text a => HasForeignType Python Text (Headers a) where + typeFor lang ftype _ = "dict" <> typeFor lang ftype (Proxy :: Proxy a) + +instance HasForeignType Python Text a => HasForeignType Python Text (Maybe a) where + typeFor lang ftype _ = "Optional" <> typeFor lang ftype (Proxy :: Proxy a) + +instance HasForeignType Python Text a => HasForeignType Python Text [a] where + typeFor lang ftype _ = "list of " <> typeFor lang ftype (Proxy :: Proxy a) diff --git a/src/Servant/PY/Requests.hs b/src/Servant/PY/Requests.hs index 6648a7e..31fd56b 100644 --- a/src/Servant/PY/Requests.hs +++ b/src/Servant/PY/Requests.hs @@ -1,19 +1,9 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeOperators #-} - module Servant.PY.Requests where -import Control.Lens -import Data.Maybe (isJust) import Data.Monoid import Data.Proxy import Data.Text (Text) import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8) -import Servant.Foreign import Servant.PY.Internal @@ -24,11 +14,11 @@ requests reqs = defPyImports <> mconcat (map requestsWithDef reqs) -- | Generate python functions that use the requests library. -- Lets you specify your own 'CommonGeneratorOptions'. -requestsWith :: CommonGeneratorOptions -> PythonGenerator +requestsWith :: CommonGeneratorOptions -> [PythonRequest] -> Text requestsWith opts reqs = mconcat (map (generatePyRequestWith opts) reqs) -- | python codegen using requests with default options -requestsWithDef :: PyRequest -> Text +requestsWithDef :: PythonRequest -> Text requestsWithDef = generatePyRequestWith defCommonGeneratorOptions defPyImports :: Text @@ -40,9 +30,9 @@ defPyImports = ] -- | python codegen with requests -generatePyRequestWith :: CommonGeneratorOptions -> PyRequest -> Text +generatePyRequestWith :: CommonGeneratorOptions -> PythonRequest -> Text generatePyRequestWith opts req = "\n" <> - "def " <> fname <> "(" <> argsStr <> "):\n" + "def " <> functionName opts req <> "(" <> argsStr <> "):\n" <> indent' <> docStringMarker <> indent' <> buildDocString req opts <> "\n" <> indent' <> docStringMarker @@ -52,38 +42,28 @@ generatePyRequestWith opts req = "\n" <> <> requestBuilder <> "(url" <> remaining (T.length requestBuilder + 1) <> "\n" <> functionReturn (returnMode opts) (indentation opts) <> "\n\n" - -- where argsStr = functionArguments req where argsStr = T.intercalate ", " args args = captures req - ++ map (view $ queryArgName . argPath) queryparams + ++ qparams ++ body ++ map (toValidFunctionName . (<>) "header" - . view (headerArg . argPath) ) hs - hs = req ^. reqHeaders - fname = toValidFunctionName (functionNameBuilder opts $ req ^. reqFuncName) - method = (T.toLower . decodeUtf8) $ req ^. reqMethod - - remaining = remainingReqCall $ PyRequestArgs (not . null $ hs) (not . null $ queryparams) hasBody + hs = retrieveHeaders req + qparams = paramNames req + method = T.toLower $ getMethod req + remaining = remainingReqCall $ PyRequestArgs (not . null $ hs) (not . null $ qparams) (hasBody req) paramDef - | null queryparams = "" - | otherwise = indent' <> "params = " <> toPyParams (indent' <> indent') queryparams <> "\n" + | null qparams = "" + | otherwise = indent' <> "params = " <> getParams (indent' <> indent') req <> "\n" headerDef | null hs = "" - | otherwise = indent' <> "headers = " <> buildHeaderDict hs <> "\n" + | otherwise = indent' <> "headers = " <> getHeaderDict req <> "\n" requestBuilder = indent' <> "resp = requests." <> method - hasBody = isJust (req ^. reqBody) - queryparams = req ^.. reqUrl.queryStr.traverse - body = [requestBody opts | hasBody] + body = [requestBody opts | hasBody req] indent' = indentation opts indent docStringMarker = "\"\"\"\n" -data PyRequestArgs = PyRequestArgs { - hasHeaders :: Bool - , hasParams :: Bool - , hasData :: Bool - } deriving (Show) remainingReqCall :: PyRequestArgs -> Int -> Text remainingReqCall reqArgs width