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

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

module Language.Nix.PrettyPrinting
  ( onlyIf
  , toAscList, toAscListSortedOn
  , setattr
  , listattr, listattrDoc
  , 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

listattrDoc :: String -> Doc -> [Doc] -> Doc
listattrDoc :: String -> Doc -> [Doc] -> Doc
listattrDoc String
n Doc
prefix [Doc]
vs = Bool -> Doc -> Doc
onlyIf (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
vs)) 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 forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep [Doc]
vs,
        Doc
rbrack Doc -> Doc -> Doc
<> Doc
semi
      ]

listattr :: String -> Doc -> [String] -> Doc
listattr :: String -> Doc -> [String] -> Doc
listattr String
n Doc
p = String -> Doc -> [Doc] -> Doc
listattrDoc String
n Doc
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text

setattr :: String -> Doc -> Set String -> Doc
setattr :: String -> Doc -> Set String -> Doc
setattr String
name Doc
prefix Set String
set = String -> Doc -> [Doc] -> Doc
listattrDoc String
name Doc
prefix
  forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text forall a b. (a -> b) -> a -> b
$ Set String -> [String]
toAscList Set String
set

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

toAscList :: Set String -> [String]
toAscList :: Set String -> [String]
toAscList = forall a. (a -> String) -> Set a -> [a]
toAscListSortedOn forall a. a -> a
id

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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
quoteString

quoteString :: String -> Doc
quoteString :: String -> Doc
quoteString []          = forall a. Monoid a => a
mempty
quoteString [Char
'\\']      = String -> Doc
text String
"\\\\"
quoteString (Char
'\\':Char
x:String
xs)
  | Char
x 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
xforall 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 forall a. a -> [a] -> [a]
: 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
" ") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2) [Doc]
xs),
               Doc
rbrace Doc -> Doc -> Doc
<> Doc
colon
             ]