{-# LANGUAGE OverloadedStrings #-}

module Database.Bloodhound.Internal.Versions.Common.Types.Query.CommonTerms
  ( CommonMinimumMatch (..),
    CommonTermsQuery (..),
    MinimumMatchHighLow (..),

    -- * Optics
    commonTermsQueryFieldLens,
    commonTermsQueryQueryLens,
    commonTermsQueryCutoffFrequencyLens,
    commonTermsQueryLowFreqOperatorLens,
    commonTermsQueryHighFreqOperatorLens,
    commonTermsQueryMinimumShouldMatchLens,
    commonTermsQueryBoostLens,
    commonTermsQueryAnalyzerLens,
    commonTermsQueryDisableCoordLens,
    commonMinimumMatchHighLowPrism,
    commonMinimumMatchPrism,
    minimumMatchHighLowLowFreqLens,
    minimumMatchHighLowHighFreqLens,
  )
where

import Database.Bloodhound.Internal.Utils.Imports
import Database.Bloodhound.Internal.Versions.Common.Types.Newtypes
import Database.Bloodhound.Internal.Versions.Common.Types.Query.Commons
import GHC.Generics

data CommonTermsQuery = CommonTermsQuery
  { CommonTermsQuery -> FieldName
commonField :: FieldName,
    CommonTermsQuery -> QueryString
commonQuery :: QueryString,
    CommonTermsQuery -> CutoffFrequency
commonCutoffFrequency :: CutoffFrequency,
    CommonTermsQuery -> BooleanOperator
commonLowFreqOperator :: BooleanOperator,
    CommonTermsQuery -> BooleanOperator
commonHighFreqOperator :: BooleanOperator,
    CommonTermsQuery -> Maybe CommonMinimumMatch
commonMinimumShouldMatch :: Maybe CommonMinimumMatch,
    CommonTermsQuery -> Maybe Boost
commonBoost :: Maybe Boost,
    CommonTermsQuery -> Maybe Analyzer
commonAnalyzer :: Maybe Analyzer,
    CommonTermsQuery -> Maybe DisableCoord
commonDisableCoord :: Maybe DisableCoord
  }
  deriving stock (CommonTermsQuery -> CommonTermsQuery -> Bool
(CommonTermsQuery -> CommonTermsQuery -> Bool)
-> (CommonTermsQuery -> CommonTermsQuery -> Bool)
-> Eq CommonTermsQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommonTermsQuery -> CommonTermsQuery -> Bool
== :: CommonTermsQuery -> CommonTermsQuery -> Bool
$c/= :: CommonTermsQuery -> CommonTermsQuery -> Bool
/= :: CommonTermsQuery -> CommonTermsQuery -> Bool
Eq, Int -> CommonTermsQuery -> ShowS
[CommonTermsQuery] -> ShowS
CommonTermsQuery -> String
(Int -> CommonTermsQuery -> ShowS)
-> (CommonTermsQuery -> String)
-> ([CommonTermsQuery] -> ShowS)
-> Show CommonTermsQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommonTermsQuery -> ShowS
showsPrec :: Int -> CommonTermsQuery -> ShowS
$cshow :: CommonTermsQuery -> String
show :: CommonTermsQuery -> String
$cshowList :: [CommonTermsQuery] -> ShowS
showList :: [CommonTermsQuery] -> ShowS
Show, (forall x. CommonTermsQuery -> Rep CommonTermsQuery x)
-> (forall x. Rep CommonTermsQuery x -> CommonTermsQuery)
-> Generic CommonTermsQuery
forall x. Rep CommonTermsQuery x -> CommonTermsQuery
forall x. CommonTermsQuery -> Rep CommonTermsQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommonTermsQuery -> Rep CommonTermsQuery x
from :: forall x. CommonTermsQuery -> Rep CommonTermsQuery x
$cto :: forall x. Rep CommonTermsQuery x -> CommonTermsQuery
to :: forall x. Rep CommonTermsQuery x -> CommonTermsQuery
Generic)

commonTermsQueryFieldLens :: Lens' CommonTermsQuery FieldName
commonTermsQueryFieldLens :: Lens' CommonTermsQuery FieldName
commonTermsQueryFieldLens = (CommonTermsQuery -> FieldName)
-> (CommonTermsQuery -> FieldName -> CommonTermsQuery)
-> Lens' CommonTermsQuery FieldName
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CommonTermsQuery -> FieldName
commonField (\CommonTermsQuery
x FieldName
y -> CommonTermsQuery
x {commonField = y})

commonTermsQueryQueryLens :: Lens' CommonTermsQuery QueryString
commonTermsQueryQueryLens :: Lens' CommonTermsQuery QueryString
commonTermsQueryQueryLens = (CommonTermsQuery -> QueryString)
-> (CommonTermsQuery -> QueryString -> CommonTermsQuery)
-> Lens' CommonTermsQuery QueryString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CommonTermsQuery -> QueryString
commonQuery (\CommonTermsQuery
x QueryString
y -> CommonTermsQuery
x {commonQuery = y})

commonTermsQueryCutoffFrequencyLens :: Lens' CommonTermsQuery CutoffFrequency
commonTermsQueryCutoffFrequencyLens :: Lens' CommonTermsQuery CutoffFrequency
commonTermsQueryCutoffFrequencyLens = (CommonTermsQuery -> CutoffFrequency)
-> (CommonTermsQuery -> CutoffFrequency -> CommonTermsQuery)
-> Lens' CommonTermsQuery CutoffFrequency
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CommonTermsQuery -> CutoffFrequency
commonCutoffFrequency (\CommonTermsQuery
x CutoffFrequency
y -> CommonTermsQuery
x {commonCutoffFrequency = y})

commonTermsQueryLowFreqOperatorLens :: Lens' CommonTermsQuery BooleanOperator
commonTermsQueryLowFreqOperatorLens :: Lens' CommonTermsQuery BooleanOperator
commonTermsQueryLowFreqOperatorLens = (CommonTermsQuery -> BooleanOperator)
-> (CommonTermsQuery -> BooleanOperator -> CommonTermsQuery)
-> Lens' CommonTermsQuery BooleanOperator
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CommonTermsQuery -> BooleanOperator
commonLowFreqOperator (\CommonTermsQuery
x BooleanOperator
y -> CommonTermsQuery
x {commonLowFreqOperator = y})

commonTermsQueryHighFreqOperatorLens :: Lens' CommonTermsQuery BooleanOperator
commonTermsQueryHighFreqOperatorLens :: Lens' CommonTermsQuery BooleanOperator
commonTermsQueryHighFreqOperatorLens = (CommonTermsQuery -> BooleanOperator)
-> (CommonTermsQuery -> BooleanOperator -> CommonTermsQuery)
-> Lens' CommonTermsQuery BooleanOperator
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CommonTermsQuery -> BooleanOperator
commonHighFreqOperator (\CommonTermsQuery
x BooleanOperator
y -> CommonTermsQuery
x {commonHighFreqOperator = y})

commonTermsQueryMinimumShouldMatchLens :: Lens' CommonTermsQuery (Maybe CommonMinimumMatch)
commonTermsQueryMinimumShouldMatchLens :: Lens' CommonTermsQuery (Maybe CommonMinimumMatch)
commonTermsQueryMinimumShouldMatchLens = (CommonTermsQuery -> Maybe CommonMinimumMatch)
-> (CommonTermsQuery
    -> Maybe CommonMinimumMatch -> CommonTermsQuery)
-> Lens' CommonTermsQuery (Maybe CommonMinimumMatch)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CommonTermsQuery -> Maybe CommonMinimumMatch
commonMinimumShouldMatch (\CommonTermsQuery
x Maybe CommonMinimumMatch
y -> CommonTermsQuery
x {commonMinimumShouldMatch = y})

commonTermsQueryBoostLens :: Lens' CommonTermsQuery (Maybe Boost)
commonTermsQueryBoostLens :: Lens' CommonTermsQuery (Maybe Boost)
commonTermsQueryBoostLens = (CommonTermsQuery -> Maybe Boost)
-> (CommonTermsQuery -> Maybe Boost -> CommonTermsQuery)
-> Lens' CommonTermsQuery (Maybe Boost)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CommonTermsQuery -> Maybe Boost
commonBoost (\CommonTermsQuery
x Maybe Boost
y -> CommonTermsQuery
x {commonBoost = y})

commonTermsQueryAnalyzerLens :: Lens' CommonTermsQuery (Maybe Analyzer)
commonTermsQueryAnalyzerLens :: Lens' CommonTermsQuery (Maybe Analyzer)
commonTermsQueryAnalyzerLens = (CommonTermsQuery -> Maybe Analyzer)
-> (CommonTermsQuery -> Maybe Analyzer -> CommonTermsQuery)
-> Lens' CommonTermsQuery (Maybe Analyzer)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CommonTermsQuery -> Maybe Analyzer
commonAnalyzer (\CommonTermsQuery
x Maybe Analyzer
y -> CommonTermsQuery
x {commonAnalyzer = y})

commonTermsQueryDisableCoordLens :: Lens' CommonTermsQuery (Maybe DisableCoord)
commonTermsQueryDisableCoordLens :: Lens' CommonTermsQuery (Maybe DisableCoord)
commonTermsQueryDisableCoordLens = (CommonTermsQuery -> Maybe DisableCoord)
-> (CommonTermsQuery -> Maybe DisableCoord -> CommonTermsQuery)
-> Lens' CommonTermsQuery (Maybe DisableCoord)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CommonTermsQuery -> Maybe DisableCoord
commonDisableCoord (\CommonTermsQuery
x Maybe DisableCoord
y -> CommonTermsQuery
x {commonDisableCoord = y})

instance ToJSON CommonTermsQuery where
  toJSON :: CommonTermsQuery -> Value
toJSON
    ( CommonTermsQuery
        (FieldName Text
fieldName)
        (QueryString Text
query)
        CutoffFrequency
cf
        BooleanOperator
lfo
        BooleanOperator
hfo
        Maybe CommonMinimumMatch
msm
        Maybe Boost
boost
        Maybe Analyzer
analyzer
        Maybe DisableCoord
disableCoord
      ) =
      [Pair] -> Value
object [Text -> Key
fromText Text
fieldName Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
omitNulls [Pair]
base]
      where
        base :: [Pair]
base =
          [ Key
"query" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
query,
            Key
"cutoff_frequency" Key -> CutoffFrequency -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CutoffFrequency
cf,
            Key
"low_freq_operator" Key -> BooleanOperator -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BooleanOperator
lfo,
            Key
"minimum_should_match" Key -> Maybe CommonMinimumMatch -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe CommonMinimumMatch
msm,
            Key
"boost" Key -> Maybe Boost -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Boost
boost,
            Key
"analyzer" Key -> Maybe Analyzer -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Analyzer
analyzer,
            Key
"disable_coord" Key -> Maybe DisableCoord -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe DisableCoord
disableCoord,
            Key
"high_freq_operator" Key -> BooleanOperator -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BooleanOperator
hfo
          ]

instance FromJSON CommonTermsQuery where
  parseJSON :: Value -> Parser CommonTermsQuery
parseJSON = String
-> (Object -> Parser CommonTermsQuery)
-> Value
-> Parser CommonTermsQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CommonTermsQuery" Object -> Parser CommonTermsQuery
parse
    where
      parse :: Object -> Parser CommonTermsQuery
parse = (FieldName -> Object -> Parser CommonTermsQuery)
-> Object -> Parser CommonTermsQuery
forall (m :: * -> *) a.
(Monad m, MonadFail m) =>
(FieldName -> Object -> m a) -> Object -> m a
fieldTagged ((FieldName -> Object -> Parser CommonTermsQuery)
 -> Object -> Parser CommonTermsQuery)
-> (FieldName -> Object -> Parser CommonTermsQuery)
-> Object
-> Parser CommonTermsQuery
forall a b. (a -> b) -> a -> b
$ \FieldName
fn Object
o ->
        FieldName
-> QueryString
-> CutoffFrequency
-> BooleanOperator
-> BooleanOperator
-> Maybe CommonMinimumMatch
-> Maybe Boost
-> Maybe Analyzer
-> Maybe DisableCoord
-> CommonTermsQuery
CommonTermsQuery FieldName
fn
          (QueryString
 -> CutoffFrequency
 -> BooleanOperator
 -> BooleanOperator
 -> Maybe CommonMinimumMatch
 -> Maybe Boost
 -> Maybe Analyzer
 -> Maybe DisableCoord
 -> CommonTermsQuery)
-> Parser QueryString
-> Parser
     (CutoffFrequency
      -> BooleanOperator
      -> BooleanOperator
      -> Maybe CommonMinimumMatch
      -> Maybe Boost
      -> Maybe Analyzer
      -> Maybe DisableCoord
      -> CommonTermsQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser QueryString
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"query"
          Parser
  (CutoffFrequency
   -> BooleanOperator
   -> BooleanOperator
   -> Maybe CommonMinimumMatch
   -> Maybe Boost
   -> Maybe Analyzer
   -> Maybe DisableCoord
   -> CommonTermsQuery)
-> Parser CutoffFrequency
-> Parser
     (BooleanOperator
      -> BooleanOperator
      -> Maybe CommonMinimumMatch
      -> Maybe Boost
      -> Maybe Analyzer
      -> Maybe DisableCoord
      -> CommonTermsQuery)
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 CutoffFrequency
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cutoff_frequency"
          Parser
  (BooleanOperator
   -> BooleanOperator
   -> Maybe CommonMinimumMatch
   -> Maybe Boost
   -> Maybe Analyzer
   -> Maybe DisableCoord
   -> CommonTermsQuery)
-> Parser BooleanOperator
-> Parser
     (BooleanOperator
      -> Maybe CommonMinimumMatch
      -> Maybe Boost
      -> Maybe Analyzer
      -> Maybe DisableCoord
      -> CommonTermsQuery)
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 BooleanOperator
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"low_freq_operator"
          Parser
  (BooleanOperator
   -> Maybe CommonMinimumMatch
   -> Maybe Boost
   -> Maybe Analyzer
   -> Maybe DisableCoord
   -> CommonTermsQuery)
-> Parser BooleanOperator
-> Parser
     (Maybe CommonMinimumMatch
      -> Maybe Boost
      -> Maybe Analyzer
      -> Maybe DisableCoord
      -> CommonTermsQuery)
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 BooleanOperator
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"high_freq_operator"
          Parser
  (Maybe CommonMinimumMatch
   -> Maybe Boost
   -> Maybe Analyzer
   -> Maybe DisableCoord
   -> CommonTermsQuery)
-> Parser (Maybe CommonMinimumMatch)
-> Parser
     (Maybe Boost
      -> Maybe Analyzer -> Maybe DisableCoord -> CommonTermsQuery)
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 CommonMinimumMatch)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"minimum_should_match"
          Parser
  (Maybe Boost
   -> Maybe Analyzer -> Maybe DisableCoord -> CommonTermsQuery)
-> Parser (Maybe Boost)
-> Parser
     (Maybe Analyzer -> Maybe DisableCoord -> CommonTermsQuery)
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 Boost)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"boost"
          Parser (Maybe Analyzer -> Maybe DisableCoord -> CommonTermsQuery)
