{- |
Module      : Prosidy.Internal.JSON
Description : Orphan JSON instances to let as many modules be -XSafe as possible.
Copyright   : (c) James Alexander Feldman-Crough, 2019
License     : MPL-2.0
Maintainer  : alex@fldcr.com
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Trustworthy #-}
module Prosidy.Internal.JSON () where

import           Prosidy.Internal.Classes
import           Prosidy.Types
import           Data.Aeson
import qualified Data.HashMap.Strict           as HM
import           Data.Text                      ( Text )
import           Control.Exception              ( displayException )

instance FromJSON Block where
    parseJSON :: Value -> Parser Block
parseJSON = String -> (Object -> Parser Block) -> Value -> Parser Block
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "block" ((Object -> Parser Block) -> Value -> Parser Block)
-> (Object -> Parser Block) -> Value -> Parser Block
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        Text
ty <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "type"
        case Text
ty :: Text of
            "tag" -> do
                Text
subtype <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "subtype"
                case Text
subtype :: Text of
                    "block"   -> BlockTag -> Block
BlockTag (BlockTag -> Block) -> Parser BlockTag -> Parser Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser BlockTag
forall a. FromJSON a => Object -> Text -> Parser a
.: "value"
                    "literal" -> LiteralTag -> Block
BlockLiteral (LiteralTag -> Block) -> Parser LiteralTag -> Parser Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser LiteralTag
forall a. FromJSON a => Object -> Text -> Parser a
.: "value"
                    _         -> String -> Parser Block
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Block) -> String -> Parser Block
forall a b. (a -> b) -> a -> b
$ "unknown tag subtype: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
subtype
            "paragraph" -> Paragraph -> Block
BlockParagraph (Paragraph -> Block) -> Parser Paragraph -> Parser Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Paragraph
forall a. FromJSON a => Object -> Text -> Parser a
.: "value"
            _           -> String -> Parser Block
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Block) -> String -> Parser Block
forall a b. (a -> b) -> a -> b
$ "unknown block type: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
ty

instance ToJSON Block where
    toEncoding :: Block -> Encoding
toEncoding b :: Block
b = Series -> Encoding
pairs (Series -> Encoding)
-> ([Series] -> Series) -> [Series] -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Encoding) -> [Series] -> Encoding
forall a b. (a -> b) -> a -> b
$ case Block
b of
        BlockLiteral t :: LiteralTag
t ->
            [ "type" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("tag" :: Text)
            , "subtype" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("literal" :: Text)
            , "value" Text -> LiteralTag -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= LiteralTag
t
            ]
        BlockParagraph p :: Paragraph
p -> ["type" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("paragraph" :: Text), "value" Text -> Paragraph -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Paragraph
p]
        BlockTag t :: BlockTag
t ->
            [ "type" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("tag" :: Text)
            , "subtype" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("block" :: Text)
            , "value" Text -> BlockTag -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockTag
t
            ]

    toJSON :: Block -> Value
toJSON b :: Block
b = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ case Block
b of
        BlockLiteral t :: LiteralTag
t ->
            [ "type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("tag" :: Text)
            , "subtype" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("literal" :: Text)
            , "value" Text -> LiteralTag -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= LiteralTag
t
            ]
        BlockParagraph p :: Paragraph
p -> ["type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("paragraph" :: Text), "value" Text -> Paragraph -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Paragraph
p]
        BlockTag t :: BlockTag
t ->
            [ "type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("tag" :: Text)
            , "subtype" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("block" :: Text)
            , "value" Text -> BlockTag -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockTag
t
            ]

instance FromJSON Document where
    parseJSON :: Value -> Parser Document
parseJSON = String -> (Object -> Parser Document) -> Value -> Parser Document
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Document"
        ((Object -> Parser Document) -> Value -> Parser Document)
