module PPUtil where

--
-- Some additional pretty-print functions
-- for pretty-printing abstract syntax trees.
--

import Data.List
import qualified Data.Map as Map
import Pretty
import Options

ppListSep :: (PP s, PP c, PP o, PP a) => o -> c -> s -> [a] -> PP_Doc
ppListSep :: forall s c o a.
(PP s, PP c, PP o, PP a) =>
o -> c -> s -> [a] -> PP_Doc
ppListSep o
o c
c s
s [a]
pps = o
o forall a b. (PP a, PP b) => a -> b -> PP_Doc
>|< forall a. PP a => [a] -> PP_Doc
hlist (forall a. a -> [a] -> [a]
intersperse (forall a. PP a => a -> PP_Doc
pp s
s) (forall a b. (a -> b) -> [a] -> [b]
map forall a. PP a => a -> PP_Doc
pp [a]
pps)) forall a b. (PP a, PP b) => a -> b -> PP_Doc
>|< c
c

ppSpaced :: PP a => [a] -> PP_Doc
ppSpaced :: forall a. PP a => [a] -> PP_Doc
ppSpaced = forall s c o a.
(PP s, PP c, PP o, PP a) =>
o -> c -> s -> [a] -> PP_Doc
ppListSep String
"" String
"" String
" "

ppCommas :: PP a => [a] -> PP_Doc
ppCommas :: forall a. PP a => [a] -> PP_Doc
ppCommas = forall s c o a.
(PP s, PP c, PP o, PP a) =>
o -> c -> s -> [a] -> PP_Doc
ppListSep String
"" String
"" String
", "

ppVList :: PP a => [a] -> PP_Doc
ppVList :: forall a. PP a => [a] -> PP_Doc
ppVList []     = String
"[" forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< String
"]"
ppVList (a
x:[a]
xs) = forall a. PP a => [a] -> PP_Doc
vlist ((String
"[" forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< forall a. PP a => a -> PP_Doc
pp a
x) forall a. a -> [a] -> [a]
: (forall a b. (a -> b) -> [a] -> [b]
map (\a
y -> String
"," forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< forall a. PP a => a -> PP_Doc
pp a
y) [a]
xs)) forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< String
"]"

ppMap :: (Show a, Show b) => Map.Map a b -> PP_Doc
ppMap :: forall a b. (Show a, Show b) => Map a b -> PP_Doc
ppMap Map a b
m = forall a. PP a => [a] -> PP_Doc
ppVList [ String -> PP_Doc -> PP_Doc
ppF (forall a. Show a => a -> String
show a
k) forall a b. (a -> b) -> a -> b
$ forall x. Show x => x -> PP_Doc
ppShow b
v | (a
k,b
v) <- forall k a. Map k a -> [(k, a)]
Map.toList Map a b
m ]

ppAssocL :: (Show a, Show b) => [(a,b)] -> PP_Doc
ppAssocL :: forall a b. (Show a, Show b) => [(a, b)] -> PP_Doc
ppAssocL [(a, b)]
m = forall a. PP a => [a] -> PP_Doc
ppVList [ String -> PP_Doc -> PP_Doc
ppF (forall a. Show a => a -> String
show a
k) forall a b. (a -> b) -> a -> b
$ forall x. Show x => x -> PP_Doc
ppShow b
v | (a
k,b
v) <- [(a, b)]
m ]

ppF :: String -> PP_Doc -> PP_Doc
ppF :: String -> PP_Doc -> PP_Doc
ppF String
s PP_Doc
x = String
s forall a b. (PP a, PP b) => a -> b -> PP_Doc
>|< String
":" forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< PP_Doc
x

ppNest :: PP a => [a] -> [PP_Doc] -> [PP_Doc] -> PP_Doc
ppNest :: forall a. PP a => [a] -> [PP_Doc] -> [PP_Doc] -> PP_Doc
ppNest [a]
nms [PP_Doc]
attrs [PP_Doc]
ps = forall a.
PP a =>
[a] -> [PP_Doc] -> [PP_Doc] -> [(String, PP_Doc)] -> PP_Doc
ppNestInfo {- defaultEHCOpts -} [a]
nms [PP_Doc]
attrs [PP_Doc]
ps []

ppNestInfo :: PP a => {- EHCOpts -> -} [a] -> [PP_Doc] -> [PP_Doc] -> [(String,PP_Doc)] -> PP_Doc
ppNestInfo :: forall a.
PP a =>
[a] -> [PP_Doc] -> [PP_Doc] -> [(String, PP_Doc)] -> PP_Doc
ppNestInfo {- opts -} [a]
nms [PP_Doc]
attrs [PP_Doc]
ps [(String, PP_Doc)]
infos
  = forall s c o a.
(PP s, PP c, PP o, PP a) =>
o -> c -> s -> [a] -> PP_Doc
ppListSep String
"" String
"" String
"_" [a]
nms
    forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< (   (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PP_Doc]
attrs then PP_Doc
empty else forall a. PP a => [a] -> PP_Doc
ppSpaced [PP_Doc]
attrs)
        forall a b. (PP a, PP b) => a -> b -> PP_Doc
>-< (if Bool
False {- ehcOptDebug opts -} then forall a. PP a => [a] -> PP_Doc
vlist (forall a b. (a -> b) -> [a] -> [b]
map (\(String
i,PP_Doc
p) -> forall a. PP a => a -> PP_Doc
pp String
i forall a b. (PP a, PP b) => a -> b -> PP_Doc
>|< String
":" forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< PP_Doc
p) [(String, PP_Doc)]
infos) else PP_Doc
empty)
        )
    forall a b. (PP a, PP b) => a -> b -> PP_Doc
>-< forall a. PP a => Int -> a -> PP_Doc
indent Int
2 (forall a. PP a => [a] -> PP_Doc
vlist [PP_Doc]
ps)

ppNm :: String -> PP_Doc
ppNm :: String -> PP_Doc
ppNm = String -> PP_Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

ppShow :: Show x => x -> PP_Doc
ppShow :: forall x. Show x => x -> PP_Doc
ppShow x
x = forall a. PP a => a -> PP_Doc
pp forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show x
x

mkInfo1 :: String -> PP_Doc -> (String,PP_Doc)
mkInfo1 :: String -> PP_Doc -> (String, PP_Doc)
mkInfo1 = (,)

ppLinePragma :: Options -> Int -> String -> PP_Doc
ppLinePragma :: Options -> Int -> String -> PP_Doc
ppLinePragma Options
opts Int
ln String
fl
  | Options -> Bool
ocaml Options
opts = String
"#" forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< forall a. Show a => a -> String
show Int
ln forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< forall a. Show a => a -> String
show String
fl
  | Options -> Bool
clean Options
opts = String
"//" forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< forall a. Show a => a -> String
show Int
ln forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< forall a. Show a => a -> String
show String
fl
  | Bool
otherwise  = String
"{-# LINE" forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< forall a. Show a => a -> String
show Int
ln forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< forall a. Show a => a -> String
show String
fl forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< String
"#-}"