servant-purescript (empty) → 0.1.0.0
raw patch · 7 files changed
+615/−0 lines, 7 filesdep +aesondep +basedep +containerssetup-changed
Dependencies added: aeson, base, containers, directory, filepath, http-types, lens, mainland-pretty, purescript-bridge, servant, servant-foreign, servant-purescript, servant-subscriber, text
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- servant-purescript.cabal +59/−0
- src/Servant/PureScript.hs +74/−0
- src/Servant/PureScript/CodeGen.hs +224/−0
- src/Servant/PureScript/Internal.hs +148/−0
- test/Spec.hs +78/−0
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ servant-purescript.cabal view
@@ -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
+ src/Servant/PureScript.hs view
@@ -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
+ src/Servant/PureScript/CodeGen.hs view
@@ -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
+ src/Servant/PureScript/Internal.hs view
@@ -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
+ test/Spec.hs view
@@ -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