module ProAbstract.Metadata.MetaValue
    ( MetaValueMaybe (..), MetaValue (..)
    , IsMetaValue (..)
    , isPropertyValue, settingValueMaybe
    , metaValueJust
    ) where

class IsMetaValue a where
    metaValue :: Prism' MetaValueMaybe a
    propertyValue :: a
    settingValue :: Text -> a

instance IsMetaValue MetaValueMaybe where
    metaValue :: Prism' MetaValueMaybe MetaValueMaybe
metaValue = Optic
  An_Iso
  NoIx
  MetaValueMaybe
  MetaValueMaybe
  MetaValueMaybe
  MetaValueMaybe
-> Prism' MetaValueMaybe MetaValueMaybe
forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic Optic
  An_Iso
  NoIx
  MetaValueMaybe
  MetaValueMaybe
  MetaValueMaybe
  MetaValueMaybe
forall a. Iso' a a
simple
    propertyValue :: MetaValueMaybe
propertyValue = Bool -> Maybe Text -> MetaValueMaybe
MetaValueMaybe Bool
True Maybe Text
forall a. Maybe a
Nothing
    settingValue :: Text -> MetaValueMaybe
settingValue Text
s = Bool -> Maybe Text -> MetaValueMaybe
MetaValueMaybe Bool
False (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s)

instance IsMetaValue MetaValue where
    metaValue :: Prism' MetaValueMaybe MetaValue
metaValue = Prism' MetaValueMaybe MetaValue
metaValueJust
    propertyValue :: MetaValue
propertyValue = MetaValue
MetaValue_Property
    settingValue :: Text -> MetaValue
settingValue = Text -> MetaValue
MetaValue_Setting

isPropertyValue :: IsMetaValue a => a -> Bool
isPropertyValue :: a -> Bool
isPropertyValue = Optic' A_Getter NoIx a Bool -> a -> Bool
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic' A_Getter NoIx a Bool -> a -> Bool)
-> Optic' A_Getter NoIx a Bool -> a -> Bool
forall a b. (a -> b) -> a -> b
$ Optic A_Prism NoIx MetaValueMaybe MetaValueMaybe a a
-> Optic
     (ReversedOptic A_Prism) NoIx a a MetaValueMaybe MetaValueMaybe
forall k (is :: IxList) s t a b.
(ReversibleOptic k, AcceptsEmptyIndices "re" is) =>
Optic k is s t a b -> Optic (ReversedOptic k) is b a t s
re Optic A_Prism NoIx MetaValueMaybe MetaValueMaybe a a
forall a. IsMetaValue a => Prism' MetaValueMaybe a
metaValue Optic A_ReversedPrism NoIx a a MetaValueMaybe MetaValueMaybe
-> Optic A_Getter NoIx MetaValueMaybe MetaValueMaybe Bool Bool
-> Optic' A_Getter NoIx a 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
% (MetaValueMaybe -> Bool)
-> Optic A_Getter NoIx MetaValueMaybe MetaValueMaybe Bool Bool
forall s a. (s -> a) -> Getter s a
to MetaValueMaybe -> Bool
metaValueMaybe_property

settingValueMaybe :: IsMetaValue a => a -> Maybe Text
settingValueMaybe :: a -> Maybe Text
settingValueMaybe = Optic' A_Getter NoIx a (Maybe Text) -> a -> Maybe Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic' A_Getter NoIx a (Maybe Text) -> a -> Maybe Text)
-> Optic' A_Getter NoIx a (Maybe Text) -> a -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Optic A_Prism NoIx MetaValueMaybe MetaValueMaybe a a
-> Optic
     (ReversedOptic A_Prism) NoIx a a MetaValueMaybe MetaValueMaybe
forall k (is :: IxList) s t a b.
(ReversibleOptic k, AcceptsEmptyIndices "re" is) =>
Optic k is s t a b -> Optic (ReversedOptic k) is b a t s
re Optic A_Prism NoIx MetaValueMaybe MetaValueMaybe a a
forall a. IsMetaValue a => Prism' MetaValueMaybe a
metaValue Optic A_ReversedPrism NoIx a a MetaValueMaybe MetaValueMaybe
-> Optic
     A_Getter
     NoIx
     MetaValueMaybe
     MetaValueMaybe
     (Maybe Text)
     (Maybe Text)
