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