module ProAbstract.Tag.HasManyTags
    ( HasManyTags (..), HasWitherableTags (..)
    , HasManyBlockTags (..), HasWitherableBlockTags (..)
    , HasWitherableInlineTags (..)
    ) where

import ProAbstract.Annotation
import ProAbstract.Tag.TagType

class HasManyTags x where
    allTags :: Traversal' x (Tag (Annotation x))
    allInlineTags :: Traversal' x (Tag (Annotation x))

class HasWitherableTags x where
    witherTags :: Monad f => (Tag (Annotation x) -> f (Maybe (Tag (Annotation x)))) -> x -> f x

    mapMaybeTags :: (Tag (Annotation x) -> Maybe (Tag (Annotation x))) -> x -> x
    mapMaybeTags Tag (Annotation x) -> Maybe (Tag (Annotation x))
f = Identity x -> x
forall a. Identity a -> a
runIdentity (Identity x -> x) -> (x -> Identity x) -> x -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag (Annotation x) -> Identity (Maybe (Tag (Annotation x))))
-> x -> Identity x
forall x (f :: * -> *).
(HasWitherableTags x, Monad f) =>
(Tag (Annotation x) -> f (Maybe (Tag (Annotation x)))) -> x -> f x
witherTags (Maybe (Tag (Annotation x)) -> Identity (Maybe (Tag (Annotation x)))
forall a. a -> Identity a
Identity (Maybe (Tag (Annotation x))
 -> Identity (Maybe (Tag (Annotation x))))
-> (Tag (Annotation x) -> Maybe (Tag (Annotation x)))
-> Tag (Annotation x)
-> Identity (Maybe (Tag (Annotation x)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag (Annotation x) -> Maybe (Tag (Annotation x))
f)

class HasManyTags x => HasManyBlockTags x where
    allBlockTags :: Traversal' x (Tag (Annotation x))

class HasManyBlockTags x => HasWitherableBlockTags x where
    witherBlockTags :: Monad f => (Tag (Annotation x) -> f (Maybe (Tag (Annotation x)))) -> x -> f x

    mapMaybeBlockTags :: (Tag (Annotation x) -> Maybe (Tag (Annotation x))) -> x -> x
    mapMaybeBlockTags Tag (Annotation x) -> Maybe (Tag (Annotation x))
f = Identity x -> x
forall a. Identity a -> a
runIdentity (Identity x -> x) -> (x -> Identity x) -> x -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag (Annotation x) -> Identity (Maybe (Tag (Annotation x))))
-> x -> Identity x
forall x (f :: * -> *).
(HasWitherableBlockTags x, Monad f) =>
(Tag (Annotation x) -> f (Maybe (Tag (Annotation x)))) -> x -> f x
witherBlockTags (Maybe (Tag (Annotation x)) -> Identity (Maybe (Tag (Annotation x)))
forall a. a -> Identity a
Identity (Maybe (Tag (Annotation x))
 -> Identity (Maybe (Tag (Annotation x))))
-> (Tag (Annotation x) -> Maybe (Tag (Annotation x)))
-> Tag (Annotation x)
-> Identity (Maybe (Tag (Annotation x)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag (Annotation x) -> Maybe (Tag (Annotation x))
f)

class HasManyTags x => HasWitherableInlineTags x where
    witherInlineTags :: Monad f => (Tag (Annotation x) -> f (Maybe (Tag (Annotation x)))) -> x -> f x

    mapMaybeInlineTags :: (Tag (Annotation x) -> Maybe (Tag (Annotation x))) -> x -> x
    mapMaybeInlineTags Tag (Annotation x) -> Maybe (Tag (Annotation x))
f = Identity x -> x
forall a. Identity a -> a
runIdentity (Identity x -> x) -> (x -> Identity x) -> x -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag (Annotation x) -> Identity (Maybe (Tag (Annotation x))))
-> x -> Identity x
forall x (f :: * -> *).
(HasWitherableInlineTags x, Monad f) =>
(Tag (Annotation x) -> f (Maybe (Tag (Annotation x)))) -> x -> f x
witherInlineTags (Maybe (Tag (Annotation x)) -> Identity (Maybe (Tag (Annotation x)))
forall a. a -> Identity a
Identity (Maybe (Tag (Annotation x))
 -> Identity (Maybe (Tag (Annotation x))))
-> (Tag (Annotation x) -> Maybe (Tag (Annotation x)))
-> Tag (Annotation x)
-> Identity (Maybe (Tag (Annotation x)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag (Annotation x) -> Maybe (Tag (Annotation x))
f)