-> Parser (Maybe Analyzer)
-> Parser (Maybe DisableCoord -> CommonTermsQuery)
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 Analyzer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"analyzer"
          Parser (Maybe DisableCoord -> CommonTermsQuery)
-> Parser (Maybe DisableCoord) -> Parser CommonTermsQuery
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 DisableCoord)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disable_coord"

data CommonMinimumMatch
  = CommonMinimumMatchHighLow MinimumMatchHighLow
  | CommonMinimumMatch MinimumMatch
  deriving stock (CommonMinimumMatch -> CommonMinimumMatch -> Bool
(CommonMinimumMatch -> CommonMinimumMatch -> Bool)
-> (CommonMinimumMatch -> CommonMinimumMatch -> Bool)
-> Eq CommonMinimumMatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommonMinimumMatch -> CommonMinimumMatch -> Bool
== :: CommonMinimumMatch -> CommonMinimumMatch -> Bool
$c/= :: CommonMinimumMatch -> CommonMinimumMatch -> Bool
/= :: CommonMinimumMatch -> CommonMinimumMatch -> Bool
Eq, Int -> CommonMinimumMatch -> ShowS
[CommonMinimumMatch] -> ShowS
CommonMinimumMatch -> String
(Int -> CommonMinimumMatch -> ShowS)
-> (CommonMinimumMatch -> String)
-> ([CommonMinimumMatch] -> ShowS)
-> Show CommonMinimumMatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommonMinimumMatch -> ShowS
showsPrec :: Int -> CommonMinimumMatch -> ShowS
$cshow :: CommonMinimumMatch -> String
show :: CommonMinimumMatch -> String
$cshowList :: [CommonMinimumMatch] -> ShowS
showList :: [CommonMinimumMatch] -> ShowS
Show, (forall x. CommonMinimumMatch -> Rep CommonMinimumMatch x)
-> (forall x. Rep CommonMinimumMatch x -> CommonMinimumMatch)
-> Generic CommonMinimumMatch
forall x. Rep CommonMinimumMatch x -> CommonMinimumMatch
forall x. CommonMinimumMatch -> Rep CommonMinimumMatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommonMinimumMatch -> Rep CommonMinimumMatch x
from :: forall x. CommonMinimumMatch -> Rep CommonMinimumMatch x
$cto :: forall x. Rep CommonMinimumMatch x -> CommonMinimumMatch
to :: forall x. Rep CommonMinimumMatch x -> CommonMinimumMatch
Generic)

