{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ViewPatterns      #-}

module PlutusCore.Value (
  Value, -- Do not expose data constructor
  NestedMap,
  unpack,
  pack,
  empty,
  fromList,
  toList,
  totalSize,
  maxInnerSize,
) where

import Codec.Serialise (Serialise)
import Control.DeepSeq (NFData)
import Data.Bifunctor
import Data.ByteString (ByteString)
import Data.ByteString.Base64 qualified as Base64
import Data.Hashable (Hashable)
import Data.IntMap.Strict (IntMap)
import Data.IntMap.Strict qualified as IntMap
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Text.Encoding qualified as Text
import GHC.Generics

import PlutusPrelude (Pretty (..))

type NestedMap = Map ByteString (Map ByteString Integer)

-- | The underlying type of the UPLC built-in type @Value@.
data Value
  = Value
      !NestedMap
      {- ^ Map from (currency symbol, token name) to amount.

      Invariants: no empty inner map, and no zero amount.
      -}
      !(IntMap Int)
      {- ^ Map from size to the number of inner maps that have that size,
      useful for efficient retrieval of the size of the largest inner map.

      Invariant: all values are positive.
      -}
      {-# UNPACK #-} !Int
      -- ^ Total size, i.e., sum total of inner map sizes
  deriving stock (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show, (forall x. Value -> Rep Value x)
-> (forall x. Rep Value x -> Value) -> Generic Value
forall x. Rep Value x -> Value
forall x. Value -> Rep Value x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Value -> Rep Value x
from :: forall x. Value -> Rep Value x
$cto :: forall x. Rep Value x -> Value
to :: forall x. Rep Value x -> Value
Generic)
  deriving anyclass (Eq Value
Eq Value =>
(Int -> Value -> Int) -> (Value -> Int) -> Hashable Value
Int -> Value -> Int
Value -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Value -> Int
hashWithSalt :: Int -> Value -> Int
$chash :: Value -> Int
hash :: Value -> Int
Hashable, [Value] -> Encoding
Value -> Encoding
(Value -> Encoding)
-> (forall s. Decoder s Value)
-> ([Value] -> Encoding)
-> (forall s. Decoder s [Value])
-> Serialise Value
forall s. Decoder s [Value]
forall s. Decoder s Value
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: Value -> Encoding
encode :: Value -> Encoding
$cdecode :: forall s. Decoder s Value
decode :: forall s. Decoder s Value
$cencodeList :: [Value] -> Encoding
encodeList :: [Value] -> Encoding
$cdecodeList :: forall s. Decoder s [Value]
decodeList :: forall s. Decoder s [Value]
Serialise, Value -> ()
(Value -> ()) -> NFData Value
forall a. (a -> ()) -> NFData a
$crnf :: Value -> ()
rnf :: Value -> ()
NFData)

{-| Unpack a `Value` into a map from (currency symbol, token name) to amount.

The map is guaranteed to not contain empty inner map or zero amount.
-}
unpack :: Value -> NestedMap
unpack :: Value -> NestedMap
unpack (Value NestedMap
v IntMap Int
_ Int
_) = NestedMap
v

{-| Pack a map from (currency symbol, token name) to amount into a `Value`.

The map will be filtered so that it does not contain empty inner map or zero amount.
-}
pack :: NestedMap -> Value
pack :: NestedMap -> Value
pack (NestedMap -> NestedMap
normalize -> NestedMap
v) = NestedMap -> IntMap Int -> Int -> Value
Value NestedMap
v IntMap Int
sizes Int
size
 where
  sizes :: IntMap Int
sizes = (Map ByteString Integer -> IntMap Int -> IntMap Int)
-> IntMap Int -> NestedMap -> IntMap Int
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr' ((Maybe Int -> Maybe Int) -> Int -> IntMap Int -> IntMap Int
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IntMap.alter (Maybe Int -> (Int -> Maybe Int) -> Maybe Int -> Maybe Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (Int -> Int) -> Int -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))) (Int -> IntMap Int -> IntMap Int)
-> (Map ByteString Integer -> Int)
-> Map ByteString Integer
-> IntMap Int
-> IntMap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ByteString Integer -> Int
forall k a. Map k a -> Int
Map.size) IntMap Int
forall a. Monoid a => a
mempty NestedMap
v
  size :: Int
size = (Map ByteString Integer -> Int -> Int) -> Int -> NestedMap -> Int
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr' (Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int)
-> (Map ByteString Integer -> Int)
-> Map ByteString Integer
-> Int
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ByteString Integer -> Int
forall k a. Map k a -> Int
Map.size) Int
0 NestedMap
v

{-| Total size, i.e., the number of distinct `(currency symbol, token name)` pairs
contained in the `Value`.
-}
totalSize :: Value -> Int
totalSize :: Value -> Int
totalSize (Value NestedMap
_ IntMap Int
_ Int
size) = Int
size

