From a92c61b1e0da6a73cd8aa49e55d6ceb94e2da331 Mon Sep 17 00:00:00 2001 From: Erik Aker Date: Sat, 18 Feb 2017 14:54:41 -0800 Subject: [PATCH 1/5] Attempting generic introspection with derive data --- examples/Main.hs | 30 +++++++++------ servant-py.cabal | 2 + src/Servant/PY.hs | 8 +++- src/Servant/PY/Internal.hs | 26 +++++++++---- src/Servant/PY/Python.hs | 76 ++++++++++++++++++++++++++++++++++++++ 5 files changed, 121 insertions(+), 21 deletions(-) create mode 100644 src/Servant/PY/Python.hs diff --git a/examples/Main.hs b/examples/Main.hs index d971a18..1149ae5 100644 --- a/examples/Main.hs +++ b/examples/Main.hs @@ -1,31 +1,39 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# 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 +-- instance HasForeignType Python T.Text LoginForm where +-- typeFor _ _ _ = "{\"username\": str, \"password\": str, \"otherMissing\": Optional str}" -- * Our API type type TestApi = "counter-req-header" :> Post '[JSON] Counter @@ -36,12 +44,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 diff --git a/servant-py.cabal b/servant-py.cabal index 7b48f68..45a3c30 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 diff --git a/src/Servant/PY.hs b/src/Servant/PY.hs index 8c506dd..181efc0 100644 --- a/src/Servant/PY.hs +++ b/src/Servant/PY.hs @@ -8,7 +8,8 @@ module Servant.PY ( -- * Generating javascript code from an API type pyForAPI , writePythonForAPI , PythonGenerator - + , python + , pythonTyped , -- * Options common to all generators CommonGeneratorOptions(..) , defCommonGeneratorOptions @@ -24,7 +25,6 @@ module Servant.PY ( -- * Generating javascript code from an API type , -- * Misc. listFromAPI - , python , NoTypes , GenerateList(..) , FunctionName(..) @@ -36,6 +36,7 @@ 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 +45,9 @@ 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 +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. diff --git a/src/Servant/PY/Internal.hs b/src/Servant/PY/Internal.hs index a6afc39..21936dc 100644 --- a/src/Servant/PY/Internal.hs +++ b/src/Servant/PY/Internal.hs @@ -1,11 +1,13 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} module Servant.PY.Internal ( PythonGenerator , ReturnStyle(..) + , InformationLevel(..) , CommonGeneratorOptions(..) , defCommonGeneratorOptions , PyRequest @@ -62,12 +64,12 @@ 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 @@ -99,6 +101,10 @@ 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 InformationLevel = AsMuchAsPossible -- Must use DeriveDataTypeable and do deriving (Data, Typeable) + | Minimal -- Really doesn't say much abotu the arguments of functions or return vals + -- | This structure is used by specific implementations to let you -- customize the output data CommonGeneratorOptions = CommonGeneratorOptions @@ -114,6 +120,8 @@ data CommonGeneratorOptions = CommonGeneratorOptions -- ^ indentation to use for Python codeblocks , returnMode :: ReturnStyle -- ^ whether the generated functions return the raw response or content + , informationMode :: InformationLevel + -- ^ if we should include more information on request bodies and objects returned } -- | Default options. @@ -125,6 +133,7 @@ data CommonGeneratorOptions = CommonGeneratorOptions -- > , urlPrefix = "" -- > , indentation = " " -- 4 spaces -- > , returnMode = DangerMode +-- > , informationMode = Minimal -- > } -- @ defCommonGeneratorOptions :: CommonGeneratorOptions @@ -135,6 +144,7 @@ defCommonGeneratorOptions = CommonGeneratorOptions , urlPrefix = "http://localhost:8000" , indentation = defaultPyIndent , returnMode = DangerMode + , informationMode = Minimal } -- | Attempts to reduce the function name provided to that allowed by @'Foreign'@. @@ -247,7 +257,7 @@ makePyUrl opts req offset = if url' == "\"" then "\"/\"" else url' pathParts = req ^.. reqUrl.path.traverse makePyUrl' :: [Segment f] -> Text -makePyUrl' [] = "" +makePyUrl' [] = "" makePyUrl' segments = T.intercalate "/" (map segmentToStr segments) <> "\"" withFormattedCaptures :: Text -> [Segment f] -> Text @@ -267,7 +277,7 @@ 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 diff --git a/src/Servant/PY/Python.hs b/src/Servant/PY/Python.hs new file mode 100644 index 0000000..7c74d67 --- /dev/null +++ b/src/Servant/PY/Python.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} + +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 Data.Monoid ((<>)) +import Data.Proxy +import Data.Text (Text) +import qualified Data.Text as T +import Servant.Foreign + +data Python + +getFieldsFor :: forall a. Data a => a -> [Text] +getFieldsFor = 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" + +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) From ae43862be3124ab199ef81c1977d6c60e98033d3 Mon Sep 17 00:00:00 2001 From: Erik Aker Date: Mon, 20 Feb 2017 09:13:27 -0800 Subject: [PATCH 2/5] 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 From 88684c9340b7c86000160b21b3596549c86ac622 Mon Sep 17 00:00:00 2001 From: Erik Aker Date: Mon, 20 Feb 2017 12:33:24 -0800 Subject: [PATCH 3/5] Collapse the different functions for both generator types --- src/Servant/PY.hs | 3 +++ src/Servant/PY/Internal.hs | 19 +------------------ src/Servant/PY/Requests.hs | 2 +- 3 files changed, 5 insertions(+), 19 deletions(-) diff --git a/src/Servant/PY.hs b/src/Servant/PY.hs index 275efdd..8fdc16c 100644 --- a/src/Servant/PY.hs +++ b/src/Servant/PY.hs @@ -48,6 +48,9 @@ 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 diff --git a/src/Servant/PY/Internal.hs b/src/Servant/PY/Internal.hs index b2facc7..7e6db3f 100644 --- a/src/Servant/PY/Internal.hs +++ b/src/Servant/PY/Internal.hs @@ -28,7 +28,6 @@ module Servant.PY.Internal , captures , withFormattedCaptures , buildDocString - , buildDocStringWithTypes , buildHeaderDict , functionArguments , formatBuilder @@ -286,7 +285,7 @@ capturesToFormatArgs segments = map getSegment $ filter isCapture segments getSegment _ = "" getCapture s = s ^. argName . _PathSegment -buildDocString :: PyRequest -> CommonGeneratorOptions -> T.Text +buildDocString :: forall f. Req f -> CommonGeneratorOptions -> T.Text buildDocString req opts = T.toUpper method <> " \"" <> url <> "\n" <> includeArgs <> "\n\n" <> indent' <> "Returns: " <> "\n" @@ -301,19 +300,3 @@ 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/Requests.hs b/src/Servant/PY/Requests.hs index a8667c0..3092dfe 100644 --- a/src/Servant/PY/Requests.hs +++ b/src/Servant/PY/Requests.hs @@ -91,7 +91,7 @@ generatePyTypedRequestWith :: CommonGeneratorOptions -> PyTypedRequest -> Text generatePyTypedRequestWith opts req = "\n" <> "def " <> fname <> "(" <> argsStr <> "):\n" <> indent' <> docStringMarker - <> indent' <> buildDocStringWithTypes req opts <> "\n" + <> indent' <> buildDocString req opts <> "\n" <> indent' <> docStringMarker <> indent' <> "url = " <> makePyUrl opts req (indent' <> indent') <> "\n\n" <> headerDef From 7b757908c7effc58e901ffa28f3b1b3a0f2ee6d3 Mon Sep 17 00:00:00 2001 From: Erik Aker Date: Mon, 20 Feb 2017 14:27:40 -0800 Subject: [PATCH 4/5] 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 From bb915fc3a03b9f92ba06d670105f584f2336795b Mon Sep 17 00:00:00 2001 From: Erik Aker Date: Tue, 7 Mar 2017 21:39:34 -0800 Subject: [PATCH 5/5] Start to add some typing information to the docstrings --- examples/Main.hs | 2 +- src/Servant/PY.hs | 14 ++-- src/Servant/PY/Internal.hs | 149 +++++++++++++++++++++++-------------- src/Servant/PY/Requests.hs | 51 ++++--------- 4 files changed, 113 insertions(+), 103 deletions(-) diff --git a/examples/Main.hs b/examples/Main.hs index ecd1e63..770d0bb 100644 --- a/examples/Main.hs +++ b/examples/Main.hs @@ -74,4 +74,4 @@ result = "examples" main :: IO () main = do writePythonForAPI testApi requests (result "api.py") - writeTypedPythonForAPI testApi requestsTyped (result "api_typed.py") + writeTypedPythonForAPI testApi requests (result "api_typed.py") diff --git a/src/Servant/PY.hs b/src/Servant/PY.hs index 8fdc16c..8131135 100644 --- a/src/Servant/PY.hs +++ b/src/Servant/PY.hs @@ -4,9 +4,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeOperators #-} -module Servant.PY ( -- * Generating javascript code from an API type +module Servant.PY ( -- * Generating python code from an API type PythonGenerator - , PythonTypedGenerator , python , pythonTyped , writePythonForAPI @@ -19,7 +18,6 @@ module Servant.PY ( -- * Generating javascript code from an API type -- Requests library , requests - , requestsTyped , -- * Function renamers concatCase @@ -33,7 +31,7 @@ module Servant.PY ( -- * Generating javascript code from an API type , FunctionName(..) ) where -import Data.Proxy +import Data.Proxy import Data.Text (Text) import qualified Data.Text as T import Servant.Foreign @@ -61,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 @@ -79,14 +77,14 @@ writePythonForAPI p gen fp = writeFile fp (T.unpack $ pyForAPI p gen) -- 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) + -> 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 (listFromAPI (Proxy :: Proxy Python) (Proxy :: Proxy T.Text) p) +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 - -> PythonTypedGenerator -- ^ python code generator to use (requests is the only one for now) + -> 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 3602266..8b9ee0d 100644 --- a/src/Servant/PY/Internal.hs +++ b/src/Servant/PY/Internal.hs @@ -1,19 +1,15 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Servant.PY.Internal ( PythonGenerator , ReturnStyle(..) - , InformationLevel(..) + , PythonRequest(..) + , PyRequestArgs(..) , CommonGeneratorOptions(..) , defCommonGeneratorOptions - , defTypedCommonGeneratorOptions - , PyRequest - , PythonTypedGenerator , defaultPyIndent , indent , Indent @@ -23,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 @@ -78,12 +82,12 @@ import Servant.Foreign -- A 'PythonGenerator' just takes the data found in the API type --- 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 PyRequest = Req +-- for each endpoint and generates Python code as Text. +-- 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!) @@ -93,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 @@ -108,8 +113,11 @@ data ReturnStyle = DangerMode -- Throw caution to the wind and return JSON | RawResponse -- Return response object itself -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 +data PyRequestArgs = PyRequestArgs { + hasHeaders :: Bool + , hasParams :: Bool + , hasData :: Bool + } deriving (Show) -- | This structure is used by specific implementations to let you -- customize the output @@ -123,11 +131,9 @@ 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 - , informationMode :: InformationLevel - -- ^ if we should include more information on request bodies and objects returned } -- | Default options. @@ -139,7 +145,6 @@ data CommonGeneratorOptions = CommonGeneratorOptions -- > , urlPrefix = "" -- > , indentation = " " -- 4 spaces -- > , returnMode = DangerMode --- > , informationMode = Minimal -- > } -- @ defCommonGeneratorOptions :: CommonGeneratorOptions @@ -150,18 +155,6 @@ defCommonGeneratorOptions = CommonGeneratorOptions , urlPrefix = "http://localhost:8000" , indentation = defaultPyIndent , returnMode = DangerMode - , 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'@. @@ -196,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 @@ -214,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) @@ -233,11 +241,6 @@ toPyHeader (ReplaceHeaderArg n p) pn = "{" <> n ^. argName . _PathSegment <> "}" rp = T.replace pn "" p -captures :: forall f. Req f -> [T.Text] -captures req = map (view argPath . captureArg) - . filter isCapture - $ req ^. reqUrl.path - buildHeaderDict :: [HeaderArg f] -> Text buildHeaderDict [] = "" buildHeaderDict hs = "{" <> headers <> "}" @@ -245,15 +248,23 @@ buildHeaderDict hs = "{" <> headers <> "}" headerStr header = "\"" <> header ^. headerArg . argPath <> "\": " <> toPyHeader header +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 @@ -265,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) @@ -303,21 +328,33 @@ captureArgsWithTypes segments = map getSegmentArgType (filter isCapture segment getSegmentArgType _ = "" pathPart s = s ^. argName . _PathSegment -buildDocString :: forall f. Req f -> CommonGeneratorOptions -> T.Text -buildDocString req opts = T.toUpper method <> " \"" <> url <> "\n" + +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 method = decodeUtf8 $ req ^. reqMethod - url = makePyUrl' $ req ^.. reqUrl.path.traverse + 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 - 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" + +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/Requests.hs b/src/Servant/PY/Requests.hs index 7e2a11b..31fd56b 100644 --- a/src/Servant/PY/Requests.hs +++ b/src/Servant/PY/Requests.hs @@ -1,20 +1,9 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE RankNTypes #-} -{-# 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 @@ -23,17 +12,13 @@ import Servant.PY.Internal requests :: PythonGenerator requests reqs = defPyImports <> mconcat (map requestsWithDef reqs) -requestsTyped :: PythonTypedGenerator -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 :: forall f. CommonGeneratorOptions -> [Req f] -> Text +requestsWith :: CommonGeneratorOptions -> [PythonRequest] -> Text requestsWith opts reqs = mconcat (map (generatePyRequestWith opts) reqs) -- | python codegen using requests with default options -requestsWithDef :: forall f. Req f -> Text +requestsWithDef :: PythonRequest -> Text requestsWithDef = generatePyRequestWith defCommonGeneratorOptions defPyImports :: Text @@ -45,9 +30,9 @@ defPyImports = ] -- | python codegen with requests -generatePyRequestWith :: forall f. CommonGeneratorOptions -> Req f -> 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 @@ -57,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