An Iso that removes a data Thunk if present

TT.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
module TT where

import Control.Lens

data Thunk a = Thunk a deriving Show

{- |

>>> Thunk 5 & unthunk %~ succ
Thunk 6


>>> 'x' & unthunk %~ succ
'y'

-}
class UnthunkC (b :: Bool) s t where
    type UnthunkT b a :: *
    unthunk :: (HasThunk s ~ b, HasThunk t ~ b) => Iso s t (UnthunkT b s) (UnthunkT b t)

instance UnthunkC False s t where
    type UnthunkT False a = a
    unthunk = id

instance (Thunk (UnthunkT True s) ~ s,
         Thunk (UnthunkT True t) ~ t)  => UnthunkC True s t where
    type UnthunkT True (Thunk a) = a
    unthunk = unthunk1

unthunk1 :: Iso (Thunk s) (Thunk t) s t
unthunk1 = iso (\(Thunk a) -> a) Thunk

type family HasThunk x :: Bool where
  HasThunk (Thunk x) = True
  HasThunk x = False