{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------

-- |

-- Module      :  Data.Dynamic.Lens

-- Copyright   :  (C) 2012-2016 Edward Kmett

-- License     :  BSD-style (see the file LICENSE)

-- Maintainer  :  Edward Kmett <ekmett@gmail.com>

-- Stability   :  experimental

-- Portability :  non-portable

--

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

module Data.Dynamic.Lens
  ( AsDynamic(..)
  , pattern Data.Dynamic.Lens.Dynamic
  ) where

import Control.Exception
import Control.Exception.Lens
import Control.Lens
import Data.Dynamic

-- | Any 'Dynamic' can be thrown as an 'Exception'

class AsDynamic t where
  -- | This 'Prism' allows you to traverse the typed value contained in a

  -- 'Dynamic' where the type required by your function matches that

  -- of the contents of the 'Dynamic', or construct a 'Dynamic' value

  -- out of whole cloth. It can also be used to catch or throw a 'Dynamic'

  -- value as 'SomeException'.

  --

  -- @

  -- '_Dynamic' :: 'Typeable' a => 'Prism'' 'Dynamic'       a

  -- '_Dynamic' :: 'Typeable' a => 'Prism'' 'SomeException' a

  -- @

  _Dynamic :: Typeable a => Prism' t a

instance AsDynamic Dynamic where
  _Dynamic :: forall a. Typeable a => Prism' Dynamic a
_Dynamic = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' forall a. Typeable a => a -> Dynamic
toDyn forall a. Typeable a => Dynamic -> Maybe a
fromDynamic
  {-# INLINE _Dynamic #-}

instance AsDynamic SomeException where
  _Dynamic :: forall a. Typeable a => Prism' SomeException a
_Dynamic = forall a. Exception a => Prism' SomeException a
exceptionforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' forall a. Typeable a => a -> Dynamic
toDyn forall a. Typeable a => Dynamic -> Maybe a
fromDynamic
  {-# INLINE _Dynamic #-}

pattern Dynamic :: (AsDynamic s, Typeable a) => a -> s
pattern $bDynamic :: forall s a. (AsDynamic s, Typeable a) => a -> s
$mDynamic :: forall {r} {s} {a}.
(AsDynamic s, Typeable a) =>
s -> (a -> r) -> ((# #) -> r) -> r
Dynamic a <- (preview _Dynamic -> Just a) where
  Dynamic a
a = forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review forall t a. (AsDynamic t, Typeable a) => Prism' t a
_Dynamic a
a