commonMinimumMatchHighLowPrism :: Prism' CommonMinimumMatch MinimumMatchHighLow
commonMinimumMatchHighLowPrism :: Prism' CommonMinimumMatch MinimumMatchHighLow
commonMinimumMatchHighLowPrism = (MinimumMatchHighLow -> CommonMinimumMatch)
-> (CommonMinimumMatch
    -> Either CommonMinimumMatch MinimumMatchHighLow)
-> Prism' CommonMinimumMatch MinimumMatchHighLow
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism MinimumMatchHighLow -> CommonMinimumMatch
CommonMinimumMatchHighLow CommonMinimumMatch -> Either CommonMinimumMatch MinimumMatchHighLow
extract
  where
    extract :: CommonMinimumMatch -> Either CommonMinimumMatch MinimumMatchHighLow
extract CommonMinimumMatch
cmm =
      case CommonMinimumMatch
cmm of
        CommonMinimumMatchHighLow MinimumMatchHighLow
x -> MinimumMatchHighLow
-> Either CommonMinimumMatch MinimumMatchHighLow
forall a b. b -> Either a b
Right MinimumMatchHighLow
x
        CommonMinimumMatch
_ -> CommonMinimumMatch -> Either CommonMinimumMatch MinimumMatchHighLow
forall a b. a -> Either a b
Left CommonMinimumMatch
cmm

