module BNFC.Utils.Decoration where
import Prelude (id, (.), ($), Eq, Ord, Show, Functor(..), (<$>), Foldable, Traversable)
import Control.Applicative ( Const(Const), getConst )
import Data.Bifunctor
import Data.Functor.Identity
import Data.Functor.Compose
class Functor t => Decoration t where
traverseF :: Functor m => (a -> m b) -> t a -> m (t b)
traverseF a -> m b
f = t (m b) -> m (t b)
forall (t :: * -> *) (m :: * -> *) a.
(Decoration t, Functor m) =>
t (m a) -> m (t a)
distributeF (t (m b) -> m (t b)) -> (t a -> t (m b)) -> t a -> m (t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m b) -> t a -> t (m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m b
f
distributeF :: Functor m => t (m a) -> m (t a)
distributeF = (m a -> m a) -> t (m a) -> m (t a)
forall (t :: * -> *) (m :: * -> *) a b.
(Decoration t, Functor m) =>
(a -> m b) -> t a -> m (t b)
traverseF m a -> m a
forall a. a -> a
id
traverseF2 :: Bifunctor m => (a -> m b c) -> t a -> m (t b) (t c)
traverseF2 a -> m b c
f = t (m b c) -> m (t b) (t c)
forall (t :: * -> *) (m :: * -> * -> *) a b.
(Decoration t, Bifunctor m) =>
t (m a b) -> m (t a) (t b)
distributeF2 (t (m b c) -> m (t b) (t c))
-> (t a -> t (m b c)) -> t a -> m (t b) (t c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m b c) -> t a -> t (m b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m b c
f
distributeF2 :: Bifunctor m => t (m a b) -> m (t a) (t b)
distributeF2 = (m a b -> m a b) -> t (m a b) -> m (t a) (t b)
forall (t :: * -> *) (m :: * -> * -> *) a b c.
(Decoration t, Bifunctor m) =>
(a -> m b c) -> t a -> m (t b) (t c)
traverseF2 m a b -> m a b
forall a. a -> a
id
{-# MINIMAL (traverseF | distributeF) , ( traverseF2 | distributeF2) #-}
dmap :: Decoration t => (a -> b) -> t a -> t b
dmap :: (a -> b) -> t a -> t b
dmap a -> b
f = Identity (t b) -> t b
forall a. Identity a -> a
runIdentity (Identity (t b) -> t b) -> (t a -> Identity (t b)) -> t a -> t b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Identity b) -> t a -> Identity (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(Decoration t, Functor m) =>
(a -> m b) -> t a -> m (t b)
traverseF (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
dget :: Decoration t => t a -> a
dget :: t a -> a
dget = Const a (t Any) -> a
forall a k (b :: k). Const a b -> a
getConst (Const a (t Any) -> a) -> (t a -> Const a (t Any)) -> t a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const a Any) -> t a -> Const a (t Any)
forall (t :: * -> *) (m :: * -> *) a b.
(Decoration t, Functor m) =>
(a -> m b) -> t a -> m (t b)
traverseF a -> Const a Any
forall k a (b :: k). a -> Const a b
Const
instance Decoration Identity where
traverseF :: (a -> m b) -> Identity a -> m (Identity b)
traverseF a -> m b
f (Identity a
x) = b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> m b -> m (Identity b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
f a
x
traverseF2 :: (a -> m b c) -> Identity a -> m (Identity b) (Identity c)
traverseF2 a -> m b c
f (Identity a
x) = (b -> Identity b)
-> (c -> Identity c) -> m b c -> m (Identity b) (Identity c)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap b -> Identity b
forall a. a -> Identity a
Identity c -> Identity c
forall a. a -> Identity a
Identity (m b c -> m (Identity b) (Identity c))
-> m b c -> m (Identity b) (Identity c)
forall a b. (a -> b) -> a -> b
$ a -> m b c
f a
x
instance (Decoration d, Decoration t) => Decoration (Compose d t) where
traverseF :: (a -> m b) -> Compose d t a -> m (Compose d t b)
traverseF a -> m b
f (Compose d (t a)
x) = d (t b) -> Compose d t b
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (d (t b) -> Compose d t b) -> m (d (t b)) -> m (Compose d t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t a -> m (t b)) -> d (t a) -> m (d (t b))
forall (t :: * -> *) (m :: * -> *) a b.
(Decoration t, Functor m) =>
(a -> m b) -> t a -> m (t b)
traverseF ((a -> m b) -> t a -> m (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(Decoration t, Functor m) =>
(a -> m b) -> t a -> m (t b)
traverseF a -> m b
f) d (t a)
x
traverseF2 :: (a -> m b c) -> Compose d t a -> m (Compose d t b) (Compose d t c)
traverseF2 a -> m b c
f (Compose d (t a)
x) = (d (t b) -> Compose d t b)
-> (d (t c) -> Compose d t c)
-> m (d (t b)) (d (t c))
-> m (Compose d t b) (Compose d t c)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap d (t b) -> Compose d t b
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose d (t c) -> Compose d t c
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (m (d (t b)) (d (t c)) -> m (Compose d t b) (Compose d t c))
-> m (d (t b)) (d (t c)) -> m (Compose d t b) (Compose d t c)
forall a b. (a -> b) -> a -> b
$ (t a -> m (t b) (t c)) -> d (t a) -> m (d (t b)) (d (t c))
forall (t :: * -> *) (m :: * -> * -> *) a b c.
(Decoration t, Bifunctor m) =>
(a -> m b c) -> t a -> m (t b) (t c)
traverseF2 ((a -> m b c) -> t a -> m (t b) (t c)
forall (t :: * -> *) (m :: * -> * -> *) a b c.
(Decoration t, Bifunctor m) =>
(a -> m b c) -> t a -> m (t b) (t c)
traverseF2 a -> m b c
f) d (t a)
x
instance Decoration ((,) a) where
traverseF :: (a -> m b) -> (a, a) -> m (a, b)
traverseF a -> m b
f (a
a, a
x) = (a
a,) (b -> (a, b)) -> m b -> m (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
f a
x
traverseF2 :: (a -> m b c) -> (a, a) -> m (a, b) (a, c)
traverseF2 a -> m b c
f (a
a, a
x) = (b -> (a, b)) -> (c -> (a, c)) -> m b c -> m (a, b) (a, c)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (a
a,) (a
a,) (m b c -> m (a, b) (a, c)) -> m b c -> m (a, b) (a, c)
forall a b. (a -> b) -> a -> b
$ a -> m b c
f a
x
data DecorationT d a = DecorationT
{ DecorationT d a -> d
decoration :: d
, DecorationT d a -> a
decorated :: a
}
deriving (DecorationT d a -> DecorationT d a -> Bool
(DecorationT d a -> DecorationT d a -> Bool)
-> (DecorationT d a -> DecorationT d a -> Bool)
-> Eq (DecorationT d a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall d a.
(Eq d, Eq a) =>
DecorationT d a -> DecorationT d a -> Bool
/= :: DecorationT d a -> DecorationT d a -> Bool
$c/= :: forall d a.
(Eq d, Eq a) =>
DecorationT d a -> DecorationT d a -> Bool
== :: DecorationT d a -> DecorationT d a -> Bool
$c== :: forall d a.
(Eq d, Eq a) =>
DecorationT d a -> DecorationT d a -> Bool
Eq, Eq (DecorationT d a)
Eq (DecorationT d a)
-> (DecorationT d a -> DecorationT d a -> Ordering)
-> (DecorationT d a -> DecorationT d a -> Bool)
-> (DecorationT d a -> DecorationT d a -> Bool)
-> (DecorationT d a -> DecorationT d a -> Bool)
-> (DecorationT d a -> DecorationT d a -> Bool)
-> (DecorationT d a -> DecorationT d a -> DecorationT d a)
-> (DecorationT d a -> DecorationT d a -> DecorationT d a)
-> Ord (DecorationT d a)
DecorationT d a -> DecorationT d a -> Bool
DecorationT d a -> DecorationT d a -> Ordering
DecorationT d a -> DecorationT d a -> DecorationT d a
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
forall d a. (Ord d, Ord a) => Eq (DecorationT d a)
forall d a.
(Ord d, Ord a) =>
DecorationT d a -> DecorationT d a -> Bool
forall d a.
(Ord d, Ord a) =>
DecorationT d a -> DecorationT d a -> Ordering
forall d a.
(Ord d, Ord a) =>
DecorationT d a -> DecorationT d a -> DecorationT d a
min :: DecorationT d a -> DecorationT d a -> DecorationT d a
$cmin :: forall d a.
(Ord d, Ord a) =>
DecorationT d a -> DecorationT d a -> DecorationT d a
max :: DecorationT d a -> DecorationT d a -> DecorationT d a
$cmax :: forall d a.
(Ord d, Ord a) =>
DecorationT d a -> DecorationT d a -> DecorationT d a
>= :: DecorationT d a -> DecorationT d a -> Bool
$c>= :: forall d a.
(Ord d, Ord a) =>
DecorationT d a -> DecorationT d a -> Bool
> :: DecorationT d a -> DecorationT d a -> Bool
$c> :: forall d a.
(Ord d, Ord a) =>
DecorationT d a -> DecorationT d a -> Bool
<= :: DecorationT d a -> DecorationT d a -> Bool
$c<= :: forall d a.
(Ord d, Ord a) =>
DecorationT d a -> DecorationT d a -> Bool
< :: DecorationT d a -> DecorationT d a -> Bool
$c< :: forall d a.
(Ord d, Ord a) =>
DecorationT d a -> DecorationT d a -> Bool
compare :: DecorationT d a -> DecorationT d a -> Ordering
$ccompare :: forall d a.
(Ord d, Ord a) =>
DecorationT d a -> DecorationT d a -> Ordering
$cp1Ord :: forall d a. (Ord d, Ord a) => Eq (DecorationT d a)
Ord, Int -> DecorationT d a -> ShowS
[DecorationT d a] -> ShowS
DecorationT d a -> String
(Int -> DecorationT d a -> ShowS)
-> (DecorationT d a -> String)
-> ([DecorationT d a] -> ShowS)
-> Show (DecorationT d a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall d a. (Show d, Show a) => Int -> DecorationT d a -> ShowS
forall d a. (Show d, Show a) => [DecorationT d a] -> ShowS
forall d a. (Show d, Show a) => DecorationT d a -> String
showList :: [DecorationT d a] -> ShowS
$cshowList :: forall d a. (Show d, Show a) => [DecorationT d a] -> ShowS
show :: DecorationT d a -> String
$cshow :: forall d a. (Show d, Show a) => DecorationT d a -> String
showsPrec :: Int -> DecorationT d a -> ShowS
$cshowsPrec :: forall d a. (Show d, Show a) => Int -> DecorationT d a -> ShowS
Show, a -> DecorationT d b -> DecorationT d a
(a -> b) -> DecorationT d a -> DecorationT d b
(forall a b. (a -> b) -> DecorationT d a -> DecorationT d b)
-> (forall a b. a -> DecorationT d b -> DecorationT d a)
-> Functor (DecorationT d)
forall a b. a -> DecorationT d b -> DecorationT d a
forall a b. (a -> b) -> DecorationT d a -> DecorationT d b
forall d a b. a -> DecorationT d b -> DecorationT d a
forall d a b. (a -> b) -> DecorationT d a -> DecorationT d b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DecorationT d b -> DecorationT d a
$c<$ :: forall d a b. a -> DecorationT d b -> DecorationT d a
fmap :: (a -> b) -> DecorationT d a -> DecorationT d b
$cfmap :: forall d a b. (a -> b) -> DecorationT d a -> DecorationT d b
Functor, DecorationT d a -> Bool
(a -> m) -> DecorationT d a -> m
(a -> b -> b) -> b -> DecorationT d a -> b
(forall m. Monoid m => DecorationT d m -> m)
-> (forall m a. Monoid m => (a -> m) -> DecorationT d a -> m)
-> (forall m a. Monoid m => (a -> m) -> DecorationT d a -> m)
-> (forall a b. (a -> b -> b) -> b -> DecorationT d a -> b)
-> (forall a b. (a -> b -> b) -> b -> DecorationT d a -> b)
-> (forall b a. (b -> a -> b) -> b -> DecorationT d a -> b)
-> (forall b a. (b -> a -> b) -> b -> DecorationT d a -> b)
-> (forall a. (a -> a -> a) -> DecorationT d a -> a)
-> (forall a. (a -> a -> a) -> DecorationT d a -> a)
-> (forall a. DecorationT d a -> [a])
-> (forall a. DecorationT d a -> Bool)
-> (forall a. DecorationT d a -> Int)
-> (forall a. Eq a => a -> DecorationT d a -> Bool)
-> (forall a. Ord a => DecorationT d a -> a)
-> (forall a. Ord a => DecorationT d a -> a)
-> (forall a. Num a => DecorationT d a -> a)
-> (forall a. Num a => DecorationT d a -> a)
-> Foldable (DecorationT d)
forall a. Eq a => a -> DecorationT d a -> Bool
forall a. Num a => DecorationT d a -> a
forall a. Ord a => DecorationT d a -> a
forall m. Monoid m => DecorationT d m -> m
forall a. DecorationT d a -> Bool
forall a. DecorationT d a -> Int
forall a. DecorationT d a -> [a]
forall a. (a -> a -> a) -> DecorationT d a -> a
forall d a. Eq a => a -> DecorationT d a -> Bool
forall d a. Num a => DecorationT d a -> a
forall d a. Ord a => DecorationT d a -> a
forall m a. Monoid m => (a -> m) -> DecorationT d a -> m
forall d m. Monoid m => DecorationT d m -> m
forall d a. DecorationT d a -> Bool
forall d a. DecorationT d a -> Int
forall d a. DecorationT d a -> [a]
forall b a. (b -> a -> b) -> b -> DecorationT d a -> b
forall a b. (a -> b -> b) -> b -> DecorationT d a -> b
forall d a. (a -> a -> a) -> DecorationT d a -> a
forall d m a. Monoid m => (a -> m) -> DecorationT d a -> m
forall d b a. (b -> a -> b) -> b -> DecorationT d a -> b
forall d a b. (a -> b -> b) -> b -> DecorationT d a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: DecorationT d a -> a
$cproduct :: forall d a. Num a => DecorationT d a -> a
sum :: DecorationT d a -> a
$csum :: forall d a. Num a => DecorationT d a -> a
minimum :: DecorationT d a -> a
$cminimum :: forall d a. Ord a => DecorationT d a -> a
maximum :: DecorationT d a -> a
$cmaximum :: forall d a. Ord a => DecorationT d a -> a
elem :: a -> DecorationT d a -> Bool
$celem :: forall d a. Eq a => a -> DecorationT d a -> Bool
length :: DecorationT d a -> Int
$clength :: forall d a. DecorationT d a -> Int
null :: DecorationT d a -> Bool
$cnull :: forall d a. DecorationT d a -> Bool
toList :: DecorationT d a -> [a]
$ctoList :: forall d a. DecorationT d a -> [a]
foldl1 :: (a -> a -> a) -> DecorationT d a -> a
$cfoldl1 :: forall d a. (a -> a -> a) -> DecorationT d a -> a
foldr1 :: (a -> a -> a) -> DecorationT d a -> a
$cfoldr1 :: forall d a. (a -> a -> a) -> DecorationT d a -> a
foldl' :: (b -> a -> b) -> b -> DecorationT d a -> b
$cfoldl' :: forall d b a. (b -> a -> b) -> b -> DecorationT d a -> b
foldl :: (b -> a -> b) -> b -> DecorationT d a -> b
$cfoldl :: forall d b a. (b -> a -> b) -> b -> DecorationT d a -> b
foldr' :: (a -> b -> b) -> b -> DecorationT d a -> b
$cfoldr' :: forall d a b. (a -> b -> b) -> b -> DecorationT d a -> b
foldr :: (a -> b -> b) -> b -> DecorationT d a -> b
$cfoldr :: forall d a b. (a -> b -> b) -> b -> DecorationT d a -> b
foldMap' :: (a -> m) -> DecorationT d a -> m
$cfoldMap' :: forall d m a. Monoid m => (a -> m) -> DecorationT d a -> m
foldMap :: (a -> m) -> DecorationT d a -> m
$cfoldMap :: forall d m a. Monoid m => (a -> m) -> DecorationT d a -> m
fold :: DecorationT d m -> m
$cfold :: forall d m. Monoid m => DecorationT d m -> m
Foldable, Functor (DecorationT d)
Foldable (DecorationT d)
Functor (DecorationT d)
-> Foldable (DecorationT d)
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DecorationT d a -> f (DecorationT d b))
-> (forall (f :: * -> *) a.
Applicative f =>
DecorationT d (f a) -> f (DecorationT d a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DecorationT d a -> m (DecorationT d b))
-> (forall (m :: * -> *) a.
Monad m =>
DecorationT d (m a) -> m (DecorationT d a))
-> Traversable (DecorationT d)
(a -> f b) -> DecorationT d a -> f (DecorationT d b)
forall d. Functor (DecorationT d)
forall d. Foldable (DecorationT d)
forall d (m :: * -> *) a.
Monad m =>
DecorationT d (m a) -> m (DecorationT d a)
forall d (f :: * -> *) a.
Applicative f =>
DecorationT d (f a) -> f (DecorationT d a)
forall d (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DecorationT d a -> m (DecorationT d b)
forall d (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DecorationT d a -> f (DecorationT d b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
DecorationT d (m a) -> m (DecorationT d a)
forall (f :: * -> *) a.
Applicative f =>
DecorationT d (f a) -> f (DecorationT d a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DecorationT d a -> m (DecorationT d b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DecorationT d a -> f (DecorationT d b)
sequence :: DecorationT d (m a) -> m (DecorationT d a)
$csequence :: forall d (m :: * -> *) a.
Monad m =>
DecorationT d (m a) -> m (DecorationT d a)
mapM :: (a -> m b) -> DecorationT d a -> m (DecorationT d b)
$cmapM :: forall d (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DecorationT d a -> m (DecorationT d b)
sequenceA :: DecorationT d (f a) -> f (DecorationT d a)
$csequenceA :: forall d (f :: * -> *) a.
Applicative f =>
DecorationT d (f a) -> f (DecorationT d a)
traverse :: (a -> f b) -> DecorationT d a -> f (DecorationT d b)
$ctraverse :: forall d (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DecorationT d a -> f (DecorationT d b)
$cp2Traversable :: forall d. Foldable (DecorationT d)
$cp1Traversable :: forall d. Functor (DecorationT d)
Traversable)
instance Decoration (DecorationT d) where
traverseF :: (a -> m b) -> DecorationT d a -> m (DecorationT d b)
traverseF a -> m b
f (DecorationT d
d a
x) = d -> b -> DecorationT d b
forall d a. d -> a -> DecorationT d a
DecorationT d
d (b -> DecorationT d b) -> m b -> m (DecorationT d b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
f a
x
traverseF2 :: (a -> m b c)
-> DecorationT d a -> m (DecorationT d b) (DecorationT d c)
traverseF2 a -> m b c
f (DecorationT d
d a
x) = (b -> DecorationT d b)
-> (c -> DecorationT d c)
-> m b c
-> m (DecorationT d b) (DecorationT d c)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (d -> b -> DecorationT d b
forall d a. d -> a -> DecorationT d a
DecorationT d
d) (d -> c -> DecorationT d c
forall d a. d -> a -> DecorationT d a
DecorationT d
d) (m b c -> m (DecorationT d b) (DecorationT d c))
-> m b c -> m (DecorationT d b) (DecorationT d c)
forall a b. (a -> b) -> a -> b
$ a -> m b c
f a
x