-> Optic' A_Getter NoIx a (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
% (MetaValueMaybe -> Maybe Text)
-> Optic
     A_Getter
     NoIx
     MetaValueMaybe
     MetaValueMaybe
     (Maybe Text)
     (Maybe Text)
forall s a. (s -> a) -> Getter s a
to MetaValueMaybe -> Maybe Text
metaValueMaybe_setting

data MetaValueMaybe =
  MetaValueMaybe
    { MetaValueMaybe -> Bool
metaValueMaybe_property :: Bool
    , MetaValueMaybe -> Maybe Text
metaValueMaybe_setting :: Maybe Text
    }
    deriving stock (MetaValueMaybe -> MetaValueMaybe -> Bool
(MetaValueMaybe -> MetaValueMaybe -> Bool)
-> (MetaValueMaybe -> MetaValueMaybe -> Bool) -> Eq MetaValueMaybe
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetaValueMaybe -> MetaValueMaybe -> Bool
$c/= :: MetaValueMaybe -> MetaValueMaybe -> Bool
== :: MetaValueMaybe -> MetaValueMaybe -> Bool
$c== :: MetaValueMaybe -> MetaValueMaybe -> Bool
Eq, Eq MetaValueMaybe
Eq MetaValueMaybe
-> (MetaValueMaybe -> MetaValueMaybe -> Ordering)
-> (MetaValueMaybe -> MetaValueMaybe -> Bool)
-> (MetaValueMaybe -> MetaValueMaybe -> Bool)
-> (MetaValueMaybe -> MetaValueMaybe -> Bool)
-> (MetaValueMaybe -> MetaValueMaybe -> Bool)
-> (MetaValueMaybe -> MetaValueMaybe -> MetaValueMaybe)
-> (MetaValueMaybe -> MetaValueMaybe -> MetaValueMaybe)
-> Ord MetaValueMaybe
MetaValueMaybe -> MetaValueMaybe -> Bool
MetaValueMaybe -> MetaValueMaybe -> Ordering
MetaValueMaybe -> MetaValueMaybe -> MetaValueMaybe
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MetaValueMaybe -> MetaValueMaybe -> MetaValueMaybe
$cmin :: MetaValueMaybe -> MetaValueMaybe -> MetaValueMaybe
max :: MetaValueMaybe -> MetaValueMaybe -> MetaValueMaybe
$cmax :: MetaValueMaybe -> MetaValueMaybe -> MetaValueMaybe
>= :: MetaValueMaybe -> MetaValueMaybe -> Bool
$c>= :: MetaValueMaybe -> MetaValueMaybe -> Bool
> :: MetaValueMaybe -> MetaValueMaybe -> Bool
$c> :: MetaValueMaybe -> MetaValueMaybe -> Bool
<= :: MetaValueMaybe -> MetaValueMaybe -> Bool
$c<= :: MetaValueMaybe -> MetaValueMaybe -> Bool
< :: MetaValueMaybe -> MetaValueMaybe -> Bool
$c< :: MetaValueMaybe -> MetaValueMaybe -> Bool
compare :: MetaValueMaybe -> MetaValueMaybe -> Ordering
$ccompare :: MetaValueMaybe -> MetaValueMaybe -> Ordering
$cp1Ord :: Eq MetaValueMaybe
Ord, Int -> MetaValueMaybe -> ShowS
[MetaValueMaybe] -> ShowS
MetaValueMaybe -> String
(Int -> MetaValueMaybe -> ShowS)
-> (MetaValueMaybe -> String)
-> ([MetaValueMaybe] -> ShowS)
-> Show MetaValueMaybe
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetaValueMaybe] -> ShowS
$cshowList :: [MetaValueMaybe] -> ShowS
show :: MetaValueMaybe -> String
$cshow :: MetaValueMaybe -> String
showsPrec :: Int -> MetaValueMaybe -> ShowS
$cshowsPrec :: Int -> MetaValueMaybe -> ShowS
Show, (forall x. MetaValueMaybe -> Rep MetaValueMaybe x)
-> (forall x. Rep MetaValueMaybe x -> MetaValueMaybe)
-> Generic MetaValueMaybe
forall x. Rep MetaValueMaybe x -> MetaValueMaybe
forall x. MetaValueMaybe -> Rep MetaValueMaybe x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetaValueMaybe x -> MetaValueMaybe
$cfrom :: forall x. MetaValueMaybe -> Rep MetaValueMaybe x
Generic)
    deriving anyclass (MetaValueMaybe -> ()
(MetaValueMaybe -> ()) -> NFData MetaValueMaybe
forall a. (a -> ()) -> NFData a
rnf :: MetaValueMaybe -> ()
$crnf :: MetaValueMaybe -> ()
NFData, Eq MetaValueMaybe
Eq MetaValueMaybe
-> (Int -> MetaValueMaybe -> Int)
-> (MetaValueMaybe -> Int)
-> Hashable MetaValueMaybe
Int -> MetaValueMaybe -> Int
MetaValueMaybe -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: MetaValueMaybe -> Int
$chash :: MetaValueMaybe -> Int
hashWithSalt :: Int -> MetaValueMaybe -> Int
$chashWithSalt :: Int -> MetaValueMaybe -> Int
$cp1Hashable :: Eq MetaValueMaybe
Hashable)

