diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,21 +1,21 @@ -MIT License - -Copyright (c) 2017-2018 MATSUBARA Nobutada - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. +MIT License + +Copyright (c) 2017-2018 MATSUBARA Nobutada + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,28 +1,28 @@ -# Servant Kotlin - -[![Hackage](https://img.shields.io/hackage/v/servant-kotlin.svg?style=flat)](https://hackage.haskell.org/package/servant-kotlin) -[![Build Status](https://travis-ci.org/matsubara0507/servant-kotlin.svg?branch=master)](https://travis-ci.org/matsubara0507/servant-kotlin) -[![Stackage LTS](http://stackage.org/package/servant-kotlin/badge/lts)](http://stackage.org/lts/package/servant-kotlin) -[![Stackage Nightly](http://stackage.org/package/servant-kotlin/badge/nightly)](http://stackage.org/nightly/package/servant-kotlin) - -Generate Kotlin class to query your Servant API! - -## Example - -see [`example/Generater.hs`](/example/Generater.hs). - -this file generate [`TodoAPI.kt`](/example/com/github/matsubara0507/TodoAPI.kt). - -## dependencies for Kotlin - -- [kittinunf/Fuel](https://github.com/kittinunf/Fuel): The easiest HTTP networking library for Kotlin/Android -- [google/gson](https://github.com/google/gson): A Java serialization/deserialization library to convert Java Objects into JSON and back - -## not yet, no Implements - -- [ ] Original QueryFlag -- [ ] Original Header - -## Acknowledgement - -This package is greatly inspired by [`elm-export`](https://hackage.haskell.org/package/elm-export) and [`servant-elm`](https://hackage.haskell.org/package/servant-elm). +# Servant Kotlin + +[![Hackage](https://img.shields.io/hackage/v/servant-kotlin.svg?style=flat)](https://hackage.haskell.org/package/servant-kotlin) +[![Build Status](https://travis-ci.org/matsubara0507/servant-kotlin.svg?branch=master)](https://travis-ci.org/matsubara0507/servant-kotlin) +[![Stackage LTS](http://stackage.org/package/servant-kotlin/badge/lts)](http://stackage.org/lts/package/servant-kotlin) +[![Stackage Nightly](http://stackage.org/package/servant-kotlin/badge/nightly)](http://stackage.org/nightly/package/servant-kotlin) + +Generate Kotlin class to query your Servant API! + +## Example + +see [`example/Generater.hs`](/example/Generater.hs). + +this file generate [`TodoAPI.kt`](/example/com/github/matsubara0507/TodoAPI.kt). + +## dependencies for Kotlin + +- [kittinunf/Fuel](https://github.com/kittinunf/Fuel): The easiest HTTP networking library for Kotlin/Android +- [google/gson](https://github.com/google/gson): A Java serialization/deserialization library to convert Java Objects into JSON and back + +## not yet, no Implements + +- [ ] Original QueryFlag +- [ ] Original Header + +## Acknowledgement + +This package is greatly inspired by [`elm-export`](https://hackage.haskell.org/package/elm-export) and [`servant-elm`](https://hackage.haskell.org/package/servant-elm). diff --git a/example/Generater.hs b/example/Generater.hs --- a/example/Generater.hs +++ b/example/Generater.hs @@ -1,52 +1,52 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} - -module Main where - -import Data.Aeson (FromJSON, ToJSON) -import Data.Proxy (Proxy (Proxy)) -import Data.Text (Text) -import GHC.Generics (Generic) -import Servant.API ((:<|>) (..), (:>), Capture, - Delete, FormUrlEncoded, Get, JSON, - Post, Put, ReqBody) -import Servant.Kotlin -import Shelly (cd, run_, shelly, which) -import Web.Internal.FormUrlEncoded (FromForm) - -data Todo = Todo - { todoId :: Int - , title :: Text - , done :: Bool - } deriving (Generic, Show, Eq, KotlinType) - -instance FromJSON Todo -instance ToJSON Todo -instance FromForm Todo - -type CRUD = "todos" :> Get '[JSON] [Todo] - :<|> "todos" :> ReqBody '[JSON, FormUrlEncoded] Todo :> Post '[JSON] Todo - :<|> "todos" :> Capture "id" Int :> ReqBody '[JSON, FormUrlEncoded] Todo :> Put '[JSON] () - :<|> "todos" :> Capture "id" Int :> Delete '[JSON] () - -body :: [Text] -body = mconcat - [ [ defKotlinImports ] - , generateKotlinForAPIClass "TodoAPI" $ mconcat - [ generateKotlinForDefDataClass (Proxy :: Proxy Todo) - , generateKotlinForAPI (Proxy :: Proxy CRUD) - ] - ] - -spec :: Spec -spec = Spec ["com", "github", "matsubara0507"] "TodoAPI" body - -main :: IO () -main = do - specsToDir [spec] "example/src/main/java" - shelly $ do - cd "example" - which "gradle" >>= mapM_ (\_ -> run_ "gradle" ["build"]) +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +module Main where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Proxy (Proxy (Proxy)) +import Data.Text (Text) +import GHC.Generics (Generic) +import Servant.API ((:<|>) (..), (:>), Capture, + Delete, FormUrlEncoded, Get, JSON, + Post, Put, ReqBody) +import Servant.Kotlin +import Shelly (cd, run_, shelly, which) +import Web.Internal.FormUrlEncoded (FromForm) + +data Todo = Todo + { todoId :: Int + , title :: Text + , done :: Bool + } deriving (Generic, Show, Eq, KotlinType) + +instance FromJSON Todo +instance ToJSON Todo +instance FromForm Todo + +type CRUD = "todos" :> Get '[JSON] [Todo] + :<|> "todos" :> ReqBody '[JSON, FormUrlEncoded] Todo :> Post '[JSON] Todo + :<|> "todos" :> Capture "id" Int :> ReqBody '[JSON, FormUrlEncoded] Todo :> Put '[JSON] () + :<|> "todos" :> Capture "id" Int :> Delete '[JSON] () + +body :: [Text] +body = mconcat + [ [ defKotlinImports ] + , generateKotlinForAPIClass "TodoAPI" $ mconcat + [ generateKotlinForDefDataClass (Proxy :: Proxy Todo) + , generateKotlinForAPI (Proxy :: Proxy CRUD) + ] + ] + +spec :: Spec +spec = Spec ["com", "github", "matsubara0507"] "TodoAPI" body + +main :: IO () +main = do + specsToDir [spec] "example/src/main/java" + shelly $ do + cd "example" + which "gradle" >>= mapM_ (\_ -> run_ "gradle" ["build"]) diff --git a/servant-kotlin.cabal b/servant-kotlin.cabal --- a/servant-kotlin.cabal +++ b/servant-kotlin.cabal @@ -1,11 +1,11 @@ --- This file has been generated from package.yaml by hpack version 0.20.0. +-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack -- --- hash: 72d6da8fcfbeeb254805cbaf73c72da019a8ab6a31d9b651dd95eaadb6be1443 +-- hash: adcb0ee175174fe1ee5718b11a866be2613b0763a25715055ac3e9fa4c4ac69e name: servant-kotlin -version: 0.1.1.0 +version: 0.1.1.1 synopsis: Automatically derive Kotlin class to query servant webservices description: See README at category: Web @@ -17,7 +17,6 @@ license-file: LICENSE build-type: Simple cabal-version: >= 1.10 - extra-source-files: README.md @@ -35,7 +34,7 @@ , servant-foreign >=0.9 && <0.12 , text >=1.2 && <1.3 , time >=1.6 && <1.9 - , wl-pprint-text >=1.1 && <1.2 + , wl-pprint-text >=1.1 && <1.3 exposed-modules: Servant.Kotlin Servant.Kotlin.Internal.File @@ -54,19 +53,19 @@ test ghc-options: -Wall build-depends: - aeson >=1.0 && <1.3 + aeson >=1.0 && <1.4 , base >=4.7 && <5 , containers >=0.5.7 && <0.6.0 , directory >=1.3 && <1.4 , formatting >=6.2 && <6.4 - , hspec >=2.4.1 && <2.5 - , http-api-data >=0.3.7 && <0.3.8 + , hspec >=2.4.1 && <2.6 + , http-api-data >=0.3.7 && <0.3.9 , lens >=4.15 && <4.17 , servant >=0.9 && <0.14 , servant-foreign >=0.9 && <0.12 , text >=1.2 && <1.3 , time >=1.6 && <1.9 - , wl-pprint-text >=1.1 && <1.2 + , wl-pprint-text >=1.1 && <1.3 other-modules: Servant.Kotlin Servant.Kotlin.Internal.File @@ -83,20 +82,20 @@ main-is: example/Generater.hs ghc-options: -Wall build-depends: - aeson >=1.0 && <1.3 + aeson >=1.0 && <1.4 , base >=4.7 && <5 , containers >=0.5.7 && <0.6.0 , directory >=1.3 && <1.4 , formatting >=6.2 && <6.4 - , http-api-data >=0.3.7 && <0.3.8 + , http-api-data >=0.3.7 && <0.3.9 , lens >=4.15 && <4.17 , servant >=0.9 && <0.14 , servant-foreign >=0.9 && <0.12 , servant-kotlin - , shelly >=1.6.8 && <1.8 + , shelly >=1.6.8 && <1.9 , text >=1.2 && <1.3 , time >=1.6 && <1.9 - , wl-pprint-text >=1.1 && <1.2 + , wl-pprint-text >=1.1 && <1.3 other-modules: Paths_servant_kotlin default-language: Haskell2010 diff --git a/src/Servant/Kotlin.hs b/src/Servant/Kotlin.hs --- a/src/Servant/Kotlin.hs +++ b/src/Servant/Kotlin.hs @@ -1,29 +1,29 @@ -module Servant.Kotlin - ( generateKotlinForDefDataClass - , defKotlinImports - , generateKotlinForAPI - , generateKotlinForAPIWith - , generateKotlinForAPIClass - , KotlinOptions(..) - , UrlPrefix(..) - , defKotlinOptions - , Spec (..) - , specsToDir - -- * Convenience re-exports from the "Kotlin" module - , KotlinType - -- * Convenience re-exports from "Data.Proxy" - , Proxy(Proxy) - ) where - -import Servant.Kotlin.Internal.File (Spec (..), specsToDir) -import Servant.Kotlin.Internal.Generate (KotlinOptions (..), - UrlPrefix (..), - defKotlinImports, - defKotlinOptions, - generateKotlinForAPI, - generateKotlinForAPIClass, - generateKotlinForAPIWith, - generateKotlinForDefDataClass) - -import Data.Proxy (Proxy (Proxy)) -import Servant.Kotlin.Type (KotlinType) +module Servant.Kotlin + ( generateKotlinForDefDataClass + , defKotlinImports + , generateKotlinForAPI + , generateKotlinForAPIWith + , generateKotlinForAPIClass + , KotlinOptions(..) + , UrlPrefix(..) + , defKotlinOptions + , Spec (..) + , specsToDir + -- * Convenience re-exports from the "Kotlin" module + , KotlinType + -- * Convenience re-exports from "Data.Proxy" + , Proxy(Proxy) + ) where + +import Servant.Kotlin.Internal.File (Spec (..), specsToDir) +import Servant.Kotlin.Internal.Generate (KotlinOptions (..), + UrlPrefix (..), + defKotlinImports, + defKotlinOptions, + generateKotlinForAPI, + generateKotlinForAPIClass, + generateKotlinForAPIWith, + generateKotlinForDefDataClass) + +import Data.Proxy (Proxy (Proxy)) +import Servant.Kotlin.Type (KotlinType) diff --git a/src/Servant/Kotlin/Internal/File.hs b/src/Servant/Kotlin/Internal/File.hs --- a/src/Servant/Kotlin/Internal/File.hs +++ b/src/Servant/Kotlin/Internal/File.hs @@ -1,46 +1,46 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Servant.Kotlin.Internal.File - ( Spec (..) - , specsToDir - ) where - -import Data.Monoid ((<>)) -import Data.Text (Text, pack, unpack) -import qualified Data.Text as Text -import qualified Data.Text.IO as Text -import Formatting as F -import System.Directory (createDirectoryIfMissing) - -makePath :: [Text] -> Text -makePath = Text.intercalate "/" - -data Spec = Spec - { namespace :: [Text] - , filename :: Text - , declarations :: [Text] - } deriving (Show) - -pathForSpec :: FilePath -> Spec -> [Text] -pathForSpec rootDir spec = pack rootDir : namespace spec <> [filename spec] - -ensureDirectory :: FilePath -> Spec -> IO () -ensureDirectory rootDir spec = createDirectoryIfMissing True $ unpack dir - where - dir = makePath . init $ pathForSpec rootDir spec - -specToFile :: FilePath -> Spec -> IO () -specToFile rootDir spec = do - fprint ("Writing: " % F.stext % "\n") file - Text.writeFile (unpack file) body - where - path = pathForSpec rootDir spec - file = makePath path <> ".kt" - namespaceText = Text.intercalate "." (namespace spec) - body = Text.intercalate "\n\n" $ - "package " <> namespaceText : declarations spec - -specsToDir :: [Spec] -> FilePath -> IO () -specsToDir specs rootDir = mapM_ processSpec specs - where - processSpec = ensureDirectory rootDir >> specToFile rootDir +{-# LANGUAGE OverloadedStrings #-} + +module Servant.Kotlin.Internal.File + ( Spec (..) + , specsToDir + ) where + +import Data.Monoid ((<>)) +import Data.Text (Text, pack, unpack) +import qualified Data.Text as Text +import qualified Data.Text.IO as Text +import Formatting as F +import System.Directory (createDirectoryIfMissing) + +makePath :: [Text] -> Text +makePath = Text.intercalate "/" + +data Spec = Spec + { namespace :: [Text] + , filename :: Text + , declarations :: [Text] + } deriving (Show) + +pathForSpec :: FilePath -> Spec -> [Text] +pathForSpec rootDir spec = pack rootDir : namespace spec <> [filename spec] + +ensureDirectory :: FilePath -> Spec -> IO () +ensureDirectory rootDir spec = createDirectoryIfMissing True $ unpack dir + where + dir = makePath . init $ pathForSpec rootDir spec + +specToFile :: FilePath -> Spec -> IO () +specToFile rootDir spec = do + fprint ("Writing: " % F.stext % "\n") file + Text.writeFile (unpack file) body + where + path = pathForSpec rootDir spec + file = makePath path <> ".kt" + namespaceText = Text.intercalate "." (namespace spec) + body = Text.intercalate "\n\n" $ + "package " <> namespaceText : declarations spec + +specsToDir :: [Spec] -> FilePath -> IO () +specsToDir specs rootDir = mapM_ processSpec specs + where + processSpec = ensureDirectory rootDir >> specToFile rootDir diff --git a/src/Servant/Kotlin/Internal/Foreign.hs b/src/Servant/Kotlin/Internal/Foreign.hs --- a/src/Servant/Kotlin/Internal/Foreign.hs +++ b/src/Servant/Kotlin/Internal/Foreign.hs @@ -1,25 +1,25 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} - -module Servant.Kotlin.Internal.Foreign where - -import Data.Proxy (Proxy (Proxy)) -import Servant.Foreign (Foreign, GenerateList, HasForeign, - HasForeignType, Req, listFromAPI, typeFor) -import Servant.Kotlin.Type (KotlinClass, KotlinType, toKotlinType') - -data LangKotlin - -instance (KotlinType a) => HasForeignType LangKotlin KotlinClass a where - typeFor _ _ _ = toKotlinType' (Proxy :: Proxy a) - -getEndpoints :: - ( HasForeign LangKotlin KotlinClass api - , GenerateList KotlinClass (Foreign KotlinClass api)) - => Proxy api - -> [Req KotlinClass] -getEndpoints = - listFromAPI (Proxy :: Proxy LangKotlin) (Proxy :: Proxy KotlinClass) +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +module Servant.Kotlin.Internal.Foreign where + +import Data.Proxy (Proxy (Proxy)) +import Servant.Foreign (Foreign, GenerateList, HasForeign, + HasForeignType, Req, listFromAPI, typeFor) +import Servant.Kotlin.Type (KotlinClass, KotlinType, toKotlinType') + +data LangKotlin + +instance (KotlinType a) => HasForeignType LangKotlin KotlinClass a where + typeFor _ _ _ = toKotlinType' (Proxy :: Proxy a) + +getEndpoints :: + ( HasForeign LangKotlin KotlinClass api + , GenerateList KotlinClass (Foreign KotlinClass api)) + => Proxy api + -> [Req KotlinClass] +getEndpoints = + listFromAPI (Proxy :: Proxy LangKotlin) (Proxy :: Proxy KotlinClass) diff --git a/src/Servant/Kotlin/Internal/Generate.hs b/src/Servant/Kotlin/Internal/Generate.hs --- a/src/Servant/Kotlin/Internal/Generate.hs +++ b/src/Servant/Kotlin/Internal/Generate.hs @@ -1,362 +1,364 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} - -module Servant.Kotlin.Internal.Generate - ( GenerateKotlin (..) - , generateKotlinForDefDataClass - , generateKotlinForDefDataClass' - , defKotlinImports - , generateKotlinForAPIClass - , generateKotlinForAPI - , generateKotlinForAPIWith - , KotlinOptions (..) - , defKotlinOptions - , UrlPrefix (..) - ) where - -import Control.Lens (to, (^.)) -import Data.List (nub) -import Data.Maybe (catMaybes, fromMaybe) -import Data.Monoid ((<>)) -import Data.Proxy (Proxy) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Text.Lazy as L -import Servant.API (NoContent (..)) -import qualified Servant.Foreign as F -import Servant.Kotlin.Internal.Foreign (LangKotlin, getEndpoints) -import Servant.Kotlin.Type -import Text.PrettyPrint.Leijen.Text hiding ((<>)) - -class GenerateKotlin a where - generateKotlin :: a -> [Text] - generateKotlin' :: a -> Text - generateKotlin' = T.concat . generateKotlin - -instance GenerateKotlin KotlinClass where - generateKotlin (PrimitiveClass c) = generateKotlin c - generateKotlin (ExClass c) = generateKotlin c - generateKotlin (DataClass (KotlinDataClass name _)) = [name] - -instance GenerateKotlin KotlinPrimitiveClass where - generateKotlin KDouble = ["Double"] - generateKotlin KFloat = ["Float"] - generateKotlin KLong = ["Long"] - generateKotlin KInt = ["Int"] - generateKotlin KShort = ["Short"] - generateKotlin KByte = ["Byte"] - generateKotlin KChar = ["Char"] - generateKotlin KBoolean = ["Boolean"] - generateKotlin (KArray c) = ["Array<" <> generateKotlin' c <> ">"] - generateKotlin KString = ["String"] - generateKotlin KUnit = ["Unit"] - generateKotlin (KNullable c) = [generateKotlin' c <> "?"] - generateKotlin KAny = ["Any"] - -instance GenerateKotlin KotlinExClass where - generateKotlin (KList c) = - ["List<" <> generateKotlin' c <> ">"] - generateKotlin (KHashMap k v) = - ["HashMap<" <> generateKotlin' k <> ", " <> generateKotlin' v <> ">"] - generateKotlin (KPair a b) = - ["Pair<" <> generateKotlin' a <> ", " <> generateKotlin' b <> ">"] - generateKotlin KTime = ["Time"] - -instance GenerateKotlin KotlinDataClass where - generateKotlin (KotlinDataClass name fields) = - [ "data class " <> name <> "(" <> generateKotlin' fields <> ")" ] - -instance GenerateKotlin KotlinFields where - generateKotlin (Node field) = generateKotlin field - generateKotlin (Brunch a b) = [generateKotlin' a <> ", " <> generateKotlin' b] - -instance GenerateKotlin KotlinField where - generateKotlin (KotlinField name c) = - ["val " <> name <> ": " <> generateKotlin' c] - -generateKotlinForDefDataClass' :: KotlinClass -> [Text] -generateKotlinForDefDataClass' (DataClass c) = generateKotlin c -generateKotlinForDefDataClass' _ = [] - -generateKotlinForDefDataClass :: (KotlinType a) => Proxy a -> [Text] -generateKotlinForDefDataClass = - maybe [] generateKotlinForDefDataClass' . toKotlinType - ---- - -defKotlinImports :: Text -defKotlinImports = docToText . vsep $ fmap ("import" <+>) - [ "com.github.kittinunf.fuel.Fuel" - , "com.github.kittinunf.fuel.core.FuelError" - , "com.github.kittinunf.fuel.core.FuelManager" - , "com.github.kittinunf.fuel.core.Request" - , "com.github.kittinunf.fuel.core.Response" - , "com.github.kittinunf.fuel.gson.responseObject" - , "com.github.kittinunf.result.Result" - , "com.google.gson.Gson" - ] - ---- - -generateKotlinForAPIClass :: Text -> [Text] -> [Text] -generateKotlinForAPIClass className body = mconcat - [ [ docToText $ "class" <+> textStrict className <> "(private val baseURL: String) {" ] - , [ docToText $ indent indentNum initialize ] - , fmap (docToText . vsep . fmap (indent indentNum . textStrict) . T.lines) body - , [ "}" ] - ] - where - initialize = vsep [ "init {", indent indentNum fuelManager, "}" ] - fuelManager = vsep - [ "FuelManager.instance.apply {" - , indent indentNum "basePath = baseURL" - , indent indentNum $ "baseHeaders = mapOf(" <> header <> ")" - , "}" - ] - header = hsep . punctuate comma $ - fmap (\(k, v) -> dquotes k <+> "to" <+> dquotes v) - [("Content-Type", "application/json"), ("Device", "Android")] - ---- - -{-| - Generate Kotlin code for the API with default options. - Returns a list of Kotlin functions to query your Servant API from Kotlin. --} -generateKotlinForAPI :: - ( F.HasForeign LangKotlin KotlinClass api - , F.GenerateList KotlinClass (F.Foreign KotlinClass api)) - => Proxy api - -> [Text] -generateKotlinForAPI = - generateKotlinForAPIWith defKotlinOptions - -{-| - Generate Kotlin code for the API with custom options. --} -generateKotlinForAPIWith :: - ( F.HasForeign LangKotlin KotlinClass api - , F.GenerateList KotlinClass (F.Foreign KotlinClass api)) - => KotlinOptions - -> Proxy api - -> [Text] -generateKotlinForAPIWith opts = - nub . fmap (docToText . generateKotlinForRequest opts) . getEndpoints - -indentNum :: Int -indentNum = 4 - -{-| - Generate an Kotlin function for one endpoint. --} -generateKotlinForRequest :: KotlinOptions -> F.Req KotlinClass -> Doc -generateKotlinForRequest opts request = funcDef - where - funcDef = - vsep - [ "fun" <+> fnName <> "(" <> args <> ") {" - , indent indentNum kotlinRequest - , "}" - ] - - fnName = - request ^. F.reqFuncName . to (T.replace "-" "" . F.camelCase) . to stext - - args = - mkArgs opts request - - kotlinRequest = - mkRequest opts request - -mkArgs :: KotlinOptions -> F.Req KotlinClass -> Doc -mkArgs opts request = - (hsep . punctuate comma . concat) - [ urlPrefixArg - , headerArgs - , urlCaptureArgs - , queryArgs - , requestBodyArg - , handlerArg - ] - where - urlPrefixArg :: [Doc] - urlPrefixArg = - case urlPrefix opts of - Dynamic -> ["urlBase: String"] - Static _ -> [] - - headerArgs :: [Doc] - headerArgs = - [ kotlinHeaderArg header <> ": " <> kotlinHeaderType header - | header <- request ^. F.reqHeaders - ] - - urlCaptureArgs :: [Doc] - urlCaptureArgs = - [ kotlinCaptureArg segment <> ": " <> kotlinCaptureType segment - | segment <- request ^. F.reqUrl . F.path, F.isCapture segment - ] - - queryArgs :: [Doc] - queryArgs = - [ kotlinQueryArg arg <> ": " <> kotlinQueryType arg - | arg <- request ^. F.reqUrl . F.queryStr - ] - - requestBodyArg :: [Doc] - requestBodyArg = - maybe [] (\body -> [kotlinBodyArg <> ": " <> kotlinTypeRef body]) $ - request ^. F.reqBody - - handlerArg :: [Doc] - handlerArg = [kotlinHandlerArg <> ": " <> handlerType] - where - handlerType = - "(Request, Response, Result<" <> returnType <> ", FuelError>) -> Unit" - - returnType :: Doc - returnType = kotlinTypeRef . - fromMaybe (PrimitiveClass KUnit) $ request ^. F.reqReturnType - -kotlinHeaderArg :: F.HeaderArg KotlinClass -> Doc -kotlinHeaderArg header = "header_" <> - header ^. F.headerArg . F.argName - . to (stext . T.replace "-" "_" . F.unPathSegment) - -kotlinHeaderType :: F.HeaderArg KotlinClass -> Doc -#if MIN_VERSION_servant_foreign(0,11,0) -kotlinHeaderType header = - header ^. F.headerArg . F.argType . to kotlinTypeRef -#else -kotlinHeaderType header = - header ^. F.headerArg . F.argType . to (kotlinTypeRef . wrapper) - where - wrapper = PrimitiveClass . KNullable -#endif - -kotlinCaptureArg :: F.Segment KotlinClass -> Doc -kotlinCaptureArg segment = "capture_" <> - F.captureArg segment ^. F.argName . to (stext . F.unPathSegment) - -kotlinCaptureType :: F.Segment KotlinClass -> Doc -kotlinCaptureType segment = - F.captureArg segment ^. F.argType . to kotlinTypeRef - -kotlinQueryArg :: F.QueryArg KotlinClass -> Doc -kotlinQueryArg arg = "query_" <> - arg ^. F.queryArgName . F.argName . to (stext . F.unPathSegment) - -kotlinQueryType :: F.QueryArg KotlinClass -> Doc -#if MIN_VERSION_servant_foreign(0,11,0) -kotlinQueryType arg = - arg ^. F.queryArgName . F.argType . to kotlinTypeRef -#else -kotlinQueryType arg = - arg ^. F.queryArgName . F.argType . to (kotlinTypeRef . wrapper) - where - wrapper = case arg ^. F.queryArgType of - F.Normal -> PrimitiveClass . KNullable - _ -> id -#endif - -kotlinBodyArg :: Doc -kotlinBodyArg = "body" - -kotlinHandlerArg :: Doc -kotlinHandlerArg = "handler" - -kotlinTypeRef :: KotlinClass -> Doc -kotlinTypeRef = stext . generateKotlin' - - -mkRequest :: KotlinOptions -> F.Req KotlinClass -> Doc -mkRequest opts request = "Fuel" <> align (vsep methodChain) - where - methodChain = catMaybes - [ Just $ mconcat [".", method, "(", url, ")"] - , body - , Just ".responseObject(handler)" - ] - - method = - request ^. F.reqMethod . to (stext . T.toLower . T.decodeUtf8) - - url = - mkUrl opts (request ^. F.reqUrl . F.path) <> mkQueryParams request - - body = fmap (\b -> mconcat - [ ".body(Gson().toJson(" - , kotlinBodyArg - , ", " - , kotlinTypeRef b - , "::class.java))" - ] - ) $ request ^. F.reqBody - - -mkUrl :: KotlinOptions -> [F.Segment KotlinClass] -> Doc -mkUrl _opts segments = mconcat . punctuate " + " $ - dquotes "/" : punctuate (" + " <> dquotes "/") (map segmentToDoc segments) - where - segmentToDoc :: F.Segment KotlinClass -> Doc - segmentToDoc segment = - case F.unSegment segment of - F.Static path -> dquotes (stext (F.unPathSegment path)) - F.Cap _arg -> kotlinCaptureArg segment - --- TODO: implements -mkQueryParams :: F.Req KotlinClass -> Doc -mkQueryParams _request = "" - -- if null (request ^. F.reqUrl . F.queryStr) then - -- empty - -- else - -- " +" <+> dquotes "?" <+> "+" <+> - -- "params.joinToString(" <> dquotes "&" <> ")" - -{-| - Options to configure how code is generated. --} -data KotlinOptions = KotlinOptions - { urlPrefix :: UrlPrefix - , emptyResponseKotlinTypes :: [KotlinClass] - -- ^ Types that represent an empty Http response. - , stringKotlinTypes :: [KotlinClass] - -- ^ Types that represent a String. - } - -data UrlPrefix - = Static Text - | Dynamic - -{-| - Default options for generating Kotlin code. - The default options are: - > { urlPrefix = Static "" - > , emptyResponseKotlinTypes = [ toKotlinType NoContent ] - > , stringKotlinTypes = [ toKotlinType "" ] - > } --} -defKotlinOptions :: KotlinOptions -defKotlinOptions = KotlinOptions - { urlPrefix = Static "" - , emptyResponseKotlinTypes = - [ toKotlinType' NoContent - , toKotlinType' () - ] - , stringKotlinTypes = - [ toKotlinType' ("" :: String) - , toKotlinType' ("" :: Text) - ] - } - ---- - -docToText :: Doc -> Text -docToText = - L.toStrict . displayT . renderPretty 0.4 100 - -stext :: Text -> Doc -stext = text . L.fromStrict +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} + +module Servant.Kotlin.Internal.Generate + ( GenerateKotlin (..) + , generateKotlinForDefDataClass + , generateKotlinForDefDataClass' + , defKotlinImports + , generateKotlinForAPIClass + , generateKotlinForAPI + , generateKotlinForAPIWith + , KotlinOptions (..) + , defKotlinOptions + , UrlPrefix (..) + ) where + +import Control.Lens (to, (^.)) +import Data.List (nub) +import Data.Maybe (catMaybes, fromMaybe) +import Data.Monoid ((<>)) +import Data.Proxy (Proxy) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy as L +import Servant.API (NoContent (..)) +import qualified Servant.Foreign as F +import Servant.Kotlin.Internal.Foreign (LangKotlin, getEndpoints) +import Servant.Kotlin.Type +import Text.PrettyPrint.Leijen.Text (Doc, (<+>)) +import qualified Text.PrettyPrint.Leijen.Text as PP + +class GenerateKotlin a where + generateKotlin :: a -> [Text] + generateKotlin' :: a -> Text + generateKotlin' = T.concat . generateKotlin + +instance GenerateKotlin KotlinClass where + generateKotlin (PrimitiveClass c) = generateKotlin c + generateKotlin (ExClass c) = generateKotlin c + generateKotlin (DataClass (KotlinDataClass name _)) = [name] + +instance GenerateKotlin KotlinPrimitiveClass where + generateKotlin KDouble = ["Double"] + generateKotlin KFloat = ["Float"] + generateKotlin KLong = ["Long"] + generateKotlin KInt = ["Int"] + generateKotlin KShort = ["Short"] + generateKotlin KByte = ["Byte"] + generateKotlin KChar = ["Char"] + generateKotlin KBoolean = ["Boolean"] + generateKotlin (KArray c) = ["Array<" <> generateKotlin' c <> ">"] + generateKotlin KString = ["String"] + generateKotlin KUnit = ["Unit"] + generateKotlin (KNullable c) = [generateKotlin' c <> "?"] + generateKotlin KAny = ["Any"] + +instance GenerateKotlin KotlinExClass where + generateKotlin (KList c) = + ["List<" <> generateKotlin' c <> ">"] + generateKotlin (KHashMap k v) = + ["HashMap<" <> generateKotlin' k <> ", " <> generateKotlin' v <> ">"] + generateKotlin (KPair a b) = + ["Pair<" <> generateKotlin' a <> ", " <> generateKotlin' b <> ">"] + generateKotlin KTime = ["Time"] + +instance GenerateKotlin KotlinDataClass where + generateKotlin (KotlinDataClass name fields) = + [ "data class " <> name <> "(" <> generateKotlin' fields <> ")" ] + +instance GenerateKotlin KotlinFields where + generateKotlin (Node field) = generateKotlin field + generateKotlin (Brunch a b) = [generateKotlin' a <> ", " <> generateKotlin' b] + +instance GenerateKotlin KotlinField where + generateKotlin (KotlinField name c) = + ["val " <> name <> ": " <> generateKotlin' c] + +generateKotlinForDefDataClass' :: KotlinClass -> [Text] +generateKotlinForDefDataClass' (DataClass c) = generateKotlin c +generateKotlinForDefDataClass' _ = [] + +generateKotlinForDefDataClass :: (KotlinType a) => Proxy a -> [Text] +generateKotlinForDefDataClass = + maybe [] generateKotlinForDefDataClass' . toKotlinType + +--- + +defKotlinImports :: Text +defKotlinImports = docToText . PP.vsep $ fmap ("import" <+>) + [ "com.github.kittinunf.fuel.Fuel" + , "com.github.kittinunf.fuel.core.FuelError" + , "com.github.kittinunf.fuel.core.FuelManager" + , "com.github.kittinunf.fuel.core.Request" + , "com.github.kittinunf.fuel.core.Response" + , "com.github.kittinunf.fuel.gson.responseObject" + , "com.github.kittinunf.result.Result" + , "com.google.gson.Gson" + ] + +--- + +generateKotlinForAPIClass :: Text -> [Text] -> [Text] +generateKotlinForAPIClass className body = mconcat + [ [ docToText $ "class" <+> PP.textStrict className <> "(private val baseURL: String) {" ] + , [ docToText $ PP.indent indentNum initialize ] + , fmap (docToText . PP.vsep . fmap (PP.indent indentNum . PP.textStrict) . T.lines) body + , [ "}" ] + ] + where + initialize = PP.vsep [ "init {", PP.indent indentNum fuelManager, "}" ] + fuelManager = PP.vsep + [ "FuelManager.instance.apply {" + , PP.indent indentNum "basePath = baseURL" + , PP.indent indentNum $ "baseHeaders = mapOf(" <> header <> ")" + , "}" + ] + header = PP.hsep . PP.punctuate PP.comma $ + fmap (\(k, v) -> PP.dquotes k <+> "to" <+> PP.dquotes v) + [("Content-Type", "application/json"), ("Device", "Android")] + +--- + +{-| + Generate Kotlin code for the API with default options. + Returns a list of Kotlin functions to query your Servant API from Kotlin. +-} +generateKotlinForAPI :: + ( F.HasForeign LangKotlin KotlinClass api + , F.GenerateList KotlinClass (F.Foreign KotlinClass api)) + => Proxy api + -> [Text] +generateKotlinForAPI = + generateKotlinForAPIWith defKotlinOptions + +{-| + Generate Kotlin code for the API with custom options. +-} +generateKotlinForAPIWith :: + ( F.HasForeign LangKotlin KotlinClass api + , F.GenerateList KotlinClass (F.Foreign KotlinClass api)) + => KotlinOptions + -> Proxy api + -> [Text] +generateKotlinForAPIWith opts = + nub . fmap (docToText . generateKotlinForRequest opts) . getEndpoints + +indentNum :: Int +indentNum = 4 + +{-| + Generate an Kotlin function for one endpoint. +-} +generateKotlinForRequest :: KotlinOptions -> F.Req KotlinClass -> Doc +generateKotlinForRequest opts request = funcDef + where + funcDef = + PP.vsep + [ "fun" <+> fnName <> "(" <> args <> ") {" + , PP.indent indentNum kotlinRequest + , "}" + ] + + fnName = + request ^. F.reqFuncName . to (T.replace "-" "" . F.camelCase) . to stext + + args = + mkArgs opts request + + kotlinRequest = + mkRequest opts request + +mkArgs :: KotlinOptions -> F.Req KotlinClass -> Doc +mkArgs opts request = + (PP.hsep . PP.punctuate PP.comma . concat) + [ urlPrefixArg + , headerArgs + , urlCaptureArgs + , queryArgs + , requestBodyArg + , handlerArg + ] + where + urlPrefixArg :: [Doc] + urlPrefixArg = + case urlPrefix opts of + Dynamic -> ["urlBase: String"] + Static _ -> [] + + headerArgs :: [Doc] + headerArgs = + [ kotlinHeaderArg header <> ": " <> kotlinHeaderType header + | header <- request ^. F.reqHeaders + ] + + urlCaptureArgs :: [Doc] + urlCaptureArgs = + [ kotlinCaptureArg segment <> ": " <> kotlinCaptureType segment + | segment <- request ^. F.reqUrl . F.path, F.isCapture segment + ] + + queryArgs :: [Doc] + queryArgs = + [ kotlinQueryArg arg <> ": " <> kotlinQueryType arg + | arg <- request ^. F.reqUrl . F.queryStr + ] + + requestBodyArg :: [Doc] + requestBodyArg = + maybe [] (\body -> [kotlinBodyArg <> ": " <> kotlinTypeRef body]) $ + request ^. F.reqBody + + handlerArg :: [Doc] + handlerArg = [kotlinHandlerArg <> ": " <> handlerType] + where + handlerType = + "(Request, Response, Result<" <> returnType <> ", FuelError>) -> Unit" + + returnType :: Doc + returnType = kotlinTypeRef . + fromMaybe (PrimitiveClass KUnit) $ request ^. F.reqReturnType + +kotlinHeaderArg :: F.HeaderArg KotlinClass -> Doc +kotlinHeaderArg header = "header_" <> + header ^. F.headerArg . F.argName + . to (stext . T.replace "-" "_" . F.unPathSegment) + +kotlinHeaderType :: F.HeaderArg KotlinClass -> Doc +#if MIN_VERSION_servant_foreign(0,11,0) +kotlinHeaderType header = + header ^. F.headerArg . F.argType . to kotlinTypeRef +#else +kotlinHeaderType header = + header ^. F.headerArg . F.argType . to (kotlinTypeRef . wrapper) + where + wrapper = PrimitiveClass . KNullable +#endif + +kotlinCaptureArg :: F.Segment KotlinClass -> Doc +kotlinCaptureArg segment = "capture_" <> + F.captureArg segment ^. F.argName . to (stext . F.unPathSegment) + +kotlinCaptureType :: F.Segment KotlinClass -> Doc +kotlinCaptureType segment = + F.captureArg segment ^. F.argType . to kotlinTypeRef + +kotlinQueryArg :: F.QueryArg KotlinClass -> Doc +kotlinQueryArg arg = "query_" <> + arg ^. F.queryArgName . F.argName . to (stext . F.unPathSegment) + +kotlinQueryType :: F.QueryArg KotlinClass -> Doc +#if MIN_VERSION_servant_foreign(0,11,0) +kotlinQueryType arg = + arg ^. F.queryArgName . F.argType . to kotlinTypeRef +#else +kotlinQueryType arg = + arg ^. F.queryArgName . F.argType . to (kotlinTypeRef . wrapper) + where + wrapper = case arg ^. F.queryArgType of + F.Normal -> PrimitiveClass . KNullable + _ -> id +#endif + +kotlinBodyArg :: Doc +kotlinBodyArg = "body" + +kotlinHandlerArg :: Doc +kotlinHandlerArg = "handler" + +kotlinTypeRef :: KotlinClass -> Doc +kotlinTypeRef = stext . generateKotlin' + + +mkRequest :: KotlinOptions -> F.Req KotlinClass -> Doc +mkRequest opts request = "Fuel" <> PP.align (PP.vsep methodChain) + where + methodChain = catMaybes + [ Just $ mconcat [".", method, "(", url, ")"] + , body + , Just ".responseObject(handler)" + ] + + method = + request ^. F.reqMethod . to (stext . T.toLower . T.decodeUtf8) + + url = + mkUrl opts (request ^. F.reqUrl . F.path) <> mkQueryParams request + + body = fmap (\b -> mconcat + [ ".body(Gson().toJson(" + , kotlinBodyArg + , ", " + , kotlinTypeRef b + , "::class.java))" + ] + ) $ request ^. F.reqBody + + +mkUrl :: KotlinOptions -> [F.Segment KotlinClass] -> Doc +mkUrl _opts segments = mconcat . PP.punctuate " + " $ + PP.dquotes "/" : + PP.punctuate (" + " <> PP.dquotes "/") (map segmentToDoc segments) + where + segmentToDoc :: F.Segment KotlinClass -> Doc + segmentToDoc segment = + case F.unSegment segment of + F.Static path -> PP.dquotes (stext (F.unPathSegment path)) + F.Cap _arg -> kotlinCaptureArg segment + +-- TODO: implements +mkQueryParams :: F.Req KotlinClass -> Doc +mkQueryParams _request = "" + -- if null (request ^. F.reqUrl . F.queryStr) then + -- empty + -- else + -- " +" <+> dquotes "?" <+> "+" <+> + -- "params.joinToString(" <> dquotes "&" <> ")" + +{-| + Options to configure how code is generated. +-} +data KotlinOptions = KotlinOptions + { urlPrefix :: UrlPrefix + , emptyResponseKotlinTypes :: [KotlinClass] + -- ^ Types that represent an empty Http response. + , stringKotlinTypes :: [KotlinClass] + -- ^ Types that represent a String. + } + +data UrlPrefix + = Static Text + | Dynamic + +{-| + Default options for generating Kotlin code. + The default options are: + > { urlPrefix = Static "" + > , emptyResponseKotlinTypes = [ toKotlinType NoContent ] + > , stringKotlinTypes = [ toKotlinType "" ] + > } +-} +defKotlinOptions :: KotlinOptions +defKotlinOptions = KotlinOptions + { urlPrefix = Static "" + , emptyResponseKotlinTypes = + [ toKotlinType' NoContent + , toKotlinType' () + ] + , stringKotlinTypes = + [ toKotlinType' ("" :: String) + , toKotlinType' ("" :: Text) + ] + } + +--- + +docToText :: Doc -> Text +docToText = + L.toStrict . PP.displayT . PP.renderPretty 0.4 100 + +stext :: Text -> Doc +stext = PP.text . L.fromStrict diff --git a/src/Servant/Kotlin/Type.hs b/src/Servant/Kotlin/Type.hs --- a/src/Servant/Kotlin/Type.hs +++ b/src/Servant/Kotlin/Type.hs @@ -1,185 +1,185 @@ -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeSynonymInstances #-} - -module Servant.Kotlin.Type - ( KotlinClass (..) - , KotlinPrimitiveClass (..) - , KotlinExClass (..) - , KotlinDataClass (..) - , KotlinFields (..) - , KotlinField (..) - , KotlinType (..) - , GenericKotlinType (..) - , GenericKotlinFields (..) - , toKotlinType' - ) where - -import Data.Int (Int16, Int32, Int64, Int8) -import Data.IntMap (IntMap) -import Data.Map (Map) -import Data.Maybe (fromMaybe) -import Data.Proxy (Proxy (..)) -import Data.Text (Text, pack) -import Data.Time (UTCTime) -import GHC.Generics -import Servant.API (NoContent (..)) - -data KotlinClass - = PrimitiveClass KotlinPrimitiveClass - | DataClass KotlinDataClass - | ExClass KotlinExClass - deriving (Show, Eq) - -data KotlinPrimitiveClass - = KDouble - | KFloat - | KLong - | KInt - | KShort - | KByte - | KChar - | KBoolean - | KArray KotlinClass - | KString - | KUnit - | KNullable KotlinClass - | KAny - deriving (Show, Eq) - -data KotlinExClass - = KList KotlinClass - | KHashMap KotlinClass KotlinClass - | KPair KotlinClass KotlinClass - | KTime - deriving (Show, Eq) - -data KotlinDataClass = KotlinDataClass Text KotlinFields deriving (Show, Eq) - -data KotlinFields - = Node KotlinField - | Brunch KotlinFields KotlinFields - deriving (Show, Eq) - -data KotlinField = KotlinField Text KotlinClass deriving (Show, Eq) - -class KotlinType a where - toKotlinType :: a -> Maybe KotlinClass - toKotlinType = genericToKotlinType . from - default toKotlinType :: (Generic a, GenericKotlinType (Rep a)) => - a -> Maybe KotlinClass - -class GenericKotlinType f where - genericToKotlinType :: f a -> Maybe KotlinClass - -instance (Datatype d, GenericKotlinFields f) - => GenericKotlinType (D1 d f) where - genericToKotlinType datatype = fmap DataClass $ - KotlinDataClass (pack $ datatypeName datatype) - <$> genericToKotlinFields (unM1 datatype) - -class GenericKotlinFields f where - genericToKotlinFields :: f a -> Maybe KotlinFields - -instance (Constructor c, GenericKotlinFields f) - => GenericKotlinFields (C1 c f) where - genericToKotlinFields constructor = - if conIsRecord constructor then - genericToKotlinFields (unM1 constructor) - else - Nothing - -instance GenericKotlinFields (f :+: g) where - genericToKotlinFields _ = Nothing - -instance (Selector s, GenericKotlinType a) - => GenericKotlinFields (S1 s a) where - genericToKotlinFields selector = - case selName selector of - "" -> Nothing - name -> - Node . KotlinField (pack name) - <$> genericToKotlinType (undefined :: a p) - -instance (GenericKotlinFields f, GenericKotlinFields g) - => GenericKotlinFields (f :*: g) where - genericToKotlinFields _ = - Brunch <$> genericToKotlinFields (undefined :: f p) - <*> genericToKotlinFields (undefined :: g p) - -instance GenericKotlinFields U1 where - genericToKotlinFields _ = Nothing - -instance KotlinType a => GenericKotlinType (Rec0 a) where - genericToKotlinType _ = toKotlinType (Proxy :: Proxy a) - -instance KotlinType a => KotlinType [a] where - toKotlinType _ = ExClass . KList <$> toKotlinType (Proxy :: Proxy a) - -instance KotlinType a => KotlinType (Maybe a) where - toKotlinType _ = - PrimitiveClass . KNullable <$> toKotlinType (Proxy :: Proxy a) - -instance KotlinType () where - toKotlinType _ = Just $ PrimitiveClass KUnit - -instance KotlinType Text where - toKotlinType _ = Just $ PrimitiveClass KString - -instance KotlinType UTCTime where - toKotlinType _ = Just $ ExClass KTime - -instance KotlinType Float where - toKotlinType _ = Just $ PrimitiveClass KFloat - -instance KotlinType Double where - toKotlinType _ = Just $ PrimitiveClass KDouble - -instance KotlinType Int where - toKotlinType _ = Just $ PrimitiveClass KInt - -instance KotlinType Int8 where - toKotlinType _ = Just $ PrimitiveClass KByte - -instance KotlinType Int16 where - toKotlinType _ = Just $ PrimitiveClass KShort - -instance KotlinType Int32 where - toKotlinType _ = Just $ PrimitiveClass KInt - -instance KotlinType Int64 where - toKotlinType _ = Just $ PrimitiveClass KLong - -instance KotlinType Char where - toKotlinType _ = Just $ PrimitiveClass KChar - -instance KotlinType Bool where - toKotlinType _ = Just $ PrimitiveClass KBoolean - -instance (KotlinType a, KotlinType b) => KotlinType (a, b) where - toKotlinType _ = fmap ExClass $ - KPair - <$> toKotlinType (Proxy :: Proxy a) - <*> toKotlinType (Proxy :: Proxy b) - -instance (KotlinType a) => KotlinType (Proxy a) where - toKotlinType _ = toKotlinType (undefined :: a) - -instance (KotlinType k, KotlinType v) => KotlinType (Map k v) where - toKotlinType _ = fmap ExClass $ - KHashMap - <$> toKotlinType (Proxy :: Proxy k) - <*> toKotlinType (Proxy :: Proxy v) - -instance (KotlinType v) => KotlinType (IntMap v) where - toKotlinType _ = - PrimitiveClass . KArray <$> toKotlinType (Proxy :: Proxy v) - -instance KotlinType NoContent where - toKotlinType _ = Just $ PrimitiveClass KUnit - -toKotlinType' :: (KotlinType a) => a -> KotlinClass -toKotlinType' = fromMaybe (PrimitiveClass KAny) . toKotlinType +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module Servant.Kotlin.Type + ( KotlinClass (..) + , KotlinPrimitiveClass (..) + , KotlinExClass (..) + , KotlinDataClass (..) + , KotlinFields (..) + , KotlinField (..) + , KotlinType (..) + , GenericKotlinType (..) + , GenericKotlinFields (..) + , toKotlinType' + ) where + +import Data.Int (Int16, Int32, Int64, Int8) +import Data.IntMap (IntMap) +import Data.Map (Map) +import Data.Maybe (fromMaybe) +import Data.Proxy (Proxy (..)) +import Data.Text (Text, pack) +import Data.Time (UTCTime) +import GHC.Generics +import Servant.API (NoContent (..)) + +data KotlinClass + = PrimitiveClass KotlinPrimitiveClass + | DataClass KotlinDataClass + | ExClass KotlinExClass + deriving (Show, Eq) + +data KotlinPrimitiveClass + = KDouble + | KFloat + | KLong + | KInt + | KShort + | KByte + | KChar + | KBoolean + | KArray KotlinClass + | KString + | KUnit + | KNullable KotlinClass + | KAny + deriving (Show, Eq) + +data KotlinExClass + = KList KotlinClass + | KHashMap KotlinClass KotlinClass + | KPair KotlinClass KotlinClass + | KTime + deriving (Show, Eq) + +data KotlinDataClass = KotlinDataClass Text KotlinFields deriving (Show, Eq) + +data KotlinFields + = Node KotlinField + | Brunch KotlinFields KotlinFields + deriving (Show, Eq) + +data KotlinField = KotlinField Text KotlinClass deriving (Show, Eq) + +class KotlinType a where + toKotlinType :: a -> Maybe KotlinClass + toKotlinType = genericToKotlinType . from + default toKotlinType :: (Generic a, GenericKotlinType (Rep a)) => + a -> Maybe KotlinClass + +class GenericKotlinType f where + genericToKotlinType :: f a -> Maybe KotlinClass + +instance (Datatype d, GenericKotlinFields f) + => GenericKotlinType (D1 d f) where + genericToKotlinType datatype = fmap DataClass $ + KotlinDataClass (pack $ datatypeName datatype) + <$> genericToKotlinFields (unM1 datatype) + +class GenericKotlinFields f where + genericToKotlinFields :: f a -> Maybe KotlinFields + +instance (Constructor c, GenericKotlinFields f) + => GenericKotlinFields (C1 c f) where + genericToKotlinFields constructor = + if conIsRecord constructor then + genericToKotlinFields (unM1 constructor) + else + Nothing + +instance GenericKotlinFields (f :+: g) where + genericToKotlinFields _ = Nothing + +instance (Selector s, GenericKotlinType a) + => GenericKotlinFields (S1 s a) where + genericToKotlinFields selector = + case selName selector of + "" -> Nothing + name -> + Node . KotlinField (pack name) + <$> genericToKotlinType (undefined :: a p) + +instance (GenericKotlinFields f, GenericKotlinFields g) + => GenericKotlinFields (f :*: g) where + genericToKotlinFields _ = + Brunch <$> genericToKotlinFields (undefined :: f p) + <*> genericToKotlinFields (undefined :: g p) + +instance GenericKotlinFields U1 where + genericToKotlinFields _ = Nothing + +instance KotlinType a => GenericKotlinType (Rec0 a) where + genericToKotlinType _ = toKotlinType (Proxy :: Proxy a) + +instance KotlinType a => KotlinType [a] where + toKotlinType _ = ExClass . KList <$> toKotlinType (Proxy :: Proxy a) + +instance KotlinType a => KotlinType (Maybe a) where + toKotlinType _ = + PrimitiveClass . KNullable <$> toKotlinType (Proxy :: Proxy a) + +instance KotlinType () where + toKotlinType _ = Just $ PrimitiveClass KUnit + +instance KotlinType Text where + toKotlinType _ = Just $ PrimitiveClass KString + +instance KotlinType UTCTime where + toKotlinType _ = Just $ ExClass KTime + +instance KotlinType Float where + toKotlinType _ = Just $ PrimitiveClass KFloat + +instance KotlinType Double where + toKotlinType _ = Just $ PrimitiveClass KDouble + +instance KotlinType Int where + toKotlinType _ = Just $ PrimitiveClass KInt + +instance KotlinType Int8 where + toKotlinType _ = Just $ PrimitiveClass KByte + +instance KotlinType Int16 where + toKotlinType _ = Just $ PrimitiveClass KShort + +instance KotlinType Int32 where + toKotlinType _ = Just $ PrimitiveClass KInt + +instance KotlinType Int64 where + toKotlinType _ = Just $ PrimitiveClass KLong + +instance KotlinType Char where + toKotlinType _ = Just $ PrimitiveClass KChar + +instance KotlinType Bool where + toKotlinType _ = Just $ PrimitiveClass KBoolean + +instance (KotlinType a, KotlinType b) => KotlinType (a, b) where + toKotlinType _ = fmap ExClass $ + KPair + <$> toKotlinType (Proxy :: Proxy a) + <*> toKotlinType (Proxy :: Proxy b) + +instance (KotlinType a) => KotlinType (Proxy a) where + toKotlinType _ = toKotlinType (undefined :: a) + +instance (KotlinType k, KotlinType v) => KotlinType (Map k v) where + toKotlinType _ = fmap ExClass $ + KHashMap + <$> toKotlinType (Proxy :: Proxy k) + <*> toKotlinType (Proxy :: Proxy v) + +instance (KotlinType v) => KotlinType (IntMap v) where + toKotlinType _ = + PrimitiveClass . KArray <$> toKotlinType (Proxy :: Proxy v) + +instance KotlinType NoContent where + toKotlinType _ = Just $ PrimitiveClass KUnit + +toKotlinType' :: (KotlinType a) => a -> KotlinClass +toKotlinType' = fromMaybe (PrimitiveClass KAny) . toKotlinType diff --git a/test/Servant/Kotlin/Internal/GenerateSpec.hs b/test/Servant/Kotlin/Internal/GenerateSpec.hs --- a/test/Servant/Kotlin/Internal/GenerateSpec.hs +++ b/test/Servant/Kotlin/Internal/GenerateSpec.hs @@ -1,140 +1,140 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} - -module Servant.Kotlin.Internal.GenerateSpec - ( main - , spec - , Todo (..) - ) where - -import Data.Proxy (Proxy (Proxy)) -import Data.Text (Text) -import qualified Data.Text as T -import GHC.Generics (Generic) -import Servant.Kotlin.Internal.Generate -import Servant.Kotlin.Type -import Test.Hspec (Spec, describe, hspec, it, - shouldBe) -import Test.TestAPI - -data Todo = Todo - { todoId :: Int - , title :: Text - , done :: Bool - } deriving (Generic, Show, Eq, KotlinType) - -data Hoge - = Hoge1 Int - | Hoge2 Bool - deriving (Generic, Show, Eq, KotlinType) - -main :: IO () -main = hspec spec - -spec :: Spec -spec = do - describe "generateKotlinForDefDataClass :: Proxy a -> [Text]" $ do - it "sample Todo type" $ - generateKotlinForDefDataClass (Proxy :: Proxy Todo) `shouldBe` - [ "data class Todo(val todoId: Int, val title: String, val done: Boolean)" ] - it "not data class, e.g. Int" $ - generateKotlinForDefDataClass (Proxy :: Proxy Int) `shouldBe` [] - it "return Nothing e.g. Product Type" $ - generateKotlinForDefDataClass (Proxy :: Proxy Hoge) `shouldBe` [] - - describe "generateKotlinForAPIClass :: Text -> [Text] -> [Text]" $ do - it "body is empty" $ - generateKotlinForAPIClass "TodoAPI" [] `shouldBe` - [ "class TodoAPI(private val baseURL: String) {" - , T.intercalate "\n" - [ " init {" - , " FuelManager.instance.apply {" - , " basePath = baseURL" - , " baseHeaders = mapOf(\"Content-Type\" to \"application/json\", \"Device\" to \"Android\")" - , " }" - , " }" - ] - , "}" - ] - it "body is non empty" $ - generateKotlinForAPIClass "TodoAPI" ["aaa", "bbb\nccc"] `shouldBe` - [ "class TodoAPI(private val baseURL: String) {" - , T.intercalate "\n" - [ " init {" - , " FuelManager.instance.apply {" - , " basePath = baseURL" - , " baseHeaders = mapOf(\"Content-Type\" to \"application/json\", \"Device\" to \"Android\")" - , " }" - , " }" - ] - , " aaa" - , T.intercalate "\n" - [ " bbb" - , " ccc" - ] - , "}" - ] - - describe "generateKotlinForAPI :: Proxy api -> [Text]" $ - it "sample CRUD" $ - generateKotlinForAPI (Proxy :: Proxy TestApi) `shouldBe` - [ T.intercalate "\n" - [ "fun getOne(handler: (Request, Response, Result) -> Unit) {" - , " Fuel.get(\"/\" + \"one\")" - , " .responseObject(handler)" - , "}" - ] - , T.intercalate "\n" - [ "fun postTwo(body: String, handler: (Request, Response, Result) -> Unit) {" - , " Fuel.post(\"/\" + \"two\")" - , " .body(Gson().toJson(body, String::class.java))" - , " .responseObject(handler)" - , "}" - ] - , T.intercalate "\n" - [ "fun getBooksById(capture_id: Int, handler: (Request, Response, Result) -> Unit) {" - , " Fuel.get(\"/\" + \"books\" + \"/\" + capture_id)" - , " .responseObject(handler)" - , "}" - ] - , T.intercalate "\n" - [ "fun getBooksByTitle(capture_title: String, handler: (Request, Response, Result) -> Unit) {" - , " Fuel.get(\"/\" + \"books\" + \"/\" + capture_title)" - , " .responseObject(handler)" - , "}" - ] - , T.intercalate "\n" - [ "fun getBooks(query_published: Boolean, query_sort: String?, query_year: Int?, query_filters: List, handler: (Request, Response, Result, FuelError>) -> Unit) {" - , " Fuel.get(\"/\" + \"books\")" - , " .responseObject(handler)" - , "}" - ] - , T.intercalate "\n" - [ "fun postBooks(body: Book, handler: (Request, Response, Result) -> Unit) {" - , " Fuel.post(\"/\" + \"books\")" - , " .body(Gson().toJson(body, Book::class.java))" - , " .responseObject(handler)" - , "}" - ] - , T.intercalate "\n" - [ "fun getNothing(handler: (Request, Response, Result) -> Unit) {" - , " Fuel.get(\"/\" + \"nothing\")" - , " .responseObject(handler)" - , "}" - ] - , T.intercalate "\n" - [ "fun putNothing(handler: (Request, Response, Result) -> Unit) {" - , " Fuel.put(\"/\" + \"nothing\")" - , " .responseObject(handler)" - , "}" - ] - , T.intercalate "\n" - [ "fun getWithaheader(header_myTextHeader: String?, header_MyIntHeader: Int?, handler: (Request, Response, Result) -> Unit) {" - , " Fuel.get(\"/\" + \"with-a-header\")" - , " .responseObject(handler)" - , "}" - ] - ] +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +module Servant.Kotlin.Internal.GenerateSpec + ( main + , spec + , Todo (..) + ) where + +import Data.Proxy (Proxy (Proxy)) +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Generics (Generic) +import Servant.Kotlin.Internal.Generate +import Servant.Kotlin.Type +import Test.Hspec (Spec, describe, hspec, it, + shouldBe) +import Test.TestAPI + +data Todo = Todo + { todoId :: Int + , title :: Text + , done :: Bool + } deriving (Generic, Show, Eq, KotlinType) + +data Hoge + = Hoge1 Int + | Hoge2 Bool + deriving (Generic, Show, Eq, KotlinType) + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "generateKotlinForDefDataClass :: Proxy a -> [Text]" $ do + it "sample Todo type" $ + generateKotlinForDefDataClass (Proxy :: Proxy Todo) `shouldBe` + [ "data class Todo(val todoId: Int, val title: String, val done: Boolean)" ] + it "not data class, e.g. Int" $ + generateKotlinForDefDataClass (Proxy :: Proxy Int) `shouldBe` [] + it "return Nothing e.g. Product Type" $ + generateKotlinForDefDataClass (Proxy :: Proxy Hoge) `shouldBe` [] + + describe "generateKotlinForAPIClass :: Text -> [Text] -> [Text]" $ do + it "body is empty" $ + generateKotlinForAPIClass "TodoAPI" [] `shouldBe` + [ "class TodoAPI(private val baseURL: String) {" + , T.intercalate "\n" + [ " init {" + , " FuelManager.instance.apply {" + , " basePath = baseURL" + , " baseHeaders = mapOf(\"Content-Type\" to \"application/json\", \"Device\" to \"Android\")" + , " }" + , " }" + ] + , "}" + ] + it "body is non empty" $ + generateKotlinForAPIClass "TodoAPI" ["aaa", "bbb\nccc"] `shouldBe` + [ "class TodoAPI(private val baseURL: String) {" + , T.intercalate "\n" + [ " init {" + , " FuelManager.instance.apply {" + , " basePath = baseURL" + , " baseHeaders = mapOf(\"Content-Type\" to \"application/json\", \"Device\" to \"Android\")" + , " }" + , " }" + ] + , " aaa" + , T.intercalate "\n" + [ " bbb" + , " ccc" + ] + , "}" + ] + + describe "generateKotlinForAPI :: Proxy api -> [Text]" $ + it "sample CRUD" $ + generateKotlinForAPI (Proxy :: Proxy TestApi) `shouldBe` + [ T.intercalate "\n" + [ "fun getOne(handler: (Request, Response, Result) -> Unit) {" + , " Fuel.get(\"/\" + \"one\")" + , " .responseObject(handler)" + , "}" + ] + , T.intercalate "\n" + [ "fun postTwo(body: String, handler: (Request, Response, Result) -> Unit) {" + , " Fuel.post(\"/\" + \"two\")" + , " .body(Gson().toJson(body, String::class.java))" + , " .responseObject(handler)" + , "}" + ] + , T.intercalate "\n" + [ "fun getBooksById(capture_id: Int, handler: (Request, Response, Result) -> Unit) {" + , " Fuel.get(\"/\" + \"books\" + \"/\" + capture_id)" + , " .responseObject(handler)" + , "}" + ] + , T.intercalate "\n" + [ "fun getBooksByTitle(capture_title: String, handler: (Request, Response, Result) -> Unit) {" + , " Fuel.get(\"/\" + \"books\" + \"/\" + capture_title)" + , " .responseObject(handler)" + , "}" + ] + , T.intercalate "\n" + [ "fun getBooks(query_published: Boolean, query_sort: String?, query_year: Int?, query_filters: List, handler: (Request, Response, Result, FuelError>) -> Unit) {" + , " Fuel.get(\"/\" + \"books\")" + , " .responseObject(handler)" + , "}" + ] + , T.intercalate "\n" + [ "fun postBooks(body: Book, handler: (Request, Response, Result) -> Unit) {" + , " Fuel.post(\"/\" + \"books\")" + , " .body(Gson().toJson(body, Book::class.java))" + , " .responseObject(handler)" + , "}" + ] + , T.intercalate "\n" + [ "fun getNothing(handler: (Request, Response, Result) -> Unit) {" + , " Fuel.get(\"/\" + \"nothing\")" + , " .responseObject(handler)" + , "}" + ] + , T.intercalate "\n" + [ "fun putNothing(handler: (Request, Response, Result) -> Unit) {" + , " Fuel.put(\"/\" + \"nothing\")" + , " .responseObject(handler)" + , "}" + ] + , T.intercalate "\n" + [ "fun getWithaheader(header_myTextHeader: String?, header_MyIntHeader: Int?, handler: (Request, Response, Result) -> Unit) {" + , " Fuel.get(\"/\" + \"with-a-header\")" + , " .responseObject(handler)" + , "}" + ] + ] diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,1 +1,1 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover #-} +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/Test/TestAPI.hs b/test/Test/TestAPI.hs --- a/test/Test/TestAPI.hs +++ b/test/Test/TestAPI.hs @@ -1,55 +1,55 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} - -module Test.TestAPI where - -import Data.Aeson (ToJSON) -import Data.Proxy (Proxy (Proxy)) -import Data.Text (Text) -import GHC.Generics (Generic) -import Servant.API ((:<|>), (:>), Capture, Get, GetNoContent, - Header, JSON, NoContent, Post, - PostNoContent, Put, QueryFlag, QueryParam, - QueryParams, ReqBody) -import Servant.Kotlin.Type (KotlinType) - -newtype Book = Book - { title :: Text - } deriving (Generic, KotlinType, Show, Eq) - -instance ToJSON Book - -type TestApi = - "one" - :> Get '[JSON] Int - :<|> "two" - :> ReqBody '[JSON] Text - :> Post '[JSON] (Maybe Int) - :<|> "books" - :> Capture "id" Int - :> Get '[JSON] Book - :<|> "books" - :> Capture "title" Text - :> Get '[JSON] Book - :<|> "books" - :> QueryFlag "published" - :> QueryParam "sort" Text - :> QueryParam "year" Int - :> QueryParams "filters" (Maybe Bool) - :> Get '[JSON] [Book] - :<|> "books" - :> ReqBody '[JSON] Book - :> PostNoContent '[JSON] NoContent - :<|> "nothing" - :> GetNoContent '[JSON] NoContent - :<|> "nothing" - :> Put '[JSON] () -- old way to specify no content - :<|> "with-a-header" - :> Header "myTextHeader" Text - :> Header "MyIntHeader" Int - :> Get '[JSON] Text - -testApi :: Proxy TestApi -testApi = Proxy +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeOperators #-} + +module Test.TestAPI where + +import Data.Aeson (ToJSON) +import Data.Proxy (Proxy (Proxy)) +import Data.Text (Text) +import GHC.Generics (Generic) +import Servant.API ((:<|>), (:>), Capture, Get, GetNoContent, + Header, JSON, NoContent, Post, + PostNoContent, Put, QueryFlag, QueryParam, + QueryParams, ReqBody) +import Servant.Kotlin.Type (KotlinType) + +newtype Book = Book + { title :: Text + } deriving (Generic, KotlinType, Show, Eq) + +instance ToJSON Book + +type TestApi = + "one" + :> Get '[JSON] Int + :<|> "two" + :> ReqBody '[JSON] Text + :> Post '[JSON] (Maybe Int) + :<|> "books" + :> Capture "id" Int + :> Get '[JSON] Book + :<|> "books" + :> Capture "title" Text + :> Get '[JSON] Book + :<|> "books" + :> QueryFlag "published" + :> QueryParam "sort" Text + :> QueryParam "year" Int + :> QueryParams "filters" (Maybe Bool) + :> Get '[JSON] [Book] + :<|> "books" + :> ReqBody '[JSON] Book + :> PostNoContent '[JSON] NoContent + :<|> "nothing" + :> GetNoContent '[JSON] NoContent + :<|> "nothing" + :> Put '[JSON] () -- old way to specify no content + :<|> "with-a-header" + :> Header "myTextHeader" Text + :> Header "MyIntHeader" Int + :> Get '[JSON] Text + +testApi :: Proxy TestApi +testApi = Proxy