From ae43862be3124ab199ef81c1977d6c60e98033d3 Mon Sep 17 00:00:00 2001 From: Erik Aker Date: Mon, 20 Feb 2017 09:13:27 -0800 Subject: [PATCH] Make it so that we can get type information in our generator --- .gitignore | 2 +- examples/Main.hs | 31 +++++++++--- servant-py.cabal | 1 + src/Servant/PY.hs | 29 +++++++++-- src/Servant/PY/Internal.hs | 28 ++++++++-- src/Servant/PY/Python.hs | 101 +++++++++++++++++++------------------ src/Servant/PY/Requests.hs | 51 ++++++++++++++++++- 7 files changed, 176 insertions(+), 67 deletions(-) diff --git a/.gitignore b/.gitignore index 6aa5289..059678a 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,5 @@ *~ .stack-work/ build/ -examples/api.py +examples/*py __pycache__ diff --git a/examples/Main.hs b/examples/Main.hs index 1149ae5..ecd1e63 100644 --- a/examples/Main.hs +++ b/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") diff --git a/servant-py.cabal b/servant-py.cabal index 45a3c30..45cbf6e 100644 --- a/servant-py.cabal +++ b/servant-py.cabal @@ -57,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 181efc0..275efdd 100644 --- a/src/Servant/PY.hs +++ b/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) diff --git a/src/Servant/PY/Internal.hs b/src/Servant/PY/Internal.hs index 21936dc..b2facc7 100644 --- a/src/Servant/PY/Internal.hs +++ b/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" diff --git a/src/Servant/PY/Python.hs b/src/Servant/PY/Python.hs index 7c74d67..034ef8c 100644 --- a/src/Servant/PY/Python.hs +++ b/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) diff --git a/src/Servant/PY/Requests.hs b/src/Servant/PY/Requests.hs index 6648a7e..a8667c0 100644 --- a/src/Servant/PY/Requests.hs +++ b/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