{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Silkscreen.Printer.Prec
( -- * Precedence printer
  runPrec
, Prec(..)
  -- * Re-exports
, module Silkscreen.Precedence
) where

import Control.Applicative (liftA2)
import Silkscreen.Nesting
import Silkscreen.Precedence

-- Prec

runPrec :: level -> Prec level a -> a
runPrec :: level -> Prec level a -> a
runPrec level
level (Prec level -> a
run) = level -> a
run level
level

newtype Prec level a = Prec (level -> a)
  deriving (Functor (Prec level)
a -> Prec level a
Functor (Prec level)
-> (forall a. a -> Prec level a)
-> (forall a b.
    Prec level (a -> b) -> Prec level a -> Prec level b)
-> (forall a b c.
    (a -> b -> c) -> Prec level a -> Prec level b -> Prec level c)
-> (forall a b. Prec level a -> Prec level b -> Prec level b)
-> (forall a b. Prec level a -> Prec level b -> Prec level a)
-> Applicative (Prec level)
Prec level a -> Prec level b -> Prec level b
Prec level a -> Prec level b -> Prec level a
Prec level (a -> b) -> Prec level a -> Prec level b
(a -> b -> c) -> Prec level a -> Prec level b -> Prec level c
forall level. Functor (Prec level)
forall a. a -> Prec level a
forall level a. a -> Prec level a
forall a b. Prec level a -> Prec level b -> Prec level a
forall a b. Prec level a -> Prec level b -> Prec level b
forall a b. Prec level (a -> b) -> Prec level a -> Prec level b
forall level a b. Prec level a -> Prec level b -> Prec level a
forall level a b. Prec level a -> Prec level b -> Prec level b
forall level a b.
Prec level (a -> b) -> Prec level a -> Prec level b
forall a b c.
(a -> b -> c) -> Prec level a -> Prec level b -> Prec level c
forall level a b c.
(a -> b -> c) -> Prec level a -> Prec level b -> Prec level c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Prec level a -> Prec level b -> Prec level a
$c<* :: forall level a b. Prec level a -> Prec level b -> Prec level a
*> :: Prec level a -> Prec level b -> Prec level b
$c*> :: forall level a b. Prec level a -> Prec level b -> Prec level b
liftA2 :: (a -> b -> c) -> Prec level a -> Prec level b -> Prec level c
$cliftA2 :: forall level a b c.
(a -> b -> c) -> Prec level a -> Prec level b -> Prec level c
<*> :: Prec level (a -> b) -> Prec level a -> Prec level b
$c<*> :: forall level a b.
Prec level (a -> b) -> Prec level a -> Prec level b
pure :: a -> Prec level a
$cpure :: forall level a. a -> Prec level a
$cp1Applicative :: forall level. Functor (Prec level)
Applicative, a -> Prec level b -> Prec level a
(a -> b) -> Prec level a -> Prec level b
(forall a b. (a -> b) -> Prec level a -> Prec level b)
-> (forall a b. a -> Prec level b -> Prec level a)
-> Functor (Prec level)
forall a b. a -> Prec level b -> Prec level a
forall a b. (a -> b) -> Prec level a -> Prec level b
forall level a b. a -> Prec level b -> Prec level a
forall level a b. (a -> b) -> Prec level a -> Prec level b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Prec level b -> Prec level a
$c<$ :: forall level a b. a -> Prec level b -> Prec level a
fmap :: (a -> b) -> Prec level a -> Prec level b
$cfmap :: forall level a b. (a -> b) -> Prec level a -> Prec level b
Functor, Applicative (Prec level)
a -> Prec level a
Applicative (Prec level)
-> (forall a b.
    Prec level a -> (a -> Prec level b) -> Prec level b)
-> (forall a b. Prec level a -> Prec level b -> Prec level b)
-> (forall a. a -> Prec level a)
-> Monad (Prec level)
Prec level a -> (a -> Prec level b) -> Prec level b
Prec level a -> Prec level b -> Prec level b
forall level. Applicative (Prec level)
forall a. a -> Prec level a
forall level a. a -> Prec level a
forall a b. Prec level a -> Prec level b -> Prec level b
forall a b. Prec level a -> (a -> Prec level b) -> Prec level b
forall level a b. Prec level a -> Prec level b -> Prec level b
forall level a b.
Prec level a -> (a -> Prec level b) -> Prec level b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Prec level a
$creturn :: forall level a. a -> Prec level a
>> :: Prec level a -> Prec level b -> Prec level b
$c>> :: forall level a b. Prec level a -> Prec level b -> Prec level b
>>= :: Prec level a -> (a -> Prec level b) -> Prec level b
$c>>= :: forall level a b.
Prec level a -> (a -> Prec level b) -> Prec level b
$cp1Monad :: forall level. Applicative (Prec level)
Monad, Semigroup (Prec level a)
Prec level a
Semigroup (Prec level a)
-> Prec level a
-> (Prec level a -> Prec level a -> Prec level a)
-> ([Prec level a] -> Prec level a)
-> Monoid (Prec level a)
[Prec level a] -> Prec level a
Prec level a -> Prec level a -> Prec level a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall level a. Monoid a => Semigroup (Prec level a)
forall level a. Monoid a => Prec level a
forall level a. Monoid a => [Prec level a] -> Prec level a
forall level a.
Monoid a =>
Prec level a -> Prec level a -> Prec level a
mconcat :: [Prec level a] -> Prec level a
$cmconcat :: forall level a. Monoid a => [Prec level a] -> Prec level a
mappend :: Prec level a -> Prec level a -> Prec level a
$cmappend :: forall level a.
Monoid a =>
Prec level a -> Prec level a -> Prec level a
mempty :: Prec level a
$cmempty :: forall level a. Monoid a => Prec level a
$cp1Monoid :: forall level a. Monoid a => Semigroup (Prec level a)
Monoid, b -> Prec level a -> Prec level a
NonEmpty (Prec level a) -> Prec level a
Prec level a -> Prec level a -> Prec level a
(Prec level a -> Prec level a -> Prec level a)
-> (NonEmpty (Prec level a) -> Prec level a)
-> (forall b. Integral b => b -> Prec level a -> Prec level a)
-> Semigroup (Prec level a)
forall b. Integral b => b -> Prec level a -> Prec level a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall level a.
Semigroup a =>
NonEmpty (Prec level a) -> Prec level a
forall level a.
Semigroup a =>
Prec level a -> Prec level a -> Prec level a
forall level a b.
(Semigroup a, Integral b) =>
b -> Prec level a -> Prec level a
stimes :: b -> Prec level a -> Prec level a
$cstimes :: forall level a b.
(Semigroup a, Integral b) =>
b -> Prec level a -> Prec level a
sconcat :: NonEmpty (Prec level a) -> Prec level a
$csconcat :: forall level a.
Semigroup a =>
NonEmpty (Prec level a) -> Prec level a
<> :: Prec level a -> Prec level a -> Prec level a
$c<> :: forall level a.
Semigroup a =>
Prec level a -> Prec level a -> Prec level a
Semigroup)

instance (Bounded level, Show a) => Show (Prec level a) where
  showsPrec :: Int -> Prec level a -> ShowS
showsPrec Int
p = Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (a -> ShowS) -> (Prec level a -> a) -> Prec level a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. level -> Prec level a -> a
forall level a. level -> Prec level a -> a
runPrec level
forall a. Bounded a => a
minBound

instance (Bounded level, Printer a) => Printer (Prec level a) where
  type Ann (Prec level a) = Ann a

  liftDoc0 :: Doc (Ann (Prec level a)) -> Prec level a
liftDoc0 = a -> Prec level a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Prec level a)
-> (Doc (Ann a) -> a) -> Doc (Ann a) -> Prec level a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc (Ann a) -> a
forall p. Printer p => Doc (Ann p) -> p
liftDoc0
  liftDoc1 :: (Doc (Ann (Prec level a)) -> Doc (Ann (Prec level a)))
