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

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

import           BytePatch.Core
import           BytePatch.Pretty
import           BytePatch.Pretty.HexByteString
import           Data.Aeson
import           GHC.Generics       (Generic)
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 Parsec Void Text Bytes -> Text -> Maybe Bytes
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   (MultiPatches a) where
    toJSON :: MultiPatches a -> Value
toJSON     = Options -> MultiPatches a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON     (Int -> Options
jsonCfgCamelDrop Int
3)
    toEncoding :: MultiPatches a -> Encoding
toEncoding = Options -> MultiPatches a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Int -> Options
jsonCfgCamelDrop Int
3)
instance FromJSON a => FromJSON (MultiPatches a) where
    parseJSON :: Value -> Parser (MultiPatches a)
parseJSON  = Options -> Value -> Parser (MultiPatches a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON  (Int -> Options
jsonCfgCamelDrop Int
3)

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

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

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

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