{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

module PureNix.Print (renderExpr) where

import Data.Foldable (toList)
import Data.List (intersperse)
import Data.Semigroup (mtimesDefault)
import qualified Data.Text as Text
import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as TB
import Lens.Micro.Platform
import PureNix.Expr hiding (string)
import PureNix.Identifiers
import PureNix.Prelude

newtype PrintContext = PrintContext {PrintContext -> Int
pcIndent :: Int}

newtype PrintState = PrintState {PrintState -> Builder
psBuilder :: Builder}

newtype Printer = Printer {Printer -> ReaderT PrintContext (State PrintState) ()
_unPrinter :: ReaderT PrintContext (State PrintState) ()}

runPrinter :: Printer -> LText
runPrinter :: Printer -> LText
runPrinter (Printer ReaderT PrintContext (State PrintState) ()
p) = Builder -> LText
TB.toLazyText forall a b. (a -> b) -> a -> b
$ PrintState -> Builder
psBuilder forall a b. (a -> b) -> a -> b
$ forall s a. State s a -> s -> s
execState (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT PrintContext (State PrintState) ()
p PrintContext
pc0) PrintState
ps0
  where
    pc0 :: PrintContext
pc0 = Int -> PrintContext
PrintContext Int
0
    ps0 :: PrintState
ps0 = Builder -> PrintState
PrintState forall a. Monoid a => a
mempty

instance Semigroup Printer where Printer ReaderT PrintContext (State PrintState) ()
a <> :: Printer -> Printer -> Printer
<> Printer ReaderT PrintContext (State PrintState) ()
b = ReaderT PrintContext (State PrintState) () -> Printer
Printer (ReaderT PrintContext (State PrintState) ()
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderT PrintContext (State PrintState) ()
b)

instance Monoid Printer where mempty :: Printer
mempty = ReaderT PrintContext (State PrintState) () -> Printer
Printer (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance IsString Printer where fromString :: String -> Printer
fromString = ReaderT PrintContext (State PrintState) () -> Printer
Printer forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ReaderT PrintContext (State PrintState) ()
emit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

delimit :: Style -> Char -> Char -> Printer -> Printer
delimit :: Style -> Char -> Char -> Printer -> Printer
delimit = forall r. r -> r -> Style -> r
style Char -> Char -> Printer -> Printer
delimitSingle Char -> Char -> Printer -> Printer
delimitMulti
  where
    delimitSingle :: Char -> Char -> Printer -> Printer
    delimitSingle :: Char -> Char -> Printer -> Printer
delimitSingle Char
open Char
close Printer
body = forall a. Monoid a => [a] -> a
mconcat [Char -> Printer
char Char
open, Printer
body, Char -> Printer
char Char
close]
    delimitMulti :: Char -> Char -> Printer -> Printer
    delimitMulti :: Char -> Char -> Printer -> Printer
delimitMulti Char
open Char
close Printer
body = forall a. Monoid a => [a] -> a
mconcat [Printer
newline, Char -> Printer
char Char
open, Printer
space, Printer -> Printer
indent Printer
body, Printer
newline, Char -> Printer
char Char
close]

space :: Printer
space :: Printer
space = Char -> Printer
char Char
' '

indent :: Printer -> Printer
indent :: Printer -> Printer
indent (Printer ReaderT PrintContext (State PrintState) ()
p) = ReaderT PrintContext (State PrintState) () -> Printer
Printer forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\(PrintContext Int
n) -> Int -> PrintContext
PrintContext (Int
n forall a. Num a => a -> a -> a
+ Int
2)) ReaderT PrintContext (State PrintState) ()
p

char :: Char -> Printer
char :: Char -> Printer
char = ReaderT PrintContext (State PrintState) () -> Printer
Printer forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ReaderT PrintContext (State PrintState) ()
emit forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Builder
TB.singleton

emit :: Builder -> ReaderT PrintContext (State PrintState) ()
emit :: Builder -> ReaderT PrintContext (State PrintState) ()
emit Builder
t = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\(PrintState Builder
s) -> Builder -> PrintState
PrintState forall a b. (a -> b) -> a -> b
$ Builder
s forall a. Semigroup a => a -> a -> a
<> Builder
t)

