module Servant.PureScript (
HasBridge
, languageBridge
, defaultBridge
, defaultBridgeProxy
, DefaultBridge
, writeAPIModule
, writeAPIModuleWithSettings
, Settings (..)
, apiModuleName
, readerParams
, standardImports
, defaultSettings
, addReaderParam
, jsonParseUrlPiece
, jsonToUrlPiece
, jsonParseHeader
, jsonToHeader
) where
import Control.Lens
import Control.Monad (when)
import Data.Aeson
import Data.Bifunctor
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BS
import Data.Monoid
import Data.Proxy
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import Language.PureScript.Bridge
import Network.HTTP.Types (urlDecode, urlEncode)
import Servant.Foreign
import Servant.PureScript.CodeGen
import Servant.PureScript.Internal
import qualified Servant.PureScript.Subscriber as SubGen
import qualified Servant.PureScript.MakeRequests as MakeRequests
import System.Directory
import System.FilePath
import System.IO (IOMode (..), withFile)
import Text.PrettyPrint.Mainland (hPutDocLn, Doc)
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
writeModule (opts ^. apiModuleName) genModule
when (opts ^. generateSubscriberAPI) $ do
writeModule (opts ^. apiModuleName <> ".Subscriber") SubGen.genModule
writeModule (opts ^. apiModuleName <> ".MakeRequests") MakeRequests.genModule
T.putStrLn "\nSuccessfully created your servant API purescript functions!"
T.putStrLn "Please make sure you have purescript-servant-support version 5.0.0 or above installed:\n"
T.putStrLn " bower i --save purescript-servant-support\n"
where
apiList = apiToList pAPI pBr
writeModule :: Text -> (Settings -> [Req PSType] -> Doc) -> IO ()
writeModule mName genModule' = let
fileName = (joinPath . map T.unpack . T.splitOn "." $ mName) <> ".purs"
mPath = root </> fileName
mDir = takeDirectory mPath
contents = genModule' opts apiList
in do
unlessM (doesDirectoryExist mDir) $ createDirectoryIfMissing True mDir
withFile mPath WriteMode $ flip hPutDocLn contents
jsonParseUrlPiece :: FromJSON a => Text -> Either Text a
jsonParseUrlPiece = jsonParseHeader . T.encodeUtf8
jsonToUrlPiece :: ToJSON a => a -> Text
jsonToUrlPiece = T.decodeUtf8 . jsonToHeader
jsonParseHeader :: FromJSON a => ByteString -> Either Text a
jsonParseHeader = first T.pack . eitherDecodeStrict
jsonToHeader :: ToJSON a => a -> ByteString
jsonToHeader = BS.toStrict . encode