{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Silkscreen.Printer.Rainbow
( -- * Rainbow parentheses
  runRainbow
, Rainbow(..)
  -- * Re-exports
, module Silkscreen.Nesting
) where

import Silkscreen.Nesting
import Silkscreen.Precedence

runRainbow :: (Int -> a -> a) -> Int -> Rainbow a -> a
runRainbow :: (Int -> a -> a) -> Int -> Rainbow a -> a
runRainbow Int -> a -> a
h Int
l (Rainbow (Int -> a -> a) -> Int -> a
run) = (Int -> a -> a) -> Int -> a
run Int -> a -> a
h Int
l

newtype Rainbow a = Rainbow ((Int -> a -> a) -> Int -> a)
  deriving (Semigroup (Rainbow a)
Rainbow a
Semigroup (Rainbow a)
-> Rainbow a
-> (Rainbow a -> Rainbow a -> Rainbow a)
-> ([Rainbow a] -> Rainbow a)
-> Monoid (Rainbow a)
[Rainbow a] -> Rainbow a
Rainbow a -> Rainbow a -> Rainbow a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (Rainbow a)
forall a. Monoid a => Rainbow a
forall a. Monoid a => [Rainbow a] -> Rainbow a
forall a. Monoid a => Rainbow a -> Rainbow a -> Rainbow a
mconcat :: [Rainbow a] -> Rainbow a
$cmconcat :: forall a. Monoid a => [Rainbow a] -> Rainbow a
mappend :: Rainbow a -> Rainbow a -> Rainbow a
$cmappend :: forall a. Monoid a => Rainbow a -> Rainbow a -> Rainbow a
mempty :: Rainbow a
$cmempty :: forall a. Monoid a => Rainbow a
$cp1Monoid :: forall a. Monoid a => Semigroup (Rainbow a)
Monoid, b -> Rainbow a -> Rainbow a
NonEmpty (Rainbow a) -> Rainbow a
Rainbow a -> Rainbow a -> Rainbow a
(Rainbow a -> Rainbow a -> Rainbow a)
-> (NonEmpty (Rainbow a) -> Rainbow a)
-> (forall b. Integral b => b -> Rainbow a -> Rainbow a)
-> Semigroup (Rainbow a)
forall b. Integral b => b -> Rainbow a -> Rainbow a
forall a. Semigroup a => NonEmpty (Rainbow a) -> Rainbow a
forall a. Semigroup a => Rainbow a -> Rainbow a -> Rainbow a
forall a b.
(Semigroup a, Integral b) =>
b -> Rainbow a -> Rainbow a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Rainbow a -> Rainbow a
$cstimes :: forall a b.
(Semigroup a, Integral b) =>
b -> Rainbow a -> Rainbow a
sconcat :: NonEmpty (Rainbow a) -> Rainbow a
$csconcat :: forall a. Semigroup a => NonEmpty (Rainbow a) -> Rainbow a
<> :: Rainbow a -> Rainbow a -> Rainbow a
$c<> :: forall a. Semigroup a => Rainbow a -> Rainbow a -> Rainbow a
Semigroup)

instance Show a => Show (Rainbow a) where
  showsPrec :: Int -> Rainbow a -> ShowS
showsPrec Int
p = Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (a -> ShowS) -> (Rainbow a -> a) -> Rainbow a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> a) -> Int -> Rainbow a -> a
forall a. (Int -> a -> a) -> Int -> Rainbow a -> a
runRainbow ((a -> Int -> a) -> Int -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Int -> a
forall a b. a -> b -> a
const) Int
0

instance Printer a => Printer (Rainbow a) where
  type Ann (Rainbow a) = Ann a

  liftDoc0 :: Doc (Ann (Rainbow a)) -> Rainbow a
liftDoc0 Doc (Ann (Rainbow a))
d = ((Int -> a -> a) -> Int -> a) -> Rainbow a
forall a. ((Int -> a -> a) -> Int -> a) -> Rainbow a
Rainbow (((Int -> a -> a) -> Int -> a) -> Rainbow a)
-> ((Int -> a -> a) -> Int -> a) -> Rainbow a
forall a b. (a -> b) -> a -> b
$ \ Int -> a -> a
_ Int
_ -> Doc (Ann a) -> a
forall p. Printer p => Doc (Ann p) -> p
liftDoc0 Doc (Ann a)
Doc (Ann (Rainbow a))
d
  liftDoc1 :: (Doc (Ann (Rainbow a)) -> Doc (Ann (Rainbow a)))
