{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}

module Waterfall
  (PoolSource(..),Action(..),DistributionSeq(..),CollectionRule(..)
  ,ActionWhen(..),BookType(..),ExtraSupport(..),PayOrderBy(..))
  where

import Language.Haskell.TH
import Data.Aeson hiding (json)
import qualified Data.Text as T
import Text.Read (readMaybe)
import Data.Aeson.TH
import Data.Aeson.Types
import Data.Hashable
import Data.Fixed
import GHC.Generics

import Types
import Revolving
import Stmt (TxnComment(..))
import qualified Lib as L
import qualified Call as C
import qualified CreditEnhancement as CE
import qualified Hedge as HE
import Ledger (LedgerName)


data BookType = PDL BookDirection DealStats [(LedgerName,DealStats)] -- Reverse PDL Debit reference, [(name,cap reference)]
              | ByDS         LedgerName BookDirection DealStats     -- Book amount equal to a formula/deal stats
              | Till         LedgerName BookDirection DealStats     -- Book amount till deal stats
              deriving (Int -> BookType -> ShowS
[BookType] -> ShowS
BookType -> String
(Int -> BookType -> ShowS)
-> (BookType -> String) -> ([BookType] -> ShowS) -> Show BookType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BookType -> ShowS
showsPrec :: Int -> BookType -> ShowS
$cshow :: BookType -> String
show :: BookType -> String
$cshowList :: [BookType] -> ShowS
showList :: [BookType] -> ShowS
Show,(forall x. BookType -> Rep BookType x)
-> (forall x. Rep BookType x -> BookType) -> Generic BookType
forall x. Rep BookType x -> BookType
forall x. BookType -> Rep BookType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BookType -> Rep BookType x
from :: forall x. BookType -> Rep BookType x
$cto :: forall x. Rep BookType x -> BookType
to :: forall x. Rep BookType x -> BookType
Generic,BookType -> BookType -> Bool
(BookType -> BookType -> Bool)
-> (BookType -> BookType -> Bool) -> Eq BookType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BookType -> BookType -> Bool
== :: BookType -> BookType -> Bool
$c/= :: BookType -> BookType -> Bool
/= :: BookType -> BookType -> Bool
Eq,Eq BookType
Eq BookType =>
(BookType -> BookType -> Ordering)
-> (BookType -> BookType -> Bool)
-> (BookType -> BookType -> Bool)
-> (BookType -> BookType -> Bool)
-> (BookType -> BookType -> Bool)
-> (BookType -> BookType -> BookType)
-> (BookType -> BookType -> BookType)
-> Ord BookType
BookType -> BookType -> Bool
BookType -> BookType -> Ordering
BookType -> BookType -> BookType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BookType -> BookType -> Ordering
compare :: BookType -> BookType -> Ordering
$c< :: BookType -> BookType -> Bool
< :: BookType -> BookType -> Bool
$c<= :: BookType -> BookType -> Bool
<= :: BookType -> BookType -> Bool
$c> :: BookType -> BookType -> Bool
> :: BookType -> BookType -> Bool
$c>= :: BookType -> BookType -> Bool
>= :: BookType -> BookType -> Bool
$cmax :: BookType -> BookType -> BookType
max :: BookType -> BookType -> BookType
$cmin :: BookType -> BookType -> BookType
min :: BookType -> BookType -> BookType
Ord)

