86 lines
2.3 KiB
Haskell
86 lines
2.3 KiB
Haskell
{-# OPTIONS_GHC -Wno-orphans #-}
|
|
|
|
module Agora.Plutarch.Orphans () where
|
|
|
|
import Plutarch.Lift (PConstantDecl (..), PUnsafeLiftDecl (PLifted))
|
|
|
|
import Data.Bifunctor (Bifunctor (bimap))
|
|
import Data.Map.Strict qualified as StrictMap
|
|
import Data.Tagged (Tagged (Tagged))
|
|
import Data.Traversable (for)
|
|
import Plutarch.Api.V1 (KeyGuarantees (Sorted), PMap)
|
|
import Plutarch.Extra.Tagged (PTagged)
|
|
import PlutusTx qualified
|
|
import PlutusTx.AssocMap qualified as AssocMap
|
|
import Ply (PlyArg)
|
|
import Ply.Plutarch.Class (PlyArgOf)
|
|
|
|
-- | @since 1.0.0
|
|
instance
|
|
( PConstantData k
|
|
, PConstantData v
|
|
, Ord k
|
|
) =>
|
|
PConstantDecl (StrictMap.Map k v)
|
|
where
|
|
type
|
|
PConstantRepr (StrictMap.Map k v) =
|
|
[(PlutusTx.Data, PlutusTx.Data)]
|
|
type
|
|
PConstanted (StrictMap.Map k v) =
|
|
PMap 'Sorted (PConstanted k) (PConstanted v)
|
|
pconstantToRepr m =
|
|
bimap
|
|
PlutusTx.toData
|
|
PlutusTx.toData
|
|
<$> StrictMap.toList m
|
|
pconstantFromRepr m = fmap StrictMap.fromList $
|
|
for m $ \(x, y) -> do
|
|
x' <- PlutusTx.fromData x
|
|
y' <- PlutusTx.fromData y
|
|
Just (x', y')
|
|
|
|
-- | @since 1.0.0
|
|
instance
|
|
( PLiftData k
|
|
, PLiftData v
|
|
, Ord (PLifted k)
|
|
) =>
|
|
PUnsafeLiftDecl (PMap 'Sorted k v)
|
|
where
|
|
type PLifted (PMap 'Sorted k v) = StrictMap.Map (PLifted k) (PLifted v)
|
|
|
|
-- | @since 1.0.0
|
|
instance
|
|
(PlutusTx.ToData k, PlutusTx.ToData v) =>
|
|
PlutusTx.ToData (StrictMap.Map k v)
|
|
where
|
|
toBuiltinData = PlutusTx.toBuiltinData . toAssocMap
|
|
where
|
|
toAssocMap :: StrictMap.Map k v -> AssocMap.Map k v
|
|
toAssocMap = AssocMap.fromList . StrictMap.toAscList
|
|
|
|
-- | @since 1.0.0
|
|
instance
|
|
(PlutusTx.FromData k, PlutusTx.FromData v, Ord k) =>
|
|
PlutusTx.FromData (StrictMap.Map k v)
|
|
where
|
|
fromBuiltinData d = PlutusTx.fromBuiltinData d >>= toStrictMap
|
|
where
|
|
toStrictMap :: AssocMap.Map k v -> Maybe (StrictMap.Map k v)
|
|
toStrictMap m =
|
|
let l = AssocMap.toList m
|
|
in if isSorted $ fmap fst l
|
|
then Just $ StrictMap.fromAscList l
|
|
else Nothing
|
|
|
|
isSorted :: forall a. Ord a => [a] -> Bool
|
|
isSorted [] = True
|
|
isSorted [_] = True
|
|
isSorted (x : y : xs) = x < y && isSorted (y : xs)
|
|
|
|
-- | @since 1.0.0
|
|
type instance PlyArgOf (PTagged tag a) = Tagged tag (PlyArgOf a)
|
|
|
|
-- | @since 1.0.0
|
|
deriving newtype instance PlyArg a => PlyArg (Tagged tag a)
|