-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

module Lorentz.Wrappable
  ( Wrappable
  , Unwrappable
  ) where

import Data.Kind (Type)
import GHC.Generics
import GHC.TypeLits
import Named (NamedF(..))

import Michelson.Typed (ToT)

-- | 'Wrappable' is similar to lens 'Wrapped' class without the method.
-- It provides type family that is mainly used as constraint when
-- unwrapping Lorentz instruction into a Haskell newtype and vice versa.
class ToT s ~ ToT (Unwrappable s) => Wrappable (s :: Type) where
  type Unwrappable s :: Type
  type Unwrappable s = GUnwrappable (Rep s)

type family GUnwrappable (rep :: Type -> Type) :: Type where
  GUnwrappable (D1 ('MetaData _ _ _ 'True) (C1 _ (S1 _ (Rec0 a)))) = a
  GUnwrappable _ = TypeError ('Text "Type is not a newtype")

instance Wrappable (NamedF Identity a name) where
  type Unwrappable (NamedF Identity a name) = a

instance Wrappable (NamedF Maybe a name) where
  type Unwrappable (NamedF Maybe a name) = Maybe a