-- editorconfig-checker-disable-file
{-# LANGUAGE OverloadedStrings #-}

{- | A JSON representation of costing functions for Plutus Core
   builtins which produces a simple cost model which can be used from Agda and other
   executables -}
module PlutusCore.Evaluation.Machine.CostingFun.SimpleJSON where

import Data.Aeson
import Data.Text (Text)
import Language.Haskell.TH.Syntax (Lift)

-------------- Types representing cost mode entries and functions for JSON parsing ----------------

data LinearFunction =
    LinearFunction {LinearFunction -> Integer
intercept_ :: Integer, LinearFunction -> Integer
slope_ :: Integer}
                   deriving stock (Int -> LinearFunction -> ShowS
[LinearFunction] -> ShowS
LinearFunction -> String
(Int -> LinearFunction -> ShowS)
-> (LinearFunction -> String)
-> ([LinearFunction] -> ShowS)
-> Show LinearFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LinearFunction -> ShowS
showsPrec :: Int -> LinearFunction -> ShowS
$cshow :: LinearFunction -> String
show :: LinearFunction -> String
$cshowList :: [LinearFunction] -> ShowS
showList :: [LinearFunction] -> ShowS
Show, (forall (m :: * -> *). Quote m => LinearFunction -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    LinearFunction -> Code m LinearFunction)
-> Lift LinearFunction
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => LinearFunction -> m Exp
forall (m :: * -> *).
Quote m =>
LinearFunction -> Code m LinearFunction
$clift :: forall (m :: * -> *). Quote m => LinearFunction -> m Exp
lift :: forall (m :: * -> *). Quote m => LinearFunction -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
LinearFunction -> Code m LinearFunction
liftTyped :: forall (m :: * -> *).
Quote m =>
LinearFunction -> Code m LinearFunction
Lift)

instance FromJSON LinearFunction where
    parseJSON :: Value -> Parser LinearFunction
parseJSON = String
-> (Object -> Parser LinearFunction)
-> Value
-> Parser LinearFunction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Linear function" ((Object -> Parser LinearFunction)
 -> Value -> Parser LinearFunction)
-> (Object -> Parser LinearFunction)
-> Value
-> Parser LinearFunction
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
                Integer -> Integer -> LinearFunction
LinearFunction (Integer -> Integer -> LinearFunction)
-> Parser Integer -> Parser (Integer -> LinearFunction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"intercept" Parser (Integer -> LinearFunction)
-> Parser Integer -> Parser LinearFunction
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"slope"

data TwoVariableLinearFunction =
    TwoVariableLinearFunction {TwoVariableLinearFunction -> Integer
intercept'_ :: Integer, TwoVariableLinearFunction -> Integer
slope1_ :: Integer, TwoVariableLinearFunction -> Integer
slope2_ :: Integer}
                               deriving stock (Int -> TwoVariableLinearFunction -> ShowS
[TwoVariableLinearFunction] -> ShowS
TwoVariableLinearFunction -> String
(Int -> TwoVariableLinearFunction -> ShowS)
-> (TwoVariableLinearFunction -> String)
-> ([TwoVariableLinearFunction] -> ShowS)
-> Show TwoVariableLinearFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TwoVariableLinearFunction -> ShowS
showsPrec :: Int -> TwoVariableLinearFunction -> ShowS
$cshow :: TwoVariableLinearFunction -> String
show :: TwoVariableLinearFunction -> String
$cshowList :: [TwoVariableLinearFunction] -> ShowS
showList :: [TwoVariableLinearFunction] -> ShowS
Show, (forall (m :: * -> *).
 Quote m =>
 TwoVariableLinearFunction -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    TwoVariableLinearFunction -> Code m TwoVariableLinearFunction)
-> Lift TwoVariableLinearFunction
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => TwoVariableLinearFunction -> m Exp
forall (m :: * -> *).
Quote m =>
TwoVariableLinearFunction -> Code m TwoVariableLinearFunction
$clift :: forall (m :: * -> *). Quote m => TwoVariableLinearFunction -> m Exp
lift :: forall (m :: * -> *). Quote m => TwoVariableLinearFunction -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
TwoVariableLinearFunction -> Code m TwoVariableLinearFunction
liftTyped :: forall (m :: * -> *).
Quote m =>
TwoVariableLinearFunction -> Code m TwoVariableLinearFunction
Lift)

instance FromJSON TwoVariableLinearFunction where
    parseJSON :: Value -> Parser TwoVariableLinearFunction
parseJSON = String
-> (Object -> Parser TwoVariableLinearFunction)
-> Value
-> Parser TwoVariableLinearFunction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Linear function" ((Object -> Parser TwoVariableLinearFunction)
 -> Value -> Parser TwoVariableLinearFunction)
