content: {-# LANGUAGE AllowAmbiguousTypes #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE DeriveAnyClass #-}
  {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE DeriveLift #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE TypeFamilies #-}
  
  {-|
  Module      :  Data.Aeson.Schema.Key
  Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com>
  Stability   :  experimental
  Portability :  portable
  
  Defines a SchemaKey.
  -}
  module Data.Aeson.Schema.Key (
    SchemaKey' (..),
    SchemaKeyV,
    fromSchemaKeyV,
    showSchemaKeyV,
    getContext,
    toContext,
    SchemaKey,
    IsSchemaKey (..),
    fromSchemaKey,
    showSchemaKey,
  ) where
  
  import qualified Data.Aeson as Aeson
  import Data.Hashable (Hashable)
  import Data.Maybe (fromMaybe)
  import Data.Proxy (Proxy (..))
  import Data.String (fromString)
  import GHC.Generics (Generic)
  import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
  import Language.Haskell.TH.Syntax (Lift)
  
  import qualified Data.Aeson.Schema.Utils.Compat as Compat
  import Data.Aeson.Schema.Utils.Invariant (unreachable)
  
  -- | A key in a JSON object schema.
  data SchemaKey' s
    = NormalKey s
    | -- | A key that doesn't actually exist in the object, but whose content should be parsed from
      -- the current object.
      PhantomKey s
    deriving (Show, Eq, Generic, Hashable, Lift)
  
  -- | A value-level SchemaKey
  type SchemaKeyV = SchemaKey' String
  
  fromSchemaKeyV :: SchemaKeyV -> String
  fromSchemaKeyV (NormalKey key) = key
  fromSchemaKeyV (PhantomKey key) = key
  
  showSchemaKeyV :: SchemaKeyV -> String
  showSchemaKeyV (NormalKey key) = show key
  showSchemaKeyV (PhantomKey key) = "[" ++ key ++ "]"
  
  -- | Given schema `{ key: innerSchema }` for JSON data `{ key: val1 }`, get the JSON
  --  Value that `innerSchema` should parse.
  getContext :: SchemaKeyV -> Aeson.Object -> Aeson.Value
  getContext = \case
    -- `innerSchema` should parse `val1`
    NormalKey key -> fromMaybe Aeson.Null . Compat.lookup (fromString key)
    -- `innerSchema` should parse the same object that `key` is in
    PhantomKey _ -> Aeson.Object
  
  -- | Given JSON data `val` adhering to `innerSchema`, get the JSON object that should be
  --  merged with the outer JSON object.
  toContext :: SchemaKeyV -> Aeson.Value -> Aeson.Object
  toContext = \case
    -- `val` should be inserted with key `key`
    NormalKey key -> Compat.singleton (fromString key)
    -- If `val` is an object, it should be merged with the outer JSON object
    PhantomKey _ -> \case
      Aeson.Object o -> o
      -- `Try` schema could store `Nothing`, which would return `Null`. In this case, there is no
      -- context to merge
      Aeson.Null -> mempty
      v -> unreachable $ "Invalid value for phantom key: " ++ show v
  
  -- | A type-level SchemaKey
  type SchemaKey = SchemaKey' Symbol
  
  class (KnownSymbol (FromSchemaKey key)) => IsSchemaKey (key :: SchemaKey) where
    type FromSchemaKey key :: Symbol
    toSchemaKeyV :: Proxy key -> SchemaKeyV
  
  instance (KnownSymbol key) => IsSchemaKey ('NormalKey key) where
    type FromSchemaKey ('NormalKey key) = key
    toSchemaKeyV _ = NormalKey $ symbolVal $ Proxy @key
  
  instance (KnownSymbol key) => IsSchemaKey ('PhantomKey key) where
    type FromSchemaKey ('PhantomKey key) = key
    toSchemaKeyV _ = PhantomKey $ symbolVal $ Proxy @key
  
  fromSchemaKey :: forall key. (IsSchemaKey key) => String
  fromSchemaKey = fromSchemaKeyV $ toSchemaKeyV $ Proxy @key
  
  showSchemaKey :: forall key. (IsSchemaKey key) => String
  showSchemaKey = showSchemaKeyV $ toSchemaKeyV $ Proxy @key
  