module ErgoDex.Types where

import Prelude      (Show, Eq, Ord(..), Integer, Bool, ($), (==), (<>), negate)
import Data.Aeson   (FromJSON, ToJSON)
import GHC.Generics (Generic)

import           Ledger
import qualified Ledger.Ada        as Ada
import           Ledger.Value      (AssetClass(..), assetClassValueOf, assetClassValue, Value(..))
import           PlutusTx.Numeric  (AdditiveSemigroup(..), MultiplicativeSemigroup(..))
import qualified PlutusTx.AssocMap as Map

import ErgoDex.Contracts.Types as Currencies

--todo: move to orphans
deriving anyclass instance ToJSON (Coin a)
deriving anyclass instance FromJSON (Coin a)

newtype AssetEntry = AssetEntry { unAssetEntry :: (AssetClass, Integer) }
  deriving (Show, Eq, Generic)
  deriving newtype (ToJSON, FromJSON)

assetEntryClass :: AssetEntry -> AssetClass
assetEntryClass (AssetEntry (cls, _)) = cls

assetEntry :: CurrencySymbol -> TokenName -> Integer -> AssetEntry
assetEntry cs tn v = AssetEntry (AssetClass (cs, tn), v)

data AssetAmount a = AssetAmount
  { getAsset  :: Coin a
  , getAmount :: Amount a
  } deriving (Generic, Show, Eq, ToJSON, FromJSON)

instance AdditiveSemigroup (AssetAmount a) where
  a0 + a1 = a0 { getAmount = (getAmount a0) + (getAmount a1) }

instance MultiplicativeSemigroup (AssetAmount a) where
  a0 * a1 = a0 { getAmount = (getAmount a0) * (getAmount a1) }

instance Ord (AssetAmount a) where
  compare (AssetAmount _ (Amount x)) (AssetAmount _ (Amount y)) = compare x y

amountEq :: AssetAmount a -> Integer -> Bool
amountEq (AssetAmount _ (Amount a)) b = a == b

assetAmountSubtract :: Value -> AssetAmount a -> Value
assetAmountSubtract vl AssetAmount{getAsset=Coin ac, getAmount=Amount v} =
    vl <> negValue
  where
    (cs, tn) = unAssetClass ac
    negValue = Value $ Map.fromList [(cs, Map.fromList [(tn, negate v)])]

assetAmountRawValue :: AssetAmount a -> Integer
assetAmountRawValue AssetAmount{getAmount=Amount v} = v

assetAmountValue :: AssetAmount a -> Value
assetAmountValue AssetAmount{getAsset=Coin ac, getAmount=Amount v} = assetClassValue ac v

assetAmountOf :: AssetEntry -> AssetAmount a
assetAmountOf (AssetEntry (ac, v)) = AssetAmount (Coin ac) (Amount v)

assetAmountCoinOf :: Coin a -> Integer -> AssetAmount a
assetAmountCoinOf c v = AssetAmount c (Amount v)

assetAmountPairOf :: (AssetEntry, AssetEntry) -> Coin a -> AssetAmount a
assetAmountPairOf (AssetEntry (ac, av), AssetEntry (bc, bv)) c =
  AssetAmount c (Amount $
    if ac == unCoin c then av
    else if bc == unCoin c then bv
    else 0)

assetAmountOfCoin :: Value -> Coin a -> AssetAmount a
assetAmountOfCoin v c =
  AssetAmount c (Amount $ assetClassValueOf v (unCoin c))

retagAmount :: forall a b. Amount a -> Amount b
retagAmount (Amount x) = Amount x

adaCoin :: Coin Lovelace
adaCoin = Coin $ AssetClass (Ada.adaSymbol, Ada.adaToken )

data ExFeePerToken = ExFeePerToken
  { exFeePerTokenNum :: Integer
  , exFeePerTokenDen :: Integer
  } deriving (Show, Eq, Generic, ToJSON, FromJSON)

newtype ExFee = ExFee { unExFee :: Amount Currencies.Lovelace }
  deriving (Show, Eq, Generic, ToJSON, FromJSON)