-> (Object -> Parser Document) -> Value -> Parser Document
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> Metadata -> Series Block -> Document
Document (Metadata -> Series Block -> Document)
-> Parser Metadata -> Parser (Series Block -> Document)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Metadata
forall a. FromJSON a => Object -> Text -> Parser a
.: "metadata" Parser (Series Block -> Document)
-> Parser (Series Block) -> Parser Document
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Series Block)
forall a. FromJSON a => Object -> Text -> Parser a
.: "content"

instance ToJSON Document where
    toEncoding :: Document -> Encoding
toEncoding (Document md :: Metadata
md ct :: Series Block
ct) =
        Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ["metadata" Text -> Metadata -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Metadata
md, "content" Text -> Series Block -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Series Block
ct]

    toJSON :: Document -> Value
toJSON (Document md :: Metadata
md ct :: Series Block
ct) = [Pair] -> Value
object ["metadata" Text -> Metadata -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Metadata
md, "content" Text -> Series Block -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Series Block
ct]

instance FromJSON Fragment where
    parseJSON :: Value -> Parser Fragment
parseJSON = String -> (Text -> Parser Fragment) -> Value -> Parser Fragment
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "Fragment" ((Text -> Parser Fragment) -> Value -> Parser Fragment)
-> (Text -> Parser Fragment) -> Value -> Parser Fragment
forall a b. (a -> b) -> a -> b
$ Fragment -> Parser Fragment
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fragment -> Parser Fragment)
-> (Text -> Fragment) -> Text -> Parser Fragment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe Location -> Fragment)
-> Maybe Location -> Text -> Fragment
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Maybe Location -> Fragment
Fragment Maybe Location
forall a. Maybe a
Nothing

instance ToJSON Fragment where
    toEncoding :: Fragment -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding) -> (Fragment -> Text) -> Fragment -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fragment -> Text
fragmentText
    toJSON :: Fragment -> Value
toJSON     = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Fragment -> Text) -> Fragment -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fragment -> Text
fragmentText

instance FromJSON Inline where
    parseJSON :: Value -> Parser Inline
parseJSON = String -> (Object -> Parser Inline) -> Value -> Parser Inline
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Inline" ((Object -> Parser Inline) -> Value -> Parser Inline)
-> (Object -> Parser Inline) -> Value -> Parser Inline
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        Text
ty <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "type"
        case Text
ty :: Text of
            "break" -> Inline -> Parser Inline
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inline
Break
            "tag"   -> InlineTag -> Inline
InlineTag (InlineTag -> Inline) -> Parser InlineTag -> Parser Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser InlineTag
forall a. FromJSON a => Object -> Text -> Parser a
.: "value"
            "text"  -> Fragment -> Inline
InlineText (Fragment -> Inline) -> Parser Fragment -> Parser Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Fragment
forall a. FromJSON a => Object -> Text -> Parser a
.: "value"
            _       -> String -> Parser Inline
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Inline) -> String -> Parser Inline
forall a b. (a -> b) -> a -> b
$ "unknown inline type: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
ty

instance ToJSON Inline where
    toEncoding :: Inline -> Encoding
toEncoding i :: Inline
i = Series -> Encoding
pairs (Series -> Encoding)
-> ([Series] -> Series) -> [Series] -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Encoding) -> [Series] -> Encoding
forall a b. (a -> b) -> a -> b
$ case Inline
i of
        Break -> ["type" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("break" :: Text), "value" Text -> Value -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
Null]
        InlineTag t :: InlineTag
t ->
            [ "type" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("tag" :: Text)
            , "subtype" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("inline" :: Text)
            , "value" Text -> InlineTag -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= InlineTag
t
            ]
        InlineText t :: Fragment
t -> ["type" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("text" :: Text), "value" Text -> Fragment -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fragment
t]

    toJSON :: Inline -> Value