text :: Text -> Printer
text :: Text -> Printer
text = ReaderT PrintContext (State PrintState) () -> Printer
Printer forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ReaderT PrintContext (State PrintState) ()
emit forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
TB.fromText

string :: String -> Printer
string :: String -> Printer
string = ReaderT PrintContext (State PrintState) () -> Printer
Printer forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ReaderT PrintContext (State PrintState) ()
emit forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
TB.fromString

newline :: Printer
newline :: Printer
newline = ReaderT PrintContext (State PrintState) () -> Printer
Printer forall a b. (a -> b) -> a -> b
$ do
  Int
i <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PrintContext -> Int
pcIndent
  Builder -> ReaderT PrintContext (State PrintState) ()
emit (Builder
"\n" forall a. Semigroup a => a -> a -> a
<> forall b a. (Integral b, Monoid a) => b -> a -> a
mtimesDefault Int
i Builder
" ")

-- | Turn a Nix 'Expr' into an actual piece of text.
renderExpr :: Expr -> LText
renderExpr :: Expr -> LText
renderExpr = Printer -> LText
runPrinter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s t a b. Field1 s t a b => Lens s t a b
_1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. (ExprF r -> r) -> Expr -> r
foldExpr ExprF (Printer, Style, Associativity, Precedence)
-> (Printer, Style, Associativity, Precedence)
render
  where
    render :: ExprF (Printer, Style, Associativity, Precedence) -> (Printer, Style, Associativity, Precedence)
    render :: ExprF (Printer, Style, Associativity, Precedence)
-> (Printer, Style, Associativity, Precedence)
render ExprF (Printer, Style, Associativity, Precedence)
expr = (Style -> ExprF Printer -> Printer
ppExpr Style
sty ExprF Printer
parenthesized, Style
sty, forall a. ExprF a -> Associativity
exprAssoc ExprF (Printer, Style, Associativity, Precedence)
expr, forall a. ExprF a -> Precedence
exprPrec ExprF (Printer, Style, Associativity, Precedence)
expr)
      where
        sty :: Style
sty = ExprF Style -> Style
exprStyle (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s t a b. Field2 s t a b => Lens s t a b
_2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprF (Printer, Style, Associativity, Precedence)
expr)
        parenthesized :: ExprF Printer
parenthesized =
          forall a b.
(a -> Associativity)
-> (a -> Precedence) -> (a -> b) -> (a -> b) -> ExprF a -> ExprF b
parenthesize
            (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s t a b. Field3 s t a b => Lens s t a b
_3)
            (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s t a b. Field4 s t a b => Lens s t a b
_4)
            (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s t a b. Field1 s t a b => Lens s t a b
_1)
            (\(Printer, Style, Associativity, Precedence)
inner -> Style -> Char -> Char -> Printer -> Printer
delimit ((Printer, Style, Associativity, Precedence)
inner forall s a. s -> Getting a s a -> a
^. forall s t a b. Field2 s t a b => Lens s t a b
_2) Char
'(' Char
')' ((Printer, Style, Associativity, Precedence)
inner forall s a. s -> Getting a s a -> a
^. forall s t a b. Field1 s t a b => Lens s t a b
_1))
            ExprF (Printer, Style, Associativity, Precedence)
expr

-- | Expressions can be printed in two styles; single-line or multi-line.
data Style = Single | Multi deriving (Style -> Style -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c== :: Style -> Style -> Bool
Eq, Eq Style
Style -> Style -> Bool
Style -> Style -> Ordering
Style -> Style -> Style
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Style -> Style -> Style
$cmin :: Style -> Style -> Style
max :: Style -> Style -> Style
$cmax :: Style -> Style -> Style
>= :: Style -> Style -> Bool
$c>= :: Style -> Style -> Bool
> :: Style -> Style -> Bool
$c> :: Style -> Style -> Bool
<= :: Style -> Style -> Bool
$c<= :: Style -> Style -> Bool
< :: Style -> Style -> Bool
$c< :: Style -> Style -> Bool
compare :: Style -> Style -> Ordering
$ccompare :: Style -> Style -> Ordering
Ord)

