diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Robert Klotzner (c) 2016 + +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 Robert Klotzner 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/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-purescript.cabal b/servant-purescript.cabal new file mode 100644 --- /dev/null +++ b/servant-purescript.cabal @@ -0,0 +1,59 @@ +name: servant-purescript +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/eskimor/servant-purescript#readme +license: BSD3 +license-file: LICENSE +author: Robert Klotzner +maintainer: robert.klotzner@gmx.at +copyright: Copyright: (c) 2016 Robert Klotzner +category: Web +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Servant.PureScript.Internal + , Servant.PureScript.CodeGen + , Servant.PureScript + +-- other-modules: Main + build-depends: base >= 4.7 && < 5 + , aeson >= 0.11.2 + , containers + , directory + , filepath + , http-types + , lens + , mainland-pretty + , purescript-bridge >= 0.6 && < 0.7 + , servant + , servant-foreign + , servant-subscriber + , text + default-language: Haskell2010 + + +test-suite servant-purescript-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , aeson >= 0.11.2 && < 0.12 + , containers + , mainland-pretty + , lens + , purescript-bridge >= 0.6 && < 0.7 + , servant + , servant-foreign + , servant-purescript + , servant-subscriber + , text + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/eskimor/servant-purescript diff --git a/src/Servant/PureScript.hs b/src/Servant/PureScript.hs new file mode 100644 --- /dev/null +++ b/src/Servant/PureScript.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +module Servant.PureScript ( + HasBridge +, languageBridge +, defaultBridge +, defaultBridgeProxy +, DefaultBridge +, writeAPIModule +, writeAPIModuleWithSettings +, Settings (..) +, apiModuleName +, readerParams +, standardImports +, defaultSettings +, addReaderParam +) where + +import Control.Lens +import Data.Aeson +import Data.Bifunctor +import Data.Char +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe (mapMaybe, maybeToList) +import Data.Monoid +import Data.Proxy +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Typeable +import GHC.Generics hiding (to) +import Language.PureScript.Bridge +import Language.PureScript.Bridge.Printer +import Language.PureScript.Bridge.PSTypes +import Language.PureScript.Bridge.TypeInfo +import Servant.API +import Servant.Foreign +import Servant.PureScript.CodeGen +import Servant.PureScript.Internal +import System.Directory +import System.FilePath +import System.IO (IOMode (..), withFile) +import Text.PrettyPrint.Mainland (hPutDocLn) + +writeAPIModule :: forall bridgeSelector api. + ( HasForeign (PureScript bridgeSelector) PSType api + , GenerateList PSType (Foreign PSType api) + , HasBridge bridgeSelector + ) => FilePath -> Proxy bridgeSelector -> Proxy api -> IO () +writeAPIModule = writeAPIModuleWithSettings defaultSettings + +writeAPIModuleWithSettings :: forall bridgeSelector api. + ( HasForeign (PureScript bridgeSelector) PSType api + , GenerateList PSType (Foreign PSType api) + , HasBridge bridgeSelector + ) => Settings -> FilePath -> Proxy bridgeSelector -> Proxy api -> IO () +writeAPIModuleWithSettings opts root pBr pAPI = do + let apiList = apiToList pAPI pBr + let contents = genModule opts apiList + unlessM (doesDirectoryExist mDir) $ createDirectoryIfMissing True mDir + withFile mPath WriteMode $ flip hPutDocLn contents + where + mFile = (joinPath . map T.unpack . T.splitOn "." $ _apiModuleName opts) <> ".purs" + mPath = root mFile + mDir = takeDirectory mPath diff --git a/src/Servant/PureScript/CodeGen.hs b/src/Servant/PureScript/CodeGen.hs new file mode 100644 --- /dev/null +++ b/src/Servant/PureScript/CodeGen.hs @@ -0,0 +1,224 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +module Servant.PureScript.CodeGen where + +import Servant.PureScript.Internal +import Text.PrettyPrint.Mainland + +import Control.Lens hiding (List) +import Data.Aeson +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe (mapMaybe, maybeToList) +import Data.Monoid +import Data.Proxy +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Typeable +import GHC.Generics hiding (to) +import Language.PureScript.Bridge +import Language.PureScript.Bridge.Printer +import Language.PureScript.Bridge.PSTypes (psString) +import Language.PureScript.Bridge.TypeInfo +import Network.HTTP.Types.URI (urlEncode) +import Servant.API +import Servant.Foreign + +genModule :: Settings -> [Req PSType] -> Doc +genModule opts reqs = let + allParams = concatMap reqToParams reqs + rParams = getReaderParams opts allParams + apiImports = reqsToImportLines reqs + imports = mergeImportLines (_standardImports opts) apiImports + importLines = map (strictText . importLineToText) . Map.elems $ imports + in + "-- File auto generated by servant-purescript! --" + "module" <+> strictText (_apiModuleName opts) <+> "where" <> line + "import Prelude" <> line + docIntercalate line importLines <> line + genParamSettings rParams <> line + (docIntercalate line . map (genFunction rParams)) reqs + +getReaderParams :: Settings -> [PSParam] -> [PSParam] +getReaderParams opts allParams = let + isReaderParam = (`Set.member` _readerParams opts) . _pName + rParamsDirty = filter isReaderParam allParams + rParamsMap = Map.fromListWith useOld . map toPair $ rParamsDirty + rParams = map fromPair . Map.toList $ rParamsMap + -- Helpers + toPair (Param n t) = (n, t) + fromPair (n, t) = Param n t + useOld = flip const + in + rParams + +genParamSettings :: [PSParam]-> Doc +genParamSettings rParams = let + genEntry arg = arg ^. pName ^. to psVar <+> "::" <+> arg ^. pType ^. typeName ^. to strictText + genEntries = docIntercalate (line <> ", ") . map genEntry + in + "newtype SPParams_ = SPParams_" <+/> align ( + lbrace + <+> genEntries rParams + rbrace + ) + +genFunction :: [PSParam] -> Req PSType -> Doc +genFunction allRParams req = let + rParamsSet = Set.fromList allRParams + fnName = req ^. reqFuncName ^. camelCaseL + allParamsList = baseURLParam : reqToParams req + allParams = Set.fromList allParamsList + fnParams = filter (not . flip Set.member rParamsSet) allParamsList -- Use list not set, as we don't want to change order of parameters + rParams = Set.toList $ rParamsSet `Set.intersection` allParams + + pTypes = map _pType fnParams + pNames = map _pName fnParams + signature = genSignature fnName pTypes (req ^. reqReturnType) + body = genFnHead fnName pNames <+> genFnBody rParams req + in signature body + + +genGetReaderParams :: [PSParam] -> Doc +genGetReaderParams = stack . map (genGetReaderParam . psVar . _pName) + where + genGetReaderParam pName = "let" <+> pName <+> "= spParams_." <> pName + + +genSignature :: Text -> [PSType] -> Maybe PSType -> Doc +genSignature fnName params mRet = fName <+> align (constraint <+/> parameterString) + where + fName = strictText fnName + constraint = ":: forall eff m." <+/> "(MonadReader (SPSettings_ SPParams_) m, MonadError AjaxError m, MonadAff ( ajax :: AJAX | eff) m)" <+/> "=>" + retName = maybe "Unit" (strictText . typeInfoToText True) mRet + retString = "m" <+> retName + typeNames = map (strictText . typeInfoToText True) params + parameterString = docIntercalate (softline <> "-> ") (typeNames <> [retString]) + +genFnHead :: Text -> [Text] -> Doc +genFnHead fnName params = fName <+> align (docIntercalate softline docParams <+> "=") + where + docParams = map psVar params + fName = strictText fnName + +genFnBody :: [PSParam] -> Req PSType -> Doc +genFnBody rParams req = "do" + indent 2 ( + "SPSettings_ spOpts_ <- ask" + "let spParams_ = case spOpts_.params of SPParams_ ps_ -> ps_" + genGetReaderParams rParams + hang 6 ("let httpMethod =" <+> dquotes (req ^. reqMethod ^. to T.decodeUtf8 ^. to strictText)) + hang 6 ("let reqUrl =" <+> genBuildURL (req ^. reqUrl)) + "let reqHeaders =" indent 6 (req ^. reqHeaders ^. to genBuildHeaders) + "affResp <- liftAff $ affjax " <> hang 2 ( "defaultRequest" + "{ method =" <+> "httpMethod" + ", url =" <+> "reqUrl" + ", headers =" <+> "defaultRequest.headers <> reqHeaders" + case req ^. reqBody of + Nothing -> "}" + Just _ -> ", content =" <+> "toNullable <<< Just <<< printJson <<< gAesonEncodeJson $ reqBody" "}" + ) + "getResult gAesonDecodeJson affResp" <> line + ) + +genBuildURL :: Url PSType -> Doc +genBuildURL url = psVar baseURLId <+> "<>" + <+> genBuildPath (url ^. path ) <+> genBuildQuery (url ^. queryStr) + +---------- +genBuildPath :: Path PSType -> Doc +genBuildPath = docIntercalate (softline <> "<> \"/\" <> ") . map (genBuildSegment . unSegment) + +genBuildSegment :: SegmentType PSType -> Doc +genBuildSegment (Static (PathSegment seg)) = dquotes $ strictText (textURLEncode False seg) +genBuildSegment (Cap arg) = parens $ "encodeURIComponent" <+> arg ^. argName ^. to unPathSegment ^. to psVar + +---------- +genBuildQuery :: [QueryArg PSType] -> Doc +genBuildQuery [] = "" +genBuildQuery args = softline <> "<> \"?\" <> " <> (docIntercalate (softline <> "<> \"&\" <> ") . map genBuildQueryArg $ args) + +genBuildQueryArg :: QueryArg PSType -> Doc +genBuildQueryArg arg = case arg ^. queryArgType of + Normal -> genQueryEncoding "encodeQuery" + Flag -> genQueryEncoding "encodeQuery" + List -> genQueryEncoding "encodeListQuery" + where + argText = arg ^. queryArgName ^. argName ^. to unPathSegment + encodedArgName = strictText . textURLEncode True $ argText + genQueryEncoding fn = fn <+> dquotes encodedArgName <+> psVar argText + +----------- + +genBuildHeaders :: [HeaderArg PSType] -> Doc +genBuildHeaders = list . map genBuildHeader + +genBuildHeader :: HeaderArg PSType -> Doc +genBuildHeader (HeaderArg arg) = let + argText = arg ^. argName ^. to unPathSegment + encodedArgName = strictText . textURLEncode True $ argText + in + align $ "{ field : " <> dquotes encodedArgName + <+/> comma <+> "value :" + <+> "(encodeURIComponent <<< gDefaultToURLPiece)" <+> psVar argText + "}" +genBuildHeader (ReplaceHeaderArg _ _) = error "ReplaceHeaderArg - not yet implemented!" + +reqsToImportLines :: [Req PSType] -> ImportLines +reqsToImportLines = typesToImportLines Map.empty . concatMap reqToPSTypes + +reqToPSTypes :: Req PSType -> [PSType] +reqToPSTypes req = map _pType (reqToParams req) ++ maybeToList (req ^. reqReturnType) + +-- | Extract all function parameters from a given Req. +reqToParams :: Req PSType -> [Param PSType] +reqToParams req = Param baseURLId psString + : fmap headerArgToParam (req ^. reqHeaders) + ++ maybeToList (reqBodyToParam (req ^. reqBody)) + ++ urlToParams (req ^. reqUrl) + +urlToParams :: Url f -> [Param f] +urlToParams url = mapMaybe (segmentToParam . unSegment) (url ^. path) ++ map queryArgToParam (url ^. queryStr) + +segmentToParam :: SegmentType f -> Maybe (Param f) +segmentToParam (Static _) = Nothing +segmentToParam (Cap arg) = Just Param { + _pType = arg ^. argType + , _pName = arg ^. argName ^. to unPathSegment + } + +queryArgToParam :: QueryArg f -> Param f +queryArgToParam arg = Param { + _pType = arg ^. queryArgName ^. argType + , _pName = arg ^. queryArgName ^. argName ^. to unPathSegment + } + +headerArgToParam :: HeaderArg f -> Param f +headerArgToParam (HeaderArg arg) = Param { + _pName = arg ^. argName ^. to unPathSegment + , _pType = arg ^. argType + } +headerArgToParam _ = error "We do not support ReplaceHeaderArg - as I have no idea what this is all about." + +reqBodyToParam :: Maybe f -> Maybe (Param f) +reqBodyToParam = fmap (Param "reqBody") + +docIntercalate :: Doc -> [Doc] -> Doc +docIntercalate i = mconcat . punctuate i + + +textURLEncode :: Bool -> Text -> Text +textURLEncode spaceIsPlus = T.decodeUtf8 . urlEncode spaceIsPlus . T.encodeUtf8 + +-- | Little helper for generating valid variable names +psVar :: Text -> Doc +psVar = strictText . toPSVarName diff --git a/src/Servant/PureScript/Internal.hs b/src/Servant/PureScript/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Servant/PureScript/Internal.hs @@ -0,0 +1,148 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeOperators #-} + + +module Servant.PureScript.Internal where + +import Control.Lens +import Data.Aeson +import Data.Bifunctor +import Data.Char +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe (mapMaybe, maybeToList) +import Data.Monoid +import Data.Proxy +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Typeable +import GHC.Generics hiding (to) +import Language.PureScript.Bridge +import Language.PureScript.Bridge.Printer +import Language.PureScript.Bridge.PSTypes +import Language.PureScript.Bridge.TypeInfo +import Servant.API +import Servant.Foreign + + +-- | Our language type is Paramized, so you can choose a custom 'TypeBridge' for your translation, by +-- providing your own data type and implementing 'HasBridge' for it. +-- +-- > data MyBridge +-- > +-- > myBridge :: TypeBridge +-- > myBridge = defaultBridge <|> customBridge1 <|> customBridge2 +-- > +-- > instance HasBridge MyBridge where +-- > languageBridge _ = myBridge +-- +data PureScript bridgeSelector + +instance (Generic a, Typeable a, HasBridge bridgeSelector) => HasForeignType (PureScript bridgeSelector) PSType a where + typeFor _ _ _ = languageBridge (Proxy :: Proxy bridgeSelector) (mkTypeInfo (Proxy :: Proxy a)) + +class HasBridge a where + languageBridge :: Proxy a -> FullBridge + +-- | Use 'PureScript' 'DefaultBridge' if 'defaultBridge' suffices for your needs. +data DefaultBridge + +-- | 'languageBridge' for 'DefaultBridge' evaluates to 'buildBridge' 'defaultBridge' - no surprise there. +instance HasBridge DefaultBridge where + languageBridge _ = buildBridge defaultBridge + +-- | A proxy for 'DefaultBridge' +defaultBridgeProxy :: Proxy DefaultBridge +defaultBridgeProxy = Proxy + +type ParamName = Text + +data Param f = Param { + _pName :: ParamName +, _pType :: f +} deriving (Eq, Ord, Show) + +type PSParam = Param PSType + +makeLenses ''Param + + +data Settings = Settings { + _apiModuleName :: Text + -- | This function parameters should instead be put in a Reader monad. + -- + -- 'baseUrl' will be put there by default, you can add additional parameters. + -- + -- If your API uses a given parameter name multiple times with different types, + -- only the ones matching the type of the first occurrence + -- will be put in the Reader monad, all others will still be passed as function parameter. +, _readerParams :: Set ParamName +, _standardImports :: ImportLines +} +makeLenses ''Settings + +defaultSettings :: Settings +defaultSettings = Settings { + _apiModuleName = "ServerAPI" + , _readerParams = Set.singleton baseURLId + , _standardImports = importsFromList + [ ImportLine "Control.Monad.Reader.Class" (Set.fromList [ "class MonadReader", "ask" ]) + , ImportLine "Control.Monad.Error.Class" (Set.fromList [ "class MonadError" ]) + , ImportLine "Control.Monad.Aff.Class" (Set.fromList [ "class MonadAff", "liftAff" ]) + , ImportLine "Network.HTTP.Affjax" (Set.fromList [ "AJAX" ]) + , ImportLine "Global" (Set.fromList [ "encodeURIComponent" ]) -- from package globals + , ImportLine "Data.Nullable" (Set.fromList [ "Nullable()", "toNullable" ]) + , ImportLine "Servant.PureScript.Affjax" (Set.fromList [ "defaultRequest", "affjax", "AjaxError(..)" ]) + , ImportLine "Servant.PureScript.Settings" (Set.fromList [ "SPSettings_(..)", "gDefaultToURLPiece" ]) + , ImportLine "Servant.PureScript.Util" (Set.fromList [ "encodeListQuery", "encodeQueryItem", "getResult" ]) + , ImportLine "Prim" (Set.fromList [ "String" ]) -- For baseURL! + , ImportLine "Data.Argonaut.Aeson" (Set.fromList [ "gAesonEncodeJson", "gAesonDecodeJson" ]) -- Should not be necessary - compiler bug! + , ImportLine "Data.Maybe" (Set.fromList [ "Maybe(..)"]) + , ImportLine "Data.Argonaut.Printer" (Set.fromList [ "printJson" ]) + ] + } + +-- | Add a parameter name to be us put in the Reader monad instead of being passed to the +-- generated functions. +addReaderParam :: ParamName -> Settings -> Settings +addReaderParam n opts = opts & over readerParams (Set.insert n) + +baseURLId :: ParamName +baseURLId = "baseURL" + +baseURLParam :: PSParam +baseURLParam = Param baseURLId psString + +apiToList :: forall bridgeSelector api. + ( HasForeign (PureScript bridgeSelector) PSType api + , GenerateList PSType (Foreign PSType api) + , HasBridge bridgeSelector + ) => Proxy api -> Proxy bridgeSelector -> [Req PSType] +apiToList _ _ = listFromAPI (Proxy :: Proxy (PureScript bridgeSelector)) (Proxy :: Proxy PSType) (Proxy :: Proxy api) + + +-- | Transform a given identifer to be a valid PureScript variable name (hopefully). +toPSVarName :: Text -> Text +toPSVarName = dropInvalid . unTitle . doPrefix . replaceInvalid + where + unTitle = uncurry mappend . first T.toLower . T.splitAt 1 + doPrefix t = let + s = T.head t + cond = isAlpha s || s == '_' + in + if cond then t else "_" <> t + replaceInvalid = T.replace "-" "_" + dropInvalid = let + isValid c = isAlphaNum c || c == '_' + in + T.filter isValid diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + + +module Main where + +import Control.Applicative +import Control.Lens +import Data.Aeson +import Data.Proxy +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text.IO as T +import Data.Typeable +import GHC.Generics +import Language.PureScript.Bridge +import Language.PureScript.Bridge.PSTypes +import Servant.API +import Servant.Foreign +import Servant.PureScript +import Servant.PureScript.CodeGen +import Servant.PureScript.Internal +import Text.PrettyPrint.Mainland (hPutDocLn) + + +data Hello = Hello { + message :: Text +} deriving Generic + +instance FromJSON Hello +instance ToJSON Hello + +newtype TestHeader = TestHeader Text deriving (Generic, Show, Eq) + +instance ToJSON TestHeader + +type MyAPI = Header "TestHeader" TestHeader :> QueryFlag "myFlag" :> QueryParam "myParam" Hello :> QueryParams "myParams" Hello :> "hello" :> ReqBody '[JSON] Hello :> Get '[JSON] Hello + :<|> Header "TestHeader" Hello :> "testHeader" :> Get '[JSON] TestHeader + :<|> Header "TestHeader" TestHeader :> "by" :> Get '[JSON] Int + + +reqs = apiToList (Proxy :: Proxy MyAPI) (Proxy :: Proxy DefaultBridge) +req = head reqs + +mySettings = addReaderParam "TestHeader" defaultSettings + +myTypes :: [SumType 'Haskell] +myTypes = [ + mkSumType (Proxy :: Proxy Hello) + , mkSumType (Proxy :: Proxy TestHeader) + ] + +moduleTranslator :: BridgePart +moduleTranslator = do + typeModule ^== "Main" + t <- view haskType + TypeInfo (_typePackage t) "ServerTypes" (_typeName t) <$> psTypeParameters + +myBridge :: BridgePart +myBridge = defaultBridge <|> moduleTranslator + +data MyBridge + +instance HasBridge MyBridge where + languageBridge _ = buildBridge myBridge + +myBridgeProxy :: Proxy MyBridge +myBridgeProxy = Proxy + +main :: IO () +main = do + writeAPIModuleWithSettings mySettings "test/output" myBridgeProxy (Proxy :: Proxy MyAPI) + writePSTypes "test/output" (buildBridge myBridge) myTypes