{-# 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 =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> StringlyTypedDouble
StringlyTypedDouble
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON
      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 =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> StringlyTypedInt
StringlyTypedInt
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON
      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 =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> StringlyTypedBool
StringlyTypedBool
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON
      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 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