{-# 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 (
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)
data SchemaKey' s
= NormalKey s
|
PhantomKey s
deriving (Int -> SchemaKey' s -> ShowS
[SchemaKey' s] -> ShowS
SchemaKey' s -> String
(Int -> SchemaKey' s -> ShowS)
-> (SchemaKey' s -> String)
-> ([SchemaKey' s] -> ShowS)
-> Show (SchemaKey' s)
forall s. Show s => Int -> SchemaKey' s -> ShowS
forall s. Show s => [SchemaKey' s] -> ShowS
forall s. Show s => SchemaKey' s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Show s => Int -> SchemaKey' s -> ShowS
showsPrec :: Int -> SchemaKey' s -> ShowS
$cshow :: forall s. Show s => SchemaKey' s -> String
show :: SchemaKey' s -> String
$cshowList :: forall s. Show s => [SchemaKey' s] -> ShowS
showList :: [SchemaKey' s] -> ShowS
Show, SchemaKey' s -> SchemaKey' s -> Bool
(SchemaKey' s -> SchemaKey' s -> Bool)
-> (SchemaKey' s -> SchemaKey' s -> Bool) -> Eq (SchemaKey' s)
forall s. Eq s => SchemaKey' s -> SchemaKey' s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall s. Eq s => SchemaKey' s -> SchemaKey' s -> Bool
== :: SchemaKey' s -> SchemaKey' s -> Bool
$c/= :: forall s. Eq s => SchemaKey' s -> SchemaKey' s -> Bool
/= :: SchemaKey' s -> SchemaKey' s -> Bool
Eq, (forall x. SchemaKey' s -> Rep (SchemaKey' s) x)
-> (forall x. Rep (SchemaKey' s) x -> SchemaKey' s)
-> Generic (SchemaKey' s)
forall x. Rep (SchemaKey' s) x -> SchemaKey' s
forall x. SchemaKey' s -> Rep (SchemaKey' s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s x. Rep (SchemaKey' s) x -> SchemaKey' s
forall s x. SchemaKey' s -> Rep (SchemaKey' s) x
$cfrom :: forall s x. SchemaKey' s -> Rep (SchemaKey' s) x
from :: forall x. SchemaKey' s -> Rep (SchemaKey' s) x
$cto :: forall s x. Rep (SchemaKey' s) x -> SchemaKey' s
to :: forall x. Rep (SchemaKey' s) x -> SchemaKey' s
Generic, Eq (SchemaKey' s)
Eq (SchemaKey' s) =>
(Int -> SchemaKey' s -> Int)
-> (SchemaKey' s -> Int) -> Hashable (SchemaKey' s)
Int -> SchemaKey' s -> Int
SchemaKey' s -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall s. Hashable s => Eq (SchemaKey' s)
forall s. Hashable s => Int -> SchemaKey' s -> Int
forall s. Hashable s => SchemaKey' s -> Int
$chashWithSalt :: forall s. Hashable s => Int -> SchemaKey' s -> Int
hashWithSalt :: Int -> SchemaKey' s -> Int
$chash :: forall s. Hashable s => SchemaKey' s -> Int
hash :: SchemaKey' s -> Int
Hashable, (forall (m :: * -> *). Quote m => SchemaKey' s -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
SchemaKey' s -> Code m (SchemaKey' s))
-> Lift (SchemaKey' s)
forall s (m :: * -> *). (Lift s, Quote m) => SchemaKey' s -> m Exp
forall s (m :: * -> *).
(Lift s, Quote m) =>
SchemaKey' s -> Code m (SchemaKey' s)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => SchemaKey' s -> m Exp
forall (m :: * -> *).
Quote m =>
SchemaKey' s -> Code m (SchemaKey' s)
$clift :: forall s (m :: * -> *). (Lift s, Quote m) => SchemaKey' s -> m Exp
lift :: forall (m :: * -> *). Quote m => SchemaKey' s -> m Exp
$cliftTyped :: forall s (m :: * -> *).
(Lift s, Quote m) =>
SchemaKey' s -> Code m (SchemaKey' s)
liftTyped :: forall (m :: * -> *).
Quote m =>
SchemaKey' s -> Code m (SchemaKey' s)
Lift)
type SchemaKeyV = SchemaKey' String
fromSchemaKeyV :: SchemaKeyV -> String
fromSchemaKeyV :: SchemaKeyV -> String
fromSchemaKeyV (NormalKey String
key) = String
key
fromSchemaKeyV (PhantomKey String
key) = String
key
showSchemaKeyV :: SchemaKeyV -> String
showSchemaKeyV :: SchemaKeyV -> String
showSchemaKeyV (NormalKey String
key) = ShowS
forall a. Show a => a -> String
show String
key
showSchemaKeyV (PhantomKey String
key) = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
key String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
getContext :: SchemaKeyV -> Aeson.Object -> Aeson.Value
getContext :: SchemaKeyV -> Object -> Value
getContext = \case
NormalKey String
key -> Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Aeson.Null (Maybe Value -> Value)
-> (Object -> Maybe Value) -> Object -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
Compat.lookup (String -> Key
forall a. IsString a => String -> a
fromString String
key)
PhantomKey String
_ -> Object -> Value
Aeson.Object
toContext :: SchemaKeyV -> Aeson.Value -> Aeson.Object
toContext :: SchemaKeyV -> Value -> Object
toContext = \case
NormalKey String
key -> Key -> Value -> Object
forall v. Key -> v -> KeyMap v
Compat.singleton (String -> Key
forall a. IsString a => String -> a
fromString String
key)
PhantomKey String
_ -> \case
Aeson.Object Object
o -> Object
o
Value
Aeson.Null -> Object
forall a. Monoid a => a
mempty
Value
v -> String -> Object
forall a. String -> a
unreachable (String -> Object) -> String -> Object
forall a b. (a -> b) -> a -> b
$ String
"Invalid value for phantom key: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
v
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 :: Proxy ('NormalKey key) -> SchemaKeyV
toSchemaKeyV Proxy ('NormalKey key)
_ = String -> SchemaKeyV
forall s. s -> SchemaKey' s
NormalKey (String -> SchemaKeyV) -> String -> SchemaKeyV
forall a b. (a -> b) -> a -> b
$ Proxy key -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy key -> String) -> Proxy key -> String
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @key
instance (KnownSymbol key) => IsSchemaKey ('PhantomKey key) where
type FromSchemaKey ('PhantomKey key) = key
toSchemaKeyV :: Proxy ('PhantomKey key) -> SchemaKeyV
toSchemaKeyV Proxy ('PhantomKey key)
_ = String -> SchemaKeyV
forall s. s -> SchemaKey' s
PhantomKey (String -> SchemaKeyV) -> String -> SchemaKeyV
forall a b. (a -> b) -> a -> b
$ Proxy key -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy key -> String) -> Proxy key -> String
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @key
fromSchemaKey :: forall key. (IsSchemaKey key) => String
fromSchemaKey :: forall (key :: SchemaKey). IsSchemaKey key => String
fromSchemaKey = SchemaKeyV -> String
fromSchemaKeyV (SchemaKeyV -> String) -> SchemaKeyV -> String
forall a b. (a -> b) -> a -> b
$ Proxy key -> SchemaKeyV
forall (key :: SchemaKey).
IsSchemaKey key =>
Proxy key -> SchemaKeyV
toSchemaKeyV (Proxy key -> SchemaKeyV) -> Proxy key -> SchemaKeyV
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: SchemaKey). Proxy t
Proxy @key
showSchemaKey :: forall key. (IsSchemaKey key) => String
showSchemaKey :: forall (key :: SchemaKey). IsSchemaKey key => String
showSchemaKey = SchemaKeyV -> String
showSchemaKeyV (SchemaKeyV -> String) -> SchemaKeyV -> String
forall a b. (a -> b) -> a -> b
$ Proxy key -> SchemaKeyV
forall (key :: SchemaKey).
IsSchemaKey key =>
Proxy key -> SchemaKeyV
toSchemaKeyV (Proxy key -> SchemaKeyV) -> Proxy key -> SchemaKeyV
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: SchemaKey). Proxy t
Proxy @key