-> Rainbow a -> Rainbow a
liftDoc1 Doc (Ann (Rainbow a)) -> Doc (Ann (Rainbow a))
f Rainbow a
p = ((Int -> a -> a) -> Int -> a) -> Rainbow a
forall a. ((Int -> a -> a) -> Int -> a) -> Rainbow a
Rainbow (((Int -> a -> a) -> Int -> a) -> Rainbow a)
-> ((Int -> a -> a) -> Int -> a) -> Rainbow a
forall a b. (a -> b) -> a -> b
$ \ Int -> a -> a
h Int
l -> (Doc (Ann a) -> Doc (Ann a)) -> a -> a
forall p. Printer p => (Doc (Ann p) -> Doc (Ann p)) -> p -> p
liftDoc1 Doc (Ann a) -> Doc (Ann a)
Doc (Ann (Rainbow a)) -> Doc (Ann (Rainbow a))
f ((Int -> a -> a) -> Int -> Rainbow a -> a
forall a. (Int -> a -> a) -> Int -> Rainbow a -> a
runRainbow Int -> a -> a
h Int
l Rainbow a
p)
  liftDoc2 :: (Doc (Ann (Rainbow a))
 -> Doc (Ann (Rainbow a)) -> Doc (Ann (Rainbow a)))
-> Rainbow a -> Rainbow a -> Rainbow a
liftDoc2 Doc (Ann (Rainbow a))
-> Doc (Ann (Rainbow a)) -> Doc (Ann (Rainbow a))
f Rainbow a
p1 Rainbow a
p2 = ((Int -> a -> a) -> Int -> a) -> Rainbow a
forall a. ((Int -> a -> a) -> Int -> a) -> Rainbow a
Rainbow (((Int -> a -> a) -> Int -> a) -> Rainbow a)
-> ((Int -> a -> a) -> Int -> a) -> Rainbow a
forall a b. (a -> b) -> a -> b
$ \ Int -> a -> a
h Int
l -> (Doc (Ann a) -> Doc (Ann a) -> Doc (Ann a)) -> a -> a -> a
forall p.
Printer p =>
(Doc (Ann p) -> Doc (Ann p) -> Doc (Ann p)) -> p -> p -> p
liftDoc2 Doc (Ann a) -> Doc (Ann a) -> Doc (Ann a)
Doc (Ann (Rainbow a))
-> Doc (Ann (Rainbow a)) -> Doc (Ann (Rainbow a))
f ((Int -> a -> a) -> Int -> Rainbow a -> a
forall a. (Int -> a -> a) -> Int -> Rainbow a -> a
runRainbow Int -> a -> a
h Int
l Rainbow a
p1) ((Int -> a -> a) -> Int -> Rainbow a -> a
forall a. (Int -> a -> a) -> Int -> Rainbow a -> a
runRainbow Int -> a -> a
h Int
l Rainbow a
p2)

  enclosing :: Rainbow a -> Rainbow a -> Rainbow a -> Rainbow a
enclosing = Rainbow a -> Rainbow a -> Rainbow a -> Rainbow a
forall p. NestingPrinter p => p -> p -> p -> p
encloseNesting

  column :: (Int -> Rainbow a) -> Rainbow a
column    Int -> Rainbow a
f = ((Int -> a -> a) -> Int -> a) -> Rainbow a
forall a. ((Int -> a -> a) -> Int -> a) -> Rainbow a
Rainbow (((Int -> a -> a) -> Int -> a) -> Rainbow a)
-> ((Int -> a -> a) -> Int -> a) -> Rainbow a
forall a b. (a -> b) -> a -> b
$ \ Int -> a -> a
h Int
l -> (Int -> a) -> a
forall p. Printer p => (Int -> p) -> p
column    ((Int -> a -> a) -> Int -> Rainbow a -> a
forall a. (Int -> a -> a) -> Int -> Rainbow a -> a
runRainbow Int -> a -> a
h Int
l (Rainbow a -> a) -> (Int -> Rainbow a) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rainbow a
f)
  nesting :: (Int -> Rainbow a) -> Rainbow a
nesting   Int -> Rainbow a
f = ((Int -> a -> a) -> Int -> a) -> Rainbow a
forall a. ((Int -> a -> a) -> Int -> a) -> Rainbow a
Rainbow (((Int -> a -> a) -> Int -> a) -> Rainbow a)
-> ((Int -> a -> a) -> Int -> a) -> Rainbow a
forall a b. (a -> b) -> a -> b
$ \ Int -> a -> a
h Int
l -> (Int -> a) -> a
forall p. Printer p => (Int -> p) -> p
nesting   ((Int -> a -> a) -> Int -> Rainbow a -> a
forall a. (Int -> a -> a) -> Int -> Rainbow a -> a
runRainbow Int -> a -> a
h Int
l (Rainbow a -> a) -> (Int -> Rainbow a) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rainbow a
f)
  pageWidth :: (PageWidth -> Rainbow a) -> Rainbow a
