Encoder.hs

-- | Module      : IPLD.DM.Encoder
--   Description : Type-class of IPLD data model encoders
--   Copyright   : Zoey McBride (c) 2026
--   License     : AGPL-3.0-or-later
--   Maintainer  : zoeymcbride@mailbox.org
--   Stability   : experimental
module IPLD.DM.Encoder
  ( -- * Class of data model encoders.
    Encoder (..),
  )
where

import Control.Applicative (Alternative (..))
import Data.ByteString.Builder (Builder)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.XCodec.BinaryTranscoder (BinaryTranscoder)
import Data.XCodec.BinaryTranscoder qualified as BXC
import IPLD.DM qualified as DM
import MultiFormats.CID (CID)
import Unsafe.Coerce (unsafeCoerce)

-- | Class of functions implementing `encoder` for `codec` in the IPLD data
-- model. Each abstract method takes a Node and produces a bytestring Builder
-- containing the CBOR object for that IPLD kind.
class (Alternative codec) => Encoder codec where
  -- | Encodes DAG from the `codec` format.
  encoder :: DM.Node -> codec Builder
  encoder node =
    mapKind node
      <|> listKind node
      <|> resourceKind node
      <|> bytesKind node
      <|> stringKind node
      <|> floatKind node
      <|> intKind node
      <|> boolKind node
      <|> nullKind node

  -- | Encodes a object into the IPLD data model.
  mapKind :: DM.Node -> codec Builder

  -- | Encodes a list object into the IPLD data model.
  listKind :: DM.Node -> codec Builder

  -- | Encodes a ResourceKind aka link kind in IPLD.
  resourceKind :: DM.Node -> codec Builder

  -- | Encodes a UTF-8 Text into IPLD data model.
  stringKind :: DM.Node -> codec Builder

  -- | Encodes a ByteString into IPLD data model.
  bytesKind :: DM.Node -> codec Builder

  -- | Encodes Integer values into IPLD whole-numbers.
  intKind :: DM.Node -> codec Builder

  -- | Encodes a IEEE754 value into a valid IPLD floating point number.
  floatKind :: DM.Node -> codec Builder

  -- | Encodes IPLD booleans.
  boolKind :: DM.Node -> codec Builder

  -- | Encodes IPLD null values.
  nullKind :: DM.Node -> codec Builder

  -- | Encodes a Text string directly into a StringKind node.
  encodeText :: Text -> codec Builder
  encodeText = stringKind . DM.StringKind

  -- | Encodes a Haskell String directly into a StringKind node.
  encodeString :: String -> codec Builder
  encodeString = encodeText . Text.pack

  -- | Encodes BinaryTranscoder class directly into a BytesKind node.
  encodeBytes :: (BinaryTranscoder bxc) => bxc -> codec Builder
  encodeBytes bxc = bytesKind $ DM.BytesKind (DM.BytesData builder len)
    where
      builder = BXC.unpackSerial bxc
      len = BXC.totalOctets bxc

  -- | Encodes CID into the ResourceKind node.
  encodeResource :: CID -> codec Builder
  encodeResource = resourceKind . DM.ResourceKind

  -- | Encodes an Integral value into the data model.
  encodeIntValue :: (Integral a) => a -> codec Builder
  encodeIntValue = intKind . DM.IntKind . fromIntegral

  -- | Encodes a Haskell Float into the data model for convenience. This
  -- function crashes for invalid inputs, so use `encodeFloatKind` for input
  -- data.
  encodeFloatValue :: Float -> codec Builder
  encodeFloatValue value
    | isNaN value || isInfinite value = error "encodeFloat: Invalid IPLD"
    | otherwise = floatKind $ DM.FloatKind single
    where
      -- Get the binary value of the floating point
      single = DM.SinglePrecision $ unsafeCoerce value

  -- | Encodes a Haskell Double into the data model for convenience. This
  -- function crashes for invalid inputs, so use `encodeFloatKind` for input
  -- data.
  encodeDoubleValue :: Double -> codec Builder
  encodeDoubleValue value
    | isNaN value || isInfinite value = error "encodeFloat: Invalid IPLD"
    | otherwise = floatKind $ DM.FloatKind double
    where
      -- Get the binary value of the floating point
      double = DM.DoublePrecision $ unsafeCoerce value

  -- | Encodes a Haskell boolean into the data model format.
  encodeBool :: Bool -> codec Builder
  encodeBool = boolKind . DM.BoolKind

  -- | Encodes the null data model
  encodeNull :: codec Builder
  encodeNull = nullKind DM.NullKind