data ExtraSupport = SupportAccount AccountName (Maybe BookLedger)  -- ^ if there is deficit, draw another account to pay the shortfall
                  | SupportLiqFacility CE.LiquidityProviderName                        -- ^ if there is deficit, draw facility's available credit to pay the shortfall
                  | MultiSupport [ExtraSupport]                                     -- ^ if there is deficit, draw multiple supports (by sequence in the list) to pay the shortfall
                  | WithCondition Pre ExtraSupport                                  -- ^ support only available if Pre is true
                  deriving (Int -> ExtraSupport -> ShowS
[ExtraSupport] -> ShowS
ExtraSupport -> String
(Int -> ExtraSupport -> ShowS)
-> (ExtraSupport -> String)
-> ([ExtraSupport] -> ShowS)
-> Show ExtraSupport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtraSupport -> ShowS
showsPrec :: Int -> ExtraSupport -> ShowS
$cshow :: ExtraSupport -> String
show :: ExtraSupport -> String
$cshowList :: [ExtraSupport] -> ShowS
showList :: [ExtraSupport] -> ShowS
Show,(forall x. ExtraSupport -> Rep ExtraSupport x)
-> (forall x. Rep ExtraSupport x -> ExtraSupport)
-> Generic ExtraSupport
forall x. Rep ExtraSupport x -> ExtraSupport
forall x. ExtraSupport -> Rep ExtraSupport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExtraSupport -> Rep ExtraSupport x
from :: forall x. ExtraSupport -> Rep ExtraSupport x
$cto :: forall x. Rep ExtraSupport x -> ExtraSupport
to :: forall x. Rep ExtraSupport x -> ExtraSupport
Generic,ExtraSupport -> ExtraSupport -> Bool
(ExtraSupport -> ExtraSupport -> Bool)
-> (ExtraSupport -> ExtraSupport -> Bool) -> Eq ExtraSupport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtraSupport -> ExtraSupport -> Bool
== :: ExtraSupport -> ExtraSupport -> Bool
$c/= :: ExtraSupport -> ExtraSupport -> Bool
/= :: ExtraSupport -> ExtraSupport -> Bool
Eq,Eq ExtraSupport
Eq ExtraSupport =>
(ExtraSupport -> ExtraSupport -> Ordering)
-> (ExtraSupport -> ExtraSupport -> Bool)
-> (ExtraSupport -> ExtraSupport -> Bool)
-> (ExtraSupport -> ExtraSupport -> Bool)
-> (ExtraSupport -> ExtraSupport -> Bool)
-> (ExtraSupport -> ExtraSupport -> ExtraSupport)
-> (ExtraSupport -> ExtraSupport -> ExtraSupport)
-> Ord ExtraSupport
ExtraSupport -> ExtraSupport -> Bool
ExtraSupport -> ExtraSupport -> Ordering
ExtraSupport -> ExtraSupport -> ExtraSupport
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ExtraSupport -> ExtraSupport -> Ordering
compare :: ExtraSupport -> ExtraSupport -> Ordering
$c< :: ExtraSupport -> ExtraSupport -> Bool
< :: ExtraSupport -> ExtraSupport -> Bool
$c<= :: ExtraSupport -> ExtraSupport -> Bool
<= :: ExtraSupport -> ExtraSupport -> Bool
$c> :: ExtraSupport -> ExtraSupport -> Bool
> :: ExtraSupport -> ExtraSupport -> Bool
$c>= :: ExtraSupport -> ExtraSupport -> Bool
>= :: ExtraSupport -> ExtraSupport -> Bool
$cmax :: ExtraSupport -> ExtraSupport -> ExtraSupport
max :: ExtraSupport -> ExtraSupport -> ExtraSupport
$cmin :: ExtraSupport -> ExtraSupport -> ExtraSupport
min :: ExtraSupport -> ExtraSupport -> ExtraSupport
Ord)

data PayOrderBy = ByName 
                | ByProRataCurBal
                | ByCurrentRate
                | ByMaturity
                | ByStartDate
                | ByCustomNames [String]
                -- | InverseSeq PayOrderBy
                deriving (Int -> PayOrderBy -> ShowS
[PayOrderBy] -> ShowS
PayOrderBy -> String
(Int -> PayOrderBy -> ShowS)
-> (PayOrderBy -> String)
-> ([PayOrderBy] -> ShowS)
-> Show PayOrderBy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PayOrderBy -> ShowS
showsPrec :: Int -> PayOrderBy -> ShowS
$cshow :: PayOrderBy -> String
show :: PayOrderBy -> String
$cshowList :: [PayOrderBy] -> ShowS
showList :: [PayOrderBy] -> ShowS
Show,(forall x. PayOrderBy -> Rep PayOrderBy x)
-> (forall x. Rep PayOrderBy x -> PayOrderBy) -> Generic PayOrderBy
forall x. Rep PayOrderBy x -> PayOrderBy
forall x. PayOrderBy -> Rep PayOrderBy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PayOrderBy -> Rep PayOrderBy x
from :: forall x. PayOrderBy -> Rep PayOrderBy x
$cto :: forall x. Rep PayOrderBy x -> PayOrderBy
to :: forall x. Rep PayOrderBy x -> PayOrderBy
Generic,PayOrderBy -> PayOrderBy -> Bool
(PayOrderBy -> PayOrderBy -> Bool)
-> (PayOrderBy -> PayOrderBy -> Bool) -> Eq PayOrderBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PayOrderBy -> PayOrderBy -> Bool
== :: PayOrderBy -> PayOrderBy -> Bool
$c/= :: PayOrderBy -> PayOrderBy -> Bool
/= :: PayOrderBy -> PayOrderBy -> Bool
Eq,Eq PayOrderBy
Eq PayOrderBy =>
(PayOrderBy -> PayOrderBy -> Ordering)
-> (PayOrderBy -> PayOrderBy -> Bool)
-> (PayOrderBy -> PayOrderBy -> Bool)
-> (PayOrderBy -> PayOrderBy -> Bool)
-> (PayOrderBy -> PayOrderBy -> Bool)
-> (PayOrderBy -> PayOrderBy -> PayOrderBy)
-> (PayOrderBy -> PayOrderBy -> PayOrderBy)
-> Ord PayOrderBy
PayOrderBy -> PayOrderBy -> Bool
PayOrderBy -> PayOrderBy -> Ordering
PayOrderBy -> PayOrderBy -> PayOrderBy
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PayOrderBy -> PayOrderBy -> Ordering
compare :: PayOrderBy -> PayOrderBy -> Ordering
$c< :: PayOrderBy -> PayOrderBy -> Bool
< :: PayOrderBy -> PayOrderBy -> Bool
$c<= :: PayOrderBy -> PayOrderBy -> Bool
<= :: PayOrderBy -> PayOrderBy -> Bool
$c> :: PayOrderBy -> PayOrderBy -> Bool
> :: PayOrderBy -> PayOrderBy -> Bool
$c>= :: PayOrderBy -> PayOrderBy -> Bool
>= :: PayOrderBy -> PayOrderBy -> Bool
$cmax :: PayOrderBy -> PayOrderBy -> PayOrderBy
max :: PayOrderBy -> PayOrderBy -> PayOrderBy
$cmin :: PayOrderBy -> PayOrderBy -> PayOrderBy
min :: PayOrderBy -> PayOrderBy -> PayOrderBy
Ord)

