{-# LANGUAGE PackageImports #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# language ConstraintKinds #-}
{-# language DataKinds #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language FunctionalDependencies #-}
{-# language MultiParamTypeClasses #-}
{-# language ScopedTypeVariables #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}
{-# language UndecidableInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Generics.Wrapped
-- Copyright   :  (C) 2020 Csongor Kiss
-- License     :  BSD3
-- Maintainer  :  Csongor Kiss <kiss.csongor.kiss@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Derive an isomorphism between a newtype and its wrapped type.
--
-----------------------------------------------------------------------------

module Data.Generics.Wrapped
  ( Wrapped (..)
  , wrappedTo
  , wrappedFrom
  , _Unwrapped
  , _Wrapped
  )
where

import qualified "this" Data.Generics.Internal.VL.Iso as VL

import "generic-lens-core" Data.Generics.Internal.Wrapped (Context, derived)

import Control.Applicative    (Const(..))


-- | @since 1.1.0.0
_Unwrapped :: Wrapped s t a b => VL.Iso s t a b
_Unwrapped :: Iso s t a b
_Unwrapped = p a (f b) -> p s (f t)
forall s t a b. Wrapped s t a b => Iso s t a b
wrappedIso
{-# inline _Unwrapped #-}

-- | @since 1.1.0.0
_Wrapped :: Wrapped s t a b => VL.Iso b a t s
_Wrapped :: Iso b a t s
_Wrapped = Iso s t a b -> Iso b a t s
forall s t a b. Iso s t a b -> Iso b a t s
VL.fromIso forall s t a b. Wrapped s t a b => Iso s t a b
Iso s t a b
wrappedIso
{-# inline _Wrapped #-}

-- | @since 1.1.0.0
class Wrapped s t a b | s -> a, t -> b where
  -- | @since 1.1.0.0
  wrappedIso :: VL.Iso s t a b

-- | @since 1.1.0.0
wrappedTo :: forall s t a b. Wrapped s t a b => s -> a
wrappedTo :: s -> a
wrappedTo s
a = ((a -> Const a b) -> s -> Const a t) -> s -> a
forall a b t a b. ((a -> Const a b) -> t -> Const a b) -> t -> a
view (Wrapped s t a b => Iso s t a b
forall s t a b. Wrapped s t a b => Iso s t a b
wrappedIso @s @t @a @b) s
a
  where view :: ((a -> Const a b) -> t -> Const a b) -> t -> a
view (a -> Const a b) -> t -> Const a b
l t
s = Const a b -> a
forall a k (b :: k). Const a b -> a
getConst ((a -> Const a b) -> t -> Const a b
l a -> Const a b
forall k a (b :: k). a -> Const a b
Const t
s)
{-# INLINE wrappedTo #-}

-- | @since 1.1.0.0
wrappedFrom :: forall s t a b. Wrapped s t a b => b -> t
wrappedFrom :: b -> t
wrappedFrom b
a = ((t -> Const t s) -> b -> Const t a) -> b -> t
forall a b t a b. ((a -> Const a b) -> t -> Const a b) -> t -> a
view (Iso s t a b -> Iso b a t s
forall s t a b. Iso s t a b -> Iso b a t s
VL.fromIso (Wrapped s t a b => Iso s t a b
forall s t a b. Wrapped s t a b => Iso s t a b
wrappedIso @s @t @a @b)) b
a
  where view :: ((a -> Const a b) -> t -> Const a b) -> t -> a
view (a -> Const a b) -> t -> Const a b
l t
s = Const a b -> a
forall a k (b :: k). Const a b -> a
getConst ((a -> Const a b) -> t -> Const a b
l a -> Const a b
forall k a (b :: k). a -> Const a b
Const t
s)
{-# INLINE wrappedFrom #-}

instance Context s t a b => Wrapped s t a b where
  wrappedIso :: p a (f b) -> p s (f t)
wrappedIso = Iso s t a b -> Iso s t a b
forall s t a b. Iso s t a b -> Iso s t a b
VL.iso2isovl forall s t a b. Context s t a b => Iso s t a b
Iso s t a b
derived
  {-# INLINE wrappedIso #-}