-- | Annotations - allow custom, extra data in AST nodes.
module Descript.Misc.Ann
( Ann (..)
, SAnn (..)
, EAnn (..)
, AnnSummary (..)
, SummaryWithAnn (..)
, remAnns
, (=@=)
, (/@=)
, (<$@>)
, (<*@>)
, summaryWithAnn
) where
import Data.Semigroup
-- | An AST node which can be annotated.
class (Functor a, Foldable a, Traversable a) => Ann a where
-- | Gets the annotation.
getAnn :: a an -> an
-- | An AST node whose surface annotation can be transformed.
-- Technically every 'Ann' is an 'SAnn', but this functionality rarely
-- seems necessary so for most values it isn't implemented.
class (Ann a) => SAnn a where
-- | Transforms the surface annotation. Different than 'fmap', which
-- also transforms child nodes' annotations.
mapSAnn :: (an -> an) -> a an -> a an
-- | An AST node which can be combined with a semantically equivalent
-- node (equal via '=@='), combining annotations. Technically every
-- 'Ann' is an 'EAnn', but not all have implementations.
class (Ann a) => EAnn a where
-- | Combine 2 nodes with equivalent semantic content, but different
-- annotations. Assumes the nodes are semantically equal (via '=@=').
eappend :: (Semigroup an) => a an -> a an -> a an
-- | An annotation which affects a summary.
class (Show a) => AnnSummary a where
-- | A prefix added to a summary by the annotation
annSummaryPre :: a -> String
-- | Gets its summary by adding its annotation to a base summary.
--
-- > instance (SummaryWithAnn a) => Summary a where
-- > summary = summaryWithAnn
class (Ann a) => SummaryWithAnn a where
-- | The part of the summary without the annotation.
baseSummary :: a an -> String
instance AnnSummary () where
annSummaryPre () = ""
-- | Removes the annotations from the value and sub-values.
remAnns :: (Functor w) => w a -> w ()
remAnns x = () <$ x
-- | Whether the expressions are equal without annotations.
(=@=) :: (Functor w, Eq (w ())) => w a1 -> w a2 -> Bool
x =@= y = remAnns x == remAnns y
-- | Whether the expressions aren't equal without annotations.
(/@=) :: (Functor w, Eq (w ())) => w a1 -> w a2 -> Bool
x /@= y = remAnns x /= remAnns y
-- | Like '<$>', but delays applying an initial argument (the annotation).
--
-- Useful for creating parsers or other functors on annotated values,
-- which get ranges later. For example:
--
-- > ranged $ Add <$@> numParser <*@> numParser
--
-- is equivalent to
--
-- > ranged $ \range -> Add range <$> numParser <*> numParser
infixl 4 <$@>
(<$@>) :: (Functor w) => (ann -> a -> b) -> w a -> w (ann -> b)
f <$@> x = flip f <$> x
-- | Like '<*>', but delays applying an initial argument (the annotation).
--
-- Useful for creating parsers or other functors on annotated values,
-- which get ranges later. For example:
--
-- > ranged $ Add <$@> numParser <*@> numParser
--
-- is equivalent to
--
-- > ranged $ \range -> Add range <$> numParser <*> numParser
infixl 4 <*@>
(<*@>) :: (Applicative w) => w (ann -> a -> b) -> w a -> w (ann -> b)
f <*@> x = fmap flip f <*> x
-- | Gets the summary of a value, including its annotation.
summaryWithAnn :: (SummaryWithAnn a, AnnSummary an) => a an -> String
summaryWithAnn x = annSummaryPre (getAnn x) ++ baseSummary x