{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}

#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Typeable.Lens
-- Copyright   :  (C) 2012-16 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  Rank2Types
--
----------------------------------------------------------------------------
module Data.Typeable.Lens
  ( _cast
  , _gcast
  ) where

import Control.Lens
import Data.Typeable
import Data.Maybe

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif

-- | A 'Traversal'' for working with a 'cast' of a 'Typeable' value.
_cast :: (Typeable s, Typeable a) => Traversal' s a
_cast :: Traversal' s a
_cast f :: a -> f a
f s :: s
s = case s -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast s
s of
  Just a :: a
a  -> s -> Maybe s -> s
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> s
forall a. HasCallStack => [Char] -> a
error "_cast: recast failed") (Maybe s -> s) -> (a -> Maybe s) -> a -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe s
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast (a -> s) -> f a -> f s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
a
  Nothing -> s -> f s
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s
{-# INLINE _cast #-}

-- | A 'Traversal'' for working with a 'gcast' of a 'Typeable' value.
_gcast :: (Typeable s, Typeable a) => Traversal' (c s) (c a)
_gcast :: Traversal' (c s) (c a)
_gcast f :: c a -> f (c a)
f s :: c s
s = case c s -> Maybe (c a)
forall k (a :: k) (b :: k) (c :: k -> *).
(Typeable a, Typeable b) =>
c a -> Maybe (c b)
gcast c s
s of
  Just a :: c a
a  -> c s -> Maybe (c s) -> c s
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> c s
forall a. HasCallStack => [Char] -> a
error "_gcast: recast failed") (Maybe (c s) -> c s) -> (c a -> Maybe (c s)) -> c a -> c s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c a -> Maybe (c s)
forall k (a :: k) (b :: k) (c :: k -> *).
(Typeable a, Typeable b) =>
c a -> Maybe (c b)
gcast (c a -> c s) -> f (c a) -> f (c s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c a -> f (c a)
f c a
a
  Nothing -> c s -> f (c s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure c s
s
{-# INLINE _gcast #-}