style :: r -> r -> Style -> r
style :: forall r. r -> r -> Style -> r
style r
a r
_ Style
Single = r
a
style r
_ r
b Style
Multi = r
b

exprStyle :: ExprF Style -> Style
exprStyle :: ExprF Style -> Style
exprStyle (Attrs [Var]
_ [] []) = Style
Single
exprStyle (Attrs [] [(Style
sty, [Key]
_)] []) = Style
sty
exprStyle (Attrs [] [] [(Key
_, Style
sty)]) = Style
sty
exprStyle Attrs {} = Style
Multi
exprStyle Let {} = Style
Multi
exprStyle ExprF Style
v = forall a. a -> a -> Bool -> a
bool Style
Single Style
Multi forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Style
Multi ExprF Style
v

newtype Precedence = Precedence Int deriving newtype (Integer -> Precedence
Precedence -> Precedence
Precedence -> Precedence -> Precedence
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Precedence
$cfromInteger :: Integer -> Precedence
signum :: Precedence -> Precedence
$csignum :: Precedence -> Precedence
abs :: Precedence -> Precedence
$cabs :: Precedence -> Precedence
negate :: Precedence -> Precedence
$cnegate :: Precedence -> Precedence
* :: Precedence -> Precedence -> Precedence
$c* :: Precedence -> Precedence -> Precedence
- :: Precedence -> Precedence -> Precedence
$c- :: Precedence -> Precedence -> Precedence
+ :: Precedence -> Precedence -> Precedence
$c+ :: Precedence -> Precedence -> Precedence
Num, Precedence -> Precedence -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Precedence -> Precedence -> Bool
$c/= :: Precedence -> Precedence -> Bool
== :: Precedence -> Precedence -> Bool
$c== :: Precedence -> Precedence -> Bool
Eq, Eq Precedence
Precedence -> Precedence -> Bool
Precedence -> Precedence -> Ordering
Precedence -> Precedence -> Precedence
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Precedence -> Precedence -> Precedence
$cmin :: Precedence -> Precedence -> Precedence
max :: Precedence -> Precedence -> Precedence
$cmax :: Precedence -> Precedence -> Precedence
>= :: Precedence -> Precedence -> Bool
$c>= :: Precedence -> Precedence -> Bool
> :: Precedence -> Precedence -> Bool
$c> :: Precedence -> Precedence -> Bool
<= :: Precedence -> Precedence -> Bool
$c<= :: Precedence -> Precedence -> Bool
< :: Precedence -> Precedence -> Bool
$c< :: Precedence -> Precedence -> Bool
compare :: Precedence -> Precedence -> Ordering
$ccompare :: Precedence -> Precedence -> Ordering
Ord)

data Associativity = AssocLeft | AssocRight | AssocNone | Associative
  deriving (Associativity -> Associativity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Associativity -> Associativity -> Bool
$c/= :: Associativity -> Associativity -> Bool
== :: Associativity -> Associativity -> Bool
$c== :: Associativity -> Associativity -> Bool
Eq, Int -> Associativity -> ShowS
[Associativity] -> ShowS
Associativity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Associativity] -> ShowS
$cshowList :: [Associativity] -> ShowS
show :: Associativity -> String
$cshow :: Associativity -> String
showsPrec :: Int -> Associativity -> ShowS
$cshowsPrec :: Int -> Associativity -> ShowS
Show)

exprAssoc :: ExprF a -> Associativity
exprAssoc :: forall a. ExprF a -> Associativity
exprAssoc Sel {} = Associativity
AssocLeft
exprAssoc App {} = Associativity
AssocLeft
exprAssoc (Bin Op
op a
_ a
_) = Op -> Associativity
opAssoc Op
op
  where
    opAssoc :: Op -> Associativity
