{-# LANGUAGE DataKinds #-}

-- | Optics for mutating Huddle rules
module Codec.CBOR.Cuddle.Huddle.Optics (commentL, nameL) where

import Codec.CBOR.Cuddle.Huddle
import Data.Generics.Product (HasField' (field'))
import Data.Text qualified as T
import Optics.Core

mcommentL ::
  HasField' "description" a (Maybe T.Text) =>
  Lens a a (Maybe T.Text) (Maybe T.Text)
mcommentL :: forall a.
HasField' "description" a (Maybe Text) =>
Lens a a (Maybe Text) (Maybe Text)
mcommentL = forall (field :: Symbol) s a. HasField' field s a => Lens s s a a
field' @"description"

-- | Traversal to the comment field of a description. Using this we can for
--   example set the comment with 'a & commentL .~ "This is a comment"'
commentL ::
  HasField' "description" a (Maybe T.Text) =>
  AffineTraversal a a T.Text T.Text
commentL :: forall a.
HasField' "description" a (Maybe Text) =>
AffineTraversal a a Text Text
commentL = Lens a a (Maybe Text) (Maybe Text)
forall a.
HasField' "description" a (Maybe Text) =>
Lens a a (Maybe Text) (Maybe Text)
mcommentL Lens a a (Maybe Text) (Maybe Text)
-> Optic A_Prism NoIx (Maybe Text) (Maybe Text) Text Text
-> Optic An_AffineTraversal NoIx a a Text Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx (Maybe Text) (Maybe Text) Text Text
forall a b. Prism (Maybe a) (Maybe b) a b
_Just

-- | Lens to the name of a rule (or other named entity). Using this we can
--   for example append to the name with 'a & nameL %~ (<> "_1")'
nameL :: Lens (Named a) (Named a) T.Text T.Text
nameL :: forall a. Lens (Named a) (Named a) Text Text
nameL = forall (field :: Symbol) s a. HasField' field s a => Lens s s a a
field' @"name"