{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}

module Database.Bloodhound.Common.Script where

import Bloodhound.Import

import qualified Data.Aeson.KeyMap as KeyMap

import           Database.Bloodhound.Internal.Newtypes

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

type ScriptFieldValue = Value

data Script =
  Script { Script -> Maybe ScriptLanguage
scriptLanguage :: Maybe ScriptLanguage
         , Script -> Maybe ScriptInline
scriptInline   :: Maybe ScriptInline
         , Script -> Maybe ScriptId
scriptStored   :: Maybe ScriptId
         , Script -> Maybe ScriptParams
scriptParams   :: Maybe ScriptParams
         } deriving (Script -> Script -> Bool
(Script -> Script -> Bool)
-> (Script -> Script -> Bool) -> Eq Script
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Script -> Script -> Bool
== :: Script -> Script -> Bool
$c/= :: Script -> Script -> Bool
/= :: Script -> Script -> Bool
Eq, Int -> Script -> ShowS
[Script] -> ShowS
Script -> String
(Int -> Script -> ShowS)
-> (Script -> String) -> ([Script] -> ShowS) -> Show Script
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Script -> ShowS
showsPrec :: Int -> Script -> ShowS
$cshow :: Script -> String
show :: Script -> String
$cshowList :: [Script] -> ShowS
showList :: [Script] -> ShowS
Show)

newtype ScriptLanguage =
  ScriptLanguage Text deriving (ScriptLanguage -> ScriptLanguage -> Bool
(ScriptLanguage -> ScriptLanguage -> Bool)
-> (ScriptLanguage -> ScriptLanguage -> Bool) -> Eq ScriptLanguage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScriptLanguage -> ScriptLanguage -> Bool
== :: ScriptLanguage -> ScriptLanguage -> Bool
$c/= :: ScriptLanguage -> ScriptLanguage -> Bool
/= :: ScriptLanguage -> ScriptLanguage -> Bool
Eq, Int -> ScriptLanguage -> ShowS
[ScriptLanguage] -> ShowS
ScriptLanguage -> String
(Int -> ScriptLanguage -> ShowS)
-> (ScriptLanguage -> String)
-> ([ScriptLanguage] -> ShowS)
-> Show ScriptLanguage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptLanguage -> ShowS
showsPrec :: Int -> ScriptLanguage -> ShowS
$cshow :: ScriptLanguage -> String
show :: ScriptLanguage -> String
$cshowList :: [ScriptLanguage] -> ShowS
showList :: [ScriptLanguage] -> ShowS
Show, Value -> Parser [ScriptLanguage]
Value -> Parser ScriptLanguage
(Value -> Parser ScriptLanguage)
-> (Value -> Parser [ScriptLanguage]) -> FromJSON ScriptLanguage
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ScriptLanguage
parseJSON :: Value -> Parser ScriptLanguage
$cparseJSONList :: Value -> Parser [ScriptLanguage]
parseJSONList :: Value -> Parser [ScriptLanguage]
FromJSON, [ScriptLanguage] -> Value
[ScriptLanguage] -> Encoding
ScriptLanguage -> Value
ScriptLanguage -> Encoding
(ScriptLanguage -> Value)
-> (ScriptLanguage -> Encoding)
-> ([ScriptLanguage] -> Value)
-> ([ScriptLanguage] -> Encoding)
-> ToJSON ScriptLanguage
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ScriptLanguage -> Value
toJSON :: ScriptLanguage -> Value
$ctoEncoding :: ScriptLanguage -> Encoding
toEncoding :: ScriptLanguage -> Encoding
$ctoJSONList :: [ScriptLanguage] -> Value
toJSONList :: [ScriptLanguage] -> Value
$ctoEncodingList :: [ScriptLanguage] -> Encoding
toEncodingList :: [ScriptLanguage] -> Encoding
ToJSON)

newtype ScriptInline =
  ScriptInline Text deriving (ScriptInline -> ScriptInline -> Bool
(ScriptInline -> ScriptInline -> Bool)
-> (ScriptInline -> ScriptInline -> Bool) -> Eq ScriptInline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScriptInline -> ScriptInline -> Bool
== :: ScriptInline -> ScriptInline -> Bool
$c/= :: ScriptInline -> ScriptInline -> Bool
/= :: ScriptInline -> ScriptInline -> Bool
Eq, Int -> ScriptInline -> ShowS
[ScriptInline] -> ShowS
ScriptInline -> String
(Int -> ScriptInline -> ShowS)
-> (ScriptInline -> String)
-> ([ScriptInline] -> ShowS)
-> Show ScriptInline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptInline -> ShowS
showsPrec :: Int -> ScriptInline -> ShowS
$cshow :: ScriptInline -> String
show :: ScriptInline -> String
$cshowList :: [ScriptInline] -> ShowS
showList :: [ScriptInline] -> ShowS
Show, Value -> Parser [ScriptInline]
Value -> Parser ScriptInline
(Value -> Parser ScriptInline)
-> (Value -> Parser [ScriptInline]) -> FromJSON ScriptInline
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ScriptInline
parseJSON :: Value -> Parser ScriptInline
$cparseJSONList :: Value -> Parser [ScriptInline]
parseJSONList :: Value -> Parser [ScriptInline]
FromJSON, [ScriptInline] -> Value
[ScriptInline] -> Encoding
ScriptInline -> Value
ScriptInline -> Encoding
(ScriptInline -> Value)
-> (ScriptInline -> Encoding)
-> ([ScriptInline] -> Value)
-> ([ScriptInline] -> Encoding)
-> ToJSON ScriptInline
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ScriptInline -> Value
toJSON :: ScriptInline -> Value
$ctoEncoding :: ScriptInline -> Encoding
toEncoding :: ScriptInline -> Encoding
$ctoJSONList :: [ScriptInline] -> Value
toJSONList :: [ScriptInline] -> Value
$ctoEncodingList :: [ScriptInline] -> Encoding
toEncodingList :: [ScriptInline] -> Encoding
ToJSON)

newtype ScriptId =
  ScriptId Text deriving (ScriptId -> ScriptId -> Bool
(ScriptId -> ScriptId -> Bool)
-> (ScriptId -> ScriptId -> Bool) -> Eq ScriptId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScriptId -> ScriptId -> Bool
== :: ScriptId -> ScriptId -> Bool
$c/= :: ScriptId -> ScriptId -> Bool
/= :: ScriptId -> ScriptId -> Bool
Eq, Int -> ScriptId -> ShowS
[ScriptId] -> ShowS
ScriptId -> String
(Int -> ScriptId -> ShowS)
-> (ScriptId -> String) -> ([ScriptId] -> ShowS) -> Show ScriptId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptId -> ShowS
showsPrec :: Int -> ScriptId -> ShowS
$cshow :: ScriptId -> String
show :: ScriptId -> String
$cshowList :: [ScriptId] -> ShowS
showList :: [ScriptId] -> ShowS
Show, Value -> Parser [ScriptId]
Value -> Parser ScriptId
(Value -> Parser ScriptId)
-> (Value -> Parser [ScriptId]) -> FromJSON ScriptId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ScriptId
parseJSON :: Value -> Parser ScriptId
$cparseJSONList :: Value -> Parser [ScriptId]
parseJSONList :: Value -> Parser [ScriptId]
FromJSON, [ScriptId] -> Value
[ScriptId] -> Encoding
ScriptId -> Value
ScriptId -> Encoding
(ScriptId -> Value)
-> (ScriptId -> Encoding)
-> ([ScriptId] -> Value)
-> ([ScriptId] -> Encoding)
-> ToJSON ScriptId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ScriptId -> Value
toJSON :: ScriptId -> Value
$ctoEncoding :: ScriptId -> Encoding
toEncoding :: ScriptId -> Encoding
$ctoJSONList :: [ScriptId] -> Value
toJSONList :: [ScriptId] -> Value
$ctoEncodingList :: [ScriptId] -> Encoding
toEncodingList :: [ScriptId] -> Encoding
ToJSON)

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

type ScriptParamValue = Value

data BoostMode =
    BoostModeMultiply
  | BoostModeReplace
  | BoostModeSum
  | BoostModeAvg
  | BoostModeMax
  | BoostModeMin deriving (BoostMode -> BoostMode -> Bool
(BoostMode -> BoostMode -> Bool)
-> (BoostMode -> BoostMode -> Bool) -> Eq BoostMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoostMode -> BoostMode -> Bool
== :: BoostMode -> BoostMode -> Bool
$c/= :: BoostMode -> BoostMode -> Bool
/= :: BoostMode -> BoostMode -> Bool
Eq, Int -> BoostMode -> ShowS
[BoostMode] -> ShowS
BoostMode -> String
(Int -> BoostMode -> ShowS)
-> (BoostMode -> String)
-> ([BoostMode] -> ShowS)
-> Show BoostMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoostMode -> ShowS
showsPrec :: Int -> BoostMode -> ShowS
$cshow :: BoostMode -> String
show :: BoostMode -> String
$cshowList :: [BoostMode] -> ShowS
showList :: [BoostMode] -> ShowS
Show)

