-- |
-- Module: Data.Typeable.Optics
-- Description: Optics for working with 'Typeable'.
--
module Data.Typeable.Optics
  ( _cast
  , _gcast
  ) where

import Data.Typeable
import Data.Maybe

import Optics.AffineTraversal

-- | An 'AffineTraversal'' for working with a 'cast' of a 'Typeable' value.
_cast :: (Typeable s, Typeable a) => AffineTraversal' s a
_cast :: forall s a. (Typeable s, Typeable a) => AffineTraversal' s a
_cast = forall s t a b.
AffineTraversalVL s t a b -> AffineTraversal s t a b
atraversalVL forall a b. (a -> b) -> a -> b
$ \forall r. r -> f r
point a -> f a
f s
s -> case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast s
s of
  Just a
a  -> forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"_cast: recast failed") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
a
  Maybe a
Nothing -> forall r. r -> f r
point s
s
{-# INLINE _cast #-}

-- | An 'AffineTraversal'' for working with a 'gcast' of a 'Typeable' value.
_gcast :: (Typeable s, Typeable a) => AffineTraversal' (c s) (c a)
_gcast :: forall s a (c :: * -> *).
(Typeable s, Typeable a) =>
AffineTraversal' (c s) (c a)
_gcast = forall s t a b.
AffineTraversalVL s t a b -> AffineTraversal s t a b
atraversalVL forall a b. (a -> b) -> a -> b
$ \forall r. r -> f r
point c a -> f (c a)
f c s
s -> case forall {k} (a :: k) (b :: k) (c :: k -> *).
(Typeable a, Typeable b) =>
c a -> Maybe (c b)
gcast c s
s of
  Just c a
a  -> forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"_gcast: recast failed") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k) (b :: k) (c :: k -> *).
(Typeable a, Typeable b) =>
c a -> Maybe (c b)
gcast forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c a -> f (c a)
f c a
a
  Maybe (c a)
Nothing -> forall r. r -> f r
point c s
s
{-# INLINE _gcast #-}