-- | Size of the largest inner map.
maxInnerSize :: Value -> Int
maxInnerSize :: Value -> Int
maxInnerSize (Value NestedMap
_ IntMap Int
sizes Int
_) = Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> a
fst (IntMap Int -> Maybe (Int, Int)
forall a. IntMap a -> Maybe (Int, a)
IntMap.lookupMax IntMap Int
sizes)

empty :: Value
empty :: Value
empty = NestedMap -> IntMap Int -> Int -> Value
Value NestedMap
forall a. Monoid a => a
mempty IntMap Int
forall a. Monoid a => a
mempty Int
0

toList :: Value -> [(ByteString, [(ByteString, Integer)])]
toList :: Value -> [(ByteString, [(ByteString, Integer)])]
toList = Map ByteString [(ByteString, Integer)]
-> [(ByteString, [(ByteString, Integer)])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map ByteString [(ByteString, Integer)]
 -> [(ByteString, [(ByteString, Integer)])])
-> (Value -> Map ByteString [(ByteString, Integer)])
-> Value
-> [(ByteString, [(ByteString, Integer)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ByteString Integer -> [(ByteString, Integer)])
-> NestedMap -> Map ByteString [(ByteString, Integer)]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Map ByteString Integer -> [(ByteString, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList (NestedMap -> Map ByteString [(ByteString, Integer)])
-> (Value -> NestedMap)
-> Value
-> Map ByteString [(ByteString, Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> NestedMap
unpack

fromList :: [(ByteString, [(ByteString, Integer)])] -> Value
fromList :: [(ByteString, [(ByteString, Integer)])] -> Value
fromList =
  NestedMap -> Value
pack
    (NestedMap -> Value)
-> ([(ByteString, [(ByteString, Integer)])] -> NestedMap)
-> [(ByteString, [(ByteString, Integer)])]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ByteString Integer
 -> Map ByteString Integer -> Map ByteString Integer)
-> [(ByteString, Map ByteString Integer)] -> NestedMap
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith ((Integer -> Integer -> Integer)
-> Map ByteString Integer
-> Map ByteString Integer
-> Map ByteString Integer
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
    ([(ByteString, Map ByteString Integer)] -> NestedMap)
-> ([(ByteString, [(ByteString, Integer)])]
    -> [(ByteString, Map ByteString Integer)])
-> [(ByteString, [(ByteString, Integer)])]
-> NestedMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, [(ByteString, Integer)])
 -> (ByteString, Map ByteString Integer))
-> [(ByteString, [(ByteString, Integer)])]
-> [(ByteString, Map ByteString Integer)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(ByteString, Integer)] -> Map ByteString Integer)
-> (ByteString, [(ByteString, Integer)])
-> (ByteString, Map ByteString Integer)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Integer -> Integer -> Integer)
-> [(ByteString, Integer)] -> Map ByteString Integer
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)))

normalize :: NestedMap -> NestedMap
normalize :: NestedMap -> NestedMap
normalize = (Map ByteString Integer -> Bool) -> NestedMap -> NestedMap
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool)
-> (Map ByteString Integer -> Bool)
-> Map ByteString Integer
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ByteString Integer -> Bool
forall k a. Map k a -> Bool
Map.null) (NestedMap -> NestedMap)
-> (NestedMap -> NestedMap) -> NestedMap -> NestedMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ByteString Integer -> Map ByteString Integer)
-> NestedMap -> NestedMap
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((Integer -> Bool)
-> Map ByteString Integer -> Map ByteString Integer
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0))

instance Pretty Value where
  pretty :: forall ann. Value -> Doc ann
pretty = [(Text, [(Text, Integer)])] -> Doc ann
forall ann. [(Text, [(Text, Integer)])] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([(Text, [(Text, Integer)])] -> Doc ann)
-> (Value -> [(Text, [(Text, Integer)])]) -> Value -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, [(ByteString, Integer)])
 -> (Text, [(Text, Integer)]))
-> [(ByteString, [(ByteString, Integer)])]
-> [(Text, [(Text, Integer)])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> Text)
-> ([(ByteString, Integer)] -> [(Text, Integer)])
-> (ByteString, [(ByteString, Integer)])
-> (Text, [(Text, Integer)])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ByteString -> Text
toText (((ByteString, Integer) -> (Text, Integer))
-> [(ByteString, Integer)] -> [(Text, Integer)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> Text) -> (ByteString, Integer) -> (Text, Integer)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ByteString -> Text
toText))) ([(ByteString, [(ByteString, Integer)])]
 -> [(Text, [(Text, Integer)])])
-> (Value -> [(ByteString, [(ByteString, Integer)])])
-> Value
-> [(Text, [(Text, Integer)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [(ByteString, [(ByteString, Integer)])]
toList
   where
    toText :: ByteString -> Text
toText = ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode