{-# LANGUAGE CPP               #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes        #-}
module Data.Aeson.Picker
  ( (|--)
  , (|-?)
  ) where

import           Control.Lens    (Traversal', (^?))
import           Data.Aeson      (FromJSON (..), Result (..), Value, fromJSON)
import           Data.Aeson.Lens (AsValue, key, _Value)
import           Data.Maybe      (fromMaybe)
import           Data.Text       (Text)

#if MIN_VERSION_aeson(2, 0, 0)
import qualified Data.Aeson.Key
#endif

-- | From given JSON and selectors returns typed field. If input JSON is not valid or selected field is not found then error is thrown.
-- If you need more safe way use '(|-?)' instead. Examples:
--
-- > ghci> "5" |-- [] :: Int
-- > 5
-- > ghci> "5" |-- [] :: Float
-- > 5.0
-- > ghci>"5" |-- [] :: String
-- > *** Exception: Data.Aeson.Picker: could not pick field with path: []
-- >
-- > ghci> :set -XOverloadedStrings
-- > ghci> "{\"a\": 5}" |-- ["a"] :: Int
-- > 5
-- > ghci> "{\"a\": 5}" |-- ["b"] :: Int
-- > *** Exception: Data.Aeson.Picker: could not pick field with path: ["b"]
-- > ghci> "{\"outer\": {\"inner\": [1,2,3]}}" |-- ["outer", "inner"] :: [Int]
-- > [1,2,3]
-- > ghci> {\"outer\": {\"inner\": [1,2,3]}}" |-- ["outer", "inner"] :: [Double]
-- > [1.0,2.0,3.0]
-- > ghci> "{a: 5}" |-- ["a"] :: Int
-- > *** Exception: Data.Aeson.Picker: input json is not valid
infix 5 |--
(|--) :: (AsValue t, FromJSON a) => t -> [Text] -> a
t
json |-- :: t -> [Text] -> a
|-- [Text]
selectors = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Aeson.Picker: could not pick field with path: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Text] -> [Char]
forall a. Show a => a -> [Char]
show [Text]
selectors) (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ t
json t -> [Text] -> Maybe a
forall t a. (AsValue t, FromJSON a) => t -> [Text] -> Maybe a
|-? [Text]
selectors

-- | From given JSON and selectors returns typed field inside 'Maybe'. If input JSON is not valid then error is thrown.
-- Examples:
--
-- > ghci> "5" |-? [] :: Maybe Int
-- > Just 5
-- > ghci> "5" |-? [] :: Maybe String
-- > Nothing
-- > ghci> "{\"a\": 5}" |-? ["a"] :: Maybe Int
-- > Just 5
-- > ghci> "{a: 5}" |-? ["a"] :: Maybe Int
-- > *** Exception: Data.Aeson.Picker: input json is not valid
infix 5 |-?
(|-?) :: (AsValue t, FromJSON a) => t -> [Text] -> Maybe a
t
json |-? :: t -> [Text] -> Maybe a
|-? [Text]
selectors = let validJSON :: t
validJSON = t -> t
forall t. AsValue t => t -> t
checkValidity t
json
                     in t -> [Text] -> Maybe Value
forall t. AsValue t => t -> [Text] -> Maybe Value
pick t
validJSON [Text]
selectors Maybe Value -> (Value -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe a
forall a. FromJSON a => Value -> Maybe a
convert

-- | Checks validity for JSON format. Throws error if it is not valid.
checkValidity :: AsValue t => t -> t
checkValidity :: t -> t
checkValidity t
json = Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Value
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Aeson.Picker: input json is not valid") (t
json t -> Getting (First Value) t Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Value) t Value
forall t. AsValue t => Prism' t Value
_Value) Value -> t -> t
`seq` t
json

-- | Picks from given JSON selected field
pick :: AsValue t => t -> [Text] -> Maybe Value
pick :: t -> [Text] -> Maybe Value
pick t
json []        = t
json t -> Getting (First Value) t Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Value) t Value
forall t. AsValue t => Prism' t Value
_Value
pick t
json [Text]
selectors = t
json t -> Getting (First Value) t Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? [Text] -> Traversal' t Value
forall t. AsValue t => [Text] -> Traversal' t Value
genGetter [Text]
selectors

-- | Converts from 'Value'
convert :: FromJSON a => Value -> Maybe a
convert :: Value -> Maybe a
convert Value
value = case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
value of
  Success a
r -> a -> Maybe a
forall a. a -> Maybe a
Just a
r
  Error [Char]
_   -> Maybe a
forall a. Maybe a
Nothing

-- | Generates getter from given selectors
genGetter :: AsValue t => [Text] -> Traversal' t Value
genGetter :: [Text] -> Traversal' t Value
genGetter []     = [Char] -> (Value -> f Value) -> t -> f t
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Aeson.Picker.Internal.Functions.genGetter: this should not be happened"
#if MIN_VERSION_aeson(2, 0, 0)
genGetter [Text
x]    = Key -> Traversal' t Value
forall t. AsValue t => Key -> Traversal' t Value
key (Text -> Key
Data.Aeson.Key.fromText Text
x)
genGetter (Text
x:[Text]
xs) = Key -> Traversal' t Value
forall t. AsValue t => Key -> Traversal' t Value
key (Text -> Key
Data.Aeson.Key.fromText Text
x) ((Value -> f Value) -> t -> f t)
-> ((Value -> f Value) -> Value -> f Value)
-> (Value -> f Value)
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Traversal' Value Value
forall t. AsValue t => [Text] -> Traversal' t Value
genGetter [Text]
xs
#else
genGetter [x]    = key x
genGetter (x:xs) = key x . genGetter xs
#endif