-> (Object -> Parser TwoVariableLinearFunction)
-> Value
-> Parser TwoVariableLinearFunction
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
                Integer -> Integer -> Integer -> TwoVariableLinearFunction
TwoVariableLinearFunction (Integer -> Integer -> Integer -> TwoVariableLinearFunction)
-> Parser Integer
-> Parser (Integer -> Integer -> TwoVariableLinearFunction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"intercept" Parser (Integer -> Integer -> TwoVariableLinearFunction)
-> Parser Integer -> Parser (Integer -> TwoVariableLinearFunction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"slope1" Parser (Integer -> TwoVariableLinearFunction)
-> Parser Integer -> Parser TwoVariableLinearFunction
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"slope2"

data OneVariableQuadraticFunction =
    OneVariableQuadraticFunction
    { OneVariableQuadraticFunction -> Integer
coeff0_ :: Integer
    , OneVariableQuadraticFunction -> Integer
coeff1_ :: Integer
    , OneVariableQuadraticFunction -> Integer
coeff2_ :: Integer
    }
    deriving stock (Int -> OneVariableQuadraticFunction -> ShowS
[OneVariableQuadraticFunction] -> ShowS
OneVariableQuadraticFunction -> String
(Int -> OneVariableQuadraticFunction -> ShowS)
-> (OneVariableQuadraticFunction -> String)
-> ([OneVariableQuadraticFunction] -> ShowS)
-> Show OneVariableQuadraticFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OneVariableQuadraticFunction -> ShowS
showsPrec :: Int -> OneVariableQuadraticFunction -> ShowS
$cshow :: OneVariableQuadraticFunction -> String
show :: OneVariableQuadraticFunction -> String
$cshowList :: [OneVariableQuadraticFunction] -> ShowS
showList :: [OneVariableQuadraticFunction] -> ShowS
Show, (forall (m :: * -> *).
 Quote m =>
 OneVariableQuadraticFunction -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    OneVariableQuadraticFunction
    -> Code m OneVariableQuadraticFunction)
-> Lift OneVariableQuadraticFunction
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *).
Quote m =>
OneVariableQuadraticFunction -> m Exp
forall (m :: * -> *).
Quote m =>
OneVariableQuadraticFunction -> Code m OneVariableQuadraticFunction
$clift :: forall (m :: * -> *).
Quote m =>
OneVariableQuadraticFunction -> m Exp
lift :: forall (m :: * -> *).
Quote m =>
OneVariableQuadraticFunction -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
OneVariableQuadraticFunction -> Code m OneVariableQuadraticFunction
liftTyped :: forall (m :: * -> *).
Quote m =>
OneVariableQuadraticFunction -> Code m OneVariableQuadraticFunction
Lift)

instance FromJSON OneVariableQuadraticFunction where
    parseJSON :: Value -> Parser OneVariableQuadraticFunction
parseJSON = String
-> (Object -> Parser OneVariableQuadraticFunction)
-> Value
-> Parser OneVariableQuadraticFunction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"One-variable quadratic function" ((Object -> Parser OneVariableQuadraticFunction)
 -> Value -> Parser OneVariableQuadraticFunction)
-> (Object -> Parser OneVariableQuadraticFunction)
-> Value
-> Parser OneVariableQuadraticFunction
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
                Integer -> Integer -> Integer -> OneVariableQuadraticFunction
OneVariableQuadraticFunction (Integer -> Integer -> Integer -> OneVariableQuadraticFunction)
-> Parser Integer
-> Parser (Integer -> Integer -> OneVariableQuadraticFunction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"c0" Parser (Integer -> Integer -> OneVariableQuadraticFunction)
-> Parser Integer
-> Parser (Integer -> OneVariableQuadraticFunction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"c1" Parser (Integer -> OneVariableQuadraticFunction)
-> Parser Integer -> Parser OneVariableQuadraticFunction
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"c2"

data TwoVariableQuadraticFunction =
    TwoVariableQuadraticFunction
    { TwoVariableQuadraticFunction -> Integer
minimum  :: Integer
    , TwoVariableQuadraticFunction -> Integer
coeff00_ :: Integer
    , TwoVariableQuadraticFunction -> Integer
coeff10_ :: Integer
    , TwoVariableQuadraticFunction -> Integer
coeff01_ :: Integer
    , TwoVariableQuadraticFunction -> Integer
coeff20_ :: Integer
    , TwoVariableQuadraticFunction -> Integer
coeff11_ :: Integer
    , TwoVariableQuadraticFunction -> Integer
coeff02_ :: Integer
    }
    deriving stock (Int -> TwoVariableQuadraticFunction -> ShowS
[TwoVariableQuadraticFunction] -> ShowS
TwoVariableQuadraticFunction -> String
(Int -> TwoVariableQuadraticFunction -> ShowS)
-> (TwoVariableQuadraticFunction -> String)
-> ([TwoVariableQuadraticFunction] -> ShowS)
-> Show TwoVariableQuadraticFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TwoVariableQuadraticFunction -> ShowS
showsPrec :: Int -> TwoVariableQuadraticFunction -> ShowS
$cshow :: TwoVariableQuadraticFunction -> String
show :: TwoVariableQuadraticFunction -> String
$cshowList :: [TwoVariableQuadraticFunction] -> ShowS
showList :: [TwoVariableQuadraticFunction] -> ShowS
Show, (forall (m :: * -> *).
 Quote m =>
 TwoVariableQuadraticFunction -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    TwoVariableQuadraticFunction
    -> Code m TwoVariableQuadraticFunction)
-> Lift TwoVariableQuadraticFunction
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *).
Quote m =>
TwoVariableQuadraticFunction -> m Exp
forall (m :: * -> *).
Quote m =>
TwoVariableQuadraticFunction -> Code m TwoVariableQuadraticFunction
$clift :: forall (m :: * -> *).
Quote m =>
TwoVariableQuadraticFunction -> m Exp
lift :: forall (m :: * -> *).
Quote m =>
TwoVariableQuadraticFunction -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
TwoVariableQuadraticFunction -> Code m TwoVariableQuadraticFunction
liftTyped :: forall (m :: * -> *).
Quote m =>
TwoVariableQuadraticFunction -> Code m TwoVariableQuadraticFunction
Lift)

instance FromJSON TwoVariableQuadraticFunction where
    parseJSON :: Value -> Parser TwoVariableQuadraticFunction
parseJSON = String
-> (Object -> Parser TwoVariableQuadraticFunction)
-> Value
-> Parser TwoVariableQuadraticFunction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Two-variable quadratic function" ((Object -> Parser TwoVariableQuadraticFunction)
 -> Value -> Parser TwoVariableQuadraticFunction)
-> (Object -> Parser TwoVariableQuadraticFunction)
-> Value
-> Parser TwoVariableQuadraticFunction
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
                Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> TwoVariableQuadraticFunction
TwoVariableQuadraticFunction (Integer
 -> Integer
 -> Integer
 -> Integer
 -> Integer
 -> Integer
 -> Integer
 -> TwoVariableQuadraticFunction)
-> Parser Integer
-> Parser
     (Integer
      -> Integer
      -> Integer
      -> Integer
      -> Integer
      -> Integer
      -> TwoVariableQuadraticFunction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"minimum" Parser
  (Integer
   -> Integer
   -> Integer
   -> Integer
   -> Integer
   -> Integer
   -> TwoVariableQuadraticFunction)
-> Parser Integer
-> Parser
     (Integer
      -> Integer
      -> Integer
      -> Integer
      -> Integer
      -> TwoVariableQuadraticFunction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"c00" Parser
  (Integer
   -> Integer
   -> Integer
   -> Integer
   -> Integer
   -> TwoVariableQuadraticFunction)
-> Parser Integer
-> Parser
     (Integer
      -> Integer -> Integer -> Integer -> TwoVariableQuadraticFunction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"c10" Parser
  (Integer
   -> Integer -> Integer -> Integer -> TwoVariableQuadraticFunction)
-> Parser Integer
-> Parser
     (Integer -> Integer -> Integer -> TwoVariableQuadraticFunction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"c01" Parser
  (Integer -> Integer -> Integer -> TwoVariableQuadraticFunction)
-> Parser Integer
-> Parser (Integer -> Integer -> TwoVariableQuadraticFunction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"c20" Parser (Integer -> Integer -> TwoVariableQuadraticFunction)
-> Parser Integer
-> Parser (Integer -> TwoVariableQuadraticFunction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"c11" Parser (Integer -> TwoVariableQuadraticFunction)
-> Parser Integer -> Parser TwoVariableQuadraticFunction
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"c02"

{- | This type reflects what is actually in the JSON.  The stuff in
   CostingFun.Core and CostingFun.JSON is much more rigid, allowing parsing only
   for the model types applicable to the various ModelNArguments types; it also
   requires entries for everything in DefaultFun. Using the type defined here
   allows us to be more flexible and parse stuff that's not exactly what's
   expected in builtinCostModel.json.
-}
data Model
    = ConstantCost          Integer
    | AddedSizes            LinearFunction
    | MultipliedSizes       LinearFunction
    | MinSize               LinearFunction
    | MaxSize               LinearFunction
    | LinearInX             LinearFunction
    | LinearInY             LinearFunction
    | LinearInZ             LinearFunction
    | LiteralInYOrLinearInZ LinearFunction
    | LinearInMaxYZ         LinearFunction
    | LinearInYAndZ         TwoVariableLinearFunction
    | QuadraticInY          OneVariableQuadraticFunction
    | QuadraticInZ          OneVariableQuadraticFunction
    | QuadraticInXAndY      TwoVariableQuadraticFunction
    | SubtractedSizes       LinearFunction Integer
    -- ^ Linear model in x-y plus minimum value for the case x-y < 0.
    | ConstAboveDiagonal    Integer Model
    | ConstBelowDiagonal    Integer Model
    | ConstOffDiagonal      Integer Model
      deriving stock (Int -> Model -> ShowS
[Model] -> ShowS
Model -> String
(Int -> Model -> ShowS)
-> (Model -> String) -> ([Model] -> ShowS) -> Show Model
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Model -> ShowS
showsPrec :: Int -> Model -> ShowS
$cshow :: Model -> String
show :: Model -> String
$cshowList :: [Model] -> ShowS
showList :: [Model] -> ShowS
Show, (forall (m :: * -> *). Quote m => Model -> m Exp)
-> (forall (m :: * -> *). Quote m => Model -> Code m Model)
-> Lift Model
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Model -> m Exp
forall (m :: * -> *). Quote m => Model -> Code m Model
$clift :: forall (m :: * -> *). Quote m => Model -> m Exp
lift :: forall (m :: * -> *). Quote m => Model -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Model -> Code m Model
liftTyped :: forall (m :: * -> *). Quote m => Model -> Code m Model
Lift)

{- The JSON representation consists of a list of pairs of (type, arguments)
   values.  The "type" field corresponds to the possible constructors above, the
   "arguments" field contains the arguments for that particular constructor.

   The JSON format is a bit inconsistent, which adds some complexity.  For
   example, the "arguments" field is sometimes a constant, sometimes an object
   representing a linear function, and sometimes an object which contains the
   coefficients of a linear function together with some extra data. It would be
   nice to rationalise this a bit, but it may be too late to do that.
-}

instance FromJSON Model where
    parseJSON :: Value -> Parser Model
parseJSON =
        String -> (Object -> Parser Model) -> Value -> Parser Model
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Model" ((Object -> Parser Model) -> Value -> Parser Model)
-> (Object -> Parser Model) -> Value -> Parser Model
forall a b. (a -> b) -> a -> b
$
           \Object
obj -> do
             Text
ty   :: Text  <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
             Value
args :: Value <- Object
obj Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"arguments"
             {- We always have an "arguments" field which is a Value.  Usually it's
                actually an Object (ie, a map) representing a linear function, but
                sometimes it contains other data, and in those cases we need to
                coerce it to an Object (with objOf) to extract the relevant data.
                We could do that once here and rely on laziness to save us in the
                cases when we don't have an Object, but that looks a bit misleading. -}
             case Text
ty of
               Text
"constant_cost"               -> Integer -> Model
ConstantCost          (Integer -> Model) -> Parser Integer -> Parser Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseJSON Value
args
               Text
"added_sizes"                 -> LinearFunction -> Model
AddedSizes            (LinearFunction -> Model) -> Parser LinearFunction -> Parser Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser LinearFunction
forall a. FromJSON a => Value -> Parser a
parseJSON Value
args
               Text
"min_size"                    -> LinearFunction -> Model
MinSize               (LinearFunction -> Model) -> Parser LinearFunction -> Parser Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser LinearFunction
forall a. FromJSON a => Value -> Parser a
parseJSON Value
args
               Text
"max_size"                    -> LinearFunction -> Model
MaxSize               (LinearFunction -> Model) -> Parser LinearFunction -> Parser Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser LinearFunction
forall a. FromJSON a => Value -> Parser a
parseJSON Value
args
               Text
"multiplied_sizes"            -> LinearFunction -> Model
MultipliedSizes       (LinearFunction -> Model) -> Parser LinearFunction -> Parser Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser LinearFunction
forall a. FromJSON a => Value -> Parser a
parseJSON Value
args
               Text
"linear_in_x"                 -> LinearFunction -> Model
LinearInX             (LinearFunction -> Model) -> Parser LinearFunction -> Parser Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser LinearFunction
forall a. FromJSON a => Value -> Parser a
parseJSON Value
args
               Text
"linear_in_y"                 -> LinearFunction -> Model
LinearInY             (LinearFunction -> Model) -> Parser LinearFunction -> Parser Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser LinearFunction
forall a. FromJSON a => Value -> Parser a
parseJSON Value
args
               Text
"linear_in_z"                 -> LinearFunction -> Model
LinearInZ             (LinearFunction -> Model) -> Parser LinearFunction -> Parser Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser LinearFunction
forall a. FromJSON a => Value -> Parser a
parseJSON Value
args
               Text
"quadratic_in_y"              -> OneVariableQuadraticFunction -> Model
QuadraticInY          (OneVariableQuadraticFunction -> Model)
-> Parser OneVariableQuadraticFunction -> Parser Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser OneVariableQuadraticFunction
forall a. FromJSON a => Value -> Parser a
parseJSON Value
args
               Text
"quadratic_in_z"              -> OneVariableQuadraticFunction -> Model
QuadraticInZ          (OneVariableQuadraticFunction -> Model)
-> Parser OneVariableQuadraticFunction -> Parser Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser OneVariableQuadraticFunction
forall a. FromJSON a => Value -> Parser a
parseJSON Value
args
               Text
"quadratic_in_x_and_y"        -> TwoVariableQuadraticFunction -> Model
QuadraticInXAndY      (TwoVariableQuadraticFunction -> Model)
-> Parser TwoVariableQuadraticFunction -> Parser Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser TwoVariableQuadraticFunction
forall a. FromJSON a => Value -> Parser a
parseJSON Value
args
               Text
"literal_in_y_or_linear_in_z" -> LinearFunction -> Model
LiteralInYOrLinearInZ (LinearFunction -> Model) -> Parser LinearFunction -> Parser Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser LinearFunction
forall a. FromJSON a => Value -> Parser a
parseJSON Value
args
               Text
"linear_in_max_yz"            -> LinearFunction -> Model
LinearInMaxYZ         (LinearFunction -> Model) -> Parser LinearFunction -> Parser Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser LinearFunction
forall a. FromJSON a => Value -> Parser a
parseJSON Value
args
               Text
"linear_in_y_and_z"           -> TwoVariableLinearFunction -> Model
LinearInYAndZ         (TwoVariableLinearFunction -> Model)
-> Parser TwoVariableLinearFunction -> Parser Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser TwoVariableLinearFunction
forall a. FromJSON a => Value -> Parser a
parseJSON Value
args
               Text
"subtracted_sizes"            -> LinearFunction -> Integer -> Model
SubtractedSizes       (LinearFunction -> Integer -> Model)
-> Parser LinearFunction -> Parser (Integer -> Model)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser LinearFunction
forall a. FromJSON a => Value -> Parser a
parseJSON Value
args Parser (Integer -> Model) -> Parser Integer -> Parser Model
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Object
objOf Value
args Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"minimum"
               Text
"const_above_diagonal"        -> (Integer -> Model -> Model) -> Value -> Parser Model
forall {a} {a} {b}.
(FromJSON a, FromJSON a) =>
(a -> a -> b) -> Value -> Parser b
modelWithConstant Integer -> Model -> Model
ConstAboveDiagonal Value
args
               Text
"const_below_diagonal"        -> (Integer -> Model -> Model) -> Value -> Parser Model
forall {a} {a} {b}.
(FromJSON a, FromJSON a) =>
(a -> a -> b) -> Value -> Parser b
modelWithConstant Integer -> Model -> Model
ConstBelowDiagonal Value
args
               Text
"const_off_diagonal"          -> (Integer -> Model -> Model) -> Value -> Parser Model
forall {a} {a} {b}.
(FromJSON a, FromJSON a) =>
(a -> a -> b) -> Value -> Parser b
modelWithConstant Integer -> Model -> Model
ConstOffDiagonal   Value
args
               {- An adaptor to deal with the old "linear_on_diagonal" tag.  See Note [Backward
                  compatibility for costing functions].  We never want to convert back to JSON
                  here, so it's OK to forget that we originally got something tagged with
                 "linear_on_diagonal". -}
               Text
"linear_on_diagonal" ->
                 let o :: Object
o = Value -> Object
objOf Value
args
                 in do
                   Integer
constant   <- Object
o  Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"constant"
                   Integer
intercept  <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"intercept"
                   Integer
slope      <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"slope"
                   Model -> Parser Model
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Model -> Parser Model) -> Model -> Parser Model
forall a b. (a -> b) -> a -> b
$ Integer -> Model -> Model
ConstOffDiagonal Integer
constant (LinearFunction -> Model
LinearInX (LinearFunction -> Model) -> LinearFunction -> Model
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> LinearFunction
LinearFunction Integer
intercept Integer
slope)

               Text
_ -> String -> Parser Model
forall a. String -> a
errorWithoutStackTrace (String -> Parser Model) -> String -> Parser Model
forall a b. (a -> b) -> a -> b
$ String
"Unknown model type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
ty

               where objOf :: Value -> Object
objOf (Object Object
o) = Object
o
                     objOf Value
_          =
                      String -> Object
forall a. String -> a
errorWithoutStackTrace String
"Failed to get Object while parsing \"arguments\""

                     modelWithConstant :: (a -> a -> b) -> Value -> Parser b
modelWithConstant a -> a -> b
constr Value
x = a -> a -> b
constr (a -> a -> b) -> Parser a -> Parser (a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"constant" Parser (a -> b) -> Parser a -> Parser b
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 a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"model"
                       where o :: Object
o = Value -> Object
objOf Value
x

{- | A CPU usage modelling function and a memory usage modelling function bundled
   together -}
data CpuAndMemoryModel = CpuAndMemoryModel {CpuAndMemoryModel -> Model
cpuModel :: Model, CpuAndMemoryModel -> Model
memoryModel :: Model}
              deriving stock (Int -> CpuAndMemoryModel -> ShowS
[CpuAndMemoryModel] -> ShowS
CpuAndMemoryModel -> String
(Int -> CpuAndMemoryModel -> ShowS)
-> (CpuAndMemoryModel -> String)
-> ([CpuAndMemoryModel] -> ShowS)
-> Show CpuAndMemoryModel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CpuAndMemoryModel -> ShowS
showsPrec :: Int -> CpuAndMemoryModel -> ShowS
$cshow :: CpuAndMemoryModel -> String
show :: CpuAndMemoryModel -> String
$cshowList :: [CpuAndMemoryModel] -> ShowS
showList :: [CpuAndMemoryModel] -> ShowS
Show, (forall (m :: * -> *). Quote m => CpuAndMemoryModel -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    CpuAndMemoryModel -> Code m CpuAndMemoryModel)
-> Lift CpuAndMemoryModel
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => CpuAndMemoryModel -> m Exp
forall (m :: * -> *).
Quote m =>
CpuAndMemoryModel -> Code m CpuAndMemoryModel
$clift :: forall (m :: * -> *). Quote m => CpuAndMemoryModel -> m Exp
lift :: forall (m :: * -> *). Quote m => CpuAndMemoryModel -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
CpuAndMemoryModel -> Code m CpuAndMemoryModel
liftTyped :: forall (m :: * -> *).
Quote m =>
CpuAndMemoryModel -> Code m CpuAndMemoryModel
Lift)

instance FromJSON CpuAndMemoryModel where
    parseJSON :: Value -> Parser CpuAndMemoryModel
parseJSON = String
-> (Object -> Parser CpuAndMemoryModel)
-> Value
-> Parser CpuAndMemoryModel
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CpuAndMemoryModel" ((Object -> Parser CpuAndMemoryModel)
 -> Value -> Parser CpuAndMemoryModel)
-> (Object -> Parser CpuAndMemoryModel)
-> Value
-> Parser CpuAndMemoryModel
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
                Model -> Model -> CpuAndMemoryModel
CpuAndMemoryModel (Model -> Model -> CpuAndMemoryModel)
-> Parser Model -> Parser (Model -> CpuAndMemoryModel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Model
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cpu" Parser (Model -> CpuAndMemoryModel)
-> Parser Model -> Parser CpuAndMemoryModel
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Model
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"memory"