{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
-- | JSON serialization and deserialization for Pattern Subject.
--
-- This module provides canonical JSON representation of Pattern<Subject>
-- with bidirectional conversion support. The format is designed for
-- interoperability and can serve as an exchange format between different
-- gram implementations.
--
-- == JSON Format
--
-- Patterns are represented as:
--
-- > { "value": Subject, "elements": [Pattern] }
--
-- Subjects are represented as:
--
-- > { "symbol": String, "labels": [String], "properties": {...} }
--
-- Value types use native JSON for simple types and discriminated objects
-- for complex types (Symbol, TaggedString, Range, Measurement).
module Gram.JSON
  ( -- * Serialization
    patternToValue
  , subjectToValue
  , valueToJSON
    -- * Deserialization  
  , patternFromValue
  , subjectFromValue
  , valueFromJSON
    -- * Utilities
  , canonicalizeJSON
  ) where

import Data.Aeson
import Data.Aeson.Types (Parser)
import Data.Aeson.Key (fromString, toText)
import qualified Data.Aeson.KeyMap as KeyMap
import Data.Scientific (floatingOrInteger)
import qualified Data.Text as T
import qualified Pattern.Core as Pattern
import qualified Subject.Core as Subject
import qualified Subject.Value as SubjectValue
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.List as List
import Data.Foldable (toList)
import Control.Applicative ((<|>))

-- | Convert a Pattern to aeson Value (for serialization)
patternToValue :: Pattern.Pattern Subject.Subject -> Value
patternToValue :: Pattern Subject -> Value
patternToValue (Pattern.Pattern Subject
v [Pattern Subject]
es) = [Pair] -> Value
object
  [ Key
"subject" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Subject -> Value
subjectToValue Subject
v
  , Key
"elements" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Pattern Subject -> Value) -> [Pattern Subject] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Pattern Subject -> Value
patternToValue [Pattern Subject]
es
  ]

-- | Convert a Subject to aeson Value (for serialization)
subjectToValue :: Subject.Subject -> Value
subjectToValue :: Subject -> Value
subjectToValue (Subject.Subject Symbol
ident Set String
labels PropertyRecord
props) = [Pair] -> Value
object
  [ Key
"identity" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Symbol -> Value
symbolToValue Symbol
ident
  , Key
"labels" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [String] -> Value
forall a. ToJSON a => a -> Value
toJSON (Set String -> [String]
forall a. Set a -> [a]
Set.toList Set String
labels)
  , Key
"properties" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PropertyRecord -> Value
propsToValue PropertyRecord
props
  ]

-- | Convert a Symbol to aeson Value
symbolToValue :: Subject.Symbol -> Value
symbolToValue :: Symbol -> Value
symbolToValue (Subject.Symbol String
s) = String -> Value
forall a. ToJSON a => a -> Value
toJSON String
s

-- | Convert properties map to aeson Value
propsToValue :: Subject.PropertyRecord -> Value
propsToValue :: PropertyRecord -> Value
propsToValue PropertyRecord
props = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ ((String, Value) -> Pair) -> [(String, Value)] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
k, Value
v) -> String -> Key
fromString String
k Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value -> Value
valueToJSON Value
v) (PropertyRecord -> [(String, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList PropertyRecord
props)

-- | Convert a Subject.Value to aeson Value (for serialization)
valueToJSON :: SubjectValue.Value -> Value
valueToJSON :: Value -> Value
valueToJSON (SubjectValue.VInteger Integer
i) = Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
i
valueToJSON (SubjectValue.VDecimal Double
d) = Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
d
valueToJSON (SubjectValue.VBoolean Bool
b) = Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
b
valueToJSON (SubjectValue.VString String
s) = String -> Value
forall a. ToJSON a => a -> Value
toJSON String
s
valueToJSON (SubjectValue.VSymbol String
s) = [Pair] -> Value
object [Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"symbol" :: T.Text), Key
"value" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
s]
valueToJSON (SubjectValue.VTaggedString String
tag String
content) = [Pair] -> Value
object [Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"tagged" :: T.Text), Key
"tag" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
tag, Key
"content" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
content]
valueToJSON (SubjectValue.VArray [Value]
vs) = [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON ((Value -> Value) -> [Value] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Value
valueToJSON [Value]
vs)
valueToJSON (SubjectValue.VMap PropertyRecord
m) = Map String Value -> Value
forall a. ToJSON a => a -> Value
toJSON ((Value -> Value) -> PropertyRecord -> Map String Value
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Value -> Value
valueToJSON PropertyRecord
m)
valueToJSON (SubjectValue.VRange RangeValue
rv) = RangeValue -> Value
rangeValueToJSON RangeValue
rv
valueToJSON (SubjectValue.VMeasurement String
unit Double
val) = [Pair] -> Value
object [Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"measurement" :: T.Text), Key
"unit" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
unit, Key
"value" Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Double
val]

