module Silkscreen.Nesting
( -- * Printing with nesting levels
  NestingPrinter(..)
, incrNesting
, encloseNesting
  -- * Re-exports
, module Silkscreen
) where

import Silkscreen

class Printer p => NestingPrinter p where
  -- | Make a printer informed by the current nesting level.
  askingNesting :: (Int -> p) -> p

  -- | Locally change the nesting level for a printer.
  localNesting :: (Int -> Int) -> p -> p

  -- | Apply the current nesting level to a printer.
  --
  -- Different instances can give different meanings to this, e.g. annotating the argument with the nesting level or some other means of rendering it differently.
  applyNesting :: p -> p

-- | Increment the nesting level of a printer.
--
-- This should be used inside parentheses, brackets, braces, etc., and will inform the annotation of their delimiters.
incrNesting :: NestingPrinter p => p -> p
incrNesting :: p -> p
incrNesting = (Int -> Int) -> p -> p
forall p. NestingPrinter p => (Int -> Int) -> p -> p
localNesting Int -> Int
forall a. Enum a => a -> a
succ

encloseNesting :: NestingPrinter p => p -> p -> p -> p
encloseNesting :: p -> p -> p -> p
encloseNesting p
l p
r = p -> p -> p -> p
forall p. Printer p => p -> p -> p -> p
enclose (p -> p
forall p. NestingPrinter p => p -> p
applyNesting p
l) (p -> p
forall p. NestingPrinter p => p -> p
applyNesting p
r) (p -> p) -> (p -> p) -> p -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> p
forall p. NestingPrinter p => p -> p
incrNesting


instance NestingPrinter b => NestingPrinter (a -> b) where
  askingNesting :: (Int -> a -> b) -> a -> b
askingNesting Int -> a -> b
f = (Int -> b) -> b
forall p. NestingPrinter p => (Int -> p) -> p
askingNesting ((Int -> b) -> b) -> (a -> Int -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> b) -> a -> Int -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> a -> b
f
  localNesting :: (Int -> Int) -> (a -> b) -> a -> b
localNesting Int -> Int
f a -> b
p = (Int -> Int) -> b -> b
forall p. NestingPrinter p => (Int -> Int) -> p -> p
localNesting Int -> Int
f (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
p
  applyNesting :: (a -> b) -> a -> b
applyNesting a -> b
p = b -> b
forall p. NestingPrinter p => p -> p
applyNesting (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
p