data ScoreMode =
    ScoreModeMultiply
  | ScoreModeSum
  | ScoreModeAvg
  | ScoreModeFirst
  | ScoreModeMax
  | ScoreModeMin deriving (ScoreMode -> ScoreMode -> Bool
(ScoreMode -> ScoreMode -> Bool)
-> (ScoreMode -> ScoreMode -> Bool) -> Eq ScoreMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScoreMode -> ScoreMode -> Bool
== :: ScoreMode -> ScoreMode -> Bool
$c/= :: ScoreMode -> ScoreMode -> Bool
/= :: ScoreMode -> ScoreMode -> Bool
Eq, Int -> ScoreMode -> ShowS
[ScoreMode] -> ShowS
ScoreMode -> String
(Int -> ScoreMode -> ShowS)
-> (ScoreMode -> String)
-> ([ScoreMode] -> ShowS)
-> Show ScoreMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScoreMode -> ShowS
showsPrec :: Int -> ScoreMode -> ShowS
$cshow :: ScoreMode -> String
show :: ScoreMode -> String
$cshowList :: [ScoreMode] -> ShowS
showList :: [ScoreMode] -> ShowS
Show)

data FunctionScoreFunction =
    FunctionScoreFunctionScript Script
  | FunctionScoreFunctionRandom Seed
  | FunctionScoreFunctionFieldValueFactor FieldValueFactor
  deriving (FunctionScoreFunction -> FunctionScoreFunction -> Bool
(FunctionScoreFunction -> FunctionScoreFunction -> Bool)
-> (FunctionScoreFunction -> FunctionScoreFunction -> Bool)
-> Eq FunctionScoreFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunctionScoreFunction -> FunctionScoreFunction -> Bool
== :: FunctionScoreFunction -> FunctionScoreFunction -> Bool
$c/= :: FunctionScoreFunction -> FunctionScoreFunction -> Bool
/= :: FunctionScoreFunction -> FunctionScoreFunction -> Bool
Eq, Int -> FunctionScoreFunction -> ShowS
[FunctionScoreFunction] -> ShowS
FunctionScoreFunction -> String
(Int -> FunctionScoreFunction -> ShowS)
-> (FunctionScoreFunction -> String)
-> ([FunctionScoreFunction] -> ShowS)
-> Show FunctionScoreFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunctionScoreFunction -> ShowS
showsPrec :: Int -> FunctionScoreFunction -> ShowS
$cshow :: FunctionScoreFunction -> String
show :: FunctionScoreFunction -> String
$cshowList :: [FunctionScoreFunction] -> ShowS
showList :: [FunctionScoreFunction] -> ShowS
Show)

newtype Weight =
  Weight Float deriving (Weight -> Weight -> Bool
(Weight -> Weight -> Bool)
-> (Weight -> Weight -> Bool) -> Eq Weight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Weight -> Weight -> Bool
== :: Weight -> Weight -> Bool
$c/= :: Weight -> Weight -> Bool
/= :: Weight -> Weight -> Bool
Eq, Int -> Weight -> ShowS
[Weight] -> ShowS
Weight -> String
(Int -> Weight -> ShowS)
-> (Weight -> String) -> ([Weight] -> ShowS) -> Show Weight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Weight -> ShowS
showsPrec :: Int -> Weight -> ShowS
$cshow :: Weight -> String
show :: Weight -> String
$cshowList :: [Weight] -> ShowS
showList :: [Weight] -> ShowS
Show, Value -> Parser [Weight]
Value -> Parser Weight
(Value -> Parser Weight)
-> (Value -> Parser [Weight]) -> FromJSON Weight
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Weight
parseJSON :: Value -> Parser Weight
$cparseJSONList :: Value -> Parser [Weight]
parseJSONList :: Value -> Parser [Weight]
FromJSON, [Weight] -> Value
[Weight] -> Encoding
Weight -> Value
Weight -> Encoding
(Weight -> Value)
-> (Weight -> Encoding)
-> ([Weight] -> Value)
-> ([Weight] -> Encoding)
-> ToJSON Weight
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Weight -> Value
toJSON :: Weight -> Value
$ctoEncoding :: Weight -> Encoding
toEncoding :: Weight -> Encoding
$ctoJSONList :: [Weight] -> Value
toJSONList :: [Weight] -> Value
$ctoEncodingList :: [Weight] -> Encoding
toEncodingList :: [Weight] -> Encoding
ToJSON)

