module Hix.Data.Json where

import Data.Aeson (FromJSON (parseJSON), Key, Object, (.:?))
import Data.Aeson.Types (Parser)
import Distribution.Parsec (Parsec, eitherParsec)

aesonParsec ::
  Parsec a =>
  String ->
  Parser a
aesonParsec :: forall a. Parsec a => String -> Parser a
aesonParsec =
  (String -> Parser a) -> Either String a -> Parser a
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
leftA String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Either String a -> Parser a)
-> (String -> Either String a) -> String -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a. Parsec a => String -> Either String a
eitherParsec

newtype JsonParsec a =
  JsonParsec a
  deriving stock (JsonParsec a -> JsonParsec a -> Bool
(JsonParsec a -> JsonParsec a -> Bool)
-> (JsonParsec a -> JsonParsec a -> Bool) -> Eq (JsonParsec a)
forall a. Eq a => JsonParsec a -> JsonParsec a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => JsonParsec a -> JsonParsec a -> Bool
== :: JsonParsec a -> JsonParsec a -> Bool
$c/= :: forall a. Eq a => JsonParsec a -> JsonParsec a -> Bool
/= :: JsonParsec a -> JsonParsec a -> Bool
Eq, Int -> JsonParsec a -> ShowS
[JsonParsec a] -> ShowS
JsonParsec a -> String
(Int -> JsonParsec a -> ShowS)
-> (JsonParsec a -> String)
-> ([JsonParsec a] -> ShowS)
-> Show (JsonParsec a)
forall a. Show a => Int -> JsonParsec a -> ShowS
forall a. Show a => [JsonParsec a] -> ShowS
forall a. Show a => JsonParsec a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> JsonParsec a -> ShowS
showsPrec :: Int -> JsonParsec a -> ShowS
$cshow :: forall a. Show a => JsonParsec a -> String
show :: JsonParsec a -> String
$cshowList :: forall a. Show a => [JsonParsec a] -> ShowS
showList :: [JsonParsec a] -> ShowS
Show, (forall x. JsonParsec a -> Rep (JsonParsec a) x)
-> (forall x. Rep (JsonParsec a) x -> JsonParsec a)
-> Generic (JsonParsec a)
forall x. Rep (JsonParsec a) x -> JsonParsec a
forall x. JsonParsec a -> Rep (JsonParsec a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (JsonParsec a) x -> JsonParsec a
forall a x. JsonParsec a -> Rep (JsonParsec a) x
$cfrom :: forall a x. JsonParsec a -> Rep (JsonParsec a) x
from :: forall x. JsonParsec a -> Rep (JsonParsec a) x
$cto :: forall a x. Rep (JsonParsec a) x -> JsonParsec a
to :: forall x. Rep (JsonParsec a) x -> JsonParsec a
Generic)

instance Parsec a => FromJSON (JsonParsec a) where
  parseJSON :: Value -> Parser (JsonParsec a)
parseJSON Value
v = do
    String
raw <- Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    a -> JsonParsec a
forall a. a -> JsonParsec a
JsonParsec (a -> JsonParsec a) -> Parser a -> Parser (JsonParsec a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser a
forall a. Parsec a => String -> Parser a
aesonParsec String
raw

jsonParsec :: JsonParsec a -> a
jsonParsec :: forall a. JsonParsec a -> a
jsonParsec = JsonParsec a -> a
forall a b. Coercible a b => a -> b
coerce

foldMissing ::
  Monoid a =>
  FromJSON a =>
  Object ->
  Key ->
  Parser a
foldMissing :: forall a. (Monoid a, FromJSON a) => Object -> Key -> Parser a
foldMissing Object
o Key
k =
  Maybe a -> a
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe a -> a) -> Parser (Maybe a) -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe a)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
k

newtype JsonEither a b =
  JsonEither (Either a b)
  deriving stock (JsonEither a b -> JsonEither a b -> Bool
(JsonEither a b -> JsonEither a b -> Bool)
-> (JsonEither a b -> JsonEither a b -> Bool)
-> Eq (JsonEither a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
JsonEither a b -> JsonEither a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
JsonEither a b -> JsonEither a b -> Bool
== :: JsonEither a b -> JsonEither a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
JsonEither a b -> JsonEither a b -> Bool
/= :: JsonEither a b -> JsonEither a b -> Bool
Eq, Int -> JsonEither a b -> ShowS
[JsonEither a b] -> ShowS
JsonEither a b -> String
(Int -> JsonEither a b -> ShowS)
-> (JsonEither a b -> String)
-> ([JsonEither a b] -> ShowS)
-> Show (JsonEither a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> JsonEither a b -> ShowS
forall a b. (Show a, Show b) => [JsonEither a b] -> ShowS
forall a b. (Show a, Show b) => JsonEither a b -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> JsonEither a b -> ShowS
showsPrec :: Int -> JsonEither a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => JsonEither a b -> String
show :: JsonEither a b -> String
$cshowList :: forall a b. (Show a, Show b) => [JsonEither a b] -> ShowS
showList :: [JsonEither a b] -> ShowS
Show)

jsonEither :: JsonEither a b -> Either a b
jsonEither :: forall a b. JsonEither a b -> Either a b
jsonEither = JsonEither a b -> Either a b
forall a b. Coercible a b => a -> b
coerce

instance (FromJSON a, FromJSON b) => FromJSON (JsonEither a b) where
  parseJSON :: Value -> Parser (JsonEither a b)
parseJSON Value
v =
    Either a b -> JsonEither a b
forall a b. Either a b -> JsonEither a b
JsonEither (Either a b -> JsonEither a b)
-> Parser (Either a b) -> Parser (JsonEither a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Parser b -> Parser (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v) Parser (Either a b) -> Parser (Either a b) -> Parser (Either a b)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Parser a -> Parser (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v))