{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Ledger.Compactible (
  -- * Compactible
  Compactible (..),
  partialCompactFL,
  toCompactPartial,
) where

import Cardano.Ledger.Binary.Encoding (EncCBOR)
import Data.Kind (Type)
import Data.Maybe (fromMaybe)
import GHC.Stack (HasCallStack)
import Lens.Micro (Lens', lens)
import NoThunks.Class (NoThunks)

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

-- * 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
  ( Show (CompactForm a)
  , Eq (CompactForm a)
  , EncCBOR (CompactForm a)
  , NoThunks (CompactForm a)
  ) =>
  Compactible a
  where
  data CompactForm a :: Type
  toCompact :: a -> Maybe (CompactForm a)
  fromCompact :: CompactForm a -> a

partialCompactFL :: (Functor f, Compactible c, HasCallStack) => Lens' (f (CompactForm c)) (f c)
partialCompactFL :: forall (f :: * -> *) c.
(Functor f, Compactible c, HasCallStack) =>
Lens' (f (CompactForm c)) (f c)
partialCompactFL = (f (CompactForm c) -> f c)
-> (f (CompactForm c) -> f c -> f (CompactForm c))
-> forall {f :: * -> *}.
   Functor f =>
   (f c -> f (f c)) -> f (CompactForm c) -> f (f (CompactForm c))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ((CompactForm c -> c) -> f (CompactForm c) -> f c
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompactForm c -> c
forall a. Compactible a => CompactForm a -> a
fromCompact) ((f (CompactForm c) -> f c -> f (CompactForm c))
 -> forall {f :: * -> *}.
    Functor f =>
    (f c -> f (f c)) -> f (CompactForm c) -> f (f (CompactForm c)))
-> (f (CompactForm c) -> f c -> f (CompactForm c))
-> forall {f :: * -> *}.
   Functor f =>
   (f c -> f (f c)) -> f (CompactForm c) -> f (f (CompactForm c))
forall a b. (a -> b) -> a -> b
$ \f (CompactForm c)
_ -> (c -> CompactForm c) -> f c -> f (CompactForm c)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> CompactForm c
forall a. (HasCallStack, Compactible a) => a -> CompactForm a
toCompactPartial

toCompactPartial :: (HasCallStack, Compactible a) => a -> CompactForm a
toCompactPartial :: forall a. (HasCallStack, Compactible a) => a -> CompactForm a
toCompactPartial = CompactForm a -> Maybe (CompactForm a) -> CompactForm a
forall a. a -> Maybe a -> a
fromMaybe CompactForm a
forall {a}. a
err (Maybe (CompactForm a) -> CompactForm a)
-> (a -> Maybe (CompactForm a)) -> a -> CompactForm a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe (CompactForm a)
forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact
  where
    err :: a
err = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Failed to compact the value"