toJSON i :: Inline
i = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ case Inline
i of
        Break -> ["type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("break" :: Text)]
        InlineTag t :: InlineTag
t ->
            [ "type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("tag" :: Text)
            , "subtype" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("inline" :: Text)
            , "value" Text -> InlineTag -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= InlineTag
t
            ]
        InlineText t :: Fragment
t -> ["type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("text" :: Text), "value" Text -> Fragment -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fragment
t]

instance FromJSON Metadata where
    parseJSON :: Value -> Parser Metadata
parseJSON = String -> (Object -> Parser Metadata) -> Value -> Parser Metadata
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Metadata"
        ((Object -> Parser Metadata) -> Value -> Parser Metadata)
-> (Object -> Parser Metadata) -> Value -> Parser Metadata
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> Set Key -> Assoc Key Text -> Metadata
Metadata (Set Key -> Assoc Key Text -> Metadata)
-> Parser (Set Key) -> Parser (Assoc Key Text -> Metadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Set Key)
forall a. FromJSON a => Object -> Text -> Parser a
.: "properties" Parser (Assoc Key Text -> Metadata)
-> Parser (Assoc Key Text) -> Parser Metadata
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Assoc Key Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: "settings"

instance ToJSON Metadata where
    toEncoding :: Metadata -> Encoding
toEncoding (Metadata ps :: Set Key
ps ss :: Assoc Key Text
ss) =
        Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ["properties" Text -> Set Key -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Set Key
ps, "settings" Text -> Assoc Key Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Assoc Key Text
ss]

    toJSON :: Metadata -> Value
toJSON (Metadata ps :: Set Key
ps ss :: Assoc Key Text
ss) = [Pair] -> Value
object ["properties" Text -> Set Key -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Set Key
ps, "settings" Text -> Assoc Key Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Assoc Key Text
ss]

instance FromJSON Paragraph where
    parseJSON :: Value -> Parser Paragraph
parseJSON = (SeriesNE Inline -> Paragraph)
-> Parser (SeriesNE Inline) -> Parser Paragraph
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SeriesNE Inline -> Maybe Location -> Paragraph)
-> Maybe Location -> SeriesNE Inline -> Paragraph
forall a b c. (a -> b -> c) -> b -> a -> c
flip SeriesNE Inline -> Maybe Location -> Paragraph
Paragraph Maybe Location
forall a. Maybe a
Nothing) (Parser (SeriesNE Inline) -> Parser Paragraph)
-> (Value -> Parser (SeriesNE Inline)) -> Value -> Parser Paragraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (SeriesNE Inline)
forall a. FromJSON a => Value -> Parser a
parseJSON

instance ToJSON Paragraph where
    toEncoding :: Paragraph -> Encoding
toEncoding (Paragraph s :: SeriesNE Inline
s _) = SeriesNE Inline -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding SeriesNE Inline
s
    toJSON :: Paragraph -> Value
toJSON (Paragraph s :: SeriesNE Inline
s _) = SeriesNE Inline -> Value
forall a. ToJSON a => a -> Value
toJSON SeriesNE Inline
s

instance ToJSON a => ToJSON (Region a) where
    toJSON :: Region a -> Value
toJSON (Region md :: Metadata
md ct :: a
ct _) = [Pair] -> Value
object ["metadata" Text -> Metadata -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Metadata
md, "content" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
ct]

instance FromJSON a => FromJSON (Tag a) where
    parseJSON :: Value -> Parser (Tag a)