newtype Seed =
  Seed Float deriving (Seed -> Seed -> Bool
(Seed -> Seed -> Bool) -> (Seed -> Seed -> Bool) -> Eq Seed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Seed -> Seed -> Bool
== :: Seed -> Seed -> Bool
$c/= :: Seed -> Seed -> Bool
/= :: Seed -> Seed -> Bool
Eq, Int -> Seed -> ShowS
[Seed] -> ShowS
Seed -> String
(Int -> Seed -> ShowS)
-> (Seed -> String) -> ([Seed] -> ShowS) -> Show Seed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Seed -> ShowS
showsPrec :: Int -> Seed -> ShowS
$cshow :: Seed -> String
show :: Seed -> String
$cshowList :: [Seed] -> ShowS
showList :: [Seed] -> ShowS
Show, Value -> Parser [Seed]
Value -> Parser Seed
(Value -> Parser Seed) -> (Value -> Parser [Seed]) -> FromJSON Seed
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Seed
parseJSON :: Value -> Parser Seed
$cparseJSONList :: Value -> Parser [Seed]
parseJSONList :: Value -> Parser [Seed]
FromJSON, [Seed] -> Value
[Seed] -> Encoding
Seed -> Value
Seed -> Encoding
(Seed -> Value)
-> (Seed -> Encoding)
-> ([Seed] -> Value)
-> ([Seed] -> Encoding)
-> ToJSON Seed
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Seed -> Value
toJSON :: Seed -> Value
$ctoEncoding :: Seed -> Encoding
toEncoding :: Seed -> Encoding
$ctoJSONList :: [Seed] -> Value
toJSONList :: [Seed] -> Value
$ctoEncodingList :: [Seed] -> Encoding
toEncodingList :: [Seed] -> Encoding
ToJSON)

data FieldValueFactor =
  FieldValueFactor { FieldValueFactor -> FieldName
fieldValueFactorField    :: FieldName
                   , FieldValueFactor -> Maybe Factor
fieldValueFactor         :: Maybe Factor
                   , FieldValueFactor -> Maybe FactorModifier
fieldValueFactorModifier :: Maybe FactorModifier
                   , FieldValueFactor -> Maybe FactorMissingFieldValue
fieldValueFactorMissing  :: Maybe FactorMissingFieldValue
                   } deriving (FieldValueFactor -> FieldValueFactor -> Bool
(FieldValueFactor -> FieldValueFactor -> Bool)
-> (FieldValueFactor -> FieldValueFactor -> Bool)
-> Eq FieldValueFactor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldValueFactor -> FieldValueFactor -> Bool
== :: FieldValueFactor -> FieldValueFactor -> Bool
$c/= :: FieldValueFactor -> FieldValueFactor -> Bool
/= :: FieldValueFactor -> FieldValueFactor -> Bool
Eq, Int -> FieldValueFactor -> ShowS
[FieldValueFactor] -> ShowS
FieldValueFactor -> String
(Int -> FieldValueFactor -> ShowS)
-> (FieldValueFactor -> String)
-> ([FieldValueFactor] -> ShowS)
-> Show FieldValueFactor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldValueFactor -> ShowS
showsPrec :: Int -> FieldValueFactor -> ShowS
$cshow :: FieldValueFactor -> String
show :: FieldValueFactor -> String
$cshowList :: [FieldValueFactor] -> ShowS
showList :: [FieldValueFactor] -> ShowS
Show)

newtype Factor =
  Factor Float deriving (Factor -> Factor -> Bool
(Factor -> Factor -> Bool)
-> (Factor -> Factor -> Bool) -> Eq Factor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Factor -> Factor -> Bool
== :: Factor -> Factor -> Bool
$c/= :: Factor -> Factor -> Bool
/= :: Factor -> Factor -> Bool
Eq, Int -> Factor -> ShowS
[Factor] -> ShowS
Factor -> String
(Int -> Factor -> ShowS)
-> (Factor -> String) -> ([Factor] -> ShowS) -> Show Factor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Factor -> ShowS
showsPrec :: Int -> Factor -> ShowS
$cshow :: Factor -> String
show :: Factor -> String
$cshowList :: [Factor] -> ShowS
showList :: [Factor] -> ShowS
Show, Value -> Parser [Factor]
Value -> Parser Factor
(Value -> Parser Factor)
-> (Value -> Parser [Factor]) -> FromJSON Factor
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Factor
parseJSON :: Value -> Parser Factor
$cparseJSONList :: Value -> Parser [Factor]
parseJSONList :: Value -> Parser [Factor]
FromJSON, [Factor] -> Value
[Factor] -> Encoding
Factor -> Value
Factor -> Encoding
(Factor -> Value)
-> (Factor -> Encoding)
-> ([Factor] -> Value)
-> ([Factor] -> Encoding)
-> ToJSON Factor
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Factor -> Value
toJSON :: Factor -> Value
$ctoEncoding :: Factor -> Encoding
toEncoding :: Factor -> Encoding
$ctoJSONList :: [Factor] -> Value
toJSONList :: [Factor] -> Value
$ctoEncodingList :: [Factor] -> Encoding
toEncodingList :: [Factor] -> Encoding
ToJSON)

