OverloadedLabels.hs

{-# LANGUAGE OverloadedLabels, TypeOperators, FlexibleInstances, MultiParamTypeClasses, TypeFamilies, UndecidableInstances, ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes, PolyKinds, TypeApplications, DataKinds #-}
module HListExample.OverloadedLabels where

import Data.HList.CommonMain
import GHC.OverloadedLabels
import Control.Lens
import Data.HList.Labelable
import Properties.Common
import Test.Hspec
import GHC.TypeLits

{- | -XOverloadedLabels expands #foo into `hLens' (Label :: Label "foo")`


Not in Data.HList.Labelable because it would overlap other uses of IsLabel
-}
instance (Labelable x r s t a b, x ~ x_,
    lens ~ ((a `p` f b) `to` (r s `p` f (r t))),
    ty ~ LabelableTy r,
    LabeledOpticF ty f,
    LabeledOpticP ty p,
    LabeledOpticTo ty x to 
    ) => IsLabel x_ lens where
   fromLabel = hLens' (Label :: Label x)


{- | hLens' where the `x` type parameter must be supplied by -XTypeApplications.
In other words these are all equivalent:

> hLens' (Label :: Label "abc")
> hLens' (Label @"abc")
> hL @"abc"
> `abc -- HListPP
 
-}
hL :: forall x r s t a b to p f.
     Labelable x r s t a b =>
     LabeledOptic x r s t a b 
hL = hLens' (Label :: Label x)


r = #abc .==. 3 .*. emptyRecord


mainOverloadedLabels = describe "-XOverloadedLabels" $ do
 it "lookup" $ do
    r ^. #abc `shouldShowTo` "3"
    r ^. hL @"abc" `shouldShowTo` "3"