todo: move to orphans
module ErgoDex.Types where

import Prelude      (Show, Eq, Ord(..), Integer, Bool, ($), (==), (<>), negate)
import Data.Aeson   (FromJSON, ToJSON)
import GHC.Generics (Generic)

import           Ledger
import qualified Ledger.Ada        as Ada
import           Ledger.Value      (AssetClass(..), assetClassValueOf, assetClassValue, Value(..))
import           PlutusTx.Numeric  (AdditiveSemigroup(..), MultiplicativeSemigroup(..))
import qualified PlutusTx.AssocMap as Map

import ErgoDex.Contracts.Types as Currencies

deriving anyclass instance ToJSON (Coin a)
deriving anyclass instance FromJSON (Coin a)

newtype AssetEntry = AssetEntry { unAssetEntry :: (AssetClass, Integer) }
  deriving (Show, Eq, Generic)
  deriving newtype (ToJSON, FromJSON)

assetEntryClass :: AssetEntry -> AssetClass
assetEntryClass (AssetEntry (cls, _)) = cls

assetEntry :: CurrencySymbol -> TokenName -> Integer -> AssetEntry
assetEntry cs tn v = AssetEntry (AssetClass (cs, tn), v)

data AssetAmount a = AssetAmount
  { getAsset  :: Coin a
  , getAmount :: Amount a
  } deriving (Generic, Show, Eq, ToJSON, FromJSON)

instance AdditiveSemigroup (AssetAmount a) where
  a0 + a1 = a0 { getAmount = (getAmount a0) + (getAmount a1) }

instance MultiplicativeSemigroup (AssetAmount a) where
  a0 * a1 = a0 { getAmount = (getAmount a0) * (getAmount a1) }

instance Ord (AssetAmount a) where
  compare (AssetAmount _ (Amount x)) (AssetAmount _ (Amount y)) = compare x y

amountEq :: AssetAmount a -> Integer -> Bool
amountEq (AssetAmount _ (Amount a)) b = a == b

assetAmountSubtract :: Value -> AssetAmount a -> Value
assetAmountSubtract vl AssetAmount{getAsset=Coin ac, getAmount=Amount v} =
    vl <> negValue
  where
    (cs, tn) = unAssetClass ac
    negValue = Value $ Map.fromList [(cs, Map.fromList [(tn, negate v)])]

assetAmountRawValue :: AssetAmount a -> Integer
assetAmountRawValue AssetAmount{getAmount=Amount v} = v

assetAmountValue :: AssetAmount a -> Value
assetAmountValue AssetAmount{getAsset=Coin ac, getAmount=Amount v} = assetClassValue ac v

assetAmountOf :: AssetEntry -> AssetAmount a
assetAmountOf (AssetEntry (ac, v)) = AssetAmount (Coin ac) (Amount v)

assetAmountCoinOf :: Coin a -> Integer -> AssetAmount a
assetAmountCoinOf c v = AssetAmount c (Amount v)

assetAmountPairOf :: (AssetEntry, AssetEntry) -> Coin a -> AssetAmount a
assetAmountPairOf (AssetEntry (ac, av), AssetEntry (bc, bv)) c =
  AssetAmount c (Amount $
    if ac == unCoin c then av
    else if bc == unCoin c then bv
    else 0)

assetAmountOfCoin :: Value -> Coin a -> AssetAmount a
assetAmountOfCoin v c =
  AssetAmount c (Amount $ assetClassValueOf v (unCoin c))

retagAmount :: forall a b. Amount a -> Amount b
retagAmount (Amount x) = Amount x

adaCoin :: Coin Lovelace
adaCoin = Coin $ AssetClass (Ada.adaSymbol, Ada.adaToken )

data ExFeePerToken = ExFeePerToken
  { exFeePerTokenNum :: Integer
  , exFeePerTokenDen :: Integer
  } deriving (Show, Eq, Generic, ToJSON, FromJSON)

newtype ExFee = ExFee { unExFee :: Amount Currencies.Lovelace }
  deriving (Show, Eq, Generic, ToJSON, FromJSON)
