From 7b757908c7effc58e901ffa28f3b1b3a0f2ee6d3 Mon Sep 17 00:00:00 2001 From: Erik Aker Date: Mon, 20 Feb 2017 14:27:40 -0800 Subject: [PATCH] Won't compile when I try to switch types for captureArgs funcs --- src/Servant/PY/Internal.hs | 39 +++++++++++++++++++++------- src/Servant/PY/Requests.hs | 52 ++++---------------------------------- 2 files changed, 35 insertions(+), 56 deletions(-) diff --git a/src/Servant/PY/Internal.hs b/src/Servant/PY/Internal.hs index 7e6db3f..3602266 100644 --- a/src/Servant/PY/Internal.hs +++ b/src/Servant/PY/Internal.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-} @@ -10,8 +11,8 @@ module Servant.PY.Internal , InformationLevel(..) , CommonGeneratorOptions(..) , defCommonGeneratorOptions + , defTypedCommonGeneratorOptions , PyRequest - , PyTypedRequest , PythonTypedGenerator , defaultPyIndent , indent @@ -77,12 +78,12 @@ 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 +-- for each endpoint and generates Python code as Text. We have untyped and those +-- that contain typing information. +type PythonGenerator = [PyRequest NoContent] -> Text +type PythonTypedGenerator = [PyRequest Text] -> Text -type PyTypedRequest = Req Text -type PythonTypedGenerator = [PyTypedRequest] -> Text +type PyRequest = Req -- We'd like to encode at the type-level that indentation -- is some multiplication of whitespace (sorry: never tabs!) @@ -107,7 +108,7 @@ data ReturnStyle = DangerMode -- Throw caution to the wind and return JSON | RawResponse -- Return response object itself -data InformationLevel = AsMuchAsPossible -- Must use DeriveDataTypeable and do deriving (Data, Typeable) +data InformationLevel = WithTypes -- Must use Pragma DeriveDataTypeable and do deriving (Data, Typeable) | Minimal -- Really doesn't say much about the arguments of functions or return vals -- | This structure is used by specific implementations to let you @@ -152,6 +153,17 @@ defCommonGeneratorOptions = CommonGeneratorOptions , informationMode = Minimal } +defTypedCommonGeneratorOptions :: CommonGeneratorOptions +defTypedCommonGeneratorOptions = CommonGeneratorOptions + { + functionNameBuilder = snakeCase + , requestBody = "data" + , urlPrefix = "http://localhost:8000" + , indentation = defaultPyIndent + , returnMode = DangerMode + , informationMode = WithTypes + } + -- | Attempts to reduce the function name provided to that allowed by @'Foreign'@. -- -- For valid Python function identifiers see the following: @@ -285,18 +297,27 @@ capturesToFormatArgs segments = map getSegment $ filter isCapture segments getSegment _ = "" getCapture s = s ^. argName . _PathSegment +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 :: forall f. Req f -> CommonGeneratorOptions -> T.Text buildDocString 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 + where 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 + args = case informationMode opts of + Minimal -> capturesToFormatArgs $ req ^.. reqUrl.path.traverse + WithTypes -> capturesToFormatArgs $ req ^.. reqUrl.path.traverse 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/Requests.hs b/src/Servant/PY/Requests.hs index 3092dfe..7e2a11b 100644 --- a/src/Servant/PY/Requests.hs +++ b/src/Servant/PY/Requests.hs @@ -24,20 +24,18 @@ requests :: PythonGenerator requests reqs = defPyImports <> mconcat (map requestsWithDef reqs) requestsTyped :: PythonTypedGenerator -requestsTyped reqs = defPyImports <> mconcat (map requestsTypedWithDef reqs) +requestsTyped reqs = defPyImports <> mconcat (map requestBuilder reqs) + where requestBuilder = generatePyRequestWith defTypedCommonGeneratorOptions -- | Generate python functions that use the requests library. -- Lets you specify your own 'CommonGeneratorOptions'. -requestsWith :: CommonGeneratorOptions -> PythonGenerator +requestsWith :: forall f. CommonGeneratorOptions -> [Req f] -> Text requestsWith opts reqs = mconcat (map (generatePyRequestWith opts) reqs) -- | python codegen using requests with default options -requestsWithDef :: PyRequest -> Text +requestsWithDef :: forall f. Req f -> Text requestsWithDef = generatePyRequestWith defCommonGeneratorOptions -requestsTypedWithDef :: PyTypedRequest -> Text -requestsTypedWithDef = generatePyTypedRequestWith defCommonGeneratorOptions - defPyImports :: Text defPyImports = T.unlines @@ -47,7 +45,7 @@ defPyImports = ] -- | python codegen with requests -generatePyRequestWith :: CommonGeneratorOptions -> PyRequest -> Text +generatePyRequestWith :: forall f. CommonGeneratorOptions -> Req f -> Text generatePyRequestWith opts req = "\n" <> "def " <> fname <> "(" <> argsStr <> "):\n" <> indent' <> docStringMarker @@ -86,46 +84,6 @@ 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' <> buildDocString 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 , hasParams :: Bool