{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

{-|

This module provides a 'JSONStyle' Named style that can be used for JSON
encoding/decoding.  It also provides conversion to and from that style from the
regular 'UTF8' style, as well as an "aeson" 'ToJSON' and 'FromJSON' instance.

-}

module Data.Name.JSON where

import Data.Aeson
import Data.Aeson.Types
import Data.Functor.Contravariant ( (>$<) )
import Data.Hashable ( Hashable )
import Data.Name
import Data.Name.Internal
import Data.String ( IsString(fromString) )


-- | The JSONStyle of Named objects can be directly transformed to and from JSON
-- (via Aeson's ToJSON and FromJSON classes).  The Named nameOf is not
-- represented in the JSON form; field names are expected to be provided by the
-- Named field name itself.  Bi-directional conversions between the JSON style
-- and the UTF8 style is automatic.

type JSONStyle = "JSON" :: NameStyle

instance NameText JSONStyle

-- JSON names have no special considerations, so standard instances are
-- sufficient:

deriving instance Eq (Named JSONStyle nameOf)
deriving instance Ord (Named JSONStyle nameOf)
deriving instance Hashable (Named JSONStyle nameOf)

instance ConvertNameStyle JSONStyle UTF8 nameOf
instance ConvertNameStyle UTF8 JSONStyle nameOf

instance ConvertNameStyle JSONStyle CaseInsensitive nameOf
instance ConvertNameStyle CaseInsensitive JSONStyle nameOf


-- -- The generic instance results in an object: { "name": "..." } This
-- -- instance declaration avoids that and causes the JSON form to be a simple
-- -- string.  Currently there's no FromJSON, although it's likely the generic
-- -- instance would successfully work under OverloadedStrings
instance ToJSON (Named JSONStyle nameTy) where
  toJSON :: Named JSONStyle nameTy -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (Named JSONStyle nameTy -> Text)
-> Named JSONStyle nameTy
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Named JSONStyle nameTy -> Text
forall (nm :: Symbol). Named JSONStyle nm -> Text
forall (style :: Symbol) (nm :: Symbol).
NameText style =>
Named style nm -> Text
nameText

instance ToJSONKey (Named JSONStyle nameTy) where
  toJSONKey :: ToJSONKeyFunction (Named JSONStyle nameTy)
toJSONKey = (Named JSONStyle nameTy -> Text)
-> ToJSONKeyFunction (Named JSONStyle nameTy)
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText Named JSONStyle nameTy -> Text
forall (nm :: Symbol). Named JSONStyle nm -> Text
forall (style :: Symbol) (nm :: Symbol).
NameText style =>
Named style nm -> Text
nameText

instance FromJSON (Named JSONStyle nameTy) where
  parseJSON :: Value -> Parser (Named JSONStyle nameTy)
parseJSON Value
j = String -> Named JSONStyle nameTy
forall a. IsString a => String -> a
fromString (String -> Named JSONStyle nameTy)
-> Parser String -> Parser (Named JSONStyle nameTy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
j

instance FromJSONKey (Named JSONStyle nameTy) where
  fromJSONKey :: FromJSONKeyFunction (Named JSONStyle nameTy)
fromJSONKey = (Text -> Named JSONStyle nameTy)
-> FromJSONKeyFunction (Named JSONStyle nameTy)
forall a. (Text -> a) -> FromJSONKeyFunction a
FromJSONKeyText Text -> Named JSONStyle nameTy
forall a. IsText a => Text -> a
fromText


instance ToJSON (Name nameTy) where
  toJSON :: Name nameTy -> Value
toJSON = Named JSONStyle nameTy -> Value
forall a. ToJSON a => a -> Value
toJSON (Named JSONStyle nameTy -> Value)
-> (Name nameTy -> Named JSONStyle nameTy) -> Name nameTy -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (inpStyle :: Symbol) (outStyle :: Symbol)
       (nameTy :: Symbol).
ConvertNameStyle inpStyle outStyle nameTy =>
Named inpStyle nameTy -> Named outStyle nameTy
convertStyle @UTF8 @JSONStyle

instance ToJSONKey (Name nameTy) where
  toJSONKey :: ToJSONKeyFunction (Name nameTy)
toJSONKey = forall (inpStyle :: Symbol) (outStyle :: Symbol)
       (nameTy :: Symbol).
ConvertNameStyle inpStyle outStyle nameTy =>
Named inpStyle nameTy -> Named outStyle nameTy
convertStyle @UTF8 @JSONStyle (Name nameTy -> Named JSONStyle nameTy)
-> ToJSONKeyFunction (Named JSONStyle nameTy)
-> ToJSONKeyFunction (Name nameTy)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< ToJSONKeyFunction (Named JSONStyle nameTy)
forall a. ToJSONKey a => ToJSONKeyFunction a
toJSONKey

instance FromJSON (Name nameTy) where
  parseJSON :: Value -> Parser (Name nameTy)
parseJSON Value
j = forall (inpStyle :: Symbol) (outStyle :: Symbol)
       (nameTy :: Symbol).
ConvertNameStyle inpStyle outStyle nameTy =>
Named inpStyle nameTy -> Named outStyle nameTy
convertStyle @JSONStyle @UTF8 (Named JSONStyle nameTy -> Name nameTy)
-> (String -> Named JSONStyle nameTy) -> String -> Name nameTy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Named JSONStyle nameTy
forall a. IsString a => String -> a
fromString (String -> Name nameTy) -> Parser String -> Parser (Name nameTy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
j

instance FromJSONKey (Name nameTy) where
  fromJSONKey :: FromJSONKeyFunction (Name nameTy)
fromJSONKey = forall (inpStyle :: Symbol) (outStyle :: Symbol)
       (nameTy :: Symbol).
ConvertNameStyle inpStyle outStyle nameTy =>
Named inpStyle nameTy -> Named outStyle nameTy
convertStyle @JSONStyle @UTF8 (Named JSONStyle nameTy -> Name nameTy)
-> FromJSONKeyFunction (Named JSONStyle nameTy)
-> FromJSONKeyFunction (Name nameTy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromJSONKeyFunction (Named JSONStyle nameTy)
forall a. FromJSONKey a => FromJSONKeyFunction a
fromJSONKey


instance ToJSON (Named CaseInsensitive nameTy) where
  toJSON :: Named CaseInsensitive nameTy -> Value
toJSON = Named JSONStyle nameTy -> Value
forall a. ToJSON a => a -> Value
toJSON (Named JSONStyle nameTy -> Value)
-> (Named CaseInsensitive nameTy -> Named JSONStyle nameTy)
-> Named CaseInsensitive nameTy
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (inpStyle :: Symbol) (outStyle :: Symbol)
       (nameTy :: Symbol).
ConvertNameStyle inpStyle outStyle nameTy =>
Named inpStyle nameTy -> Named outStyle nameTy
convertStyle @CaseInsensitive @JSONStyle

instance ToJSONKey (Named CaseInsensitive nameTy) where
  toJSONKey :: ToJSONKeyFunction (Named CaseInsensitive nameTy)
toJSONKey = forall (inpStyle :: Symbol) (outStyle :: Symbol)
       (nameTy :: Symbol).
ConvertNameStyle inpStyle outStyle nameTy =>
Named inpStyle nameTy -> Named outStyle nameTy
convertStyle @CaseInsensitive @JSONStyle (Named CaseInsensitive nameTy -> Named JSONStyle nameTy)
-> ToJSONKeyFunction (Named JSONStyle nameTy)
-> ToJSONKeyFunction (Named CaseInsensitive nameTy)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< ToJSONKeyFunction (Named JSONStyle nameTy)
forall a. ToJSONKey a => ToJSONKeyFunction a
toJSONKey

instance FromJSON (Named CaseInsensitive nameTy) where
  parseJSON :: Value -> Parser (Named CaseInsensitive nameTy)
parseJSON Value
j = forall (inpStyle :: Symbol) (outStyle :: Symbol)
       (nameTy :: Symbol).
ConvertNameStyle inpStyle outStyle nameTy =>
Named inpStyle nameTy -> Named outStyle nameTy
convertStyle @JSONStyle @CaseInsensitive (Named JSONStyle nameTy -> Named CaseInsensitive nameTy)
-> (String -> Named JSONStyle nameTy)
-> String
-> Named CaseInsensitive nameTy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Named JSONStyle nameTy
forall a. IsString a => String -> a
fromString (String -> Named CaseInsensitive nameTy)
-> Parser String -> Parser (Named CaseInsensitive nameTy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
j

instance FromJSONKey (Named CaseInsensitive nameTy) where
  fromJSONKey :: FromJSONKeyFunction (Named CaseInsensitive nameTy)
fromJSONKey = forall (inpStyle :: Symbol) (outStyle :: Symbol)
       (nameTy :: Symbol).
ConvertNameStyle inpStyle outStyle nameTy =>
Named inpStyle nameTy -> Named outStyle nameTy
convertStyle @JSONStyle @CaseInsensitive (Named JSONStyle nameTy -> Named CaseInsensitive nameTy)
-> FromJSONKeyFunction (Named JSONStyle nameTy)
-> FromJSONKeyFunction (Named CaseInsensitive nameTy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromJSONKeyFunction (Named JSONStyle nameTy)
forall a. FromJSONKey a => FromJSONKeyFunction a
fromJSONKey