{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts #-}

module Descript.Misc.Build.Write.Print.Printable
  ( Printable (..)
  , FwdPrintable (..)
  ) where

import Descript.Misc.Build.Write.Print.APrint
import Descript.Misc.Ann
import Descript.Misc.Summary
import Data.Proxy

-- | An AST node which can be printed back into source text.
--
-- Note: The 'Summary' dependency is for convenience, because most (if
-- not all) prints make good summaries. With it, you can implement
-- 'Summary' using:
--
-- > summaryRec = pprintSummaryRec
class (Ann a, Summary (a ())) => Printable a where
  {-# MINIMAL aprint | aprintRec #-}

  -- | Pretty-prints this node into an abstract form.
  aprint :: (APrint r) => a an -> r
  aprint = aprintRec aprint

  -- | Pretty-prints this node into an abstract form,
  -- printing children using the given function.
  aprintRec :: (APrint r)
            => (forall b. (Printable b) => b an -> r)
            -> a an
            -> r
  aprintRec _ = aprint

  -- | Whether this node needs to be completely reprinted or patched if
  -- tainted (a child changes). Defaults to 'False' for convenience.
  needsFullReprint :: Proxy (a an) -> Bool
  needsFullReprint _ = False

-- | An "rough" AST node which can be printed back into source text. The
-- difference between this and 'Print' is that this doesn't need 'Ann',
-- which allows for (probably only use) 'Maybe' values to be printed.
--
-- If an instance is also 'Printable', the implementation should always be:
--
-- > afprintRec = id
--
-- (calls @sub@ on itself).
--
-- When printing a child instance, "forward" @sub@, e.g.:
--
-- > aprintRec sub (Add aPrintableChild aFwdPrintableChild)
-- >   = sub aPrintableChild <> " + " <> afprintRec sub aFwdPrintableChild
class (Functor a, Foldable a, Traversable a, Summary (a ())) => FwdPrintable a where
  -- | Pretty-prints this node into an abstract form,
  -- printing children using the given function.
  afprintRec :: (APrint r)
             => (forall b. (Printable b) => b an -> r)
             -> a an
             -> r