module Data.Functor.Annotated
(
Annotated
, AnnotatedF(..)
, pattern Note
, note
, erase
, foldMemo
) where
import Data.Functor.Foldable (Fix(..), fold, unfold)
import Data.Functor.Decomposed
data AnnotatedF a f t
= NoteF { note_ :: a
, erase_ :: f t
}
deriving (Eq, Ord, Functor)
pattern Note a e = Fix (NoteF a e)
instance Decomposed (AnnotatedF a) where
fmap1 f n = n { erase_ = f (erase_ n) }
type family Annotated a f
type instance Annotated a (Fix f) = Fix (AnnotatedF a f)
note :: Fix (AnnotatedF t f) -> t
note (Note t _) = t
erase :: Functor f => Fix (AnnotatedF t f) -> Fix f
erase = unfold (\(Note _ e) -> e)
foldMemo :: Functor f => (f t -> t) -> Fix f -> Fix (AnnotatedF t f)
foldMemo phi = fold phi'
where
phi' x = Note (phi $ fmap note x) x