pageWidth PageWidth -> Rainbow a
f = ((Int -> a -> a) -> Int -> a) -> Rainbow a
forall a. ((Int -> a -> a) -> Int -> a) -> Rainbow a
Rainbow (((Int -> a -> a) -> Int -> a) -> Rainbow a)
-> ((Int -> a -> a) -> Int -> a) -> Rainbow a
forall a b. (a -> b) -> a -> b
$ \ Int -> a -> a
h Int
l -> (PageWidth -> a) -> a
forall p. Printer p => (PageWidth -> p) -> p
pageWidth ((Int -> a -> a) -> Int -> Rainbow a -> a
forall a. (Int -> a -> a) -> Int -> Rainbow a -> a
runRainbow Int -> a -> a
h Int
l (Rainbow a -> a) -> (PageWidth -> Rainbow a) -> PageWidth -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageWidth -> Rainbow a
f)

instance Printer a => NestingPrinter (Rainbow a) where
  askingNesting :: (Int -> Rainbow a) -> Rainbow a
askingNesting Int -> Rainbow a
f = ((Int -> a -> a) -> Int -> a) -> Rainbow a
forall a. ((Int -> a -> a) -> Int -> a) -> Rainbow a
Rainbow (\ Int -> a -> a
as -> (Int -> a -> a) -> Int -> Rainbow a -> a
forall a. (Int -> a -> a) -> Int -> Rainbow a -> a
runRainbow Int -> a -> a
as (Int -> Rainbow a -> a) -> (Int -> Rainbow a) -> Int -> a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Rainbow a
f)
  localNesting :: (Int -> Int) -> Rainbow a -> Rainbow a
localNesting Int -> Int
f (Rainbow (Int -> a -> a) -> Int -> a
p) = ((Int -> a -> a) -> Int -> a) -> Rainbow a
forall a. ((Int -> a -> a) -> Int -> a) -> Rainbow a
Rainbow (\ Int -> a -> a
as -> (Int -> a -> a) -> Int -> a
p Int -> a -> a
as (Int -> a) -> (Int -> Int) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
f)
  applyNesting :: Rainbow a -> Rainbow a
applyNesting Rainbow a
a = ((Int -> a -> a) -> Int -> a) -> Rainbow a
forall a. ((Int -> a -> a) -> Int -> a) -> Rainbow a
Rainbow (((Int -> a -> a) -> Int -> a) -> Rainbow a)
-> ((Int -> a -> a) -> Int -> a) -> Rainbow a
forall a b. (a -> b) -> a -> b
$ \ Int -> a -> a
h Int
l -> Int -> a -> a
h Int
l ((Int -> a -> a) -> Int -> Rainbow a -> a
forall a. (Int -> a -> a) -> Int -> Rainbow a -> a
runRainbow Int -> a -> a
h Int
l Rainbow a
a)

instance PrecedencePrinter p => PrecedencePrinter (Rainbow p) where
  type Level (Rainbow p) = Level p

  askingPrec :: (Level (Rainbow p) -> Rainbow p) -> Rainbow p
askingPrec Level (Rainbow p) -> Rainbow p
f = ((Int -> p -> p) -> Int -> p) -> Rainbow p
forall a. ((Int -> a -> a) -> Int -> a) -> Rainbow a
Rainbow (((Int -> p -> p) -> Int -> p) -> Rainbow p)
-> ((Int -> p -> p) -> Int -> p) -> Rainbow p
forall a b. (a -> b) -> a -> b
$ \ Int -> p -> p
h Int
l -> (Level p -> p) -> p
forall p. PrecedencePrinter p => (Level p -> p) -> p
askingPrec ((Int -> p -> p) -> Int -> Rainbow p -> p
forall a. (Int -> a -> a) -> Int -> Rainbow a -> a
runRainbow Int -> p -> p
h Int
l (Rainbow p -> p) -> (Level p -> Rainbow p) -> Level p -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Level p -> Rainbow p
Level (Rainbow p) -> Rainbow p
f)

  localPrec :: (Level (Rainbow p) -> Level (Rainbow p)) -> Rainbow p -> Rainbow p
localPrec Level (Rainbow p) -> Level (Rainbow p)
f (Rainbow (Int -> p -> p) -> Int -> p
p) = ((Int -> p -> p) -> Int -> p) -> Rainbow p
forall a. ((Int -> a -> a) -> Int -> a) -> Rainbow a
Rainbow (((Int -> p -> p) -> Int -> p) -> Rainbow p)
-> ((Int -> p -> p) -> Int -> p) -> Rainbow p
forall a b. (a -> b) -> a -> b
$ \ Int -> p -> p
h -> (Level p -> Level p) -> p -> p
forall p. PrecedencePrinter p => (Level p -> Level p) -> p -> p
localPrec Level p -> Level p
Level (Rainbow p) -> Level (Rainbow p)
f (p -> p) -> (Int -> p) -> Int -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> p -> p) -> Int -> p
p Int -> p -> p
h