commonMinimumMatchPrism :: Prism' CommonMinimumMatch MinimumMatch
commonMinimumMatchPrism :: Prism' CommonMinimumMatch MinimumMatch
commonMinimumMatchPrism = (MinimumMatch -> CommonMinimumMatch)
-> (CommonMinimumMatch -> Either CommonMinimumMatch MinimumMatch)
-> Prism' CommonMinimumMatch MinimumMatch
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism MinimumMatch -> CommonMinimumMatch
CommonMinimumMatch CommonMinimumMatch -> Either CommonMinimumMatch MinimumMatch
extract
  where
    extract :: CommonMinimumMatch -> Either CommonMinimumMatch MinimumMatch
extract CommonMinimumMatch
cmm =
      case CommonMinimumMatch
cmm of
        CommonMinimumMatch MinimumMatch
x -> MinimumMatch -> Either CommonMinimumMatch MinimumMatch
forall a b. b -> Either a b
Right MinimumMatch
x
        CommonMinimumMatch
_ -> CommonMinimumMatch -> Either CommonMinimumMatch MinimumMatch
forall a b. a -> Either a b
Left CommonMinimumMatch
cmm

instance ToJSON CommonMinimumMatch where
  toJSON :: CommonMinimumMatch -> Value
toJSON (CommonMinimumMatch MinimumMatch
mm) = MinimumMatch -> Value
forall a. ToJSON a => a -> Value
toJSON MinimumMatch
mm
  toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow MinimumMatch
