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)