{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Wedge.Lens
(
_WedgeIso
, here
, there
, _Nowhere
, _Here
, _There
) where
import Control.Lens
import Data.Wedge
_WedgeIso :: Iso (Wedge a b) (Wedge c d) (Maybe (Either a b)) (Maybe (Either c d))
_WedgeIso = iso f g
where
f Nowhere = Nothing
f (Here a) = Just (Left a)
f (There b) = Just (Right b)
g Nothing = Nowhere
g (Just (Left a)) = Here a
g (Just (Right b)) = There b
here :: Traversal' (Wedge a b) a
here f = \case
Nowhere -> pure Nowhere
Here a -> Here <$> f a
There b -> pure (There b)
there :: Traversal' (Wedge a b) b
there f = \case
Nowhere -> pure Nowhere
Here a -> pure (Here a)
There b -> There <$> f b
_Nowhere :: Prism' (Wedge a b) ()
_Nowhere = prism (const Nowhere) $ \case
Nowhere -> Right ()
Here a -> Left (Here a)
There b -> Left (There b)
_Here :: Prism (Wedge a b) (Wedge c b) a c
_Here = prism Here $ \case
Here a -> Right a
There b -> Left (There b)
Nowhere -> Left Nowhere
_There :: Prism (Wedge a b) (Wedge a d) b d
_There = prism There $ \case
There b -> Right b
Here a -> Left (Here a)
Nowhere -> Left (Nowhere)
instance Swapped Wedge where
swapped = iso swapWedge swapWedge
instance (a ~ a', b ~ b') => Each (Wedge a a') (Wedge b b') a b where
each _ Nowhere = pure Nowhere
each f (Here a) = Here <$> f a
each f (There a) = There <$> f a