type BookLedger = (BookDirection, LedgerName) 
type BookLedgers = (BookDirection, [LedgerName]) 

data Action =
            -- Accounts 
            Transfer (Maybe Limit) AccountName AccountName (Maybe TxnComment)
            | TransferAndBook (Maybe Limit) AccountName AccountName BookLedger (Maybe TxnComment)
            | TransferMultiple [(Maybe Limit, AccountName)] AccountName (Maybe TxnComment)
            -- Fee
            | CalcFee [FeeName]                                                            -- ^ calculate fee due amount in the fee names
            | PayFee (Maybe Limit) AccountName [FeeName] (Maybe ExtraSupport)              -- ^ pay fee with cash from account with optional limit or extra support
            | PayFeeBySeq (Maybe Limit) AccountName [FeeName] (Maybe ExtraSupport)         -- ^ pay fee with cash from account with optional limit or extra support
            | CalcAndPayFee (Maybe Limit) AccountName [FeeName] (Maybe ExtraSupport)       -- ^ combination of CalcFee and PayFee
            | PayFeeResidual (Maybe Limit) AccountName FeeName                             -- ^ pay fee regardless fee due amount
            -- Bond - Interest
            | CalcBondInt [BondName]
            | CalcBondIntBy BondName DealStats DealStats                   -- ^ calculate interest due amount in the bond names,with optional balance and rate
            | PayIntOverInt (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport)      -- ^ pay interest over interest only  
            | PayInt (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport)             -- ^ pay interest with cash from the account with optional limit or extra support
            | PayIntAndBook (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) BookLedger -- ^ pay interest with cash from the account with optional limit or extra support
            | PayIntBySeq (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport)        -- ^ with sequence
            | PayIntOverIntBySeq (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ pay interest over interest only with sequence
            | AccrueAndPayInt (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport)    -- ^ combination of CalcInt and PayInt
            | AccrueAndPayIntBySeq (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) -- ^ with sequence
            | PayIntResidual (Maybe Limit) AccountName BondName                            -- ^ pay interest to bond regardless interest due
            | PayIntByRateIndex (Maybe Limit) AccountName [BondName] Int (Maybe ExtraSupport)      -- ^ pay interest to bond by index
            | PayIntByRateIndexBySeq (Maybe Limit) AccountName [BondName] Int (Maybe ExtraSupport)      -- ^ pay interest to bond by index
            -- Bond - Principal
            | CalcBondPrin (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport)        -- ^ calculate principal due amount in the bond names
            | CalcBondPrin2 (Maybe Limit) [BondName]                                        -- ^ calculate principal due amount in the bond names
            | PayPrinWithDue AccountName [BondName] (Maybe ExtraSupport)                    -- ^ pay principal to bond till due amount
            | PayPrin (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport)             -- ^ pay principal to bond via pro-rata
            | PayPrinBySeq (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport)        -- ^ pay principal to bond via sequence
            | PayPrinResidual AccountName [BondName]                                        -- ^ pay principal regardless predefined balance schedule
            | PayIntPrinBySeq (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport)     -- ^ pay int & prin to bonds sequentially
            | AccrueAndPayIntPrinBySeq (Maybe Limit) AccountName [BondName] (Maybe ExtraSupport) 
            -- Bond Group 
            | PayPrinGroup (Maybe Limit) AccountName BondName PayOrderBy (Maybe ExtraSupport) -- ^ pay bond group with cash from account with optional limit or extra support
            | AccrueIntGroup [BondName]
            | PayIntGroup (Maybe Limit) AccountName BondName PayOrderBy (Maybe ExtraSupport)  -- ^ pay bond group with cash from account with optional limit or extra support
            | AccrueAndPayIntGroup (Maybe Limit) AccountName BondName PayOrderBy (Maybe ExtraSupport) 
            -- Bond - Balance
            | WriteOff (Maybe Limit) BondName
            | WriteOffAndBook (Maybe Limit) BondName BookLedger
            | WriteOffBySeq (Maybe Limit) [BondName]
            | WriteOffBySeqAndBook (Maybe Limit) [BondName] BookLedger
            | FundWith (Maybe Limit) AccountName BondName             -- ^ extra more funds from bond and deposit cash to account
            -- Pool/Asset change
            | BuyAsset (Maybe Limit) PricingMethod AccountName (Maybe PoolId)                       -- ^ buy asset from revolving assumptions using funds from account
            | BuyAssetFrom (Maybe Limit) PricingMethod AccountName (Maybe String) (Maybe PoolId)    -- ^ buy asset from specific pool, with revolving assumptions using funds from account
            | LiquidatePool PricingMethod AccountName  (Maybe [PoolId])                             -- ^ sell all assets and deposit proceeds to account
            -- TODO include a limit for LIquidatePool
            -- Liquidation support
            | LiqSupport (Maybe Limit) CE.LiquidityProviderName CE.LiqDrawType [String]  -- ^ draw credit and deposit to account/fee/bond interest/principal
            | LiqRepay (Maybe Limit) CE.LiqRepayType AccountName CE.LiquidityProviderName   -- ^ repay liquidity facility
            | LiqYield (Maybe Limit) AccountName CE.LiquidityProviderName                   -- ^ repay compensation to liquidity facility
            | LiqAccrue [CE.LiquidityProviderName]                                            -- ^ accure premium/due interest of liquidity facility
            -- Rate Swap
            | SwapAccrue CeName                 -- ^ calculate the net amount of swap manually
            | SwapReceive AccountName CeName    -- ^ receive amount from net amount of swap and deposit to account
            | SwapPay AccountName CeName        -- ^ pay out net amount from account 
            | SwapSettle AccountName CeName     -- ^ pay & receive net amount of swap with account
            -- RateCap 
            | CollectRateCap AccountName CeName  -- ^ collect cash from rate cap and deposit to account
            -- Record booking
            | BookBy BookType                         -- ^ book an ledger with book types
            -- Pre
            | ActionWithPre Pre [Action]            -- ^ execute actions if <pre> is true 
            | ActionWithPre2 Pre [Action] [Action]  -- ^ execute action1 if <pre> is true ,else execute action2 
            -- Trigger
            | RunTrigger DealCycle [String]        -- ^ update the trigger status during the waterfall execution
            -- Debug
            | WatchVal (Maybe String) [DealStats]  -- ^ inspect vals during the waterfall execution
            | Placeholder (Maybe String)
            | ChangeStatus (Maybe Pre) DealStatus  -- change deal status
            deriving (Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
(Int -> Action -> ShowS)
-> (Action -> String) -> ([Action] -> ShowS) -> Show Action
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Action -> ShowS
showsPrec :: Int -> Action -> ShowS
$cshow :: Action -> String
show :: Action -> String
$cshowList :: [Action] -> ShowS
showList :: [Action] -> ShowS
Show,(forall x. Action -> Rep Action x)
-> (forall x. Rep Action x -> Action) -> Generic Action
forall x. Rep Action x -> Action
forall x. Action -> Rep Action x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Action -> Rep Action x
from :: forall x. Action -> Rep Action x
$cto :: forall x. Rep Action x -> Action
to :: forall x. Rep Action x -> Action
Generic,Action -> Action -> Bool
(Action -> Action -> Bool)
-> (Action -> Action -> Bool) -> Eq Action
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
/= :: Action -> Action -> Bool
Eq,Eq Action
Eq Action =>
(Action -> Action -> Ordering)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Action)
-> (Action -> Action -> Action)
-> Ord Action
Action -> Action -> Bool
Action -> Action -> Ordering
Action -> Action -> Action
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Action -> Action -> Ordering
compare :: Action -> Action -> Ordering
$c< :: Action -> Action -> Bool
< :: Action -> Action -> Bool
$c<= :: Action -> Action -> Bool
<= :: Action -> Action -> Bool
$c> :: Action -> Action -> Bool
> :: Action -> Action -> Bool
$c>= :: Action -> Action -> Bool
>= :: Action -> Action -> Bool
$cmax :: Action -> Action -> Action
max :: Action -> Action -> Action
$cmin :: Action -> Action -> Action
min :: Action -> Action -> Action
Ord)