lowF MinimumMatch
highF)) =
    [Pair] -> Value
object
      [ Key
"low_freq" Key -> MinimumMatch -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MinimumMatch
lowF,
        Key
"high_freq" Key -> MinimumMatch -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MinimumMatch
highF
      ]

instance FromJSON CommonMinimumMatch where
  parseJSON :: Value -> Parser CommonMinimumMatch
parseJSON Value
v =
    Value -> Parser CommonMinimumMatch
parseMinimum Value
v
      Parser CommonMinimumMatch
-> Parser CommonMinimumMatch -> Parser CommonMinimumMatch
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser CommonMinimumMatch
parseMinimumHighLow Value
v
    where
      parseMinimum :: Value -> Parser CommonMinimumMatch
parseMinimum = (MinimumMatch -> CommonMinimumMatch)
-> Parser MinimumMatch -> Parser CommonMinimumMatch
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MinimumMatch -> CommonMinimumMatch
CommonMinimumMatch (Parser MinimumMatch -> Parser CommonMinimumMatch)
-> (Value -> Parser MinimumMatch)
-> Value
-> Parser CommonMinimumMatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser MinimumMatch
forall a. FromJSON a => Value -> Parser a
parseJSON
      parseMinimumHighLow :: Value -> Parser CommonMinimumMatch
parseMinimumHighLow =
        (MinimumMatchHighLow -> CommonMinimumMatch)
-> Parser MinimumMatchHighLow -> Parser CommonMinimumMatch
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MinimumMatchHighLow -> CommonMinimumMatch
CommonMinimumMatchHighLow
          (Parser MinimumMatchHighLow -> Parser CommonMinimumMatch)
