{-# LANGUAGE PolyKinds #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Hercules.Agent.WorkerProtocol.Orphans where

import Control.Monad.Fail (fail)
import qualified Data.Aeson as A
import Data.Binary (Binary (get, put))
import Hercules.API.Id (Id (..))
import Hercules.CNix.Expr (ViaJSON (ViaJSON))
import Protolude hiding (get, put)

-- | Orphan
instance Binary (Id (a :: k)) where
  put :: Id a -> Put
put (Id UUID
uuid) = forall t. Binary t => t -> Put
put UUID
uuid
  get :: Get (Id a)
get = forall k (a :: k). UUID -> Id a
Id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get

-- | Orphan
instance (A.ToJSON a, A.FromJSON a) => Binary (ViaJSON a) where
  put :: ViaJSON a -> Put
put (ViaJSON a
a) = forall t. Binary t => t -> Put
put (forall a. ToJSON a => a -> ByteString
A.encode a
a)
  get :: Get (ViaJSON a)
get = do
    ByteString
bs <- forall t. Binary t => Get t
get
    case forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
bs of
      Left String
s -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s
      Right a
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> ViaJSON a
ViaJSON a
r)