Something went wrong. Try again.
Dagger 1.0.0 beta SDK experiments
dagger purescript gleam clojure
Something went wrong. Try again.
4.8 kB · 107 lines
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108module Dagger.Module.Runtime (runModule, serve, register, invoke, Call) where
import Preludeimport Data.Argonaut.Core (Json, stringify)import Data.Argonaut.Encode (encodeJson)import Data.Argonaut.Parser (jsonParser)import Data.Array (find, length, nub)import Data.Either (Either(..))import Data.Foldable (foldl, traverse_)import Data.Maybe (Maybe(..))import Data.Traversable (traverse)import Data.Tuple (Tuple(..))import Dagger (Client, withConnection)import Dagger.Function as Functionimport Dagger.FunctionCall as FunctionCallimport Dagger.FunctionCallArgValue as CallArgimport Dagger.Module as EngineModuleimport Dagger.Module.Definition (ObjectDefinition, invokeObject, objectFunctions, objectName)import Dagger.Module.Value (ValueType(..))import Dagger.Query as Queryimport Dagger.TypeDef as TypeDefimport Dagger.Types as Timport Effect (Effect)import Effect.Aff (Aff, launchAff_, throwError, try)import Effect.Exception (error, message)import Foreign.Object as Object
type Call = { parentName :: String, name :: String, parent :: Json, args :: Object.Object Json }
runModule :: Array ObjectDefinition -> Effect UnitrunModule definitions = launchAff_ $ withConnection \client -> serve client definitions
serve :: Client -> Array ObjectDefinition -> Aff Unitserve client definitions = do let call = Query.currentFunctionCall client outcome <- try do validate definitions parentName <- FunctionCall.parentName call if parentName == "" then encodeJson <$> register client definitions else do name <- FunctionCall.name call T.JSON parent <- FunctionCall.parent call parsedParent <- parse parent args <- FunctionCall.inputArgs call >>= traverse (\arg -> do argName <- CallArg.name arg T.JSON value <- CallArg.value arg parsed <- parse value pure (Tuple argName parsed)) invoke client definitions { parentName, name, parent: parsedParent, args: Object.fromFoldable args } case outcome of Right result -> void $ FunctionCall.returnValue (T.JSON (stringify result)) call Left err -> do void $ FunctionCall.returnError (Query.error (message err) client) call throwError err
register :: Client -> Array ObjectDefinition -> Aff T.IDregister client definitions = do validate definitions EngineModule.id $ foldl (\mod obj -> EngineModule.withObject (objectType obj) mod) (Query.module_ client) definitions where objectType obj = foldl addFunction (TypeDef.withObject (objectName obj) (Query.typeDef client)) (objectFunctions obj) where addFunction owner fn = let result = case fn.returnType of Nothing -> TypeDef.withObject (objectName obj) (Query.typeDef client) Just t -> toTypeDef client t definition = foldl (\f arg -> Function.withArgWith arg.name (toTypeDef client arg.valueType) (Function.defaultWithArgOpts { defaultValue = map (T.JSON <<< stringify) arg.defaultValue }) f) (Query.function fn.name result client # Function.withDescription fn.description) fn.arguments in if fn.name == "" then TypeDef.withConstructor definition owner else TypeDef.withFunction definition owner
invoke :: Client -> Array ObjectDefinition -> Call -> Aff Jsoninvoke client definitions call = case find (\obj -> objectName obj == call.parentName) definitions of Nothing -> throwError (error ("Unknown module object " <> call.parentName)) Just obj -> invokeObject client call.name call.parent call.args obj
toTypeDef :: Client -> ValueType -> T.TypeDeftoTypeDef client value = case value of StringType -> kind T.TypeDefKindStringKind IntType -> kind T.TypeDefKindIntegerKind NumberType -> kind T.TypeDefKindFloatKind BooleanType -> kind T.TypeDefKindBooleanKind VoidType -> kind T.TypeDefKindVoidKind # TypeDef.withOptional true ListType t -> base # TypeDef.withListOf (toTypeDef client t) OptionalType t -> toTypeDef client t # TypeDef.withOptional true ObjectType name -> base # TypeDef.withObject name EnumType name -> base # TypeDef.withEnum name ScalarType name -> base # TypeDef.withScalar name where base = Query.typeDef client kind t = base # TypeDef.withKind t
validate :: Array ObjectDefinition -> Aff Unitvalidate objects = do unique "object" (map objectName objects) traverse_ (\obj -> do let functions = objectFunctions obj unique (objectName obj <> " function") (map _.name functions) traverse_ (\f -> unique (f.name <> " argument") (map _.name f.arguments)) functions) objects where unique label names = unless (length names == length (nub names)) $ throwError (error ("Duplicate " <> label <> " name"))
parse :: String -> Aff Jsonparse text = case jsonParser text of Left err -> throwError (error ("Invalid module JSON: " <> err)) Right value -> pure value