instance Semigroup MetaValueMaybe where
    MetaValueMaybe Bool
p1 Maybe Text
s1 <> :: MetaValueMaybe -> MetaValueMaybe -> MetaValueMaybe
<> MetaValueMaybe Bool
p2 Maybe Text
s2 =
        Bool -> Maybe Text -> MetaValueMaybe
MetaValueMaybe (Bool
p1 Bool -> Bool -> Bool
|| Bool
p2) (Maybe Text
s1 Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
s2)

instance Monoid MetaValueMaybe where
    mempty :: MetaValueMaybe
mempty = Bool -> Maybe Text -> MetaValueMaybe
MetaValueMaybe Bool
False Maybe Text
forall a. Maybe a
Nothing

data MetaValue =
    MetaValue_Property
  | MetaValue_Setting
        Text -- ^ setting value
  | MetaValue_PropertyAndSetting
        Text -- ^ setting value
    deriving stock (MetaValue -> MetaValue -> Bool
(MetaValue -> MetaValue -> Bool)
-> (MetaValue -> MetaValue -> Bool) -> Eq MetaValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetaValue -> MetaValue -> Bool
$c/= :: MetaValue -> MetaValue -> Bool
== :: MetaValue -> MetaValue -> Bool
$c== :: MetaValue -> MetaValue -> Bool
Eq, Eq MetaValue
Eq MetaValue
-> (MetaValue -> MetaValue -> Ordering)
-> (MetaValue -> MetaValue -> Bool)
-> (MetaValue -> MetaValue -> Bool)
-> (MetaValue -> MetaValue -> Bool)
-> (MetaValue -> MetaValue -> Bool)
-> (MetaValue -> MetaValue -> MetaValue)
-> (MetaValue -> MetaValue -> MetaValue)
-> Ord MetaValue
MetaValue -> MetaValue -> Bool
MetaValue -> MetaValue -> Ordering
MetaValue -> MetaValue -> MetaValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MetaValue -> MetaValue -> MetaValue
$cmin :: MetaValue -> MetaValue -> MetaValue
max :: MetaValue -> MetaValue -> MetaValue
$cmax :: MetaValue -> MetaValue -> MetaValue
>= :: MetaValue -> MetaValue -> Bool
$c>= :: MetaValue -> MetaValue -> Bool
> :: MetaValue -> MetaValue -> Bool
$c> :: MetaValue -> MetaValue -> Bool
<= :: MetaValue -> MetaValue -> Bool
$c<= :: MetaValue -> MetaValue -> Bool
< :: MetaValue -> MetaValue -> Bool
$c< :: MetaValue -> MetaValue -> Bool
compare :: MetaValue -> MetaValue -> Ordering
$ccompare :: MetaValue -> MetaValue -> Ordering
$cp1Ord :: Eq MetaValue
Ord, Int -> MetaValue -> ShowS
[MetaValue] -> ShowS
MetaValue -> String
(Int -> MetaValue -> ShowS)
-> (MetaValue -> String)
-> ([MetaValue] -> ShowS)
-> Show MetaValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetaValue] -> ShowS
$cshowList :: [MetaValue] -> ShowS
show :: MetaValue -> String
$cshow :: MetaValue -> String
showsPrec :: Int -> MetaValue -> ShowS
$cshowsPrec :: Int -> MetaValue -> ShowS
Show, (forall x. MetaValue -> Rep MetaValue x)
-> (forall x. Rep MetaValue x -> MetaValue) -> Generic MetaValue
forall x. Rep MetaValue x -> MetaValue
forall x. MetaValue -> Rep MetaValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetaValue x -> MetaValue
$cfrom :: forall x. MetaValue -> Rep MetaValue x
Generic)
    deriving anyclass (MetaValue -> ()
(MetaValue -> ()) -> NFData MetaValue
forall a. (a -> ()) -> NFData a
rnf :: MetaValue -> ()
$crnf :: MetaValue -> ()
NFData, Eq MetaValue
Eq MetaValue
-> (Int -> MetaValue -> Int)
-> (MetaValue -> Int)
-> Hashable MetaValue
Int -> MetaValue -> Int
MetaValue -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: MetaValue -> Int
$chash :: MetaValue -> Int
hashWithSalt :: Int -> MetaValue -> Int
$chashWithSalt :: Int -> MetaValue -> Int
$cp1Hashable :: Eq MetaValue
Hashable)

