{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module       : Data.Smash.Microlens
-- Copyright 	: (c) 2020 Emily Pillmore
-- License	: BSD-style
--
-- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>
-- Stability	: Experimental
-- Portability	: FlexibleInstances, MPTC, Type Families, UndecideableInstances
--
-- 'Traversal's for the 'Smash' datatype.
--
module Data.Smash.Microlens
( -- * Traversals
  _Nada
, _Smash
, smashed
, smashing
) where


import Lens.Micro

import Data.Smash


-- | A 'Traversal' of the smashed pair, suitable for use
-- with "Control.Lens".
--
-- >>> over smashed show (Smash 1 2)
-- "(1,2)"
--
-- >>> over smashed show Nada
-- Nada
--
smashed :: Traversal (Smash a b) (Smash c d) (a,b) (c,d)
smashed :: ((a, b) -> f (c, d)) -> Smash a b -> f (Smash c d)
smashed (a, b) -> f (c, d)
f = \case
  Smash a b
Nada -> Smash c d -> f (Smash c d)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Smash c d
forall a b. Smash a b
Nada
  Smash a
a b
b -> (c -> d -> Smash c d) -> (c, d) -> Smash c d
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry c -> d -> Smash c d
forall a b. a -> b -> Smash a b
Smash ((c, d) -> Smash c d) -> f (c, d) -> f (Smash c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a, b) -> f (c, d)
f (a
a,b
b)

-- | A 'Traversal' of the smashed pair, suitable for use
-- with "Control.Lens".
--
-- >>> over smashing show (Smash 1 2)
-- Smash "1" "2"
--
-- >>> over smashing show Nada
-- Nada
--
smashing :: Traversal (Smash a a) (Smash b b) a b
smashing :: (a -> f b) -> Smash a a -> f (Smash b b)
smashing = ((a, a) -> f (b, b)) -> Smash a a -> f (Smash b b)
forall a b c d. Traversal (Smash a b) (Smash c d) (a, b) (c, d)
smashed (((a, a) -> f (b, b)) -> Smash a a -> f (Smash b b))
-> ((a -> f b) -> (a, a) -> f (b, b))
-> (a -> f b)
-> Smash a a
-> f (Smash b b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> (a, a) -> f (b, b)
forall a b. Traversal (a, a) (b, b) a b
both

-- | A 'Traversal'' selecting the 'Nada' constructor.
--
-- /Note:/ cannot change type.
--
_Nada :: Traversal' (Smash a b) ()
_Nada :: (() -> f ()) -> Smash a b -> f (Smash a b)
_Nada () -> f ()
f = \case
  Smash a b
Nada -> Smash a b
forall a b. Smash a b
Nada Smash a b -> f () -> f (Smash a b)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ () -> f ()
f ()
  Smash a
a b
b -> Smash a b -> f (Smash a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> b -> Smash a b
forall a b. a -> b -> Smash a b
Smash a
a b
b)

-- | A 'Traversal'' selecting the 'Smash' constructor.
--
-- /Note:/ cannot change type.
--
_Smash :: Traversal' (Smash a b) (a,b)
_Smash :: ((a, b) -> f (a, b)) -> Smash a b -> f (Smash a b)
_Smash (a, b) -> f (a, b)
f = \case
  Smash a
a b
b -> (a -> b -> Smash a b) -> (a, b) -> Smash a b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> Smash a b
forall a b. a -> b -> Smash a b
Smash ((a, b) -> Smash a b) -> f (a, b) -> f (Smash a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a, b) -> f (a, b)
f (a
a,b
b)
  Smash a b
Nada -> Smash a b -> f (Smash a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Smash a b
forall a b. Smash a b
Nada