{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Aeson instances for various types.
module BytePatch.JSON where

import           BytePatch.Core
import qualified BytePatch.Pretty               as Pretty
import           BytePatch.Pretty.HexByteString
import           Data.Aeson
import           Text.Megaparsec
import           Data.Void

instance FromJSON HexByteString where
    parseJSON :: Value -> Parser HexByteString
parseJSON = String
-> (Text -> Parser HexByteString) -> Value -> Parser HexByteString
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"hex bytestring" ((Text -> Parser HexByteString) -> Value -> Parser HexByteString)
-> (Text -> Parser HexByteString) -> Value -> Parser HexByteString
forall a b. (a -> b) -> a -> b
$ \Text
t ->
        case forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe @Void Parsec Void Text Bytes
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Bytes
parseHexByteString Text
t of
          Maybe Bytes
Nothing -> String -> Parser HexByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse hex bytestring (TODO)"
          Just Bytes
t' -> HexByteString -> Parser HexByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> HexByteString
HexByteString Bytes
t')
instance ToJSON   HexByteString where
    toJSON :: HexByteString -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (HexByteString -> Text) -> HexByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Text
prettyHexByteString (Bytes -> Text)
-> (HexByteString -> Bytes) -> HexByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexByteString -> Bytes
unHexByteString

jsonCfgCamelDrop :: Int -> Options
jsonCfgCamelDrop :: Int -> Options
jsonCfgCamelDrop Int
x = Options
defaultOptions
  { fieldLabelModifier :: String -> String
fieldLabelModifier = Char -> String -> String
camelTo2 Char
'_' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
x
  , rejectUnknownFields :: Bool
rejectUnknownFields = Bool
True }

instance ToJSON   a => ToJSON   (Pretty.CommonMultiEdits a) where
    toJSON :: CommonMultiEdits a -> Value
toJSON     = Options -> CommonMultiEdits a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON     (Options -> CommonMultiEdits a -> Value)
-> Options -> CommonMultiEdits a -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
4
    toEncoding :: CommonMultiEdits a -> Encoding
toEncoding = Options -> CommonMultiEdits a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> CommonMultiEdits a -> Encoding)
-> Options -> CommonMultiEdits a -> Encoding
forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
4
instance FromJSON a => FromJSON (Pretty.CommonMultiEdits a) where
    parseJSON :: Value -> Parser (CommonMultiEdits a)
parseJSON  = Options -> Value -> Parser (CommonMultiEdits a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON  (Options -> Value -> Parser (CommonMultiEdits a))
-> Options -> Value -> Parser (CommonMultiEdits a)
forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
4

instance (ToJSON   (SeekRep s), ToJSON   a) => ToJSON   (Pretty.MultiEdit s a) where
    toJSON :: MultiEdit s a -> Value
toJSON     = Options -> MultiEdit s a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON     (Options -> MultiEdit s a -> Value)
-> Options -> MultiEdit s a -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
2
    toEncoding :: MultiEdit s a -> Encoding
toEncoding = Options -> MultiEdit s a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> MultiEdit s a -> Encoding)
-> Options -> MultiEdit s a -> Encoding
forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
2
instance (FromJSON (SeekRep s), FromJSON a) => FromJSON (Pretty.MultiEdit s a) where
    parseJSON :: Value -> Parser (MultiEdit s a)
parseJSON  = Options -> Value -> Parser (MultiEdit s a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON  (Options -> Value -> Parser (MultiEdit s a))
-> Options -> Value -> Parser (MultiEdit s a)
forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
2

instance (ToJSON   (SeekRep s), ToJSON   a) => ToJSON   (Pretty.EditOffset s a) where
    toJSON :: EditOffset s a -> Value
toJSON     = Options -> EditOffset s a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON     (Options -> EditOffset s a -> Value)
-> Options -> EditOffset s a -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
2
    toEncoding :: EditOffset s a -> Encoding
toEncoding = Options -> EditOffset s a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> EditOffset s a -> Encoding)
-> Options -> EditOffset s a -> Encoding
forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
2
instance (FromJSON (SeekRep s), FromJSON a) => FromJSON (Pretty.EditOffset s a) where
    parseJSON :: Value -> Parser (EditOffset s a)
parseJSON  = Options -> Value -> Parser (EditOffset s a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON  (Options -> Value -> Parser (EditOffset s a))
-> Options -> Value -> Parser (EditOffset s a)
forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
2

instance ToJSON   a => ToJSON   (EditMeta a) where
    toJSON :: EditMeta a -> Value
toJSON     = Options -> EditMeta a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON     (Options -> EditMeta a -> Value) -> Options -> EditMeta a -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
2
    toEncoding :: EditMeta a -> Encoding
toEncoding = Options -> EditMeta a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> EditMeta a -> Encoding)
-> Options -> EditMeta a -> Encoding
forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
2
instance FromJSON a => FromJSON (EditMeta a) where
    parseJSON :: Value -> Parser (EditMeta a)
parseJSON  = Options -> Value -> Parser (EditMeta a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON  (Options -> Value -> Parser (EditMeta a))
-> Options -> Value -> Parser (EditMeta a)
forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
2

instance ToJSON   a => ToJSON   (Edit a) where
    toJSON :: Edit a -> Value
toJSON     = Options -> Edit a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON     Options
defaultOptions
    toEncoding :: Edit a -> Encoding
toEncoding = Options -> Edit a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance FromJSON a => FromJSON (Edit a) where
    parseJSON :: Value -> Parser (Edit a)
parseJSON  = Options -> Value -> Parser (Edit a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON  Options
defaultOptions