opAssoc Op
Equals = Associativity
AssocNone
    opAssoc Op
Update = Associativity
Associative
    opAssoc Op
And = Associativity
Associative
exprAssoc ExprF a
_ = Associativity
AssocNone

-- | Expression precedence.
-- See: https://nixos.org/manual/nix/stable/#sec-language-operators
-- Operators listed in the above table have a precedence of (15 - <listed precedence>)
exprPrec :: ExprF a -> Precedence
exprPrec :: forall a. ExprF a -> Precedence
exprPrec Var {} = Precedence
15
exprPrec Int {} = Precedence
15
exprPrec Double {} = Precedence
15
exprPrec String {} = Precedence
15
exprPrec Attrs {} = Precedence
15
exprPrec List {} = Precedence
15
exprPrec Path {} = Precedence
15
exprPrec Sel {} = Precedence
14
exprPrec App {} = Precedence
13
exprPrec Not {} = Precedence
8
exprPrec (Bin Op
op a
_ a
_) = Op -> Precedence
opPrec Op
op
  where
    opPrec :: Op -> Precedence
    opPrec :: Op -> Precedence
opPrec Op
Update = Precedence
6
    opPrec Op
Equals = Precedence
4
    opPrec Op
And = Precedence
3
exprPrec Cond {} = Precedence
0
exprPrec Lam {} = Precedence
0
exprPrec Let {} = Precedence
0

-- | Define whether a subexpression needs to be parenthesized, based on its associativity and precedence.
parenthesize :: forall a b. (a -> Associativity) -> (a -> Precedence) -> (a -> b) -> (a -> b) -> ExprF a -> ExprF b
parenthesize :: forall a b.
(a -> Associativity)
-> (a -> Precedence) -> (a -> b) -> (a -> b) -> ExprF a -> ExprF b
parenthesize a -> Associativity
assoc a -> Precedence
prec a -> b
no a -> b
yes = ExprF a -> ExprF b
go
  where
    below :: Precedence -> a -> b
    below :: Precedence -> a -> b
below Precedence
p a
a = if a -> Precedence
prec a
a forall a. Ord a => a -> a -> Bool
< Precedence
p then a -> b
yes a
a else a -> b
no a
a
    bin :: (forall c. c -> c -> ExprF c) -> a -> a -> ExprF b
    bin :: (forall c. c -> c -> ExprF c) -> a -> a -> ExprF b
bin forall c. c -> c -> ExprF c
op a
l a
r = forall c. c -> c -> ExprF c
op (a -> Associativity -> b
f a
l Associativity
AssocLeft) (a -> Associativity -> b
f a
r Associativity
AssocRight)
      where
        f :: a -> Associativity -> b
f a
x Associativity
a = case forall a. Ord a => a -> a -> Ordering
compare (a -> Precedence
prec a
x) (forall a. ExprF a -> Precedence
exprPrec forall a b. (a -> b) -> a -> b
$ forall c. c -> c -> ExprF c
op () ()) of
          Ordering
GT -> a -> b
no a
x
          Ordering
EQ | a -> Associativity
assoc a
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Associativity
a, Associativity
Associative] -> a -> b
no a
x
          Ordering
_ -> a -> b
yes a
x
    go :: ExprF a -> ExprF b
    go :: ExprF a -> ExprF b
go (Attrs [Var]
ih [(a, [Key])]
ihf [(Key, a)]
f) = forall f. [Var] -> [(f, [Key])] -> [(Key, f)] -> ExprF f
Attrs [Var]
ih ([(a, [Key])]
ihf forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field1 s t a b => Lens s t a b
_1 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ a -> b
yes) ([(Key, a)]
f forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ a -> b
no)
    go (Let NonEmpty (Var, a)
binds a
body) = forall f. NonEmpty (Var, f) -> f -> ExprF f
Let (NonEmpty (Var, a)
binds forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ a -> b
no) (a
body forall a b. a -> (a -> b) -> b
& a -> b
no)
    go (List [a]
elems) = forall f. [f] -> ExprF f
List (Precedence -> a -> b
below Precedence
14 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
elems)
    go (App a
f a
x) = (forall c. c -> c -> ExprF c) -> a -> a -> ExprF b
bin forall c. c -> c -> ExprF c
App a
f a
x
    go (Bin Op
op a
l a
r) = (forall c. c -> c -> ExprF c) -> a -> a -> ExprF b
bin (forall f. Op -> f -> f -> ExprF f
Bin Op
op) a
l a
r
    go ExprF a
e = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Precedence -> a -> b
below (forall a. ExprF a -> Precedence
exprPrec ExprF a
e)) ExprF a
e

sepBy :: Foldable t => Printer -> t Printer -> Printer
sepBy :: forall (t :: * -> *). Foldable t => Printer -> t Printer -> Printer
sepBy Printer
sep t Printer
ps = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Printer
sep (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Printer
ps)

binding :: (k -> Printer) -> (k, Printer) -> Printer
binding :: forall k. (k -> Printer) -> (k, Printer) -> Printer
binding k -> Printer
f (k
v, Printer
body) = k -> Printer
f k
v forall a. Semigroup a => a -> a -> a
<> Printer
" = " forall a. Semigroup a => a -> a -> a
<> Printer -> Printer
indent Printer
body forall a. Semigroup a => a -> a -> a
<> Printer
";"

binder :: Var -> Printer
binder :: Var -> Printer
binder = Text -> Printer
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> Text
unVar

key :: Key -> Printer
key :: Key -> Printer
key = Text -> Printer
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
unKey

ppString :: Text -> Printer
ppString :: Text -> Printer
ppString Text
txt = Char -> Printer
char Char
'"' forall a. Semigroup a => a -> a -> a
<> Text -> Printer
text Text
escaped forall a. Semigroup a => a -> a -> a
<> Char -> Printer
char Char
'"'
  where
    escaped :: Text
escaped = forall a b c. (a -> b -> c) -> b -> a -> c
flip (Char -> Text) -> Text -> Text
Text.concatMap Text
txt forall a b. (a -> b) -> a -> b
$ \case
      Char
'\'' -> Text
"\\"
      Char
'"' -> Text
"\""
      Char
chr -> Char -> Text
Text.singleton Char
chr

ppExpr :: Style -> ExprF Printer -> Printer
ppExpr :: Style -> ExprF Printer -> Printer
ppExpr Style
_ (Var Var
v) = Var -> Printer
binder Var
v
ppExpr Style
_ (Lam Var
arg Printer
body) = Text -> Printer
text (Var -> Text
unVar Var
arg) forall a. Semigroup a => a -> a -> a
<> Printer
": " forall a. Semigroup a => a -> a -> a
<> Printer
body
ppExpr Style
_ (App Printer
f Printer
x) = Printer
f forall a. Semigroup a => a -> a -> a
<> Printer
space forall a. Semigroup a => a -> a -> a
<> Printer
x
ppExpr Style
_ (Attrs [] [] []) = Printer
"{ }"
ppExpr Style
sty (Attrs [Var]
ih [(Printer, [Key])]
ihf [(Key, Printer)]
b) = Style -> Char -> Char -> Printer -> Printer
delimit Style
sty Char
'{' Char
'}' forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => Printer -> t Printer -> Printer
sepBy Printer
newline forall a b. (a -> b) -> a -> b
$ [Printer]
inherits forall a. Semigroup a => a -> a -> a
<> [Printer]
inheritFroms forall a. Semigroup a => a -> a -> a
<> [Printer]
binds
  where
    inherits :: [Printer]
inherits = [forall (t :: * -> *). Foldable t => Printer -> t Printer -> Printer
sepBy Printer
space (Printer
"inherit" forall a. a -> [a] -> [a]
: (Var -> Printer
binder forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
ih)) forall a. Semigroup a => a -> a -> a
<> Printer
";" | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Var]
ih)]
    inheritFroms :: [Printer]
