module BtcLsp.Data.Kind
  ( Direction (..),
    MoneyRelation (..),
    BitcoinLayer (..),
    Owner (..),
    Table (..),
  )
where

import BtcLsp.Import.External

data Direction
  = Outgoing
  | Incoming
  deriving stock
    ( Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq,
      Eq Direction
Eq Direction
-> (Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
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
min :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmax :: Direction -> Direction -> Direction
>= :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c< :: Direction -> Direction -> Bool
compare :: Direction -> Direction -> Ordering
$ccompare :: Direction -> Direction -> Ordering
Ord,
      Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show,
      (forall x. Direction -> Rep Direction x)
-> (forall x. Rep Direction x -> Direction) -> Generic Direction
forall x. Rep Direction x -> Direction
forall x. Direction -> Rep Direction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Direction x -> Direction
$cfrom :: forall x. Direction -> Rep Direction x
Generic
    )

data MoneyRelation
  = Fund
  | Refund
  | Gain
  | Loss
  deriving stock
    ( MoneyRelation -> MoneyRelation -> Bool
(MoneyRelation -> MoneyRelation -> Bool)
-> (MoneyRelation -> MoneyRelation -> Bool) -> Eq MoneyRelation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MoneyRelation -> MoneyRelation -> Bool
$c/= :: MoneyRelation -> MoneyRelation -> Bool
== :: MoneyRelation -> MoneyRelation -> Bool
$c== :: MoneyRelation -> MoneyRelation -> Bool
Eq,
      Eq MoneyRelation
Eq MoneyRelation
-> (MoneyRelation -> MoneyRelation -> Ordering)
-> (MoneyRelation -> MoneyRelation -> Bool)
-> (MoneyRelation -> MoneyRelation -> Bool)
-> (MoneyRelation -> MoneyRelation -> Bool)
-> (MoneyRelation -> MoneyRelation -> Bool)
-> (MoneyRelation -> MoneyRelation -> MoneyRelation)
-> (MoneyRelation -> MoneyRelation -> MoneyRelation)
-> Ord MoneyRelation
MoneyRelation -> MoneyRelation -> Bool
MoneyRelation -> MoneyRelation -> Ordering
MoneyRelation -> MoneyRelation -> MoneyRelation
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
min :: MoneyRelation -> MoneyRelation -> MoneyRelation
$cmin :: MoneyRelation -> MoneyRelation -> MoneyRelation
max :: MoneyRelation -> MoneyRelation -> MoneyRelation
$cmax :: MoneyRelation -> MoneyRelation -> MoneyRelation
>= :: MoneyRelation -> MoneyRelation -> Bool
$c>= :: MoneyRelation -> MoneyRelation -> Bool
> :: MoneyRelation -> MoneyRelation -> Bool
$c> :: MoneyRelation -> MoneyRelation -> Bool
<= :: MoneyRelation -> MoneyRelation -> Bool
$c<= :: MoneyRelation -> MoneyRelation -> Bool
< :: MoneyRelation -> MoneyRelation -> Bool
$c< :: MoneyRelation -> MoneyRelation -> Bool
compare :: MoneyRelation -> MoneyRelation -> Ordering
$ccompare :: MoneyRelation -> MoneyRelation -> Ordering
Ord,
      Int -> MoneyRelation -> ShowS
[MoneyRelation] -> ShowS
MoneyRelation -> String
(Int -> MoneyRelation -> ShowS)
-> (MoneyRelation -> String)
-> ([MoneyRelation] -> ShowS)
-> Show MoneyRelation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MoneyRelation] -> ShowS
$cshowList :: [MoneyRelation] -> ShowS
show :: MoneyRelation -> String
$cshow :: MoneyRelation -> String
showsPrec :: Int -> MoneyRelation -> ShowS
$cshowsPrec :: Int -> MoneyRelation -> ShowS
Show,
      (forall x. MoneyRelation -> Rep MoneyRelation x)
-> (forall x. Rep MoneyRelation x -> MoneyRelation)
-> Generic MoneyRelation
forall x. Rep MoneyRelation x -> MoneyRelation
forall x. MoneyRelation -> Rep MoneyRelation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MoneyRelation x -> MoneyRelation
$cfrom :: forall x. MoneyRelation -> Rep MoneyRelation x
Generic
    )