data FactorModifier =
  FactorModifierNone
  | FactorModifierLog
  | FactorModifierLog1p
  | FactorModifierLog2p
  | FactorModifierLn
  | FactorModifierLn1p
  | FactorModifierLn2p
  | FactorModifierSquare
  | FactorModifierSqrt
  | FactorModifierReciprocal deriving (FactorModifier -> FactorModifier -> Bool
(FactorModifier -> FactorModifier -> Bool)
-> (FactorModifier -> FactorModifier -> Bool) -> Eq FactorModifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FactorModifier -> FactorModifier -> Bool
== :: FactorModifier -> FactorModifier -> Bool
$c/= :: FactorModifier -> FactorModifier -> Bool
/= :: FactorModifier -> FactorModifier -> Bool
Eq, Int -> FactorModifier -> ShowS
[FactorModifier] -> ShowS
FactorModifier -> String
(Int -> FactorModifier -> ShowS)
-> (FactorModifier -> String)
-> ([FactorModifier] -> ShowS)
-> Show FactorModifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FactorModifier -> ShowS
showsPrec :: Int -> FactorModifier -> ShowS
$cshow :: FactorModifier -> String
show :: FactorModifier -> String
$cshowList :: [FactorModifier] -> ShowS
showList :: [FactorModifier] -> ShowS
Show)

newtype FactorMissingFieldValue =
  FactorMissingFieldValue Float deriving (FactorMissingFieldValue -> FactorMissingFieldValue -> Bool
(FactorMissingFieldValue -> FactorMissingFieldValue -> Bool)
-> (FactorMissingFieldValue -> FactorMissingFieldValue -> Bool)
-> Eq FactorMissingFieldValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FactorMissingFieldValue -> FactorMissingFieldValue -> Bool
== :: FactorMissingFieldValue -> FactorMissingFieldValue -> Bool
$c/= :: FactorMissingFieldValue -> FactorMissingFieldValue -> Bool
/= :: FactorMissingFieldValue -> FactorMissingFieldValue -> Bool
Eq, Int -> FactorMissingFieldValue -> ShowS
[FactorMissingFieldValue] -> ShowS
FactorMissingFieldValue -> String
(Int -> FactorMissingFieldValue -> ShowS)
-> (FactorMissingFieldValue -> String)
-> ([FactorMissingFieldValue] -> ShowS)
-> Show FactorMissingFieldValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FactorMissingFieldValue -> ShowS
showsPrec :: Int -> FactorMissingFieldValue -> ShowS
$cshow :: FactorMissingFieldValue -> String
show :: FactorMissingFieldValue -> String
$cshowList :: [FactorMissingFieldValue] -> ShowS
showList :: [FactorMissingFieldValue] -> ShowS
Show, Value -> Parser [FactorMissingFieldValue]
Value -> Parser FactorMissingFieldValue
(Value -> Parser FactorMissingFieldValue)
-> (Value -> Parser [FactorMissingFieldValue])
-> FromJSON FactorMissingFieldValue
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser FactorMissingFieldValue
parseJSON :: Value -> Parser FactorMissingFieldValue
$cparseJSONList :: Value -> Parser [FactorMissingFieldValue]
parseJSONList :: Value -> Parser [FactorMissingFieldValue]
FromJSON, [FactorMissingFieldValue] -> Value
[FactorMissingFieldValue] -> Encoding
FactorMissingFieldValue -> Value
FactorMissingFieldValue -> Encoding
(FactorMissingFieldValue -> Value)
-> (FactorMissingFieldValue -> Encoding)
-> ([FactorMissingFieldValue] -> Value)
-> ([FactorMissingFieldValue] -> Encoding)
-> ToJSON FactorMissingFieldValue
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: FactorMissingFieldValue -> Value
toJSON :: FactorMissingFieldValue -> Value
$ctoEncoding :: FactorMissingFieldValue -> Encoding
toEncoding :: FactorMissingFieldValue -> Encoding
$ctoJSONList :: [FactorMissingFieldValue] -> Value
toJSONList :: [FactorMissingFieldValue] -> Value
$ctoEncodingList :: [FactorMissingFieldValue] -> Encoding
toEncodingList :: [FactorMissingFieldValue] -> Encoding
ToJSON)

instance ToJSON BoostMode where
  toJSON :: BoostMode -> Value
toJSON BoostMode
BoostModeMultiply = Value
"multiply"
  toJSON BoostMode
BoostModeReplace  = Value
"replace"
  toJSON BoostMode
BoostModeSum      = Value
"sum"
  toJSON BoostMode
BoostModeAvg      = Value
"avg"
  toJSON BoostMode
BoostModeMax      = Value
"max"
  toJSON BoostMode
BoostModeMin      = Value
"min"

instance FromJSON BoostMode where
  parseJSON :: Value -> Parser BoostMode
parseJSON = String -> (Text -> Parser BoostMode) -> Value -> Parser BoostMode
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"BoostMode" Text -> Parser BoostMode
forall {a} {f :: * -> *}.
(Eq a, IsString a, MonadFail f, Show a) =>
a -> f BoostMode
parse
    where parse :: a -> f BoostMode
