module ProAbstract.Metadata.MetadataOptics
    ( properties, settings, hasProperty, atSetting
    ) where

import ProAbstract.Metadata.MetadataType

-- | Targets all properties from metadata.
properties :: Lens' Metadata (Set Text)
properties :: Lens' Metadata (Set Text)
properties = (Metadata -> Set Text)
-> (Metadata -> Set Text -> Metadata) -> Lens' Metadata (Set Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Metadata -> Set Text
metadataProperties (\Metadata
m Set Text
p -> Metadata
m { metadataProperties :: Set Text
metadataProperties = Set Text
p })

-- | Targets all settings from metadata.
settings :: Lens' Metadata (Map Text Text)
settings :: Lens' Metadata (Map Text Text)
settings = (Metadata -> Map Text Text)
-> (Metadata -> Map Text Text -> Metadata)
-> Lens' Metadata (Map Text Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Metadata -> Map Text Text
metadataSettings (\Metadata
m Map Text Text
s -> Metadata
m { metadataSettings :: Map Text Text
metadataSettings = Map Text Text
s })

-- | Check if metadata includes a property. Using this optic as a setter will add a property if set to 'True' and remove the property when set to 'False'.
hasProperty :: Text -> Lens' Metadata Bool
hasProperty :: Text -> Lens' Metadata Bool
hasProperty Text
k = Lens' Metadata (Set Text)
properties Lens' Metadata (Set Text)
-> Optic A_Lens NoIx (Set Text) (Set Text) Bool Bool
-> Lens' Metadata Bool
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
% (Set Text -> Bool)
-> (Set Text -> Bool -> Set Text)
-> Optic A_Lens NoIx (Set Text) (Set Text) Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
setMember Text
k) (\Set Text
s Bool
b -> (if Bool
b then Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
setInsert else Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
setDelete) Text
k Set Text
s)

-- | Targets a setting from metadata. Returns 'Nothing' if no value is set.
atSetting :: Text -> Lens' Metadata (Maybe Text)
atSetting :: Text -> Lens' Metadata (Maybe Text)
atSetting Text
k = Lens' Metadata (Map Text Text)
settings Lens' Metadata (Map Text Text)
-> Optic
     A_Lens
     NoIx
     (Map Text Text)
     (Map Text Text)
     (Maybe Text)
     (Maybe Text)
-> Lens' Metadata (Maybe 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
% (Map Text Text -> Maybe Text)
-> (Map Text Text -> Maybe Text -> Map Text Text)
-> Optic
     A_Lens
     NoIx
     (Map Text Text)
     (Map Text Text)
     (Maybe Text)
     (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
mapLookup Text
k) (\Map Text Text
m Maybe Text
x -> (Map Text Text -> Map Text Text)
-> (Text -> Map Text Text -> Map Text Text)
-> Maybe Text
-> Map Text Text
-> Map Text Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> Map k a -> Map k a
mapDelete Text
k) (Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
mapInsert Text
k) Maybe Text
x Map Text Text
m)