{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
module Cardano.Constitution.Config
( defaultConstitutionConfig
, defaultPredMeanings
, module Export
) where
import Cardano.Constitution.Config.Instance.FromJSON ()
import Cardano.Constitution.Config.Instance.TxLift ()
import Cardano.Constitution.Config.Types as Export
import Cardano.Constitution.DataFilePaths as DFP
import PlutusTx.Eq as Tx
import PlutusTx.Ord as Tx
import Data.Aeson.THReader as Aeson
{-# INLINABLE defaultConstitutionConfig #-}
defaultConstitutionConfig :: ConstitutionConfig
defaultConstitutionConfig :: ConstitutionConfig
defaultConstitutionConfig = $$(Aeson.readJSONFromFile DFP.defaultConstitutionConfigFile)
{-# INLINABLE defaultPredMeanings #-}
defaultPredMeanings :: PredKey -> PredMeaning a
defaultPredMeanings :: forall a. PredKey -> PredMeaning a
defaultPredMeanings = \case
PredKey
MinValue -> a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(Tx.<=)
PredKey
MaxValue -> a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(Tx.>=)
PredKey
NotEqual -> a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(Tx./=)