parseJSON = String -> (Object -> Parser (Tag a)) -> Value -> Parser (Tag a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Tag" ((Object -> Parser (Tag a)) -> Value -> Parser (Tag a))
-> (Object -> Parser (Tag a)) -> Value -> Parser (Tag a)
forall a b. (a -> b) -> a -> b
$ \o :: Object
o ->
        Key -> Metadata -> a -> Maybe Location -> Tag a
forall a. Key -> Metadata -> a -> Maybe Location -> Tag a
Tag
            (Key -> Metadata -> a -> Maybe Location -> Tag a)
-> Parser Key -> Parser (Metadata -> a -> Maybe Location -> Tag a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
            Object -> Text -> Parser Key
forall a. FromJSON a => Object -> Text -> Parser a
.:  "name"
            Parser (Metadata -> a -> Maybe Location -> Tag a)
-> Parser Metadata -> Parser (a -> Maybe Location -> Tag a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
            Object -> Text -> Parser Metadata
forall a. FromJSON a => Object -> Text -> Parser a
.:  "metadata"
            Parser (a -> Maybe Location -> Tag a)
-> Parser a -> Parser (Maybe Location -> Tag a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
            Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.:  "content"
            Parser (Maybe Location -> Tag a)
-> Parser (Maybe Location) -> Parser (Tag a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Location -> Parser (Maybe Location)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Location
forall a. Maybe a
Nothing

instance ToJSON a => ToJSON (Tag a) where
    toEncoding :: Tag a -> Encoding
toEncoding (Tag nm :: Key
nm md :: Metadata
md ct :: a
ct _) =
        Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ["name" Text -> Key -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Key
nm, "metadata" Text -> Metadata -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Metadata
md, "content" Text -> a -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
ct]

    toJSON :: Tag a -> Value
toJSON (Tag nm :: Key
nm md :: Metadata
md ct :: a
ct _) =
        [Pair] -> Value
object ["name" Text -> Key -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Key
nm, "metadata" Text -> Metadata -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Metadata
md, "content" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
ct]

instance FromJSONKey Key where
    fromJSONKey :: FromJSONKeyFunction Key
fromJSONKey =
        (Text -> Parser Key) -> FromJSONKeyFunction Key
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser Key) -> FromJSONKeyFunction Key)
-> (Text -> Parser Key) -> FromJSONKeyFunction Key
forall a b. (a -> b) -> a -> b
$ (KeyError -> Parser Key)
-> (Key -> Parser Key) -> Either KeyError Key -> Parser Key
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser Key
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Key)
-> (KeyError -> String) -> KeyError -> Parser Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyError -> String
forall e. Exception e => e -> String
displayException) Key -> Parser Key
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either KeyError Key -> Parser Key)
-> (Text -> Either KeyError Key) -> Text -> Parser Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either KeyError Key
makeKey

instance (Hashable a, Eq a, ToJSONKey a) => ToJSON (Set a) where
    toJSON :: Set a -> Value
toJSON (Set hs :: HashSet a
hs) = HashMap a Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (HashMap a Bool -> Value) -> HashMap a Bool -> Value
forall a b. (a -> b) -> a -> b
$ (a -> HashMap a Bool) -> HashSet a -> HashMap a Bool
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> Bool -> HashMap a Bool) -> Bool -> a -> HashMap a Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Bool -> HashMap a Bool
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton Bool
True) HashSet a
hs
    toEncoding :: Set a -> Encoding
toEncoding (Set hs :: HashSet a
hs) = HashMap a Bool -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (HashMap a Bool -> Encoding) -> HashMap a Bool -> Encoding
forall a b. (a -> b) -> a -> b
$ (a -> HashMap a Bool) -> HashSet a -> HashMap a Bool
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> Bool -> HashMap a Bool) -> Bool -> a -> HashMap a Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Bool -> HashMap a Bool
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton Bool
True) HashSet a
hs

instance (Hashable a, Eq a, FromJSONKey a) => FromJSON (Set a) where
    parseJSON :: Value -> Parser (Set a)
parseJSON json :: Value
json = do
        HashMap a Bool
m <- Value -> Parser (HashMap a Bool)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
json
        Set a -> Parser (Set a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set a -> Parser (Set a))
-> (HashMap a Bool -> Set a) -> HashMap a Bool -> Parser (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> Set a
forall a. HashSet a -> Set a
Set (HashSet a -> Set a)
-> (HashMap a Bool -> HashSet a) -> HashMap a Bool -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap a Bool -> HashSet a
forall k a. HashMap k a -> HashSet k
HM.keysSet (HashMap a Bool -> Parser (Set a))
-> HashMap a Bool -> Parser (Set a)
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> HashMap a Bool -> HashMap a Bool
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HM.filter Bool -> Bool
forall a. a -> a
id HashMap a Bool
m