parse a
"multiply" = BoostMode -> f BoostMode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BoostMode
BoostModeMultiply
          parse a
"replace"  = BoostMode -> f BoostMode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BoostMode
BoostModeReplace
          parse a
"sum"      = BoostMode -> f BoostMode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BoostMode
BoostModeSum
          parse a
"avg"      = BoostMode -> f BoostMode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BoostMode
BoostModeAvg
          parse a
"max"      = BoostMode -> f BoostMode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BoostMode
BoostModeMax
          parse a
"min"      = BoostMode -> f BoostMode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BoostMode
BoostModeMin
          parse a
bm         = String -> f BoostMode
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unexpected BoostMode: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
bm)

instance ToJSON ScoreMode where
  toJSON :: ScoreMode -> Value
toJSON ScoreMode
ScoreModeMultiply = Value
"multiply"
  toJSON ScoreMode
ScoreModeSum      = Value
"sum"
  toJSON ScoreMode
ScoreModeFirst    = Value
"first"
  toJSON ScoreMode
ScoreModeAvg      = Value
"avg"
  toJSON ScoreMode
ScoreModeMax      = Value
"max"
  toJSON ScoreMode
ScoreModeMin      = Value
"min"

instance FromJSON ScoreMode where
  parseJSON :: Value -> Parser ScoreMode
parseJSON = String -> (Text -> Parser ScoreMode) -> Value -> Parser ScoreMode
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ScoreMode" Text -> Parser ScoreMode
forall {a} {f :: * -> *}.
(Eq a, IsString a, MonadFail f, Show a) =>
a -> f ScoreMode
parse
    where parse :: a -> f ScoreMode
parse a
"multiply" = ScoreMode -> f ScoreMode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScoreMode
ScoreModeMultiply
          parse a
"sum"      = ScoreMode -> f ScoreMode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScoreMode
ScoreModeSum
          parse a
"first"    = ScoreMode -> f ScoreMode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScoreMode
ScoreModeFirst
          parse a
"avg"      = ScoreMode -> f ScoreMode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScoreMode
ScoreModeAvg
          parse a
"max"      = ScoreMode -> f ScoreMode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScoreMode
ScoreModeMax
          parse a
"min"      = ScoreMode -> f ScoreMode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScoreMode
ScoreModeMin
          parse a
sm         = String -> f ScoreMode
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unexpected ScoreMode: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
sm)

functionScoreFunctionPair :: FunctionScoreFunction -> (Key, Value)
functionScoreFunctionPair :: FunctionScoreFunction -> (Key, Value)
functionScoreFunctionPair (FunctionScoreFunctionScript Script
functionScoreScript) =
  (Key
"script_score", Script -> Value
forall a. ToJSON a => a -> Value
toJSON Script
functionScoreScript)
functionScoreFunctionPair (FunctionScoreFunctionRandom Seed
seed) =
  (Key
"random_score", [(Key, Value)] -> Value
omitNulls [ Key
"seed" Key -> Seed -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Seed
seed ])
functionScoreFunctionPair (FunctionScoreFunctionFieldValueFactor FieldValueFactor
fvf) =
  (Key
"field_value_factor", FieldValueFactor -> Value
forall a. ToJSON a => a -> Value
toJSON FieldValueFactor
fvf)

parseFunctionScoreFunction :: Object -> Parser FunctionScoreFunction
parseFunctionScoreFunction :: Object -> Parser FunctionScoreFunction
parseFunctionScoreFunction Object
o =
  Script -> Parser FunctionScoreFunction
singleScript (Script -> Parser FunctionScoreFunction)
-> Key -> Parser FunctionScoreFunction
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"script_score"
  Parser FunctionScoreFunction
-> Parser FunctionScoreFunction -> Parser FunctionScoreFunction
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object -> Parser FunctionScoreFunction
singleRandom (Object -> Parser FunctionScoreFunction)
-> Key -> Parser FunctionScoreFunction
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"random_score"
  Parser FunctionScoreFunction
-> Parser FunctionScoreFunction -> Parser FunctionScoreFunction
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FieldValueFactor -> Parser FunctionScoreFunction
singleFieldValueFactor (FieldValueFactor -> Parser FunctionScoreFunction)
-> Key -> Parser FunctionScoreFunction
forall {a} {b}. FromJSON a => (a -> Parser b) -> Key -> Parser b
`taggedWith` Key
"field_value_factor"
  where taggedWith :: (a -> Parser b) -> Key -> Parser b
taggedWith a -> Parser b
parser Key
k = a -> Parser b
parser (a -> Parser b) -> Parser a -> Parser b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
k
        singleScript :: Script -> Parser FunctionScoreFunction