inheritFroms = (\(Printer
from, [Key]
idents) -> forall (t :: * -> *). Foldable t => Printer -> t Printer -> Printer
sepBy Printer
space (Printer
"inherit" forall a. a -> [a] -> [a]
: Printer
from forall a. a -> [a] -> [a]
: (Key -> Printer
key forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Key]
idents)) forall a. Semigroup a => a -> a -> a
<> Printer
";") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Printer, [Key])]
ihf
    binds :: [Printer]
binds = forall k. (k -> Printer) -> (k, Printer) -> Printer
binding Key -> Printer
key forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Key, Printer)]
b
ppExpr Style
_ (List []) = Printer
"[]"
ppExpr Style
sty (List [Printer]
l) = Style -> Char -> Char -> Printer -> Printer
delimit Style
sty Char
'[' Char
']' forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => Printer -> t Printer -> Printer
sepBy Printer
newline [Printer]
l
ppExpr Style
_ (Sel Printer
a Key
b) = Printer
a forall a. Semigroup a => a -> a -> a
<> Printer
"." forall a. Semigroup a => a -> a -> a
<> Key -> Printer
key Key
b
ppExpr Style
_ (Path Text
t) = Text -> Printer
text Text
t
ppExpr Style
_ (String Text
str) = Text -> Printer
ppString Text
str
ppExpr Style
_ (Int Integer
n) = String -> Printer
string (forall a. Show a => a -> String
show Integer
n)
ppExpr Style
_ (Double Double
x) = String -> Printer
string (forall a. Show a => a -> String
show Double
x)
ppExpr Style
Single (Cond Printer
c Printer
t Printer
f) = forall (t :: * -> *). Foldable t => Printer -> t Printer -> Printer
sepBy Printer
space [Printer
"if", Printer
c, Printer
"then", Printer
t, Printer
"else", Printer
f]
ppExpr Style
Multi (Cond Printer
c Printer
t Printer
f) = Printer
newline forall a. Semigroup a => a -> a -> a
<> Printer
"if " forall a. Semigroup a => a -> a -> a
<> Printer
c forall a. Semigroup a => a -> a -> a
<> Printer -> Printer
indent (Printer
newline forall a. Semigroup a => a -> a -> a
<> Printer
"then " forall a. Semigroup a => a -> a -> a
<> Printer -> Printer
indent Printer
t forall a. Semigroup a => a -> a -> a
<> Printer
newline forall a. Semigroup a => a -> a -> a
<> Printer
"else " forall a. Semigroup a => a -> a -> a
<> Printer -> Printer
indent Printer
f)
ppExpr Style
_ (Not Printer
e) = Printer
"!" forall a. Semigroup a => a -> a -> a
<> Printer
e
ppExpr Style
_ (Let NonEmpty (Var, Printer)
binds Printer
body) =
  forall a. Monoid a => [a] -> a
mconcat
    [ Printer
newline,
      Printer
"let",
      Printer -> Printer
indent forall a b. (a -> b) -> a -> b
$ Printer
newline forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *). Foldable t => Printer -> t Printer -> Printer
sepBy Printer
newline (forall k. (k -> Printer) -> (k, Printer) -> Printer
binding Var -> Printer
binder forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Var, Printer)
binds),
      Printer
newline,
      Printer
"in",
      Printer -> Printer
indent forall a b. (a -> b) -> a -> b
$ Printer
newline forall a. Semigroup a => a -> a -> a
<> Printer
body
    ]
ppExpr Style
_ (Bin Op
Update Printer
l Printer
r) = Printer
l forall a. Semigroup a => a -> a -> a
<> Printer
" // " forall a. Semigroup a => a -> a -> a
<> Printer
r
ppExpr Style
_ (Bin Op
Equals Printer
l Printer
r) = Printer
l forall a. Semigroup a => a -> a -> a
<> Printer
" == " forall a. Semigroup a => a -> a -> a
<> Printer
r
ppExpr Style
_ (Bin Op
And Printer
l Printer
r) = Printer
l forall a. Semigroup a => a -> a -> a
<> Printer
" && " forall a. Semigroup a => a -> a -> a
<> Printer
r