instance Semigroup MetaValue where

    x :: MetaValue
x@MetaValue_PropertyAndSetting{} <> :: MetaValue -> MetaValue -> MetaValue
<> MetaValue
_ = MetaValue
x

    MetaValue
MetaValue_Property <> MetaValue
x = MetaValue -> MetaValue
forceProperty MetaValue
x
    MetaValue
x <> MetaValue
MetaValue_Property = MetaValue -> MetaValue
forceProperty MetaValue
x

    MetaValue_Setting Text
s <> MetaValue
x = Text -> MetaValue -> MetaValue
forceSetting Text
s MetaValue
x

forceProperty :: MetaValue -> MetaValue
forceProperty :: MetaValue -> MetaValue
forceProperty = \case
    MetaValue_Setting Text
s -> Text -> MetaValue
MetaValue_PropertyAndSetting Text
s
    MetaValue
x -> MetaValue
x

forceSetting :: Text -> MetaValue -> MetaValue
forceSetting :: Text -> MetaValue -> MetaValue
forceSetting Text
s = \case
    MetaValue_Setting Text
_            -> Text -> MetaValue
MetaValue_Setting Text
s
    MetaValue
MetaValue_Property             -> Text -> MetaValue
MetaValue_PropertyAndSetting Text
s
    MetaValue_PropertyAndSetting Text
_ -> Text -> MetaValue
MetaValue_PropertyAndSetting Text
s

metaValueJust :: Prism' MetaValueMaybe MetaValue
metaValueJust :: Prism' MetaValueMaybe MetaValue
metaValueJust = (MetaValue -> MetaValueMaybe)
-> (MetaValueMaybe -> Maybe MetaValue)
-> Prism' MetaValueMaybe MetaValue
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' MetaValue -> MetaValueMaybe
f MetaValueMaybe -> Maybe MetaValue
g
  where
    f :: MetaValue -> MetaValueMaybe
f = \case
        MetaValue
MetaValue_Property -> Bool -> Maybe Text -> MetaValueMaybe
MetaValueMaybe Bool
True Maybe Text
forall a. Maybe a
Nothing
        MetaValue_Setting Text
s -> Bool -> Maybe Text -> MetaValueMaybe
MetaValueMaybe Bool
False (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s)
        MetaValue_PropertyAndSetting Text
s -> Bool -> Maybe Text -> MetaValueMaybe
MetaValueMaybe Bool
True (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s)
    g :: MetaValueMaybe -> Maybe MetaValue
g = \case
        MetaValueMaybe Bool
True  Maybe Text
Nothing  -> MetaValue -> Maybe MetaValue
forall a. a -> Maybe a
Just (MetaValue -> Maybe MetaValue) -> MetaValue -> Maybe MetaValue
forall a b. (a -> b) -> a -> b
$ MetaValue
MetaValue_Property
        MetaValueMaybe Bool
False (Just Text
s) -> MetaValue -> Maybe MetaValue
forall a. a -> Maybe a
Just (MetaValue -> Maybe MetaValue) -> MetaValue -> Maybe MetaValue
forall a b. (a -> b) -> a -> b
$ Text -> MetaValue
MetaValue_Setting Text
s
        MetaValueMaybe Bool
True  (Just Text
s) -> MetaValue -> Maybe MetaValue
forall a. a -> Maybe a
Just (MetaValue -> Maybe MetaValue) -> MetaValue -> Maybe MetaValue
forall a b. (a -> b) -> a -> b
$ Text -> MetaValue
MetaValue_PropertyAndSetting Text
s
        MetaValueMaybe Bool
False Maybe Text
Nothing  -> Maybe MetaValue
forall a. Maybe a
Nothing