singleScript = FunctionScoreFunction -> Parser FunctionScoreFunction
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FunctionScoreFunction -> Parser FunctionScoreFunction)
-> (Script -> FunctionScoreFunction)
-> Script
-> Parser FunctionScoreFunction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> FunctionScoreFunction
FunctionScoreFunctionScript
        singleRandom :: Object -> Parser FunctionScoreFunction
singleRandom Object
o' = Seed -> FunctionScoreFunction
FunctionScoreFunctionRandom (Seed -> FunctionScoreFunction)
-> Parser Seed -> Parser FunctionScoreFunction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o' Object -> Key -> Parser Seed
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"seed"
        singleFieldValueFactor :: FieldValueFactor -> Parser FunctionScoreFunction
singleFieldValueFactor = FunctionScoreFunction -> Parser FunctionScoreFunction
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FunctionScoreFunction -> Parser FunctionScoreFunction)
-> (FieldValueFactor -> FunctionScoreFunction)
-> FieldValueFactor
-> Parser FunctionScoreFunction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldValueFactor -> FunctionScoreFunction
FunctionScoreFunctionFieldValueFactor

instance ToJSON ScriptFields where
  toJSON :: ScriptFields -> Value
toJSON (ScriptFields Object
x) = Object -> Value
Object Object
x

instance FromJSON ScriptFields where
  parseJSON :: Value -> Parser ScriptFields
parseJSON (Object Object
o) = ScriptFields -> Parser ScriptFields
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> ScriptFields
ScriptFields Object
o)
  parseJSON Value
_          = String -> Parser ScriptFields
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"error parsing ScriptFields"

instance ToJSON Script where
  toJSON :: Script -> Value
toJSON (Script Maybe ScriptLanguage
lang Maybe ScriptInline
inline Maybe ScriptId
stored Maybe ScriptParams
params) =
    [(Key, Value)] -> Value
object [ Key
"script" Key -> Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= [(Key, Value)] -> Value
omitNulls [(Key, Value)]
base ]
    where base :: [(Key, Value)]
base = [ Key
"lang"   Key -> Maybe ScriptLanguage -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe ScriptLanguage
lang
                 , Key
"inline" Key -> Maybe ScriptInline -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe ScriptInline
inline
                 , Key
"stored" Key -> Maybe ScriptId -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe ScriptId
stored
                 , Key
"params" Key -> Maybe ScriptParams -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe ScriptParams
params ]

instance FromJSON Script where
  parseJSON :: Value -> Parser Script
parseJSON = String -> (Object -> Parser Script) -> Value -> Parser Script
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Script" Object -> Parser Script
parse
    where parse :: Object -> Parser Script
parse Object
o = Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"script" Parser Object -> (Object -> Parser Script) -> Parser Script
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Object
o' ->
                      Maybe ScriptLanguage
-> Maybe ScriptInline
-> Maybe ScriptId
-> Maybe ScriptParams
-> Script
Script
                      (Maybe ScriptLanguage
 -> Maybe ScriptInline
 -> Maybe ScriptId
 -> Maybe ScriptParams
 -> Script)
-> Parser (Maybe ScriptLanguage)
-> Parser
     (Maybe ScriptInline
      -> Maybe ScriptId -> Maybe ScriptParams -> Script)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o' Object -> Key -> Parser (Maybe ScriptLanguage)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lang"
                      Parser
  (Maybe ScriptInline
   -> Maybe ScriptId -> Maybe ScriptParams -> Script)
-> Parser (Maybe ScriptInline)
-> Parser (Maybe ScriptId -> Maybe ScriptParams -> Script)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o' Object -> Key -> Parser (Maybe ScriptInline)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"inline"
                      Parser (Maybe ScriptId -> Maybe ScriptParams -> Script)
-> Parser (Maybe ScriptId) -> Parser (Maybe ScriptParams -> Script)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o' Object -> Key -> Parser (Maybe ScriptId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"stored"
                      Parser (Maybe ScriptParams -> Script)
-> Parser (Maybe ScriptParams) -> Parser Script
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o' Object -> Key -> Parser (Maybe ScriptParams)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params"

instance ToJSON ScriptParams where
  toJSON :: ScriptParams -> Value
toJSON (ScriptParams Object
x) = Object -> Value
Object Object
x

instance FromJSON ScriptParams where
  parseJSON :: Value -> Parser ScriptParams
parseJSON (Object Object
o) = ScriptParams -> Parser ScriptParams
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> ScriptParams
ScriptParams Object
o)
  parseJSON Value
_          = String -> Parser ScriptParams
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"error parsing ScriptParams"

instance ToJSON FieldValueFactor where
  toJSON :: FieldValueFactor -> Value
toJSON (FieldValueFactor FieldName
field Maybe Factor
factor Maybe FactorModifier
modifier Maybe FactorMissingFieldValue
missing) =
    [(Key, Value)] -> Value
