Class.hs

{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE KindSignatures       #-}
{-# LANGUAGE NoImplicitPrelude    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-strictness #-}
{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
module PlutusTx.IsData.Class where

import           Data.ByteString            as BS

import           Prelude                    (Int, Integer, Maybe (..), error)

import qualified PlutusCore.Data            as PLC
import           PlutusTx.Builtins          as Builtins
import           PlutusTx.Builtins.Internal (BuiltinData (..))
import qualified PlutusTx.Builtins.Internal as BI

import           PlutusTx.Applicative
import           PlutusTx.Functor
import           PlutusTx.Trace

import           Data.Kind
import           Data.Void

import           GHC.TypeLits               (ErrorMessage (..), TypeError)


{- HLINT ignore -}

-- | A typeclass for types that can be converted to and from 'BuiltinData'.
class IsData (a :: Type) where
    -- | Convert a value to 'BuiltinData'.
    toBuiltinData :: a -> BuiltinData
    -- TODO: this should probably provide some kind of diagnostics
    -- | Convert a value from 'BuiltinData', returning 'Nothing' if this fails.
    fromBuiltinData :: BuiltinData -> Maybe a
    -- | Convert a value from 'BuiltinData', calling 'error' if this fails.
    -- This is typically much faster than 'fromBuiltinData'.
    --
    -- When implementing this function, make sure to call 'unsafeFromBuiltinData'
    -- rather than 'fromBuiltinData' when converting substructures!
    unsafeFromBuiltinData :: BuiltinData -> a

instance IsData BuiltinData where
    {-# INLINABLE toBuiltinData #-}
    toBuiltinData = id
    {-# INLINABLE fromBuiltinData #-}
    fromBuiltinData d = Just d
    {-# INLINABLE unsafeFromBuiltinData #-}
    unsafeFromBuiltinData d = d

instance (TypeError ('Text "Int is not supported, use Integer instead"))
    => IsData Int where
    toBuiltinData = Prelude.error "unsupported"
    fromBuiltinData = Prelude.error "unsupported"
    unsafeFromBuiltinData = Prelude.error "unsupported"

instance IsData Integer where
    {-# INLINABLE toBuiltinData #-}
    toBuiltinData i = mkI i
    {-# INLINABLE fromBuiltinData #-}
    fromBuiltinData d = matchData' d (\_ _ -> Nothing) (const Nothing) (const Nothing) (\i -> Just i) (const Nothing)
    {-# INLINABLE unsafeFromBuiltinData #-}
    unsafeFromBuiltinData = BI.unsafeDataAsI

instance IsData ByteString where
    {-# INLINABLE toBuiltinData #-}
    toBuiltinData b = mkB b
    {-# INLINABLE fromBuiltinData #-}
    fromBuiltinData d = matchData' d (\_ _ -> Nothing) (const Nothing) (const Nothing) (const Nothing) (\b -> Just b)
    {-# INLINABLE unsafeFromBuiltinData #-}
    unsafeFromBuiltinData = BI.unsafeDataAsB

instance IsData a => IsData [a] where
    {-# INLINABLE toBuiltinData #-}
    toBuiltinData l = BI.mkList (mapToBuiltin l)
        where
          {-# INLINE mapToBuiltin #-}
          mapToBuiltin :: [a] -> BI.BuiltinList BI.BuiltinData
          mapToBuiltin = go
            where
                go :: [a] -> BI.BuiltinList BI.BuiltinData
                go []     = BI.mkNilData BI.unitval
                go (x:xs) = BI.mkCons (toBuiltinData x) (go xs)
    {-# INLINABLE fromBuiltinData #-}
    fromBuiltinData d =
        matchData'
        d
        (\_ _ -> Nothing)
        (const Nothing)
        traverseFromBuiltin
        (const Nothing)
        (const Nothing)
        where
          {-# INLINE traverseFromBuiltin #-}
          traverseFromBuiltin :: BI.BuiltinList BI.BuiltinData -> Maybe [a]
          traverseFromBuiltin = go
            where
                go :: BI.BuiltinList BI.BuiltinData -> Maybe [a]
                go l = BI.chooseList (const (pure [])) (\_ -> liftA2 (:) (fromBuiltinData (BI.head l)) (go (BI.tail l))) l ()
    {-# INLINABLE unsafeFromBuiltinData #-}
    unsafeFromBuiltinData d = mapFromBuiltin (BI.unsafeDataAsList d)
        where
          {-# INLINE mapFromBuiltin #-}
          mapFromBuiltin :: BI.BuiltinList BI.BuiltinData -> [a]
          mapFromBuiltin = go
            where
                go :: BI.BuiltinList BI.BuiltinData -> [a]
                go l = BI.chooseList (const []) (\_ -> unsafeFromBuiltinData (BI.head l) : go (BI.tail l)) l ()

instance IsData Void where
    {-# INLINABLE toBuiltinData #-}
    toBuiltinData v = absurd v
    {-# INLINABLE fromBuiltinData #-}
    fromBuiltinData _ = Nothing
    {-# INLINABLE unsafeFromBuiltinData #-}
    unsafeFromBuiltinData _ = traceError "unsafeFromBuiltinData: Void is not supported"

-- | Convert a value to 'PLC.Data'.
toData :: (IsData a) => a -> PLC.Data
toData a = builtinDataToData (toBuiltinData a)

-- | Convert a value from 'PLC.Data', returning 'Nothing' if this fails.
fromData :: (IsData a) => PLC.Data -> Maybe a
fromData d = fromBuiltinData (BuiltinData d)