diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Hardy Jones (c) 2017 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +# servant-ruby + +Create a Ruby client from a Servant API using `Net::HTTP`. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/servant-ruby.cabal b/servant-ruby.cabal new file mode 100644 --- /dev/null +++ b/servant-ruby.cabal @@ -0,0 +1,37 @@ +name: servant-ruby +version: 0.1.0.0 +synopsis: Generate a Ruby client from a Servant API with Net::HTTP. +description: Generate a Ruby client from a Servant API with Net::HTTP. +homepage: https://github.com/joneshf/servant-ruby#readme +license: BSD3 +license-file: LICENSE +author: Hardy Jones +maintainer: jones3.hardy@gmail.com +copyright: 2017 Hardy Jones +category: Servant, Web +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Servant.Ruby + build-depends: base >= 4.7 && < 5 + , casing >= 0.1 && < 0.2 + , lens >= 4.15 && < 4.16 + , servant-foreign >= 0.9 && < 0.10 + , text >= 1.2 && < 1.3 + default-language: Haskell2010 + ghc-options: -Wall + +test-suite doc-test + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + build-depends: base + , Cabal >= 1.24 && < 1.25 + , doctest >= 0.11 && < 0.12 + +source-repository head + type: git + location: https://github.com/joneshf/servant-ruby diff --git a/src/Servant/Ruby.hs b/src/Servant/Ruby.hs new file mode 100644 --- /dev/null +++ b/src/Servant/Ruby.hs @@ -0,0 +1,370 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +{-| +Module: Servant.Ruby +Description: Generate a Ruby client from a Servant API using Net::HTTP. +Copyright: (c) Hardy Jones, 2017 +License: BSD3 +Maintainer: jones3.hardy@gmail.com +Stability: Experimental + +-} + +module Servant.Ruby (NameSpace(..), ruby) where + +import Control.Lens (filtered, folded, to, view, (^.), (^..)) + +import Data.Function ((&)) +import Data.Monoid ((<>)) +import Data.Proxy (Proxy(Proxy)) +import Data.Text (Text) +import Data.Text.Encoding (decodeUtf8') + +import Servant.Foreign + ( ArgType(Flag, List, Normal) + , Foreign + , GenerateList + , HasForeign + , HeaderArg + , NoContent + , NoTypes + , QueryArg + , Req + , Segment(Segment) + , SegmentType(Cap, Static) + , argName + , argPath + , captureArg + , headerArg + , isCapture + , listFromAPI + , path + , queryArgName + , queryArgType + , queryStr + , reqBody + , reqFuncName + , reqHeaders + , reqMethod + , reqUrl + , snakeCaseL + , _PathSegment + ) + +import Text.Casing (quietSnake) + +import qualified Data.Text as T + +-- $setup +-- >>> :set -XDataKinds +-- >>> :set -XOverloadedStrings +-- >>> :set -XTypeOperators +-- >>> :m + Servant.API +-- >>> :m + Data.Text.IO + +{-| +The namespace for the generated class. +-} +data NameSpace + = NameSpace + { moduleNames :: [Text] + -- ^ The list of namespaces you'd like the class to appear in. + , className :: Text + -- ^ The name of the class you'd like the API methods to appear in. + } + +{-| +Generate a Ruby class with methods for the Servant API. + +Currently assumes the API accepts and returns JSON. + +For example: + +>>> Data.Text.IO.putStr $ ruby (NameSpace [] "Baz") (Proxy :: Proxy (Get '[JSON] ())) +require "json" +require "net/http" +require "uri" + +class Baz + def initialize(origin) + @origin = URI(origin) + @http = Net::HTTP.new(@origin.host, @origin.port) + end + + def get() + uri = URI("#{origin}") + + req = Net::HTTP::Get.new(uri) + req["Accept"] = "application/json" + + request(req) + end + + private + + def request(req, body = nil) + res = http.request(req, body) + res.body = JSON.parse(res.body, symbolize_names: true) + res + end +end + +The class can be nested in a module namespace if you choose so. + +>>> Data.Text.IO.putStr $ ruby (NameSpace ["Foo", "Bar"] "Baz") (Proxy :: Proxy (Get '[JSON] ())) +require "json" +require "net/http" +require "uri" + +module Foo + module Bar + class Baz + def initialize(origin) + @origin = URI(origin) + @http = Net::HTTP.new(@origin.host, @origin.port) + end + + def get() + uri = URI("#{origin}") + + req = Net::HTTP::Get.new(uri) + req["Accept"] = "application/json" + + request(req) + end + + private + + def request(req, body = nil) + res = http.request(req, body) + res.body = JSON.parse(res.body, symbolize_names: true) + res + end + end + end +end + +Captures and query parameters are translated into required arguments, in that order. + +The request body and headers are translated into keyword arguments, in that order. + +>>> let api = Proxy :: Proxy ("foo" :> Capture "fooId" Int :> ReqBody '[JSON] () :> QueryParam "bar" Bool :> Header "Max-Forwards" Int :> Post '[JSON] ()) +>>> Data.Text.IO.putStr $ ruby (NameSpace [] "Foo") api +require "json" +require "net/http" +require "uri" + +class Foo + def initialize(origin) + @origin = URI(origin) + @http = Net::HTTP.new(@origin.host, @origin.port) + end + + def post_foo_by_foo_id(foo_id, bar, body:, max_forwards:) + uri = URI("#{origin}/foo/#{fooId}?bar=#{bar}") + + req = Net::HTTP::Post.new(uri) + req["Accept"] = "application/json" + req["Content-Type"] = "application/json" + req["Max-Forwards"] = max_forwards + + request(req, body) + end + + private + + def request(req, body = nil) + res = http.request(req, body) + res.body = JSON.parse(res.body, symbolize_names: true) + res + end +end +-} +ruby + :: (GenerateList NoContent (Foreign NoContent api), HasForeign NoTypes NoContent api) + => NameSpace + -> Proxy api + -> Text +ruby (NameSpace {..}) p = + T.unlines $ + imports + ++ prologue + ++ body + ++ epilogue + where + body = + initialize indent + ++ foldMap (public indent) api + ++ private indent + api = + listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy NoContent) p + prologue = + ((\(i, n) -> T.replicate i " " <> "module " <> n) <$> zip [0..] moduleNames) + ++ [T.replicate indent " " <> "class " <> className] + epilogue = + reverse $ (\i -> T.replicate i " " <> "end") <$> [0..indent] + indent = + length moduleNames + +imports :: [Text] +imports = + [ "require \"json\"" + , "require \"net/http\"" + , "require \"uri\"" + , "" + ] + +properIndent :: Functor f => Int -> f (Maybe Text) -> f Text +properIndent indent = + fmap (maybe "" (T.replicate (indent + 1) " " <>)) + +initialize :: Int -> [Text] +initialize indent = + properIndent indent + [ Just "def initialize(origin)" + , Just " @origin = URI(origin)" + , Just " @http = Net::HTTP.new(@origin.host, @origin.port)" + , Just "end" + ] + +private :: Int -> [Text] +private indent = + properIndent indent + [ Nothing + , Just "private" + , Nothing + , Just "def request(req, body = nil)" + , Just " res = http.request(req, body)" + , Just " res.body = JSON.parse(res.body, symbolize_names: true)" + , Just " res" + , Just "end" + ] + +public :: Int -> Req NoContent -> [Text] +public indent req = + properIndent indent $ + [ Nothing + , Just $ "def " <> functionName <> "(" <> argsStr <> ")" + , Just $ " uri = URI(" <> url <> ")" + , Nothing + , Just $ " req = Net::HTTP::" <> method <> ".new(uri)" + ] + ++ requestHeaders + ++ + [ Nothing + , Just $ " request" <> request + , Just "end" + ] + where + functionName :: Text + functionName = req ^. reqFuncName.snakeCaseL.to snake + + argsStr :: Text + argsStr = T.intercalate ", " $ snake <$> args + + args :: [Text] + args = + captures + ++ ((^. queryArgName.argPath) <$> queryparams) + ++ body + ++ headerArgs + + segments :: [Segment NoContent] + segments = req ^. reqUrl.path^..folded.filtered isCapture + + queryparams :: [QueryArg NoContent] + queryparams = req ^.. reqUrl.queryStr.traverse + + captures :: [Text] + captures = view argPath . captureArg <$> segments + + body :: [Text] + body = + case req ^. reqBody of + Just _ -> ["body:"] + Nothing -> [] + + request :: Text + request = + case req ^. reqBody of + Just _ -> "(req, body)" + Nothing -> "(req)" + + accept :: [Maybe Text] + accept = [Just " req[\"Accept\"] = \"application/json\""] + + contentType :: [Maybe Text] + contentType = + case req ^. reqBody of + Just _ -> [Just " req[\"Content-Type\"] = \"application/json\""] + Nothing -> [] + + hs :: [HeaderArg NoContent] + hs = req ^. reqHeaders + + requestHeaders :: [Maybe Text] + requestHeaders = + accept + ++ contentType + ++ (requestHeader <$> rawHeaders) + + headerArgs :: [Text] + headerArgs = (<> ":") <$> rawHeaders + + rawHeaders :: [Text] + rawHeaders = (^. headerArg.argName._PathSegment) <$> hs + + method :: Text + method = + case req ^. reqMethod.to decodeUtf8' of + Right m -> T.toTitle m + Left _ -> "Get" + + url :: Text + url = "\"#{origin}" <> urlArgs <> queryArgs <> "\"" + + urlArgs :: Text + urlArgs = req ^.. reqUrl.path.traverse & rbSegments + + queryArgs :: Text + queryArgs = + if null queryparams then + "" + else + "?" <> rbParams "&" queryparams + +requestHeader :: Text -> Maybe Text +requestHeader header = Just $ " req[\"" <> header <> "\"] = " <> snake header + +rbSegments :: [Segment f] -> Text +rbSegments [] = "" +rbSegments [x] = "/" <> segmentToStr x +rbSegments (x:xs) = "/" <> segmentToStr x <> rbSegments xs + +segmentToStr :: Segment f -> Text +segmentToStr (Segment st) = segmentTypeToStr st + +segmentTypeToStr :: SegmentType f -> Text +segmentTypeToStr (Static s) = s ^. _PathSegment +segmentTypeToStr (Cap s) = "#{" <> s ^. argName._PathSegment <> "}" + +rbParams :: Text -> [QueryArg f] -> Text +rbParams _ [] = "" +rbParams _ [x] = paramToStr x +rbParams s (x:xs) = paramToStr x <> s <> rbParams s xs + +paramToStr :: QueryArg f -> Text +paramToStr qarg = + case qarg ^. queryArgType of + Normal -> key <> "=#{" <> val <> "}" + Flag -> key + List -> key <> "[]=#{" <> val <> "}" + where + key = qarg ^. queryArgName.argName._PathSegment + val = snake key + +snake :: Text -> Text +snake = T.pack . quietSnake . T.unpack diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,7 @@ +module Main where + +import Test.DocTest (doctest) + +main :: IO () +main = + doctest ["-isrc", "src"]