module AesonDecode
  (
      {- * Decoder -}
          Decoder (..), constDecoder, constSuccessDecoder, failDecoder,
          mapDecoder, apDecoder, composeDecoderFunctions, orElse,
          defaultDecoder, is, (^?),
      {- * Path -} Path (..), here, stringPath, textPath, at, only,
      {- * Text -} text, textIs,
      {- * Integer -} integer, integerIs,
      {- * Boolean -} bool, boolIs, true, false,
      {- * List -} listOf,
      {- * Vector -} vectorOf,
      {- * Ord map -} ordMapOf,
      {- * Hash map -} hashMapOf,
      {- * Null -} null, nullable,
  )
   where

import Essentials

import Control.Applicative (Alternative ((<|>), empty))
import Control.Monad (guard)
import Data.Aeson (FromJSON, Value (Object, Array, Null))
import Data.Default.Class (Default (def))
import Data.Foldable (toList)
import Data.HashMap.Lazy (HashMap)
import Data.Map (Map)
import Data.String (IsString (fromString), String)
import Data.Text (Text)
import Data.Vector (Vector)
import Prelude (Integer)

import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.Aeson.Types as Aeson
import qualified Data.HashMap.Lazy as HashMap
import qualified Data.Map as Map
import qualified Data.Text as Text

(^?) :: Value -> Decoder a -> Maybe a
Value
val ^? :: forall a. Value -> Decoder a -> Maybe a
^? Decoder Value -> Maybe a
f = Value -> Maybe a
f Value
val
infixl 8 ^?


--------------------------------------------------------------------------------
--  Decoder
--------------------------------------------------------------------------------

{-| Some way of interpreting a JSON value, with the
    possibility of failure for some values -}
newtype Decoder a = Decoder { forall a. Decoder a -> Value -> Maybe a
decodeMaybe :: Value -> Maybe a }

{-| @'fmap' = 'mapDecoder'@ -}
instance Functor Decoder where
    fmap :: forall a b. (a -> b) -> Decoder a -> Decoder b
fmap = forall a b. (a -> b) -> Decoder a -> Decoder b
mapDecoder

{-| @'pure' = 'constSuccessDecoder'@, @'<*>' = 'apDecoder'@ -}
instance Applicative Decoder where
    pure :: forall a. a -> Decoder a
pure = forall a. a -> Decoder a
constSuccessDecoder
    <*> :: forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
(<*>) = forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
apDecoder

{-| @'>=>' = 'composeDecoderFunctions'@ -}
instance Monad Decoder where
    Decoder a
d >>= :: forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
>>= a -> Decoder b
f = forall b c a.
(b -> Decoder c) -> (a -> Decoder b) -> a -> Decoder c
composeDecoderFunctions a -> Decoder b
f (\()
_ -> Decoder a
d) ()

{-| @'empty' = 'failDecoder'@, @'<|>' = 'orElse'@ -}
instance Alternative Decoder where
    empty :: forall a. Decoder a
empty = forall a. Decoder a
failDecoder
    <|> :: forall a. Decoder a -> Decoder a -> Decoder a
(<|>) = forall a. Decoder a -> Decoder a -> Decoder a
orElse

{-| @'def' = 'defaultDecoder'@ -}
instance FromJSON a => Default (Decoder a) where
    def :: Decoder a
def = forall a. FromJSON a => Decoder a
defaultDecoder

{- | Always produces the same result -}
constDecoder
  :: Maybe a    -- ^ The result that the decoder always produces
  -> Decoder a  -- ^ A decoder that always produces the given result
constDecoder :: forall a. Maybe a -> Decoder a
constDecoder Maybe a
x = forall a. (Value -> Maybe a) -> Decoder a
Decoder (\Value
_ -> Maybe a
x)

{-| Always succeeds and produces the same result -}
constSuccessDecoder :: a -> Decoder a
constSuccessDecoder :: forall a. a -> Decoder a
constSuccessDecoder a
x = forall a. Maybe a -> Decoder a
constDecoder (forall a. a -> Maybe a
Just a
x)

{-| Always fails

This is the identity of the 'Alternative' for 'Decoder'. -}
failDecoder :: Decoder a
failDecoder :: forall a. Decoder a
failDecoder = forall a. Maybe a -> Decoder a
constDecoder forall a. Maybe a
Nothing

mapDecoder :: (a -> b) -> Decoder a -> Decoder b
mapDecoder :: forall a b. (a -> b) -> Decoder a -> Decoder b
mapDecoder a -> b
f (Decoder Value -> Maybe a
d) = forall a. (Value -> Maybe a) -> Decoder a
Decoder ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f Value -> Maybe a
d)