type DistributionSeq = [Action]

data CollectionRule = Collect (Maybe [PoolId]) PoolSource AccountName                   -- ^ collect a pool source from pool collection and deposit to an account
                    | CollectByPct (Maybe [PoolId]) PoolSource [(Rate,AccountName)]     -- ^ collect a pool source from pool collection and deposit to multiple accounts with percentages
                    deriving (Int -> CollectionRule -> ShowS
[CollectionRule] -> ShowS
CollectionRule -> String
(Int -> CollectionRule -> ShowS)
-> (CollectionRule -> String)
-> ([CollectionRule] -> ShowS)
-> Show CollectionRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CollectionRule -> ShowS
showsPrec :: Int -> CollectionRule -> ShowS
$cshow :: CollectionRule -> String
show :: CollectionRule -> String
$cshowList :: [CollectionRule] -> ShowS
showList :: [CollectionRule] -> ShowS
Show,(forall x. CollectionRule -> Rep CollectionRule x)
-> (forall x. Rep CollectionRule x -> CollectionRule)
-> Generic CollectionRule
forall x. Rep CollectionRule x -> CollectionRule
forall x. CollectionRule -> Rep CollectionRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CollectionRule -> Rep CollectionRule x
from :: forall x. CollectionRule -> Rep CollectionRule x
$cto :: forall x. Rep CollectionRule x -> CollectionRule
to :: forall x. Rep CollectionRule x -> CollectionRule
Generic,CollectionRule -> CollectionRule -> Bool
(CollectionRule -> CollectionRule -> Bool)
-> (CollectionRule -> CollectionRule -> Bool) -> Eq CollectionRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CollectionRule -> CollectionRule -> Bool
== :: CollectionRule -> CollectionRule -> Bool
$c/= :: CollectionRule -> CollectionRule -> Bool
/= :: CollectionRule -> CollectionRule -> Bool
Eq,Eq CollectionRule
Eq CollectionRule =>
(CollectionRule -> CollectionRule -> Ordering)
-> (CollectionRule -> CollectionRule -> Bool)
-> (CollectionRule -> CollectionRule -> Bool)
-> (CollectionRule -> CollectionRule -> Bool)
-> (CollectionRule -> CollectionRule -> Bool)
-> (CollectionRule -> CollectionRule -> CollectionRule)
-> (CollectionRule -> CollectionRule -> CollectionRule)
-> Ord CollectionRule
CollectionRule -> CollectionRule -> Bool
CollectionRule -> CollectionRule -> Ordering
CollectionRule -> CollectionRule -> CollectionRule
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CollectionRule -> CollectionRule -> Ordering
compare :: CollectionRule -> CollectionRule -> Ordering
$c< :: CollectionRule -> CollectionRule -> Bool
< :: CollectionRule -> CollectionRule -> Bool
$c<= :: CollectionRule -> CollectionRule -> Bool
<= :: CollectionRule -> CollectionRule -> Bool
$c> :: CollectionRule -> CollectionRule -> Bool
> :: CollectionRule -> CollectionRule -> Bool
$c>= :: CollectionRule -> CollectionRule -> Bool
>= :: CollectionRule -> CollectionRule -> Bool
$cmax :: CollectionRule -> CollectionRule -> CollectionRule
max :: CollectionRule -> CollectionRule -> CollectionRule
$cmin :: CollectionRule -> CollectionRule -> CollectionRule
min :: CollectionRule -> CollectionRule -> CollectionRule
Ord)

$(deriveJSON defaultOptions ''BookType)
$(deriveJSON defaultOptions ''ExtraSupport)
$(deriveJSON defaultOptions ''PayOrderBy)
$(deriveJSON defaultOptions ''Action)
$(deriveJSON defaultOptions ''CollectionRule)