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

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

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

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

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

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

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

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

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

mkInfo1 :: String -> PP_Doc -> (String,PP_Doc)
mkInfo1 :: [Char] -> PP_Doc -> ([Char], PP_Doc)
mkInfo1 = (,)

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