data BitcoinLayer
  = OnChain
  | Ln
  deriving stock
    ( BitcoinLayer -> BitcoinLayer -> Bool
(BitcoinLayer -> BitcoinLayer -> Bool)
-> (BitcoinLayer -> BitcoinLayer -> Bool) -> Eq BitcoinLayer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BitcoinLayer -> BitcoinLayer -> Bool
$c/= :: BitcoinLayer -> BitcoinLayer -> Bool
== :: BitcoinLayer -> BitcoinLayer -> Bool
$c== :: BitcoinLayer -> BitcoinLayer -> Bool
Eq,
      Eq BitcoinLayer
Eq BitcoinLayer
-> (BitcoinLayer -> BitcoinLayer -> Ordering)
-> (BitcoinLayer -> BitcoinLayer -> Bool)
-> (BitcoinLayer -> BitcoinLayer -> Bool)
-> (BitcoinLayer -> BitcoinLayer -> Bool)
-> (BitcoinLayer -> BitcoinLayer -> Bool)
-> (BitcoinLayer -> BitcoinLayer -> BitcoinLayer)
-> (BitcoinLayer -> BitcoinLayer -> BitcoinLayer)
-> Ord BitcoinLayer
BitcoinLayer -> BitcoinLayer -> Bool
BitcoinLayer -> BitcoinLayer -> Ordering
BitcoinLayer -> BitcoinLayer -> BitcoinLayer
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
min :: BitcoinLayer -> BitcoinLayer -> BitcoinLayer
$cmin :: BitcoinLayer -> BitcoinLayer -> BitcoinLayer
max :: BitcoinLayer -> BitcoinLayer -> BitcoinLayer
$cmax :: BitcoinLayer -> BitcoinLayer -> BitcoinLayer
>= :: BitcoinLayer -> BitcoinLayer -> Bool
$c>= :: BitcoinLayer -> BitcoinLayer -> Bool
> :: BitcoinLayer -> BitcoinLayer -> Bool
$c> :: BitcoinLayer -> BitcoinLayer -> Bool
<= :: BitcoinLayer -> BitcoinLayer -> Bool
$c<= :: BitcoinLayer -> BitcoinLayer -> Bool
< :: BitcoinLayer -> BitcoinLayer -> Bool
$c< :: BitcoinLayer -> BitcoinLayer -> Bool
compare :: BitcoinLayer -> BitcoinLayer -> Ordering
$ccompare :: BitcoinLayer -> BitcoinLayer -> Ordering
Ord,
      Int -> BitcoinLayer -> ShowS
[BitcoinLayer] -> ShowS
BitcoinLayer -> String
(Int -> BitcoinLayer -> ShowS)
-> (BitcoinLayer -> String)
-> ([BitcoinLayer] -> ShowS)
-> Show BitcoinLayer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BitcoinLayer] -> ShowS
$cshowList :: [BitcoinLayer] -> ShowS
show :: BitcoinLayer -> String
$cshow :: BitcoinLayer -> String
showsPrec :: Int -> BitcoinLayer -> ShowS
$cshowsPrec :: Int -> BitcoinLayer -> ShowS
Show,
      (forall x. BitcoinLayer -> Rep BitcoinLayer x)
-> (forall x. Rep BitcoinLayer x -> BitcoinLayer)
-> Generic BitcoinLayer
forall x. Rep BitcoinLayer x -> BitcoinLayer
forall x. BitcoinLayer -> Rep BitcoinLayer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BitcoinLayer x -> BitcoinLayer
$cfrom :: forall x. BitcoinLayer -> Rep BitcoinLayer x
Generic
    )

data Owner
  = Lsp
  | Usr
  | Chan
  deriving stock
    ( Owner -> Owner -> Bool
(Owner -> Owner -> Bool) -> (Owner -> Owner -> Bool) -> Eq Owner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Owner -> Owner -> Bool
$c/= :: Owner -> Owner -> Bool
== :: Owner -> Owner -> Bool
$c== :: Owner -> Owner -> Bool
Eq,
      Eq Owner
Eq Owner
-> (Owner -> Owner -> Ordering)
-> (Owner -> Owner -> Bool)
-> (Owner -> Owner -> Bool)
-> (Owner -> Owner -> Bool)
-> (Owner -> Owner -> Bool)
-> (Owner -> Owner -> Owner)
-> (Owner -> Owner -> Owner)
-> Ord Owner
Owner -> Owner -> Bool
Owner -> Owner -> Ordering
Owner -> Owner -> Owner
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
min :: Owner -> Owner -> Owner
$cmin :: Owner -> Owner -> Owner
max :: Owner -> Owner -> Owner
$cmax :: Owner -> Owner -> Owner
>= :: Owner -> Owner -> Bool
$c>= :: Owner -> Owner -> Bool
> :: Owner -> Owner -> Bool
$c> :: Owner -> Owner -> Bool
<= :: Owner -> Owner -> Bool
$c<= :: Owner -> Owner -> Bool
< :: Owner -> Owner -> Bool
$c< :: Owner -> Owner -> Bool
compare :: Owner -> Owner -> Ordering
$ccompare :: Owner -> Owner -> Ordering
Ord,
      Int -> Owner -> ShowS
[Owner] -> ShowS
Owner -> String
(Int -> Owner -> ShowS)
-> (Owner -> String) -> ([Owner] -> ShowS) -> Show Owner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Owner] -> ShowS
$cshowList :: [Owner] -> ShowS
show :: Owner -> String
$cshow :: Owner -> String
showsPrec :: Int -> Owner -> ShowS
$cshowsPrec :: Int -> Owner -> ShowS
Show,
      (forall x. Owner -> Rep Owner x)
