{-# LANGUAGE UndecidableInstances #-}

-- | Encoding and decoding of handler results.
module Arbiter.Core.JobResult
  ( EncodeJobResult
  , encodeJobResult
  , decodeJobResult
  ) where

import Data.Aeson (FromJSON, ToJSON, Value, toJSON)
import Data.Aeson qualified as Aeson
import Data.Maybe (isJust)
import Data.Text (Text)
import Data.Text qualified as T

-- | Results a handler can store. A result from a job with a parent goes in the
-- results table for the parent rollup to collect. A root job's result goes on
-- its archive entry, if archived.
--
-- Serialization uses the type's @ToJSON@. Reads use its @FromJSON@. @()@ and
-- @Nothing@ store nothing.
class (ToJSON a) => EncodeJobResult a where
  shouldStore :: a -> Bool
  shouldStore a
_ = Bool
True

instance EncodeJobResult () where
  shouldStore :: () -> Bool
shouldStore ()
_ = Bool
False

instance {-# OVERLAPPABLE #-} (ToJSON a) => EncodeJobResult a

-- | An optional result. @Nothing@ stores nothing, @Just@ stores the wrapped value.
instance {-# OVERLAPPING #-} (ToJSON a) => EncodeJobResult (Maybe a) where
  shouldStore :: Maybe a -> Bool
shouldStore = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust

-- | A result's stored JSON, or 'Nothing' when its instance declines to store it.
encodeJobResult :: (EncodeJobResult a) => a -> Maybe Value
encodeJobResult :: forall a. EncodeJobResult a => a -> Maybe Value
encodeJobResult a
result
  | a -> Bool
forall a. EncodeJobResult a => a -> Bool
shouldStore a
result = Value -> Maybe Value
forall a. a -> Maybe a
Just (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
result)
  | Bool
otherwise = Maybe Value
forall a. Maybe a
Nothing

-- | Read a stored result back. 'Arbiter.Worker.childResults' surfaces a failure
-- as the child's 'Left'. 'Arbiter.Worker.mergedChildResults' folds it to 'mempty'.
decodeJobResult :: (FromJSON a) => Value -> Either Text a
decodeJobResult :: forall a. FromJSON a => Value -> Either Text a
decodeJobResult Value
value = case Value -> Result a
forall a. FromJSON a => Value -> Result a
Aeson.fromJSON Value
value of
  Aeson.Success a
result -> a -> Either Text a
forall a b. b -> Either a b
Right a
result
  Aeson.Error String
err -> Text -> Either Text a
forall a b. a -> Either a b
Left (String -> Text
T.pack String
err)