{-# LANGUAGE PackageImports #-}
{-# LANGUAGE CPP #-}

-- | Internal pretty-printing helpers for Nix expressions.

module Language.Nix.PrettyPrinting
  ( onlyIf
  , setattr, toAscList
  , listattr
  , boolattr
  , attr
  , string
  , funargs
  -- * Re-exports from other modules
  , module Text.PrettyPrint.HughesPJClass
  )
  where

-- Avoid name clash with Prelude.<> exported by post-SMP versions of base.
#if MIN_VERSION_base(4,11,0)
import Prelude hiding ( (<>) )
#endif
import Data.Char
import Data.Function
import Data.List (sortBy)
import Data.Set ( Set )
import qualified Data.Set as Set
import "pretty" Text.PrettyPrint.HughesPJClass

attr :: String -> Doc -> Doc
attr :: String -> Doc -> Doc
attr String
n Doc
v = String -> Doc
text String
n Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Doc
v Doc -> Doc -> Doc
<> Doc
semi

onlyIf :: Bool -> Doc -> Doc
onlyIf :: Bool -> Doc -> Doc
onlyIf Bool
b Doc
d = if Bool
b then Doc
d else Doc
empty

boolattr :: String -> Bool -> Bool -> Doc
boolattr :: String -> Bool -> Bool -> Doc
boolattr String
n Bool
p Bool
v = if Bool
p then String -> Doc -> Doc
attr String
n (Bool -> Doc
bool Bool
v) else Doc
empty

listattr :: String -> Doc -> [String] -> Doc
listattr :: String -> Doc -> [String] -> Doc
listattr String
n Doc
prefix [String]
vs = Bool -> Doc -> Doc
onlyIf (Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
vs)) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
sep [ String -> Doc
text String
n Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Doc
prefix Doc -> Doc -> Doc
<+> Doc
lbrack,
                      Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String]
vs,
                      Doc
rbrack Doc -> Doc -> Doc
<> Doc
semi
                    ]

setattr :: String -> Doc -> Set String -> Doc
setattr :: String -> Doc -> Set String -> Doc
setattr String
name Doc
prefix Set String
set = String -> Doc -> [String] -> Doc
listattr String
name Doc
prefix (Set String -> [String]
toAscList Set String
set)

toAscList :: Set String -> [String]
toAscList :: Set String -> [String]
toAscList = (String -> String -> Ordering) -> [String] -> [String]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String -> Ordering)
-> (String -> String) -> String -> String -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) ([String] -> [String])
-> (Set String -> [String]) -> Set String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set String -> [String]
forall a. Set a -> [a]
Set.toList

bool :: Bool -> Doc
bool :: Bool -> Doc
bool Bool
True  = String -> Doc
text String
"true"
bool Bool
False = String -> Doc
text String
"false"

string :: String -> Doc
string :: String -> Doc
string = Doc -> Doc
doubleQuotes (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
quoteString

quoteString :: String -> Doc
quoteString :: String -> Doc
quoteString []          = Doc
forall a. Monoid a => a
mempty
quoteString [Char
'\\']      = String -> Doc
text String
"\\\\"
quoteString (Char
'\\':Char
x:String
xs)
  | Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\"rn$\\t" = String -> Doc
text [Char
'\\',Char
x] Doc -> Doc -> Doc
<> String -> Doc
quoteString String
xs
  | Bool
otherwise           = String -> Doc
text String
"\\\\" Doc -> Doc -> Doc
<> String -> Doc
quoteString (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
quoteString (Char
x:String
xs)      = Char -> Doc
char Char
x Doc -> Doc -> Doc
<> String -> Doc
quoteString String
xs

prepunctuate :: Doc -> [Doc] -> [Doc]
prepunctuate :: Doc -> [Doc] -> [Doc]
prepunctuate Doc
_ []     = []
prepunctuate Doc
p (Doc
d:[Doc]
ds) = Doc
d Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc
p Doc -> Doc -> Doc
<>) [Doc]
ds

funargs :: [Doc] -> Doc
funargs :: [Doc] -> Doc
funargs [Doc]
xs = [Doc] -> Doc
sep [
               Doc
lbrace Doc -> Doc -> Doc
<+> [Doc] -> Doc
fcat (Doc -> [Doc] -> [Doc]
prepunctuate (Doc
comma Doc -> Doc -> Doc
<> String -> Doc
text String
" ") ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2) [Doc]
xs),
               Doc
rbrace Doc -> Doc -> Doc
<> Doc
colon
             ]