-> (forall x. Rep Owner x -> Owner) -> Generic Owner
forall x. Rep Owner x -> Owner
forall x. Owner -> Rep Owner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Owner x -> Owner
$cfrom :: forall x. Owner -> Rep Owner x
Generic
    )

data Table
  = UserTable
  | SwapIntoLnTable
  | SwapUtxoTable
  | BlockTable
  | LnChanTable
  deriving stock
    ( Table -> Table -> Bool
(Table -> Table -> Bool) -> (Table -> Table -> Bool) -> Eq Table
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Table -> Table -> Bool
$c/= :: Table -> Table -> Bool
== :: Table -> Table -> Bool
$c== :: Table -> Table -> Bool
Eq,
      Eq Table
Eq Table
-> (Table -> Table -> Ordering)
-> (Table -> Table -> Bool)
-> (Table -> Table -> Bool)
-> (Table -> Table -> Bool)
-> (Table -> Table -> Bool)
-> (Table -> Table -> Table)
-> (Table -> Table -> Table)
-> Ord Table
Table -> Table -> Bool
Table -> Table -> Ordering
Table -> Table -> Table
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
min :: Table -> Table -> Table
$cmin :: Table -> Table -> Table
max :: Table -> Table -> Table
$cmax :: Table -> Table -> Table
>= :: Table -> Table -> Bool
$c>= :: Table -> Table -> Bool
> :: Table -> Table -> Bool
$c> :: Table -> Table -> Bool
<= :: Table -> Table -> Bool
$c<= :: Table -> Table -> Bool
< :: Table -> Table -> Bool
$c< :: Table -> Table -> Bool
compare :: Table -> Table -> Ordering
$ccompare :: Table -> Table -> Ordering
Ord,
      Int -> Table -> ShowS
[Table] -> ShowS
Table -> String
(Int -> Table -> ShowS)
-> (Table -> String) -> ([Table] -> ShowS) -> Show Table
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Table] -> ShowS
$cshowList :: [Table] -> ShowS
show :: Table -> String
$cshow :: Table -> String
showsPrec :: Int -> Table -> ShowS
$cshowsPrec :: Int -> Table -> ShowS
Show,
      (forall x. Table -> Rep Table x)
-> (forall x. Rep Table x -> Table) -> Generic Table
forall x. Rep Table x -> Table
forall x. Table -> Rep Table x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Table x -> Table
$cfrom :: forall x. Table -> Rep Table x
Generic,
      Int -> Table
Table -> Int
Table -> [Table]
Table -> Table
Table -> Table -> [Table]
Table -> Table -> Table -> [Table]
(Table -> Table)
-> (Table -> Table)
-> (Int -> Table)
-> (Table -> Int)
-> (Table -> [Table])
-> (Table -> Table -> [Table])
-> (Table -> Table -> [Table])
-> (Table -> Table -> Table -> [Table])
-> Enum Table
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Table -> Table -> Table -> [Table]
$cenumFromThenTo :: Table -> Table -> Table -> [Table]
enumFromTo :: Table -> Table -> [Table]
$cenumFromTo :: Table -> Table -> [Table]
enumFromThen :: Table -> Table -> [Table]
$cenumFromThen :: Table -> Table -> [Table]
enumFrom :: Table -> [Table]
$cenumFrom :: Table -> [Table]
fromEnum :: Table -> Int
$cfromEnum :: Table -> Int
toEnum :: Int -> Table
$ctoEnum :: Int -> Table
pred :: Table -> Table
$cpred :: Table -> Table
succ :: Table -> Table
$csucc :: Table -> Table
Enum,
      Table
Table -> Table -> Bounded Table
forall a. a -> a -> Bounded a
maxBound :: Table
$cmaxBound :: Table
minBound :: Table
$cminBound :: Table
Bounded
    )