Pinch codegen example (simplified)

Pinch codegen

-- thrift source
namespace hs Thrift

# Trivial exception for testing only.
exception Exception {

  # The exception simply contains a message string.
  1: required string message;
}

# Trivial service for testing only.
service Trivial {

  # Takes an i64 and returns an arbitrary string.
  string success(1: i64 seed);

  # Throws an arbitrary string.
  void failure() throws (1: Exception error);
}

-- Types

data Success_Args
  = Success_Args { success_Args_seed :: Data.Int.Int64 }
  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)

instance Pinch.Pinchable Success_Args where
  type (Tag Success_Args) = Pinch.TStruct
  pinch (Success_Args success_Args_seed) = Pinch.struct ([ (1 Pinch..= success_Args_seed) ])
  unpinch value = (Prelude.pure (Success_Args) Prelude.<*> (value Pinch..: 1))


data Success_Result
  = Success_Result_Success Data.Text.Text
  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)

instance Pinch.Pinchable Success_Result where
  type (Tag Success_Result) = Pinch.TUnion
  pinch (Success_Result_Success x) = Pinch.union (0) (x)
  unpinch v = (Control.Applicative.empty Control.Applicative.<|> (Success_Result_Success Prelude.<$> (v Pinch..: 0)))

-- helper class to convert the result/exceptions from/to the _Result datatype
instance Pinch.ThriftResult Success_Result where
  type (ResultType Success_Result) = Data.Text.Text
  toEither (Success_Result_Success x) = Prelude.Right (x)


-- Client

-- it probably makes sense to use the _Args datatype here instead of using `Pinch.struct`...
success :: (Data.Int.Int64) -> (Pinch.Client.ThriftCall Success_Result)
success seed = Pinch.Client.ThriftCall (Pinch.mkMessage ("success") (Pinch.Call) (0) (Pinch.struct ([ (1 Pinch..= seed) ])))

failure :: (Pinch.Client.ThriftCall Failure_Result)
failure  = Pinch.Client.ThriftCall (Pinch.mkMessage ("failure") (Pinch.Call) (0) (Pinch.struct ([  ])))

-- Server

data Trivial
  = Trivial
  -- maybe we should expand the functions to take multiple arguments instead of the args/result records?
  { success :: (Pinch.Server.Context) -> (Success_Args) -> (Prelude.IO Success_Result)
  , failure :: (Pinch.Server.Context) -> (Failure_Args) -> (Prelude.IO Failure_Result)
  }
  
trivial_mkServer :: (Trivial) -> Pinch.Server.ThriftServer
trivial_mkServer server = Pinch.Server.ThriftServer ((\ctx m -> case Pinch.messageName (m) of
  "success" -> Pinch.Server.runServiceMethod (success (server) (ctx)) (m)
  "failure" -> Pinch.Server.runServiceMethod (failure (server) (ctx)) (m)
  _ -> Prelude.pure (Pinch.Server.unknownMethodError (m))))