-> Prec level a -> Prec level a
liftDoc1 = (a -> a) -> Prec level a -> Prec level a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> Prec level a -> Prec level a)
-> ((Doc (Ann a) -> Doc (Ann a)) -> a -> a)
-> (Doc (Ann a) -> Doc (Ann a))
-> Prec level a
-> Prec level a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc (Ann a) -> Doc (Ann a)) -> a -> a
forall p. Printer p => (Doc (Ann p) -> Doc (Ann p)) -> p -> p
liftDoc1
  liftDoc2 :: (Doc (Ann (Prec level a))
 -> Doc (Ann (Prec level a)) -> Doc (Ann (Prec level a)))
-> Prec level a -> Prec level a -> Prec level a
liftDoc2 = (a -> a -> a) -> Prec level a -> Prec level a -> Prec level a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((a -> a -> a) -> Prec level a -> Prec level a -> Prec level a)
-> ((Doc (Ann a) -> Doc (Ann a) -> Doc (Ann a)) -> a -> a -> a)
-> (Doc (Ann a) -> Doc (Ann a) -> Doc (Ann a))
-> Prec level a
-> Prec level a
-> Prec level a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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

  enclosing :: Prec level a -> Prec level a -> Prec level a -> Prec level a
enclosing Prec level a
l Prec level a
r Prec level a
x = a -> a -> a -> a
forall p. Printer p => p -> p -> p -> p
enclose (a -> a -> a -> a) -> Prec level a -> Prec level (a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Prec level a
l Prec level (a -> a -> a) -> Prec level a -> Prec level (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Prec level a
r Prec level (a -> a) -> Prec level a -> Prec level a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Level (Prec level a) -> Prec level a -> Prec level a
forall p. PrecedencePrinter p => Level p -> p -> p
setPrec Level (Prec level a)
forall a. Bounded a => a
minBound Prec level a
x

  column :: (Int -> Prec level a) -> Prec level a
column    Int -> Prec level a
f = (level -> a) -> Prec level a
forall level a. (level -> a) -> Prec level a
Prec ((level -> a) -> Prec level a) -> (level -> a) -> Prec level a
forall a b. (a -> b) -> a -> b
$ \ level
l -> (Int -> a) -> a
forall p. Printer p => (Int -> p) -> p
column    (level -> Prec level a -> a
forall level a. level -> Prec level a -> a
runPrec level
l (Prec level a -> a) -> (Int -> Prec level a) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Prec level a
f)
  nesting :: (Int -> Prec level a) -> Prec level a
nesting   Int -> Prec level a
f = (level -> a) -> Prec level a
forall level a. (level -> a) -> Prec level a
Prec ((level -> a) -> Prec level a) -> (level -> a) -> Prec level a
forall a b. (a -> b) -> a -> b
$ \ level
l -> (Int -> a) -> a
forall p. Printer p => (Int -> p) -> p
nesting   (level -> Prec level a -> a
forall level a. level -> Prec level a -> a
runPrec level
l (Prec level a -> a) -> (Int -> Prec level a) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Prec level a
f)
  pageWidth :: (PageWidth -> Prec level a) -> Prec level a
pageWidth PageWidth -> Prec level a
f = (level -> a) -> Prec level a
forall level a. (level -> a) -> Prec level a
Prec ((level -> a) -> Prec level a) -> (level -> a) -> Prec level a
forall a b. (a -> b) -> a -> b
$ \ level
l -> (PageWidth -> a) -> a
forall p. Printer p => (PageWidth -> p) -> p
pageWidth (level -> Prec level a -> a
forall level a. level -> Prec level a -> a
runPrec level
l (Prec level a -> a)
-> (PageWidth -> Prec level a) -> PageWidth -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageWidth -> Prec level a
f)

instance (Bounded level, Printer a) => PrecedencePrinter (Prec level a) where
  type Level (Prec level a) = level

  askingPrec :: (Level (Prec level a) -> Prec level a) -> Prec level a
askingPrec Level (Prec level a) -> Prec level a
f = (level -> a) -> Prec level a
forall level a. (level -> a) -> Prec level a
Prec (level -> Prec level a -> a
forall level a. level -> Prec level a -> a
runPrec (level -> Prec level a -> a)
-> (level -> Prec level a) -> level -> a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> level -> Prec level a
Level (Prec level a) -> Prec level a
f)
  localPrec :: (Level (Prec level a) -> Level (Prec level a))
-> Prec level a -> Prec level a
localPrec Level (Prec level a) -> Level (Prec level a)
f (Prec level -> a
p) = (level -> a) -> Prec level a
forall level a. (level -> a) -> Prec level a
Prec (level -> a
p (level -> a) -> (level -> level) -> level -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. level -> level
Level (Prec level a) -> Level (Prec level a)
f)

instance (Bounded level, NestingPrinter p) => NestingPrinter (Prec level p) where
  askingNesting :: (Int -> Prec level p) -> Prec level p
askingNesting Int -> Prec level p
f = (level -> p) -> Prec level p
forall level a. (level -> a) -> Prec level a
Prec ((level -> p) -> Prec level p) -> (level -> p) -> Prec level p
forall a b. (a -> b) -> a -> b
$ \ level
level -> (Int -> p) -> p
forall p. NestingPrinter p => (Int -> p) -> p
askingNesting (level -> Prec level p -> p
forall level a. level -> Prec level a -> a
runPrec level
level (Prec level p -> p) -> (Int -> Prec level p) -> Int -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Prec level p
f)

  localNesting :: (Int -> Int) -> Prec level p -> Prec level p
localNesting Int -> Int
f (Prec level -> p
p) = (level -> p) -> Prec level p
forall level a. (level -> a) -> Prec level a
Prec ((level -> p) -> Prec level p) -> (level -> p) -> Prec level p
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> p -> p
forall p. NestingPrinter p => (Int -> Int) -> p -> p
localNesting Int -> Int
f (p -> p) -> (level -> p) -> level -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. level -> p
p

  applyNesting :: Prec level p -> Prec level p
applyNesting (Prec level -> p
p) = (level -> p) -> Prec level p
forall level a. (level -> a) -> Prec level a
Prec ((level -> p) -> Prec level p) -> (level -> p) -> Prec level p
forall a b. (a -> b) -> a -> b
$ p -> p
forall p. NestingPrinter p => p -> p
applyNesting (p -> p) -> (level -> p) -> level -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. level -> p
p