{-# LANGUAGE OverloadedStrings #-}

module Database.Bloodhound.Internal.StringlyTyped where

import           Bloodhound.Import

import qualified Data.Text     as T


-- This whole module is a sin bucket to deal with Elasticsearch badness.
newtype StringlyTypedDouble = StringlyTypedDouble
  { StringlyTypedDouble -> Double
unStringlyTypedDouble :: Double }

instance FromJSON StringlyTypedDouble where
  parseJSON :: Value -> Parser StringlyTypedDouble
parseJSON =
      (Double -> StringlyTypedDouble)
-> Parser Double -> Parser StringlyTypedDouble
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> StringlyTypedDouble
StringlyTypedDouble
    (Parser Double -> Parser StringlyTypedDouble)
-> (Value -> Parser Double) -> Value -> Parser StringlyTypedDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Double
forall a. FromJSON a => Value -> Parser a
parseJSON
    (Value -> Parser Double)
-> (Value -> Value) -> Value -> Parser Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value
unStringlyTypeJSON

newtype StringlyTypedInt = StringlyTypedInt
  { StringlyTypedInt -> Int
unStringlyTypedInt :: Int }

instance FromJSON StringlyTypedInt where
  parseJSON :: Value -> Parser StringlyTypedInt
parseJSON =
      (Int -> StringlyTypedInt) -> Parser Int -> Parser StringlyTypedInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> StringlyTypedInt
StringlyTypedInt
    (Parser Int -> Parser StringlyTypedInt)
-> (Value -> Parser Int) -> Value -> Parser StringlyTypedInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON
    (Value -> Parser Int) -> (Value -> Value) -> Value -> Parser Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value
unStringlyTypeJSON

newtype StringlyTypedBool = StringlyTypedBool { StringlyTypedBool -> Bool
unStringlyTypedBool :: Bool }

instance FromJSON StringlyTypedBool where
  parseJSON :: Value -> Parser StringlyTypedBool
parseJSON =
      (Bool -> StringlyTypedBool)
-> Parser Bool -> Parser StringlyTypedBool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> StringlyTypedBool
StringlyTypedBool
    (Parser Bool -> Parser StringlyTypedBool)
-> (Value -> Parser Bool) -> Value -> Parser StringlyTypedBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Bool
forall a. FromJSON a => Value -> Parser a
parseJSON
    (Value -> Parser Bool) -> (Value -> Value) -> Value -> Parser Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value
unStringlyTypeJSON

-- | For some reason in several settings APIs, all leaf values get returned
-- as strings. This function attempts to recover from this for all
-- non-recursive JSON types. If nothing can be done, the value is left alone.
unStringlyTypeJSON :: Value -> Value
unStringlyTypeJSON :: Value -> Value
unStringlyTypeJSON (String Text
"true") =
  Bool -> Value
Bool Bool
True
unStringlyTypeJSON (String Text
"false") =
  Bool -> Value
Bool Bool
False
unStringlyTypeJSON (String Text
"null") =
  Value
Null
unStringlyTypeJSON v :: Value
v@(String Text
t) =
  case String -> Maybe Scientific
forall a. Read a => String -> Maybe a
readMay (Text -> String
T.unpack Text
t) of
    Just Scientific
n  -> Scientific -> Value
Number Scientific
n
    Maybe Scientific
Nothing -> Value
v
unStringlyTypeJSON Value
v = Value
v