{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE StrictData                 #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE NamedFieldPuns             #-}
module Azure.Functions.Registry
where

import           Azure.Functions.Function
import           Azure.Functions.Bindings.Class
import           Data.Aeson (Value)
import           Data.Map.Strict                       (Map)
import qualified Data.Map.Strict                       as Map
import           Data.Text                             (Text)
import           GHC.Generics                          (Generic)
import           Lens.Family                           ((&), (.~), (^.))
import           Proto.FunctionRpc
import qualified Proto.FunctionRpc_Fields              as Fields
import           Data.ProtoLens.Runtime.Data.ProtoLens (defMessage)
import           Proto.FunctionRpc_Helpers             (failureStatus)

data RegisteredFunction = forall env. RegisteredFunction
  { registeredInBinding   :: Value
  , registeredOutBinding  :: Value
  , registeredEnvFactory  :: IO env
  , registeredFunction    :: env -> InvocationRequest -> IO InvocationResponse
  }

newtype Registry = Registry
  { registeredFunctions :: Map Text RegisteredFunction
  } deriving (Generic, Semigroup)
    deriving Monoid via (Map Text RegisteredFunction)

getFunction :: Registry -> Text -> Maybe RegisteredFunction
getFunction registry name =
  Map.lookup name (registeredFunctions registry)

register :: (InMessage i, OutMessage o)
  => Text
  -> Function env i o
  -> Registry
register functionName function =
  Registry $ Map.singleton functionName RegisteredFunction
    { registeredInBinding   = toInBindingJSON (inBinding function)
    , registeredOutBinding  = toOutBindingJSON (outBinding function)
    , registeredEnvFactory  = initEnv function
    , registeredFunction    = invoke
    }
  where
    invoke ctx req = do
      case fromInvocationRequest req of
        Left err -> pure $
          defMessage
            & Fields.invocationId .~ (req ^. Fields.invocationId)
            & Fields.result .~ failureStatus ("Unable to parse request: " <> err)
        Right req' -> do
          resp <- toInvocationResponse <$> (func function ctx) req'
          pure $ resp & Fields.invocationId .~ (req ^. Fields.invocationId)