Sum.hs

{-# LANGUAGE TypeFamilies #-}
module Data.Lens.Edit.Sum where

import Data.Lens.Bidirectional
import qualified Data.Lens.Edit.Stateful  as F -- state_f_ul
import qualified Data.Lens.Edit.Stateless as L -- state_l_ess
import qualified Data.Module.Sum          as M -- _m_odule

data Sum k l = Sum k l deriving (Eq, Ord, Show, Read)
instance (Bidirectional k, Bidirectional l) => Bidirectional (Sum k l) where
	type L (Sum k l) = M.Sum (L k) (L l)
	type R (Sum k l) = M.Sum (R k) (R l)

instance (F.Lens k, F.Lens l) => F.Lens (Sum k l) where
	type F.C (Sum k l) = (F.C k, F.C l)
	missing  (Sum k l) = (F.missing k, F.missing l)
	dputr (Sum k l) (M.Sum f dx dz, (ck, cl)) = (M.Sum (M.retype f) dy dw, (ck', cl')) where
		(dy, ck') = F.dputr k (dx, M.bool f ck (F.missing k))
		(dw, cl') = F.dputr l (dz, M.bool f cl (F.missing l))
	dputl (Sum k l) (M.Sum f dy dw, (ck, cl)) = (M.Sum (M.retype f) dx dz, (ck', cl')) where
		(dx, ck') = F.dputl k (dy, M.bool f ck (F.missing k))
		(dz, cl') = F.dputl l (dw, M.bool f cl (F.missing l))

instance (L.Lens k, L.Lens l) => L.Lens (Sum k l) where
	dputr (Sum k l) (M.Sum f dx dz) = M.Sum (M.retype f) (L.dputr k dx) (L.dputr l dz)
	dputl (Sum k l) (M.Sum f dy dw) = M.Sum (M.retype f) (L.dputl k dy) (L.dputl l dw)

data SumFL k l = SumFL k l deriving (Eq, Ord, Show, Read)
instance (Bidirectional k, Bidirectional l) => Bidirectional (SumFL k l) where
	type L (SumFL k l) = M.Sum (L k) (L l)
	type R (SumFL k l) = M.Sum (R k) (R l)

instance (F.Lens k, L.Lens l) => F.Lens (SumFL k l) where
	type F.C (SumFL k l) = F.C k
	missing  (SumFL k l) = F.missing k
	dputr (SumFL k l) (M.Sum f dx dz, ck) =
		let (dy, ck') = F.dputr k (dx, M.bool f ck (F.missing k))
		in (M.Sum (M.retype f) dy (L.dputr l dz), ck')
	dputl (SumFL k l) (M.Sum f dy dw, ck) =
		let (dx, ck') = F.dputl k (dy, M.bool f ck (F.missing k))
		in (M.Sum (M.retype f) dx (L.dputl l dw), ck')

data SumLF k l = SumLF k l deriving (Eq, Ord, Show, Read)
instance (Bidirectional k, Bidirectional l) => Bidirectional (SumLF k l) where
	type L (SumLF k l) = M.Sum (L k) (L l)
	type R (SumLF k l) = M.Sum (R k) (R l)

instance (L.Lens k, F.Lens l) => F.Lens (SumLF k l) where
	type F.C (SumLF k l) = F.C l
	missing  (SumLF k l) = F.missing l
	dputr (SumLF k l) (M.Sum f dx dz, cl) =
		let (dw, cl') = F.dputr l (dz, M.bool f cl (F.missing l))
		in (M.Sum (M.retype f) (L.dputr k dx) dw, cl')
	dputl (SumLF k l) (M.Sum f dy dw, cl) =
		let (dz, cl') = F.dputl l (dw, M.bool f cl (F.missing l))
		in (M.Sum (M.retype f) (L.dputl k dy) dz, cl')