Make it so that we can get type information in our generator

.gitignore

@@ -1,5 +1,5 @@
 *~
 .stack-work/
 build/
-examples/api.py
+examples/*py
 __pycache__

examples/Main.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE RankNTypes                 #-}
 {-# LANGUAGE TypeOperators              #-}
 
 module Main where
@@ -32,8 +33,20 @@ data LoginForm = LoginForm
  , otherMissing :: Maybe T.Text
  } 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\":  Optional str}"
+--   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
@@ -44,12 +57,12 @@ type TestApi = "counter-req-header" :> Post '[JSON] Counter
           :<|> "login-params-authors-with-reqBody"
             :> QueryParams "authors" T.Text
             :> ReqBody '[JSON] LoginForm :> Post '[JSON] LoginForm
-          -- :<|> "login-with-path-var-and-header"
-          --   :> Capture "id" Int
-          --   :> Capture "Name" T.Text
-          --   :> Capture "hungrig" Bool
-          --   :> ReqBody '[JSON] LoginForm
-          --   :> Post '[JSON] (Headers '[Header "test-head" B.ByteString] LoginForm)
+          :<|> "login-with-path-var-and-header"
+            :> Capture "id" Int
+            :> Capture "Name" T.Text
+            :> Capture "hungrig" Bool
+            :> ReqBody '[JSON] LoginForm
+            :> Post '[JSON] (Headers '[Header "test-head" B.ByteString] LoginForm)
 
 testApi :: Proxy TestApi
 testApi = Proxy
@@ -59,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 requestsTyped (result </> "api_typed.py")

servant-py.cabal

@@ -57,6 +57,7 @@ executable servant-py-exe
                      , aeson
                      , wai
                      , servant
+                     , servant-foreign
                      , servant-server
                      , servant-blaze
                      , text

src/Servant/PY.hs

@@ -5,18 +5,21 @@
 {-# LANGUAGE TypeOperators         #-}
 
 module Servant.PY ( -- * Generating javascript code from an API type
-    pyForAPI
-  , writePythonForAPI
-  , PythonGenerator
+  PythonGenerator
+  , PythonTypedGenerator
   , python
   , pythonTyped
+  , writePythonForAPI
+  , pyForAPI
+  , pyTypedForAPI
+  , writeTypedPythonForAPI
   , -- * Options common to all generators
     CommonGeneratorOptions(..)
   , defCommonGeneratorOptions
 
   -- Requests library
   , requests
-
+  , requestsTyped
 
   , -- * Function renamers
     concatCase
@@ -66,3 +69,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
+         -> PythonTypedGenerator -- ^ 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 (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
+              -> PythonTypedGenerator -- ^ 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)

src/Servant/PY/Internal.hs

@@ -11,6 +11,8 @@ module Servant.PY.Internal
   , CommonGeneratorOptions(..)
   , defCommonGeneratorOptions
   , PyRequest
+  , PyTypedRequest
+  , PythonTypedGenerator
   , defaultPyIndent
   , indent
   , Indent
@@ -26,6 +28,7 @@ module Servant.PY.Internal
   , captures
   , withFormattedCaptures
   , buildDocString
+  , buildDocStringWithTypes
   , buildHeaderDict
   , functionArguments
   , formatBuilder
@@ -79,6 +82,9 @@ import           Servant.Foreign
 type PythonGenerator = [PyRequest] -> Text
 type PyRequest = Req NoContent
 
+type PyTypedRequest = Req Text
+type PythonTypedGenerator = [PyTypedRequest] -> Text
+
 -- We'd like to encode at the type-level that indentation
 -- is some multiplication of whitespace (sorry: never tabs!)
 type Indent = (" " :: Symbol)
@@ -103,7 +109,7 @@ data ReturnStyle = DangerMode  -- Throw caution to the wind and return JSON
 
 
 data InformationLevel = AsMuchAsPossible  -- Must use DeriveDataTypeable and do deriving (Data, Typeable)
-                      | Minimal  -- Really doesn't say much abotu the arguments of functions or return vals
+                      | Minimal  -- Really doesn't say much about the arguments of functions or return vals
 
 -- | This structure is used by specific implementations to let you
 -- customize the output
@@ -216,7 +222,7 @@ toPyHeader (ReplaceHeaderArg n p)
     pn = "{" <> n ^. argName . _PathSegment <> "}"
     rp = T.replace pn "" p
 
-captures :: Req NoContent -> [T.Text]
+captures :: forall f. Req f -> [T.Text]
 captures req = map (view argPath . captureArg)
          . filter isCapture
          $ req ^. reqUrl.path
@@ -228,7 +234,7 @@ buildHeaderDict hs = "{" <> headers <> "}"
         headerStr header = "\"" <> header ^. headerArg . argPath <> "\": "
                            <> toPyHeader header
 
-functionArguments :: PyRequest -> T.Text
+functionArguments :: forall f. Req f -> T.Text
 functionArguments req =
   mconcat [ T.intercalate ", " args]
   where
@@ -295,3 +301,19 @@ buildDocString req opts = T.toUpper method <> " \"" <> url <> "\n"
         returnVal = case returnMode opts of
           DangerMode -> "JSON response from the endpoint"
           RawResponse -> "response (requests.Response) from issuing the request"
+
+buildDocStringWithTypes :: PyTypedRequest -> CommonGeneratorOptions -> T.Text
+buildDocStringWithTypes req opts = 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
+        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"

src/Servant/PY/Python.hs

@@ -1,61 +1,64 @@
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE KindSignatures        #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeOperators         #-}
 
 module Servant.PY.Python where
 
--- import Data.Aeson
-import Data.Data
 import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Lazy as LB
+import qualified Data.ByteString.Lazy  as LB
+import           Data.Data
 import           Data.Monoid           ((<>))
-import           Data.Proxy
-import Data.Text (Text)
-import qualified Data.Text as T
+import           Data.Text             (Text)
+import qualified Data.Text             as T
+import           GHC.TypeLits
 import           Servant.Foreign
 
 data Python
 
-getFieldsFor :: forall a. Data a => a -> [Text]
-getFieldsFor = map T.pack . mconcat . map constrFields . getConstr
+getFieldsForInstance :: forall a. Data a => a -> [Text]
+getFieldsForInstance = map T.pack . mconcat . map constrFields . getConstr
   where getConstr = dataTypeConstrs . dataTypeOf
 
-getFieldTypesFor :: forall a. Typeable a => a -> [Text]
-getFieldTypesFor = init . T.splitOn " -> " . T.pack . show . typeOf
-
-instance (Typeable a, Data a) => HasForeignType Python Text a where
-  typeFor _ _ d = "{ lba" <> T.intercalate ", " (map printPair fieldPairs) <> "}"
-    where printPair (a, b) = "\"" <> a <> "\": " <> b
-          fieldPairs = zip fieldNames fieldTypes
-          fieldNames = getFieldsFor d
-          fieldTypes = getFieldTypesFor d
-
-
--- 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"
+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)
@@ -68,9 +71,9 @@ instance HasForeignType Python Text a => HasForeignType Python Text [Header a b]
 
 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)
+
+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)

src/Servant/PY/Requests.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes            #-}
 {-# LANGUAGE TypeOperators         #-}
 
 module Servant.PY.Requests where
@@ -22,6 +23,9 @@ import           Servant.PY.Internal
 requests :: PythonGenerator
 requests reqs = defPyImports <> mconcat (map requestsWithDef reqs)
 
+requestsTyped :: PythonTypedGenerator
+requestsTyped reqs = defPyImports <> mconcat (map requestsTypedWithDef reqs)
+
 -- | Generate python functions that use the requests library.
 --   Lets you specify your own 'CommonGeneratorOptions'.
 requestsWith :: CommonGeneratorOptions -> PythonGenerator
@@ -31,6 +35,9 @@ requestsWith opts reqs = mconcat (map (generatePyRequestWith opts) reqs)
 requestsWithDef :: PyRequest -> Text
 requestsWithDef = generatePyRequestWith defCommonGeneratorOptions
 
+requestsTypedWithDef :: PyTypedRequest -> Text
+requestsTypedWithDef = generatePyTypedRequestWith defCommonGeneratorOptions
+
 defPyImports :: Text
 defPyImports =
   T.unlines
@@ -79,10 +86,50 @@ generatePyRequestWith opts req = "\n" <>
         indent' = indentation opts indent
         docStringMarker = "\"\"\"\n"
 
+-- | python codegen with requests
+generatePyTypedRequestWith :: CommonGeneratorOptions -> PyTypedRequest -> Text
+generatePyTypedRequestWith opts req = "\n" <>
+    "def " <> fname <> "(" <> argsStr <> "):\n"
+    <> indent' <> docStringMarker
+    <> indent' <> buildDocStringWithTypes req opts <> "\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 = functionArguments req
+  where argsStr = T.intercalate ", " args
+        args = captures req
+             ++ map (view $ queryArgName . argPath) queryparams
+             ++ 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
+        paramDef
+          | null queryparams = ""
+          | otherwise = indent' <> "params = " <> toPyParams (indent' <> indent') queryparams <> "\n"
+        headerDef
+          | null hs = ""
+          | otherwise = indent' <> "headers = " <> buildHeaderDict hs <> "\n"
+        requestBuilder = indent' <> "resp = requests." <> method
+        hasBody = isJust (req ^. reqBody)
+        queryparams = req ^.. reqUrl.queryStr.traverse
+        body = [requestBody opts | hasBody]
+        indent' = indentation opts indent
+        docStringMarker = "\"\"\"\n"
+
 data PyRequestArgs = PyRequestArgs {
-  hasHeaders :: Bool
+  hasHeaders  :: Bool
   , hasParams :: Bool
-  , hasData :: Bool
+  , hasData   :: Bool
   } deriving (Show)
 
 remainingReqCall :: PyRequestArgs -> Int -> Text