-> (Value -> Parser MinimumMatchHighLow)
-> Value
-> Parser CommonMinimumMatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> (Object -> Parser MinimumMatchHighLow)
-> Value
-> Parser MinimumMatchHighLow
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
            String
"CommonMinimumMatchHighLow"
            ( \Object
o ->
                MinimumMatch -> MinimumMatch -> MinimumMatchHighLow
MinimumMatchHighLow
                  (MinimumMatch -> MinimumMatch -> MinimumMatchHighLow)
-> Parser MinimumMatch
-> Parser (MinimumMatch -> MinimumMatchHighLow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser MinimumMatch
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"low_freq"
                  Parser (MinimumMatch -> MinimumMatchHighLow)
-> Parser MinimumMatch -> Parser MinimumMatchHighLow
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 MinimumMatch
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"high_freq"
            )

data MinimumMatchHighLow = MinimumMatchHighLow
  { MinimumMatchHighLow -> MinimumMatch
lowFreq :: MinimumMatch,
    MinimumMatchHighLow -> MinimumMatch
highFreq :: MinimumMatch
  }
  deriving stock (MinimumMatchHighLow -> MinimumMatchHighLow -> Bool
(MinimumMatchHighLow -> MinimumMatchHighLow -> Bool)
-> (MinimumMatchHighLow -> MinimumMatchHighLow -> Bool)
-> Eq MinimumMatchHighLow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MinimumMatchHighLow -> MinimumMatchHighLow -> Bool
== :: MinimumMatchHighLow -> MinimumMatchHighLow -> Bool
$c/= :: MinimumMatchHighLow -> MinimumMatchHighLow -> Bool
/= :: MinimumMatchHighLow -> MinimumMatchHighLow -> Bool
Eq, Int -> MinimumMatchHighLow -> ShowS
[MinimumMatchHighLow] -> ShowS
MinimumMatchHighLow -> String
(Int -> MinimumMatchHighLow -> ShowS)
-> (MinimumMatchHighLow -> String)
-> ([MinimumMatchHighLow] -> ShowS)
-> Show MinimumMatchHighLow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MinimumMatchHighLow -> ShowS
showsPrec :: Int -> MinimumMatchHighLow -> ShowS
$cshow :: MinimumMatchHighLow -> String
show :: MinimumMatchHighLow -> String
$cshowList :: [MinimumMatchHighLow] -> ShowS
showList :: [MinimumMatchHighLow] -> ShowS
Show, (forall x. MinimumMatchHighLow -> Rep MinimumMatchHighLow x)
-> (forall x. Rep MinimumMatchHighLow x -> MinimumMatchHighLow)
-> Generic MinimumMatchHighLow
forall x. Rep MinimumMatchHighLow x -> MinimumMatchHighLow
forall x. MinimumMatchHighLow -> Rep MinimumMatchHighLow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MinimumMatchHighLow -> Rep MinimumMatchHighLow x
from :: forall x. MinimumMatchHighLow -> Rep MinimumMatchHighLow x
$cto :: forall x. Rep MinimumMatchHighLow x -> MinimumMatchHighLow
to :: forall x. Rep MinimumMatchHighLow x -> MinimumMatchHighLow
Generic)

minimumMatchHighLowLowFreqLens :: Lens' MinimumMatchHighLow MinimumMatch
minimumMatchHighLowLowFreqLens :: Lens' MinimumMatchHighLow MinimumMatch
minimumMatchHighLowLowFreqLens = (MinimumMatchHighLow -> MinimumMatch)
-> (MinimumMatchHighLow -> MinimumMatch -> MinimumMatchHighLow)
-> Lens' MinimumMatchHighLow MinimumMatch
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens MinimumMatchHighLow -> MinimumMatch
lowFreq (\MinimumMatchHighLow
x MinimumMatch
y -> MinimumMatchHighLow
x {lowFreq = y})

minimumMatchHighLowHighFreqLens :: Lens' MinimumMatchHighLow MinimumMatch
minimumMatchHighLowHighFreqLens :: Lens' MinimumMatchHighLow MinimumMatch
minimumMatchHighLowHighFreqLens = (MinimumMatchHighLow -> MinimumMatch)
-> (MinimumMatchHighLow -> MinimumMatch -> MinimumMatchHighLow)
-> Lens' MinimumMatchHighLow MinimumMatch
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens MinimumMatchHighLow -> MinimumMatch
highFreq (\MinimumMatchHighLow
x MinimumMatch
y -> MinimumMatchHighLow
x {highFreq = y})