{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Ledger.Compactible
  ( -- * Compactible
    Compactible (..),
    Compact (..),
  )
where

import Cardano.Binary (FromCBOR (..), ToCBOR (..))
import Data.Kind (Type)
import Data.Typeable (Typeable)

--------------------------------------------------------------------------------

-- * Compactible

--
-- Certain types may have a "presentation" form and a more compact
-- representation that allows for more efficient memory usage. In this case,
-- one should make instances of the 'Compactible' class for them.
--------------------------------------------------------------------------------

class Compactible a where
  data CompactForm a :: Type
  toCompact :: a -> CompactForm a
  fromCompact :: CompactForm a -> a

newtype Compact a = Compact {Compact a -> a
unCompact :: a}

instance
  (Typeable a, Compactible a, ToCBOR (CompactForm a)) =>
  ToCBOR (Compact a)
  where
  toCBOR :: Compact a -> Encoding
toCBOR = CompactForm a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (CompactForm a -> Encoding)
-> (Compact a -> CompactForm a) -> Compact a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CompactForm a
forall a. Compactible a => a -> CompactForm a
toCompact (a -> CompactForm a)
-> (Compact a -> a) -> Compact a -> CompactForm a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compact a -> a
forall a. Compact a -> a
unCompact

instance
  (Typeable a, Compactible a, FromCBOR (CompactForm a)) =>
  FromCBOR (Compact a)
  where
  fromCBOR :: Decoder s (Compact a)
fromCBOR = a -> Compact a
forall a. a -> Compact a
Compact (a -> Compact a)
-> (CompactForm a -> a) -> CompactForm a -> Compact a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompactForm a -> a
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm a -> Compact a)
-> Decoder s (CompactForm a) -> Decoder s (Compact a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (CompactForm a)
forall a s. FromCBOR a => Decoder s a
fromCBOR

-- TODO: consider if this is better the other way around
instance (Eq a, Compactible a) => Eq (CompactForm a) where
  CompactForm a
a == :: CompactForm a -> CompactForm a -> Bool
== CompactForm a
b = CompactForm a -> a
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== CompactForm a -> a
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm a
b