-- | Convert a RangeValue to aeson Value
rangeValueToJSON :: SubjectValue.RangeValue -> Value
rangeValueToJSON :: RangeValue -> Value
rangeValueToJSON (SubjectValue.RangeValue Maybe Double
lower Maybe Double
upper) = [Pair] -> Value
object
  [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"range" :: T.Text)
  , Key
"lower" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Double -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe Double
lower
  , Key
"upper" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Double -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe Double
upper
  ]

-- | Parse a Pattern from aeson Value (for deserialization)
patternFromValue :: Value -> Parser (Pattern.Pattern Subject.Subject)
patternFromValue :: Value -> Parser (Pattern Subject)
patternFromValue = String
-> (Object -> Parser (Pattern Subject))
-> Value
-> Parser (Pattern Subject)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Pattern" ((Object -> Parser (Pattern Subject))
 -> Value -> Parser (Pattern Subject))
-> (Object -> Parser (Pattern Subject))
-> Value
-> Parser (Pattern Subject)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  subj <- Object
obj Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"subject"
  elems <- obj .: "elements"
  v <- subjectFromValue subj
  es <- mapM patternFromValue elems
  return $ Pattern.Pattern v es

-- | Parse a Subject from aeson Value (for deserialization)
subjectFromValue :: Value -> Parser Subject.Subject
subjectFromValue :: Value -> Parser Subject
subjectFromValue = String -> (Object -> Parser Subject) -> Value -> Parser Subject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Subject" ((Object -> Parser Subject) -> Value -> Parser Subject)
-> (Object -> Parser Subject) -> Value -> Parser Subject
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  identStr <- Object
obj Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"identity"
  labels <- obj .: "labels"
  props <- obj .: "properties"
  let ident = String -> Symbol
Subject.Symbol String
identStr
  let labelSet = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String]
labels
  propsMap <- parseProperties props
  return $ Subject.Subject ident labelSet propsMap

-- | Parse properties map from aeson Value
parseProperties :: Value -> Parser Subject.PropertyRecord
parseProperties :: Value -> Parser PropertyRecord
parseProperties = String
-> (Object -> Parser PropertyRecord)
-> Value
-> Parser PropertyRecord
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Properties" ((Object -> Parser PropertyRecord)
 -> Value -> Parser PropertyRecord)
