module ProAbstract.Metadata.MetaItem where

data MetaItem =
    Property
        Text -- ^ key
  | Setting
        Text -- ^ key
        Text -- ^ value
    deriving stock (Int -> MetaItem -> ShowS
[MetaItem] -> ShowS
MetaItem -> String
(Int -> MetaItem -> ShowS)
-> (MetaItem -> String) -> ([MetaItem] -> ShowS) -> Show MetaItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetaItem] -> ShowS
$cshowList :: [MetaItem] -> ShowS
show :: MetaItem -> String
$cshow :: MetaItem -> String
showsPrec :: Int -> MetaItem -> ShowS
$cshowsPrec :: Int -> MetaItem -> ShowS
Show, (forall x. MetaItem -> Rep MetaItem x)
-> (forall x. Rep MetaItem x -> MetaItem) -> Generic MetaItem
forall x. Rep MetaItem x -> MetaItem
forall x. MetaItem -> Rep MetaItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetaItem x -> MetaItem
$cfrom :: forall x. MetaItem -> Rep MetaItem x
Generic)
    deriving anyclass (MetaItem -> ()
(MetaItem -> ()) -> NFData MetaItem
forall a. (a -> ()) -> NFData a
rnf :: MetaItem -> ()
$crnf :: MetaItem -> ()
NFData, Eq MetaItem
Eq MetaItem
-> (Int -> MetaItem -> Int)
-> (MetaItem -> Int)
-> Hashable MetaItem
Int -> MetaItem -> Int
MetaItem -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: MetaItem -> Int
$chash :: MetaItem -> Int
hashWithSalt :: Int -> MetaItem -> Int
$chashWithSalt :: Int -> MetaItem -> Int
$cp1Hashable :: Eq MetaItem
Hashable)

instance Ord MetaItem where
    compare :: MetaItem -> MetaItem -> Ordering
compare = (Text, Maybe Text) -> (Text, Maybe Text) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Text, Maybe Text) -> (Text, Maybe Text) -> Ordering)
-> (MetaItem -> (Text, Maybe Text))
-> MetaItem
-> MetaItem
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` \case
        Property Text
x -> (Text
x, Maybe Text
forall a. Maybe a
Nothing)
        Setting Text
x Text
y -> (Text
x, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
y)

instance Eq MetaItem where
    MetaItem
a == :: MetaItem -> MetaItem -> Bool
== MetaItem
b = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== MetaItem -> MetaItem -> Ordering
forall a. Ord a => a -> a -> Ordering
compare MetaItem
a MetaItem
b

metaKeyValue :: Iso' MetaItem (Text, Maybe Text)
metaKeyValue :: Iso' MetaItem (Text, Maybe Text)
metaKeyValue = (MetaItem -> (Text, Maybe Text))
-> ((Text, Maybe Text) -> MetaItem)
-> Iso' MetaItem (Text, Maybe Text)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso MetaItem -> (Text, Maybe Text)
f (Text, Maybe Text) -> MetaItem
g
  where
    f :: MetaItem -> (Text, Maybe Text)
f = \case Property Text
x -> (Text
x, Maybe Text
forall a. Maybe a
Nothing); Setting Text
x Text
y -> (Text
x, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
y)
    g :: (Text, Maybe Text) -> MetaItem
g = \case (Text
x, Maybe Text
Nothing) -> Text -> MetaItem
Property Text
x; (Text
x, Just Text
y) -> Text -> Text -> MetaItem
Setting Text
x Text
y

metaKey :: Lens' MetaItem Text
metaKey :: Lens' MetaItem Text
metaKey = Iso' MetaItem (Text, Maybe Text)
metaKeyValue Iso' MetaItem (Text, Maybe Text)
-> Optic
     A_Lens NoIx (Text, Maybe Text) (Text, Maybe Text) Text Text
-> Lens' MetaItem 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_Lens NoIx (Text, Maybe Text) (Text, Maybe Text) Text Text
forall s t a b. Field1 s t a b => Lens s t a b
_1

metaValueMaybe :: Lens' MetaItem (Maybe Text)
metaValueMaybe :: Lens' MetaItem (Maybe Text)
metaValueMaybe = Iso' MetaItem (Text, Maybe Text)
metaKeyValue Iso' MetaItem (Text, Maybe Text)
-> Optic
     A_Lens
     NoIx
     (Text, Maybe Text)
     (Text, Maybe Text)
     (Maybe Text)
     (Maybe Text)
-> Lens' MetaItem (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
% Optic
  A_Lens
  NoIx
  (Text, Maybe Text)
  (Text, Maybe Text)
  (Maybe Text)
  (Maybe Text)
forall s t a b. Field2 s t a b => Lens s t a b
_2

metaValue :: AffineTraversal' MetaItem Text
metaValue :: AffineTraversal' MetaItem Text
metaValue = Lens' MetaItem (Maybe Text)
metaValueMaybe Lens' MetaItem (Maybe Text)
-> Optic A_Prism NoIx (Maybe Text) (Maybe Text) Text Text
-> AffineTraversal' MetaItem 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