Main.hs

{-# language FlexibleInstances #-}
{-# language UndecidableInstances #-}
{-# language TemplateHaskell #-}
{-# language DataKinds #-}
{-# language OverloadedLabels #-}
{-# language MultiParamTypeClasses #-}
{-# language GADTs #-}

module Main where

import Control.Monad (join)
import Optics

data Box a =
  Box {
    list :: [a],
    index :: Maybe Int
  }
makeFieldLabelsWith noPrefixFieldLabels ''Box

content :: AffineTraversal' (Box a) a
content =
  affineTraversalOfFunction contentFunction
  where
    contentFunction :: Box a -> AffineTraversal' (Box a) a
    contentFunction s =
      #list
      %
      maybe trivialAffineTraversal ix (s ^. #index)
    trivialAffineTraversal :: AffineTraversal s s a b
    trivialAffineTraversal = atraversal Left const

affineTraversalOfFunction :: (s -> AffineTraversal s t a b) -> AffineTraversal s t a b
affineTraversalOfFunction affineTraversal =
  atraversal
    (collapseDoubleParameter $ matching . affineTraversal)
    (collapseDoubleParameter $ (flip . set) . affineTraversal)
  where
    collapseDoubleParameter :: (a -> a -> b) -> (a -> b)
    collapseDoubleParameter = join

main :: IO ()
main = pure ()