apDecoder :: Decoder (a -> b) -> Decoder a -> Decoder b
apDecoder :: forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
apDecoder (Decoder Value -> Maybe (a -> b)
ff) (Decoder Value -> Maybe a
fx) = forall a. (Value -> Maybe a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
v ->
  Value -> Maybe (a -> b)
ff Value
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a -> b
f -> Value -> Maybe a
fx Value
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> forall a. a -> Maybe a
Just (a -> b
f a
x)

{-| Compose two decoder-producing functions -}
composeDecoderFunctions
  :: (b -> Decoder c)
  -> (a -> Decoder b)
  -> (a -> Decoder c)
composeDecoderFunctions :: forall b c a.
(b -> Decoder c) -> (a -> Decoder b) -> a -> Decoder c
composeDecoderFunctions b -> Decoder c
f a -> Decoder b
g a
a =
  forall a. (Value -> Maybe a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
v ->
    case forall a. Decoder a -> Value -> Maybe a
decodeMaybe (a -> Decoder b
g a
a) Value
v of
      Maybe b
Nothing -> forall a. Maybe a
Nothing
      Just b
b -> forall a. Decoder a -> Value -> Maybe a
decodeMaybe (b -> Decoder c
f b
b) Value
v

orElse :: Decoder a -> Decoder a -> Decoder a
orElse :: forall a. Decoder a -> Decoder a -> Decoder a
orElse (Decoder Value -> Maybe a
a) (Decoder Value -> Maybe a
b) = forall a. (Value -> Maybe a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
v ->
  Value -> Maybe a
a Value
v forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Maybe a
b Value
v

defaultDecoder :: FromJSON a => Decoder a
defaultDecoder :: forall a. FromJSON a => Decoder a
defaultDecoder = forall a. (Value -> Maybe a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \Value
v -> forall a b. (a -> Parser b) -> a -> Maybe b
Aeson.parseMaybe forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
v

{-| @'is' x@ produces @'Just' ()@ if the JSON value decodes to @x@,
    or 'Nothing' otherwise -}
is :: (Eq a, FromJSON a) => a -> Decoder ()
is :: forall a. (Eq a, FromJSON a) => a -> Decoder ()
is a
x = forall a. FromJSON a => Decoder a
defaultDecoder forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
y -> forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
x forall a. Eq a => a -> a -> Bool
== a
y)


--------------------------------------------------------------------------------
--  Path
--------------------------------------------------------------------------------

newtype Path = Path { Path -> Value -> Maybe Value
getAt :: Value -> Maybe Value }

{-| '<>' = 'pathConcat'@ -}
instance Semigroup Path where
    <> :: Path -> Path -> Path
(<>) = Path -> Path -> Path
pathConcat

{-| @'mempty' = 'here'@ -}
instance Monoid Path where
    mempty :: Path
mempty = Path
here

{-| @'fromString' = 'stringPath'@ -}
instance IsString Path where
    fromString :: String -> Path
fromString = String -> Path
stringPath

{-| The empty path

This is the identity of the 'Monoid' for 'Path'. -}
here :: Path
here :: Path
here = (Value -> Maybe Value) -> Path
Path forall a. a -> Maybe a
Just

stringPath :: String -> Path
stringPath :: String -> Path
stringPath String
x = Text -> Path
textPath (String -> Text
Text.pack String
x)

textPath :: Text -> Path
textPath :: Text -> Path
textPath Text
x = (Value -> Maybe Value) -> Path
Path forall a b. (a -> b) -> a -> b
$ \case
    Object Object
m -> forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (Text -> Key
Key.fromText Text
x) Object
m
    Value
_ -> forall a. Maybe a
Nothing

pathConcat :: Path -> Path -> Path
pathConcat :: Path -> Path -> Path
pathConcat (Path Value -> Maybe Value
a) (Path Value -> Maybe Value
b) = (Value -> Maybe Value) -> Path
Path (Value -> Maybe Value
a forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Value -> Maybe Value
b)

at :: Path -> Decoder a -> Decoder a
at :: forall a. Path -> Decoder a -> Decoder a
at (Path Value -> Maybe Value
f1) (Decoder Value -> Maybe a
f2) = forall a. (Value -> Maybe a) -> Decoder a
Decoder (Value -> Maybe Value
f1 forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Value -> Maybe a
f2)

{-| Selects the only element from an array of length 1 -}
only :: Path
only :: Path
only = (Value -> Maybe Value) -> Path
Path forall a b. (a -> b) -> a -> b
$ \case
  Array (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList -> [Value
x]) -> forall a. a -> Maybe a
Just Value
x
  Value
_ -> forall a. Maybe a
Nothing


--------------------------------------------------------------------------------
--  Text
--------------------------------------------------------------------------------

{-| @'Just' ()@ if the JSON value is the value @null@, 'Nothing' otherwise -}
null :: Decoder ()
null :: Decoder ()
null = forall a. (Value -> Maybe a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \case
  Value
Null -> forall a. a -> Maybe a
Just ()
  Value
_ -> forall a. Maybe a
Nothing

{- | Succeeds with @'Just' x@ if the decoder @d@ succeeds with value @x@,
     succeeds with 'Nothing' if the JSON value is null, fails otherwise -}
nullable :: Decoder a -> Decoder (Maybe a)
nullable :: forall a. Decoder a -> Decoder (Maybe a)
nullable Decoder a
d = (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder a
d) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Decoder ()
null)


--------------------------------------------------------------------------------
--  Text
--------------------------------------------------------------------------------

{-| Decodes a JSON string as 'Text' -}
text :: Decoder Text
text :: Decoder Text
text = forall a. FromJSON a => Decoder a
defaultDecoder

{-| @'Just' ()@ if the JSON value is the given string, 'Nothing' otherwise -}
textIs :: Text -> Decoder ()
textIs :: Text -> Decoder ()
textIs = forall a. (Eq a, FromJSON a) => a -> Decoder ()
is


--------------------------------------------------------------------------------
--  Integer
--------------------------------------------------------------------------------

{-| Decodes a JSON number as an 'Integer' -}
integer :: Decoder Integer
integer :: Decoder Integer
integer = forall a. FromJSON a => Decoder a
defaultDecoder

{- | @'Just' ()@ if the JSON value is the given integer, 'Nothing' otherwise -}
integerIs :: Integer -> Decoder ()
integerIs :: Integer -> Decoder ()
integerIs = forall a. (Eq a, FromJSON a) => a -> Decoder ()
is


--------------------------------------------------------------------------------
--  Boolean
--------------------------------------------------------------------------------

{-| Decodes a JSON boolean as a 'Bool' -}
bool :: Decoder Bool
bool :: Decoder Bool
bool = forall a. FromJSON a => Decoder a
defaultDecoder

{-| @'Just' ()@ if the JSON value is the given boolean, 'Nothing' otherwise -}
boolIs :: Bool -> Decoder ()
boolIs :: Bool -> Decoder ()
boolIs = forall a. (Eq a, FromJSON a) => a -> Decoder ()
is

{-| @'Just' ()@ if the JSON value is @true@, 'Nothing' otherwise -}
true :: Decoder ()
true :: Decoder ()
true = forall a. (Eq a, FromJSON a) => a -> Decoder ()
is Bool
True

{-| @'Just' ()@ if the JSON value is @false@, 'Nothing' otherwise -}
false :: Decoder ()
false :: Decoder ()
false = forall a. (Eq a, FromJSON a) => a -> Decoder ()
is Bool
False


--------------------------------------------------------------------------------
--  Vector
--------------------------------------------------------------------------------

vectorOf :: Decoder a -> Decoder (Vector a)
vectorOf :: forall a. Decoder a -> Decoder (Vector a)
vectorOf Decoder a
d = forall a. (Value -> Maybe a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \case
  Array Array
xs -> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a. Decoder a -> Value -> Maybe a
decodeMaybe Decoder a
d) Array
xs
  Value
_ -> forall a. Maybe a
Nothing


--------------------------------------------------------------------------------
--  List
--------------------------------------------------------------------------------

listOf :: Decoder a -> Decoder [a]
listOf :: forall a. Decoder a -> Decoder [a]
listOf Decoder a
d = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Decoder a -> Decoder (Vector a)
vectorOf Decoder a
d


--------------------------------------------------------------------------------
--  Hash map
--------------------------------------------------------------------------------

hashMapOf :: Decoder a -> Decoder (HashMap Text a)
hashMapOf :: forall a. Decoder a -> Decoder (HashMap Text a)
hashMapOf Decoder a
d = forall a. (Value -> Maybe a) -> Decoder a
Decoder forall a b. (a -> b) -> a -> b
$ \case
    Object Object
xs -> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a. Decoder a -> Value -> Maybe a
decodeMaybe Decoder a
d) Object
xs forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText
    Value
_ -> forall a. Maybe a
Nothing


--------------------------------------------------------------------------------
--  Ord map
--------------------------------------------------------------------------------

ordMapOf :: Decoder a -> Decoder (Map Text a)
ordMapOf :: forall a. Decoder a -> Decoder (Map Text a)
ordMapOf Decoder a
d = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall k v. HashMap k v -> [(k, v)]
HashMap.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Decoder a -> Decoder (HashMap Text a)
hashMapOf Decoder a
d