module ProAbstract.Metadata.MetaList
    ( metaList
    ) where

import ProAbstract.Metadata.MetaItem
import ProAbstract.Metadata.MetaValue
import ProAbstract.Metadata.MetadataOptics
import ProAbstract.Metadata.MetadataType

metaList :: Getter Metadata [MetaItem]
metaList :: Getter Metadata [MetaItem]
metaList = Iso' Metadata (Map Text MetaValue)
metaMap Iso' Metadata (Map Text MetaValue)
-> Optic
     A_Getter
     NoIx
     (Map Text MetaValue)
     (Map Text MetaValue)
     [MetaItem]
     [MetaItem]
-> Getter Metadata [MetaItem]
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(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 MetaValue -> [MetaItem])
-> Optic
     A_Getter
     NoIx
     (Map Text MetaValue)
     (Map Text MetaValue)
     [MetaItem]
     [MetaItem]
forall (s :: OpticKind) (a :: OpticKind). (s -> a) -> Getter s a
to ((Text -> MetaValue -> [MetaItem])
-> Map Text MetaValue -> [MetaItem]
forall (m :: OpticKind) (k :: OpticKind) (a :: OpticKind).
Monoid m =>
(k -> a -> m) -> Map k a -> m
mapFoldMapWithKey Text -> MetaValue -> [MetaItem]
metaValueList)

metaValueList :: Text -> MetaValue -> [MetaItem]
metaValueList :: Text -> MetaValue -> [MetaItem]
metaValueList Text
k = \case
    MetaValue
MetaValue_Property -> [ Text -> MetaItem
Property Text
k ]
    MetaValue_Setting Text
v -> [ Text -> Text -> MetaItem
Setting Text
k Text
v ]
    MetaValue_PropertyAndSetting Text
v -> [ Text -> MetaItem
Property Text
k, Text -> Text -> MetaItem
Setting Text
k Text
v ]