servant-purescript 0.1.0.2 → 0.2.0.0
raw patch · 6 files changed
+122/−62 lines, 6 filesdep +bytestringdep +servant-server
Dependencies added: bytestring, servant-server
Files
- Readme.md +2/−2
- servant-purescript.cabal +4/−1
- src/Servant/API/BrowserHeader.hs +46/−0
- src/Servant/PureScript.hs +45/−18
- src/Servant/PureScript/CodeGen.hs +18/−29
- src/Servant/PureScript/Internal.hs +7/−12
Readme.md view
@@ -9,8 +9,8 @@ ## Features - Typed serialization/deserialization taken care of by Haskell's aeson and PureScript's argonaut.- Generic encoding/decoding of both made compatible by not yet merged- [pull request](https://github.com/purescript-contrib/purescript-argonaut-codecs/pull/12).+ Generic encoding/decoding of both made compatible by + [purescript-argonaut-generic-codecs](https://github.com/eskimor/purescript-argonaut-generic-codecs/blob/purescript-argonaut-generic-codec/src/Data/Argonaut/Generic/Aeson.purs). - You can put common parameters like Auth tokens and the base URL in a reader monad so you don't have to pass them explicitly. This is configurable in the code generator with `readerParams` in `Settings`.
servant-purescript.cabal view
@@ -1,5 +1,5 @@ name: servant-purescript-version: 0.1.0.2+version: 0.2.0.0 synopsis: Generate PureScript accessor functions for you servant API description: Please see README.md homepage: https://github.com/eskimor/servant-purescript#readme@@ -20,10 +20,12 @@ exposed-modules: Servant.PureScript.Internal , Servant.PureScript.CodeGen , Servant.PureScript+ , Servant.API.BrowserHeader -- other-modules: Main build-depends: base >= 4.7 && < 5 , aeson >= 0.11.2+ , bytestring , containers , directory , filepath@@ -33,6 +35,7 @@ , purescript-bridge >= 0.6 && < 0.7 , servant , servant-foreign+ , servant-server , servant-subscriber , text default-language: Haskell2010
+ src/Servant/API/BrowserHeader.hs view
@@ -0,0 +1,46 @@+-- | A header which gets sent by the browser and is thus of no concern for the client consumer of the API.+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module Servant.API.BrowserHeader where++import Servant.Utils.Links+import Servant+import Servant.Foreign+import Servant.Subscriber.Subscribable+import GHC.TypeLits++data BrowserHeader (sym :: Symbol) a++++type instance IsElem' e (BrowserHeader :> s) = IsElem e s++instance HasLink sub => HasLink (BrowserHeader sym a :> sub) where+ type MkLink (BrowserHeader sym a :> sub) = MkLink (Header sym a :> sub)+ toLink _ = toLink (Proxy :: Proxy (Header sym a :> sub))++instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)+ => HasServer (BrowserHeader sym a :> sublayout) context where++ type ServerT (BrowserHeader sym a :> sublayout) m = ServerT (Header sym a :> sublayout) m++ route Proxy = route (Proxy :: Proxy (Header sym a :> sublayout))+++-- Ignore BrowserHeader in HasForeign:+instance (KnownSymbol sym, HasForeign lang ftype sublayout)+ => HasForeign lang ftype (BrowserHeader sym a :> sublayout) where+ type Foreign ftype (BrowserHeader sym a :> sublayout) = Foreign ftype sublayout++ foreignFor lang p Proxy = foreignFor lang p (Proxy :: Proxy sublayout)++type instance IsSubscribable' endpoint (BrowserHeader sym a :> sub ) = IsSubscribable endpoint sub
src/Servant/PureScript.hs view
@@ -20,36 +20,31 @@ , standardImports , defaultSettings , addReaderParam+, jsonParseUrlPiece+, jsonToUrlPiece+, jsonParseHeader+, jsonToHeader ) 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.ByteString (ByteString)+import qualified Data.ByteString.Lazy as BS 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 Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T import Language.PureScript.Bridge-import Language.PureScript.Bridge.Printer-import Language.PureScript.Bridge.PSTypes-import Language.PureScript.Bridge.TypeInfo-import Servant.API+import Network.HTTP.Types (urlDecode, urlEncode) 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)+import System.IO (IOMode (..), withFile)+import Text.PrettyPrint.Mainland (hPutDocLn) writeAPIModule :: forall bridgeSelector api. ( HasForeign (PureScript bridgeSelector) PSType api@@ -72,3 +67,35 @@ mFile = (joinPath . map T.unpack . T.splitOn "." $ _apiModuleName opts) <> ".purs" mPath = root </> mFile mDir = takeDirectory mPath+++-- | Use this function for implementing 'parseUrlPiece' in your FromHttpApiData instances+-- in order to be compatible with the generated PS code.+--+-- > +-- > instance ToHttpApiData MyDataType where+-- > toUrlPiece = jsonToUrlPiece+-- > toHeader = jsonToHeader+-- >+-- > instance FromHttpApiData MyDataType where+-- > parseUrlPiece = jsonParseUrlPiece+-- > parseHeader = jsonParseHeader+-- >+-- +jsonParseUrlPiece :: FromJSON a => Text -> Either Text a+jsonParseUrlPiece = first T.pack . eitherDecodeStrict . T.encodeUtf8++-- | Use this function for implementing 'toUrlPiece' in your ToHttpApiData instances+-- in order to be compatible with the generated PS code.+jsonToUrlPiece :: ToJSON a => a -> Text+jsonToUrlPiece = T.decodeUtf8 . jsonToHeader++-- | Use this function for implementing 'parseHeader' in your FromHttpApiData instances+-- in order to be compatible with the generated PS code.+jsonParseHeader :: FromJSON a => ByteString -> Either Text a+jsonParseHeader = first T.pack . eitherDecodeStrict . urlDecode True++-- | Use this function for implementing 'toHeader' in your ToHttpApiData instances+-- in order to be compatible with the generated PS code.+jsonToHeader :: ToJSON a => a -> ByteString+jsonToHeader = urlEncode True . BS.toStrict . encode
src/Servant/PureScript/CodeGen.hs view
@@ -8,30 +8,18 @@ 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 Control.Lens hiding (List)+import qualified Data.Map as Map+import Data.Maybe (mapMaybe, maybeToList)+import qualified Data.Set as Set+import Data.Text (Text)+import qualified Data.Text.Encoding as T 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 Language.PureScript.Bridge.PSTypes (psString)+import Network.HTTP.Types.URI (urlEncode) import Servant.Foreign+import Servant.PureScript.Internal+import Text.PrettyPrint.Mainland genModule :: Settings -> [Req PSType] -> Doc genModule opts reqs = let@@ -91,7 +79,7 @@ genGetReaderParams :: [PSParam] -> Doc genGetReaderParams = stack . map (genGetReaderParam . psVar . _pName) where- genGetReaderParam pName = "let" <+> pName <+> "= spParams_." <> pName+ genGetReaderParam pName' = "let" <+> pName' <+> "= spParams_." <> pName' genSignature :: Text -> [PSType] -> Maybe PSType -> Doc@@ -99,7 +87,7 @@ 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+ retName = maybe "Unit" (strictText . typeInfoToText False) mRet retString = "m" <+> retName typeNames = map (strictText . typeInfoToText True) params parameterString = docIntercalate (softline <> "-> ") (typeNames <> [retString])@@ -113,7 +101,8 @@ genFnBody :: [PSParam] -> Req PSType -> Doc genFnBody rParams req = "do" </> indent 2 (- "SPSettings_ spOpts_ <- ask"+ "spOpts_' <- ask"+ </> "let spOpts_ = case spOpts_' of SPSettings_ o -> o" </> "let spParams_ = case spOpts_.params of SPParams_ ps_ -> ps_" </> genGetReaderParams rParams </> hang 6 ("let httpMethod =" <+> dquotes (req ^. reqMethod ^. to T.decodeUtf8 ^. to strictText))@@ -125,9 +114,9 @@ </> ", headers =" <+> "defaultRequest.headers <> reqHeaders" </> case req ^. reqBody of Nothing -> "}"- Just _ -> ", content =" <+> "toNullable <<< Just <<< printJson <<< gAesonEncodeJson $ reqBody" </> "}"+ Just _ -> ", content =" <+> "toNullable <<< Just <<< printJson <<< encodeJson $ reqBody" </> "}" )- </> "getResult gAesonDecodeJson affResp" <> line+ </> "getResult decodeJson affResp" <> line ) genBuildURL :: Url PSType -> Doc@@ -140,7 +129,7 @@ genBuildSegment :: SegmentType PSType -> Doc genBuildSegment (Static (PathSegment seg)) = dquotes $ strictText (textURLEncode False seg)-genBuildSegment (Cap arg) = parens $ "encodeURIComponent" <+> arg ^. argName ^. to unPathSegment ^. to psVar+genBuildSegment (Cap arg) = "encodeURLPiece spOpts_'" <+> arg ^. argName ^. to unPathSegment ^. to psVar ---------- genBuildQuery :: [QueryArg PSType] -> Doc@@ -169,7 +158,7 @@ in align $ "{ field : " <> dquotes encodedArgName <+/> comma <+> "value :"- <+> "(encodeURIComponent <<< gDefaultToURLPiece)" <+> psVar argText+ <+> "encodeURLPiece spOpts_'" <+> psVar argText </> "}" genBuildHeader (ReplaceHeaderArg _ _) = error "ReplaceHeaderArg - not yet implemented!"
src/Servant/PureScript/Internal.hs view
@@ -12,26 +12,21 @@ 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 @@ -48,7 +43,7 @@ -- data PureScript bridgeSelector -instance (Generic a, Typeable a, HasBridge bridgeSelector) => HasForeignType (PureScript bridgeSelector) PSType a where+instance (Typeable a, HasBridge bridgeSelector) => HasForeignType (PureScript bridgeSelector) PSType a where typeFor _ _ _ = languageBridge (Proxy :: Proxy bridgeSelector) (mkTypeInfo (Proxy :: Proxy a)) class HasBridge a where@@ -104,9 +99,9 @@ , 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 "Servant.PureScript.Util" (Set.fromList [ "encodeListQuery", "encodeURLPiece", "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.Argonaut.Generic.Aeson" (Set.fromList [ "encodeJson", "decodeJson" ]) -- Should not be necessary - compiler bug! , ImportLine "Data.Maybe" (Set.fromList [ "Maybe(..)"]) , ImportLine "Data.Argonaut.Printer" (Set.fromList [ "printJson" ]) ]