packages feed

hgg-core-0.2.0.0: src/Graphics/Hgg/Spec/CustomMark.hs

-- |
-- Module      : Graphics.Hgg.Spec.CustomMark
-- Description : Payload types for custom marks (RenderCtx / CustomMark)
-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)
-- License     : BSD-3-Clause
--
-- [日本語]: 'Graphics.Hgg.Spec' の module 分割で切り出した leaf。 custom mark
-- 拡張点のうち __型__ ('RenderCtx' / 'CustomMark') のみを持つ (smart
-- constructor @customMark@ 等は 'Graphics.Hgg.Spec.Constructors' 側)。 依存は
-- 'Graphics.Hgg.Spec.Column' ('Resolver') と 'Graphics.Hgg.Primitive'。 公開
-- API は従来どおり 'Graphics.Hgg.Spec' (facade) が re-export する。 挙動・出力
-- (JSON 形含む) は完全に不変。
--
-- [English]: A leaf split out of 'Graphics.Hgg.Spec' during its module
-- split. Carries only the __types__ ('RenderCtx' / 'CustomMark') for the
-- custom-mark extension point (the smart constructor @customMark@ and
-- friends live in 'Graphics.Hgg.Spec.Constructors'). Depends only on
-- 'Graphics.Hgg.Spec.Column' ('Resolver') and 'Graphics.Hgg.Primitive'. The
-- public API is still re-exported by the 'Graphics.Hgg.Spec' facade as
-- before; behavior and output (including the JSON shape) are completely
-- unchanged.
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Hgg.Spec.CustomMark
  ( RenderCtx(..)
  , CustomMark(..)
  ) where

import           Data.Aeson      (FromJSON, ToJSON, toJSON, parseJSON,
                                  Value)
import qualified Data.Aeson      as Aeson
import           Data.Text       (Text)

import           Graphics.Hgg.Primitive (Primitive, Rect (..))
import           Graphics.Hgg.Spec.Column (Resolver)

-- ===========================================================================
-- Phase 51: custom mark (拡張可能な描画語彙)
-- ===========================================================================

-- | [日本語]: custom mark の draw closure に渡す描画文脈。 backend 非依存。
--   scale 適用済の projection・plot 領域 (px)・データ resolver・theme 既定色を
--   提供する。 これと ("Graphics.Hgg.Render" が re-export する) 'Primitive'
--   構築子が custom mark の authoring API。
--   [English]: The drawing context passed to a custom mark's draw closure.
--   Backend-agnostic. Supplies the scale-applied projection, the plot area
--   (px), the data resolver, and the theme's default colors. Together with
--   the 'Primitive' constructors (re-exported by "Graphics.Hgg.Render"),
--   this forms the custom-mark authoring API.
data RenderCtx = RenderCtx
  { rcProjectXY :: !(Double -> Double -> (Double, Double))  -- ^ [日本語]: データ座標 (x,y) → device px
                                                             --   [English]: Converts data coordinates (x,y) to device px.
  , rcPlotArea  :: !Rect                                    -- ^ [日本語]: plot 描画領域 (px)
                                                             --   [English]: The plot drawing area (px).
  , rcResolver  :: !Resolver                                -- ^ [日本語]: 列名 → データ (layer 束縛列を引く)
                                                             --   [English]: Column name to data (looks up columns bound by the layer).
  , rcColor     :: !Text                                    -- ^ [日本語]: theme 既定の線/点色
                                                             --   [English]: The theme's default line/point color.
  , rcFill      :: !Text                                    -- ^ [日本語]: theme 既定の塗り色
                                                             --   [English]: The theme's default fill color.
  , rcTextColor :: !Text                                    -- ^ [日本語]: theme 既定の文字色
                                                             --   [English]: The theme's default text color.
  , rcAxisColor :: !Text                                    -- ^ [日本語]: theme 既定の軸色
                                                             --   [English]: The theme's default axis color.
  }

-- | [日本語]: custom mark の payload。 @lyCustom@ に載る。
--
--     * 'cmDraw' は HS の描画 closure。 データは closure に閉じ込め可。
--       __serialize 不能__ ゆえ JSON では落ち、 decode 時は no-op (@const []@)
--       に戻る。 PS は 'cmId' で自前 registry を引いて描く (parity 手登録)。
--     * 'cmOptions' は PS へ渡す必要のある serializable option (任意)。
--
--   'Eq' / 'Show' は closure を無視し 'cmId' + 'cmOptions' で比較 (function は
--   比較不能ゆえ)。
--   [English]: The payload of a custom mark, carried in @lyCustom@.
--
--     * 'cmDraw' is the Haskell draw closure. Data may be captured inside
--       the closure, so it is __not serializable__: it is dropped from
--       JSON, and decoding restores a no-op (@const []@). PS draws by
--       looking up its own registry via 'cmId' (manually registered for
--       parity).
--     * 'cmOptions' is the serializable option (optional) that needs to be
--       passed to PS.
--
--   'Eq' / 'Show' ignore the closure and compare by 'cmId' + 'cmOptions'
--   (since functions cannot be compared).
data CustomMark = CustomMark
  { cmId      :: !Text                        -- ^ [日本語]: 安定 mark 識別子 (PS dispatch の鍵・serialize される)
                                                --   [English]: The stable mark identifier (the key for PS dispatch; serialized).
  , cmOptions :: !Value                       -- ^ [日本語]: PS へ渡す option (JSON・任意)
                                               --   [English]: The option passed to PS (JSON, optional).
  , cmDraw    :: !(RenderCtx -> [Primitive])  -- ^ [日本語]: HS 描画 closure (JSON 非対象)
                                               --   [English]: The Haskell draw closure (not part of the JSON).
  }

instance Show CustomMark where
  show cm = "CustomMark " <> show (cmId cm)

instance Eq CustomMark where
  a == b = cmId a == cmId b && cmOptions a == cmOptions b

-- closure は落とし 'cmId' + 'cmOptions' のみ serialize。
instance ToJSON CustomMark where
  toJSON cm = Aeson.object [ "cmId" Aeson..= cmId cm, "cmOptions" Aeson..= cmOptions cm ]

-- decode では closure を復元できないので no-op に戻す (HS は live 値を使い、 PS は registry)。
instance FromJSON CustomMark where
  parseJSON = Aeson.withObject "CustomMark" $ \o ->
    CustomMark <$> o Aeson..:  "cmId"
               <*> o Aeson..:? "cmOptions" Aeson..!= Aeson.Null
               <*> pure (const [])