-> (Object -> Parser PropertyRecord)
-> Value
-> Parser PropertyRecord
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  let pairs :: [Pair]
pairs = Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList Object
obj
  [(String, Value)] -> PropertyRecord
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, Value)] -> PropertyRecord)
-> Parser [(String, Value)] -> Parser PropertyRecord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pair -> Parser (String, Value))
-> [Pair] -> Parser [(String, Value)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Pair -> Parser (String, Value)
parseProp [Pair]
pairs
  where
    parseProp :: Pair -> Parser (String, Value)
parseProp (Key
k, Value
v) = do
      val <- Value -> Parser Value
valueFromJSON Value
v
      return (T.unpack $ toText k, val)

-- | Parse a Subject.Value from aeson Value (for deserialization)
valueFromJSON :: Value -> Parser SubjectValue.Value
valueFromJSON :: Value -> Parser Value
valueFromJSON Value
v = 
  Value -> Parser Value
parseInteger Value
v Parser Value -> Parser Value -> Parser Value
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Value -> Parser Value
parseDecimal Value
v Parser Value -> Parser Value -> Parser Value
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Value -> Parser Value
parseBoolean Value
v Parser Value -> Parser Value -> Parser Value
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Value -> Parser Value
parseString Value
v Parser Value -> Parser Value -> Parser Value
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Value -> Parser Value
parseSymbol Value
v Parser Value -> Parser Value -> Parser Value
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Value -> Parser Value
parseTaggedString Value
v Parser Value -> Parser Value -> Parser Value
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Value -> Parser Value
parseRange Value
v Parser Value -> Parser Value -> Parser Value
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Value -> Parser Value
parseMeasurement Value
v Parser Value -> Parser Value -> Parser Value
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Value -> Parser Value
parseArray Value
v Parser Value -> Parser Value -> Parser Value
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Value -> Parser Value
parseMap Value
v
  where
    parseInteger :: Value -> Parser Value
parseInteger = String -> (Scientific -> Parser Value) -> Value -> Parser Value
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"Integer" ((Scientific -> Parser Value) -> Value -> Parser Value)
-> (Scientific -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ \Scientific
n ->
      case Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
n of
        Left Double
_ -> String -> Parser Value
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected integer"
        Right Integer
i -> Value -> Parser Value
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ Integer -> Value
SubjectValue.VInteger Integer
i
    
    parseDecimal :: Value -> Parser Value
parseDecimal = String -> (Scientific -> Parser Value) -> Value -> Parser Value
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"Decimal" ((Scientific -> Parser Value) -> Value -> Parser Value)
-> (Scientific -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ \Scientific
n ->
      Value -> Parser Value
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
SubjectValue.VDecimal (Scientific -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
n)
    
    parseBoolean :: Value -> Parser Value
parseBoolean = String -> (Bool -> Parser Value) -> Value -> Parser Value
forall a. String -> (Bool -> Parser a) -> Value -> Parser a
withBool String
"Boolean" ((Bool -> Parser Value) -> Value -> Parser Value)
-> (Bool -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ \Bool
b ->
      Value -> Parser Value
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
SubjectValue.VBoolean Bool
b
    
    parseString :: Value -> Parser Value
parseString = String -> (Text -> Parser Value) -> Value -> Parser Value
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"String" ((Text -> Parser Value) -> Value -> Parser Value)
-> (Text -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ \Text
t ->
      Value -> Parser Value
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ String -> Value
SubjectValue.VString (Text -> String
T.unpack Text
t)
    
    parseSymbol :: Value -> Parser Value
parseSymbol = String -> (Object -> Parser Value) -> Value -> Parser Value
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Symbol" ((Object -> Parser Value) -> Value -> Parser Value)
-> (Object -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      ty <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      if ty == ("symbol" :: T.Text)
        then do
          val <- obj .: "value"
          return $ SubjectValue.VSymbol val
        else fail "Not a symbol"
    
    parseTaggedString :: Value -> Parser Value
parseTaggedString = String -> (Object -> Parser Value) -> Value -> Parser Value
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TaggedString" ((Object -> Parser Value) -> Value -> Parser Value)
-> (Object -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      ty <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      if ty == ("tagged" :: T.Text)
        then do
          tag <- obj .: "tag"
          content <- obj .: "content"
          return $ SubjectValue.VTaggedString tag content
        else fail "Not a tagged string"
    
    parseRange :: Value -> Parser Value
parseRange = String -> (Object -> Parser Value) -> Value -> Parser Value
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Range" ((Object -> Parser Value) -> Value -> Parser Value)
-> (Object -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      ty <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      if ty == ("range" :: T.Text)
        then do
          lower <- obj .: "lower"
          upper <- obj .: "upper"
          return $ SubjectValue.VRange (SubjectValue.RangeValue lower upper)
        else fail "Not a range"
    
    parseMeasurement :: Value -> Parser Value
parseMeasurement = String -> (Object -> Parser Value) -> Value -> Parser Value
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Measurement" ((Object -> Parser Value) -> Value -> Parser Value)
-> (Object -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      ty <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      if ty == ("measurement" :: T.Text)
        then do
          unit <- obj .: "unit"
          val <- obj .: "value"
          return $ SubjectValue.VMeasurement unit val
        else fail "Not a measurement"
    
    parseArray :: Value -> Parser Value
parseArray = String -> (Array -> Parser Value) -> Value -> Parser Value
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"Array" ((Array -> Parser Value) -> Value -> Parser Value)
-> (Array -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ \Array
arr -> do
      vals <- (Value -> Parser Value) -> [Value] -> Parser [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Parser Value
valueFromJSON (Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
arr)
      return $ SubjectValue.VArray vals
    
    parseMap :: Value -> Parser Value
parseMap = String -> (Object -> Parser Value) -> Value -> Parser Value
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Map" ((Object -> Parser Value) -> Value -> Parser Value)
-> (Object -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      -- Only treat as map if it doesn't have a "type" field (which indicates a complex value)
      case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"type" Object
obj of
        Just Value
_ -> String -> Parser Value
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Object with type field is not a map"
        Maybe Value
Nothing -> do
          let pairs :: [Pair]
pairs = Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList Object
obj
          valMap <- [(String, Value)] -> PropertyRecord
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, Value)] -> PropertyRecord)
-> Parser [(String, Value)] -> Parser PropertyRecord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pair -> Parser (String, Value))
-> [Pair] -> Parser [(String, Value)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Pair -> Parser (String, Value)
parseMapEntry [Pair]
pairs
          return $ SubjectValue.VMap valMap
      where
        parseMapEntry :: Pair -> Parser (String, Value)
parseMapEntry (Key
k, Value
v) = do
          val <- Value -> Parser Value
valueFromJSON Value
v
          return (T.unpack $ toText k, val)

-- ToJSON instances
instance ToJSON (Pattern.Pattern Subject.Subject) where
  toJSON :: Pattern Subject -> Value
toJSON = Pattern Subject -> Value
patternToValue

instance FromJSON (Pattern.Pattern Subject.Subject) where
  parseJSON :: Value -> Parser (Pattern Subject)
parseJSON = Value -> Parser (Pattern Subject)
patternFromValue

-- | Recursively sort all object keys alphabetically in a JSON Value
--
-- This function ensures that equivalent data structures produce byte-for-byte
-- identical JSON strings, enabling reliable automated comparison.
--
-- Special handling: Pattern objects always have "subject" before "elements"
-- to maintain semantic ordering.
--
-- @since 0.1.0
canonicalizeJSON :: Value -> Value
canonicalizeJSON :: Value -> Value
canonicalizeJSON (Object Object
obj) = 
  let subjectKey :: Key
subjectKey = String -> Key
fromString String
"subject"
      elementsKey :: Key
elementsKey = String -> Key
fromString String
"elements"
      -- Special case: Pattern objects have exactly two keys: "subject" and "elements"
      -- Explicitly grab them and construct in the correct order
      subjectVal :: Maybe Value
subjectVal = Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
subjectKey Object
obj
      elementsVal :: Maybe Value
elementsVal = Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
elementsKey Object
obj
  in case (Maybe Value
subjectVal, Maybe Value
elementsVal) of
       (Just Value
s, Just Value
e) -> 
         -- Pattern object: subject first, then elements
         -- Use object to construct in correct order
         [Pair] -> Value
object [ Key
subjectKey Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value -> Value
canonicalizeJSON Value
s
                , Key
elementsKey Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value -> Value
canonicalizeJSON Value
e
                ]
       (Maybe Value, Maybe Value)
_ -> 
         -- Other objects: sort alphabetically
         let pairs :: [Pair]
pairs = (Pair -> Pair) -> [Pair] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map Pair -> Pair
forall {a}. (a, Value) -> (a, Value)
canonicalizePair ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall a b. (a -> b) -> a -> b
$ Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList Object
obj
         in Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList ([Pair] -> Object) -> [Pair] -> Object
forall a b. (a -> b) -> a -> b
$ (Pair -> Pair -> Ordering) -> [Pair] -> [Pair]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (\(Key
k1, Value
_) (Key
k2, Value
_) -> Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Key -> Text
toText Key
k1) (Key -> Text
toText Key
k2)) [Pair]
pairs
  where
    canonicalizePair :: (a, Value) -> (a, Value)
canonicalizePair (a
k, Value
v) = (a
k, Value -> Value
canonicalizeJSON Value
v)
canonicalizeJSON (Array Array
arr) = Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Value) -> Array -> Array
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
canonicalizeJSON Array
arr
canonicalizeJSON Value
v = Value
v