omitNulls [(Key, Value)]
base
    where base :: [(Key, Value)]
base = [ Key
"field"    Key -> FieldName -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= FieldName
field
                 , Key
"factor"   Key -> Maybe Factor -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Factor
factor
                 , Key
"modifier" Key -> Maybe FactorModifier -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe FactorModifier
modifier
                 , Key
"missing"  Key -> Maybe FactorMissingFieldValue -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe FactorMissingFieldValue
missing ]

instance FromJSON FieldValueFactor where
  parseJSON :: Value -> Parser FieldValueFactor
parseJSON = String
-> (Object -> Parser FieldValueFactor)
-> Value
-> Parser FieldValueFactor
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FieldValueFactor" Object -> Parser FieldValueFactor
parse
    where parse :: Object -> Parser FieldValueFactor
parse Object
o = FieldName
-> Maybe Factor
-> Maybe FactorModifier
-> Maybe FactorMissingFieldValue
-> FieldValueFactor
FieldValueFactor
                    (FieldName
 -> Maybe Factor
 -> Maybe FactorModifier
 -> Maybe FactorMissingFieldValue
 -> FieldValueFactor)
-> Parser FieldName
-> Parser
     (Maybe Factor
      -> Maybe FactorModifier
      -> Maybe FactorMissingFieldValue
      -> FieldValueFactor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser FieldName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"field"
                    Parser
  (Maybe Factor
   -> Maybe FactorModifier
   -> Maybe FactorMissingFieldValue
   -> FieldValueFactor)
-> Parser (Maybe Factor)
-> Parser
     (Maybe FactorModifier
      -> Maybe FactorMissingFieldValue -> FieldValueFactor)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Factor)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"factor"
                    Parser
  (Maybe FactorModifier
   -> Maybe FactorMissingFieldValue -> FieldValueFactor)
-> Parser (Maybe FactorModifier)
-> Parser (Maybe FactorMissingFieldValue -> FieldValueFactor)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe FactorModifier)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"modifier"
                    Parser (Maybe FactorMissingFieldValue -> FieldValueFactor)
-> Parser (Maybe FactorMissingFieldValue)
-> Parser FieldValueFactor
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe FactorMissingFieldValue)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"missing"

instance ToJSON FactorModifier where
  toJSON :: FactorModifier -> Value
toJSON FactorModifier
FactorModifierNone       = Value
"none"
  toJSON FactorModifier
FactorModifierLog        = Value
"log"
  toJSON FactorModifier
FactorModifierLog1p      = Value
"log1p"
  toJSON FactorModifier
FactorModifierLog2p      = Value
"log2p"
  toJSON FactorModifier
FactorModifierLn         = Value
"ln"
  toJSON FactorModifier
FactorModifierLn1p       = Value
"ln1p"
  toJSON FactorModifier
FactorModifierLn2p       = Value
"ln2p"
  toJSON FactorModifier
FactorModifierSquare     = Value
"square"
  toJSON FactorModifier
FactorModifierSqrt       = Value
"sqrt"
  toJSON FactorModifier
FactorModifierReciprocal = Value
"reciprocal"

instance FromJSON FactorModifier where
  parseJSON :: Value -> Parser FactorModifier
parseJSON = String
-> (Text -> Parser FactorModifier)
-> Value
-> Parser FactorModifier
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"FactorModifier" Text -> Parser FactorModifier
forall {a} {f :: * -> *}.
(Eq a, IsString a, MonadFail f, Show a) =>
a -> f FactorModifier
parse
    where parse :: a -> f FactorModifier
parse a
"none"       = FactorModifier -> f FactorModifier
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FactorModifier
FactorModifierNone
          parse a
"log"        = FactorModifier -> f FactorModifier
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FactorModifier
FactorModifierLog
          parse a
"log1p"      = FactorModifier -> f FactorModifier
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FactorModifier
FactorModifierLog1p
          parse a
"log2p"      = FactorModifier -> f FactorModifier
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FactorModifier
FactorModifierLog2p
          parse a
"ln"         = FactorModifier -> f FactorModifier
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FactorModifier
FactorModifierLn
          parse a
"ln1p"       = FactorModifier -> f FactorModifier
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FactorModifier
FactorModifierLn1p
          parse a
"ln2p"       = FactorModifier -> f FactorModifier
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FactorModifier
FactorModifierLn2p
          parse a
"square"     = FactorModifier -> f FactorModifier
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FactorModifier
FactorModifierSquare
          parse a
"sqrt"       = FactorModifier -> f FactorModifier
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FactorModifier
FactorModifierSqrt
          parse a
"reciprocal" = FactorModifier -> f FactorModifier
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FactorModifier
FactorModifierReciprocal
          parse a
fm           = String -> f FactorModifier
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unexpected FactorModifier: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
fm)