{-# LANGUAGE DeriveTraversable #-}

-- | Occurrence-tokens for values.
--
-- A 'Stamped' value pairs an occurrence token (a /stamp/) with a payload.
-- The stamp is an observation receipt: an id, a timestamp, a line number,
-- or any other token that names the occurrence without changing the
-- payload's meaning.
--
-- === Free theorem
--
-- The stamp is untouched by payload mapping:
--
-- @
-- stamp (fmap f s) = stamp s
-- stamped (fmap f s) = f (stamped s)
-- @
--
-- >>> let s = Stamped 42 "hello"
-- >>> stamp (fmap reverse s)
-- 42
-- >>> stamped (fmap reverse s)
-- "olleh"
module Circuit.Stamped
  ( Stamped (..),
  )
where

import Data.Bifunctor (Bifunctor (..))

-- | A value @a@ labelled by an occurrence token @r@.
data Stamped r a = Stamped
  { -- | Occurrence token / receipt.  Not touched by 'fmap'.
    forall r a. Stamped r a -> r
stamp :: r,
    -- | The labelled payload.
    forall r a. Stamped r a -> a
stamped :: a
  }
  deriving (Stamped r a -> Stamped r a -> Bool
(Stamped r a -> Stamped r a -> Bool)
-> (Stamped r a -> Stamped r a -> Bool) -> Eq (Stamped r a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall r a. (Eq r, Eq a) => Stamped r a -> Stamped r a -> Bool
$c== :: forall r a. (Eq r, Eq a) => Stamped r a -> Stamped r a -> Bool
== :: Stamped r a -> Stamped r a -> Bool
$c/= :: forall r a. (Eq r, Eq a) => Stamped r a -> Stamped r a -> Bool
/= :: Stamped r a -> Stamped r a -> Bool
Eq, Int -> Stamped r a -> ShowS
[Stamped r a] -> ShowS
Stamped r a -> String
(Int -> Stamped r a -> ShowS)
-> (Stamped r a -> String)
-> ([Stamped r a] -> ShowS)
-> Show (Stamped r a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall r a. (Show r, Show a) => Int -> Stamped r a -> ShowS
forall r a. (Show r, Show a) => [Stamped r a] -> ShowS
forall r a. (Show r, Show a) => Stamped r a -> String
$cshowsPrec :: forall r a. (Show r, Show a) => Int -> Stamped r a -> ShowS
showsPrec :: Int -> Stamped r a -> ShowS
$cshow :: forall r a. (Show r, Show a) => Stamped r a -> String
show :: Stamped r a -> String
$cshowList :: forall r a. (Show r, Show a) => [Stamped r a] -> ShowS
showList :: [Stamped r a] -> ShowS
Show, (forall a b. (a -> b) -> Stamped r a -> Stamped r b)
-> (forall a b. a -> Stamped r b -> Stamped r a)
-> Functor (Stamped r)
forall a b. a -> Stamped r b -> Stamped r a
forall a b. (a -> b) -> Stamped r a -> Stamped r b
forall r a b. a -> Stamped r b -> Stamped r a
forall r a b. (a -> b) -> Stamped r a -> Stamped r b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall r a b. (a -> b) -> Stamped r a -> Stamped r b
fmap :: forall a b. (a -> b) -> Stamped r a -> Stamped r b
$c<$ :: forall r a b. a -> Stamped r b -> Stamped r a
<$ :: forall a b. a -> Stamped r b -> Stamped r a
Functor, (forall m. Monoid m => Stamped r m -> m)
-> (forall m a. Monoid m => (a -> m) -> Stamped r a -> m)
-> (forall m a. Monoid m => (a -> m) -> Stamped r a -> m)
-> (forall a b. (a -> b -> b) -> b -> Stamped r a -> b)
-> (forall a b. (a -> b -> b) -> b -> Stamped r a -> b)
-> (forall b a. (b -> a -> b) -> b -> Stamped r a -> b)
-> (forall b a. (b -> a -> b) -> b -> Stamped r a -> b)
-> (forall a. (a -> a -> a) -> Stamped r a -> a)
-> (forall a. (a -> a -> a) -> Stamped r a -> a)
-> (forall a. Stamped r a -> [a])
-> (forall a. Stamped r a -> Bool)
-> (forall a. Stamped r a -> Int)
-> (forall a. Eq a => a -> Stamped r a -> Bool)
-> (forall a. Ord a => Stamped r a -> a)
-> (forall a. Ord a => Stamped r a -> a)
-> (forall a. Num a => Stamped r a -> a)
-> (forall a. Num a => Stamped r a -> a)
-> Foldable (Stamped r)
forall a. Eq a => a -> Stamped r a -> Bool
forall a. Num a => Stamped r a -> a
forall a. Ord a => Stamped r a -> a
forall m. Monoid m => Stamped r m -> m
forall a. Stamped r a -> Bool
forall a. Stamped r a -> Int
forall a. Stamped r a -> [a]
forall a. (a -> a -> a) -> Stamped r a -> a
forall r a. Eq a => a -> Stamped r a -> Bool
forall r a. Num a => Stamped r a -> a
forall r a. Ord a => Stamped r a -> a
forall r m. Monoid m => Stamped r m -> m
forall m a. Monoid m => (a -> m) -> Stamped r a -> m
forall r a. Stamped r a -> Bool
forall r a. Stamped r a -> Int
forall r a. Stamped r a -> [a]
forall b a. (b -> a -> b) -> b -> Stamped r a -> b
forall a b. (a -> b -> b) -> b -> Stamped r a -> b
forall r a. (a -> a -> a) -> Stamped r a -> a
forall r m a. Monoid m => (a -> m) -> Stamped r a -> m
forall r b a. (b -> a -> b) -> b -> Stamped r a -> b
forall r a b. (a -> b -> b) -> b -> Stamped r 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
$cfold :: forall r m. Monoid m => Stamped r m -> m
fold :: forall m. Monoid m => Stamped r m -> m
$cfoldMap :: forall r m a. Monoid m => (a -> m) -> Stamped r a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Stamped r a -> m
$cfoldMap' :: forall r m a. Monoid m => (a -> m) -> Stamped r a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Stamped r a -> m
$cfoldr :: forall r a b. (a -> b -> b) -> b -> Stamped r a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Stamped r a -> b
$cfoldr' :: forall r a b. (a -> b -> b) -> b -> Stamped r a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Stamped r a -> b
$cfoldl :: forall r b a. (b -> a -> b) -> b -> Stamped r a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Stamped r a -> b
$cfoldl' :: forall r b a. (b -> a -> b) -> b -> Stamped r a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Stamped r a -> b
$cfoldr1 :: forall r a. (a -> a -> a) -> Stamped r a -> a
foldr1 :: forall a. (a -> a -> a) -> Stamped r a -> a
$cfoldl1 :: forall r a. (a -> a -> a) -> Stamped r a -> a
foldl1 :: forall a. (a -> a -> a) -> Stamped r a -> a
$ctoList :: forall r a. Stamped r a -> [a]
toList :: forall a. Stamped r a -> [a]
$cnull :: forall r a. Stamped r a -> Bool
null :: forall a. Stamped r a -> Bool
$clength :: forall r a. Stamped r a -> Int
length :: forall a. Stamped r a -> Int
$celem :: forall r a. Eq a => a -> Stamped r a -> Bool
elem :: forall a. Eq a => a -> Stamped r a -> Bool
$cmaximum :: forall r a. Ord a => Stamped r a -> a
maximum :: forall a. Ord a => Stamped r a -> a
$cminimum :: forall r a. Ord a => Stamped r a -> a
minimum :: forall a. Ord a => Stamped r a -> a
$csum :: forall r a. Num a => Stamped r a -> a
sum :: forall a. Num a => Stamped r a -> a
$cproduct :: forall r a. Num a => Stamped r a -> a
product :: forall a. Num a => Stamped r a -> a
Foldable, Functor (Stamped r)
Foldable (Stamped r)
(Functor (Stamped r), Foldable (Stamped r)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Stamped r a -> f (Stamped r b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Stamped r (f a) -> f (Stamped r a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Stamped r a -> m (Stamped r b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Stamped r (m a) -> m (Stamped r a))
-> Traversable (Stamped r)
forall r. Functor (Stamped r)
forall r. Foldable (Stamped r)
forall r (m :: * -> *) a.
Monad m =>
Stamped r (m a) -> m (Stamped r a)
forall r (f :: * -> *) a.
Applicative f =>
Stamped r (f a) -> f (Stamped r a)
forall r (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stamped r a -> m (Stamped r b)
forall r (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stamped r a -> f (Stamped r 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 =>
Stamped r (m a) -> m (Stamped r a)
forall (f :: * -> *) a.
Applicative f =>
Stamped r (f a) -> f (Stamped r a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stamped r a -> m (Stamped r b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stamped r a -> f (Stamped r b)
$ctraverse :: forall r (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stamped r a -> f (Stamped r b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stamped r a -> f (Stamped r b)
$csequenceA :: forall r (f :: * -> *) a.
Applicative f =>
Stamped r (f a) -> f (Stamped r a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Stamped r (f a) -> f (Stamped r a)
$cmapM :: forall r (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stamped r a -> m (Stamped r b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stamped r a -> m (Stamped r b)
$csequence :: forall r (m :: * -> *) a.
Monad m =>
Stamped r (m a) -> m (Stamped r a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Stamped r (m a) -> m (Stamped r a)
Traversable)

instance Bifunctor Stamped where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> Stamped a c -> Stamped b d
bimap a -> b
f c -> d
g (Stamped a
r c
a) = b -> d -> Stamped b d
forall r a. r -> a -> Stamped r a
Stamped (a -> b
f a
r) (c -> d
g c
a)