{-# 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.Name
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

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 = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (style :: Symbol) (nm :: Symbol).
NameText style =>
Named style nm -> Text
nameText

instance ToJSONKey (Named JSONStyle nameTy) where
  toJSONKey :: ToJSONKeyFunction (Named JSONStyle nameTy)
toJSONKey = forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText 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 = forall a. IsString a => String -> a
fromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
j

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


instance ToJSON (Name nameTy) where
  toJSON :: Name nameTy -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON 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 forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSONKey a => FromJSONKeyFunction a
fromJSONKey


instance ToJSON (Named CaseInsensitive nameTy) where
  toJSON :: Named CaseInsensitive nameTy -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON 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 forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSONKey a => FromJSONKeyFunction a
fromJSONKey