module Pretty
( PP_Doc, PP(..)
, disp
, (>|<), (>-<)
, (>#<)
, ppWithLineNr
, hlist, vlist, hv
, fill
, indent
, pp_block
, vlist_sep
, pp_parens
, pp_braces
, hv_sp
, empty, empty1, text
, isEmpty
)
where
import Data.List(intersperse)
data Doc
= Emp
| Emp1
| Str !String
| Hor Doc !Doc
| Ver Doc !Doc
| Ind !Int Doc
| Line (Int -> Doc)
type PP_Doc = Doc
infixr 3 >|<, >#<
infixr 2 >-<
(>|<) :: (PP a, PP b) => a -> b -> PP_Doc
a
l >|< :: forall a b. (PP a, PP b) => a -> b -> Doc
>|< b
r = forall a. PP a => a -> Doc
pp a
l Doc -> Doc -> Doc
`Hor` forall a. PP a => a -> Doc
pp b
r
(>-<) :: (PP a, PP b) => a -> b -> PP_Doc
a
l >-< :: forall a b. (PP a, PP b) => a -> b -> Doc
>-< b
r | Doc -> Bool
isEmpty Doc
a = Doc
b
| Doc -> Bool
isEmpty Doc
b = Doc
a
| Bool
otherwise = Doc
a Doc -> Doc -> Doc
`Ver` Doc
b
where a :: Doc
a = forall a. PP a => a -> Doc
pp a
l
b :: Doc
b = forall a. PP a => a -> Doc
pp b
r
(>#<) :: (PP a, PP b) => a -> b -> PP_Doc
a
l >#< :: forall a b. (PP a, PP b) => a -> b -> Doc
>#< b
r | Doc -> Bool
isEmpty Doc
a = Doc
b
| Doc -> Bool
isEmpty Doc
b = Doc
a
| Bool
otherwise = Doc
a forall a b. (PP a, PP b) => a -> b -> Doc
>|< String
" " forall a b. (PP a, PP b) => a -> b -> Doc
>|< Doc
b
where a :: Doc
a = forall a. PP a => a -> Doc
pp a
l
b :: Doc
b = forall a. PP a => a -> Doc
pp b
r
indent :: PP a => Int -> a -> PP_Doc
indent :: forall a. PP a => Int -> a -> Doc
indent Int
i a
d = Int -> Doc -> Doc
Ind Int
i forall a b. (a -> b) -> a -> b
$ forall a. PP a => a -> Doc
pp a
d
text :: String -> PP_Doc
text :: String -> Doc
text String
s
= let ls :: [String]
ls = String -> [String]
lines String
s
ls' :: [String]
ls' | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ls = [String
""]
| Bool
otherwise = [String]
ls
in forall a. PP a => [a] -> Doc
vlist (forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
Str [String]
ls')
empty :: PP_Doc
empty :: Doc
empty = Doc
Emp
empty1 :: PP_Doc
empty1 :: Doc
empty1 = Doc
Emp1
ppWithLineNr :: PP a => (Int -> a) -> PP_Doc
ppWithLineNr :: forall a. PP a => (Int -> a) -> Doc
ppWithLineNr Int -> a
f = (Int -> Doc) -> Doc
Line (forall a. PP a => a -> Doc
pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
f)
hlist, vlist :: PP a => [a] -> PP_Doc
vlist :: forall a. PP a => [a] -> Doc
vlist [] = Doc
empty
vlist [a]
as = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b. (PP a, PP b) => a -> b -> Doc
(>-<) Doc
empty [a]
as
hlist :: forall a. PP a => [a] -> Doc
hlist [] = Doc
empty
hlist [a]
as = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b. (PP a, PP b) => a -> b -> Doc
(>|<) Doc
empty [a]
as
hv :: PP a => [a] -> PP_Doc
hv :: forall a. PP a => [a] -> Doc
hv = forall a. PP a => [a] -> Doc
vlist
hv_sp :: PP a => [a] -> PP_Doc
hv_sp :: forall a. PP a => [a] -> Doc
hv_sp = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b. (PP a, PP b) => a -> b -> Doc
(>#<) Doc
empty
fill :: PP a => [a] -> PP_Doc
fill :: forall a. PP a => [a] -> Doc
fill = forall a. PP a => [a] -> Doc
hlist
pp_block:: (PP a, PP b, PP c) => a -> b -> c -> [PP_Doc] -> PP_Doc
pp_block :: forall a b c. (PP a, PP b, PP c) => a -> b -> c -> [Doc] -> Doc
pp_block a
o b
c c
s [Doc]
as = forall a. PP a => a -> Doc
pp a
o forall a b. (PP a, PP b) => a -> b -> Doc
>|< forall a. PP a => [a] -> Doc
hlist (forall a. a -> [a] -> [a]
intersperse (forall a. PP a => a -> Doc
pp c
s) [Doc]
as) forall a b. (PP a, PP b) => a -> b -> Doc
>|< forall a. PP a => a -> Doc
pp b
c
pp_parens :: PP a => a -> PP_Doc
pp_parens :: forall a. PP a => a -> Doc
pp_parens a
p = Char
'(' forall a b. (PP a, PP b) => a -> b -> Doc
>|< a
p forall a b. (PP a, PP b) => a -> b -> Doc
>|< Char
')'
pp_braces :: PP a => a -> PP_Doc
pp_braces :: forall a. PP a => a -> Doc
pp_braces a
p = Char
'{' forall a b. (PP a, PP b) => a -> b -> Doc
>-< a
p forall a b. (PP a, PP b) => a -> b -> Doc
>-< Char
'}'
vlist_sep :: (PP a, PP b) => a -> [b] -> PP_Doc
vlist_sep :: forall a b. (PP a, PP b) => a -> [b] -> Doc
vlist_sep a
sep [b]
lst
= forall a. PP a => [a] -> Doc
vlist (forall a. a -> [a] -> [a]
intersperse (forall a. PP a => a -> Doc
pp a
sep) (forall a b. (a -> b) -> [a] -> [b]
map forall a. PP a => a -> Doc
pp [b]
lst))
class Show a => PP a where
pp :: a -> PP_Doc
pp = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
ppList :: [a] -> PP_Doc
ppList [a]
as = forall a. PP a => [a] -> Doc
hlist [a]
as
instance PP Doc where
pp :: Doc -> Doc
pp = forall a. a -> a
id
instance PP Char where
pp :: Char -> Doc
pp Char
c = String -> Doc
text [Char
c]
ppList :: String -> Doc
ppList = String -> Doc
text
instance PP a => PP [a] where
pp :: [a] -> Doc
pp = forall a. PP a => [a] -> Doc
ppList
instance Show Doc where
show :: Doc -> String
show Doc
p = Doc -> Int -> ShowS
disp Doc
p Int
200 String
""
instance PP Int where
pp :: Int -> Doc
pp = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
instance PP Float where
pp :: Float -> Doc
pp = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
isEmpty :: PP_Doc -> Bool
isEmpty :: Doc -> Bool
isEmpty Doc
Emp = Bool
True
isEmpty Doc
Emp1 = Bool
False
isEmpty (Ver Doc
d1 Doc
d2) = Doc -> Bool
isEmpty Doc
d1 Bool -> Bool -> Bool
&& Doc -> Bool
isEmpty Doc
d2
isEmpty (Hor Doc
d1 Doc
d2) = Doc -> Bool
isEmpty Doc
d1 Bool -> Bool -> Bool
&& Doc -> Bool
isEmpty Doc
d2
isEmpty (Ind Int
_ Doc
d ) = Doc -> Bool
isEmpty Doc
d
isEmpty Doc
_ = Bool
False
disp :: PP_Doc -> Int -> ShowS
disp :: Doc -> Int -> ShowS
disp Doc
d0 Int
_ String
s0
= String
r
where (String
r,Int
_,Int
_) = Int -> Int -> Doc -> String -> (String, Int, Int)
put Int
0 Int
1 Doc
d0 String
s0
put :: Int -> Int -> Doc -> String -> (String, Int, Int)
put Int
p Int
l Doc
d String
s
= case Doc
d of
Doc
Emp -> (String
s,Int
p,Int
l)
Doc
Emp1 -> (String
s,Int
p,Int
l)
Str String
s' -> (String
s' forall a. [a] -> [a] -> [a]
++ String
s,Int
p forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s',Int
l)
Ind Int
i Doc
d1 -> (String
ind forall a. [a] -> [a] -> [a]
++ String
r',Int
p', Int
l')
where (String
r',Int
p',Int
l') = Int -> Int -> Doc -> String -> (String, Int, Int)
put (Int
pforall a. Num a => a -> a -> a
+Int
i) Int
l Doc
d1 String
s
ind :: String
ind = forall a. Int -> a -> [a]
replicate Int
i Char
' '
Hor Doc
d1 Doc
d2 -> (String
r1,Int
p2,Int
l2)
where (String
r1,Int
p1,Int
l1) = Int -> Int -> Doc -> String -> (String, Int, Int)
put Int
p Int
l Doc
d1 String
r2
(String
r2,Int
p2,Int
l2) = Int -> Int -> Doc -> String -> (String, Int, Int)
put Int
p1 Int
l1 Doc
d2 String
s
Ver Doc
d1 Doc
d2 | Doc -> Bool
isEmpty Doc
d1
-> Int -> Int -> Doc -> String -> (String, Int, Int)
put Int
p Int
l Doc
d2 String
s
Ver Doc
d1 Doc
d2 | Doc -> Bool
isEmpty Doc
d2
-> Int -> Int -> Doc -> String -> (String, Int, Int)
put Int
p Int
l Doc
d1 String
s
Ver Doc
d1 Doc
d2 -> (String
r1,Int
p2,Int
l2)
where (String
r1,Int
_ ,Int
l1) = Int -> Int -> Doc -> String -> (String, Int, Int)
put Int
p Int
l Doc
d1 forall a b. (a -> b) -> a -> b
$ String
"\n" forall a. [a] -> [a] -> [a]
++ String
ind forall a. [a] -> [a] -> [a]
++ String
r2
(String
r2,Int
p2,Int
l2) = Int -> Int -> Doc -> String -> (String, Int, Int)
put Int
p (Int
l1forall a. Num a => a -> a -> a
+Int
1) Doc
d2 String
s
ind :: String
ind = forall a. Int -> a -> [a]
replicate Int
p Char
' '
Line Int -> Doc
f -> (String
r',Int
p',Int
l')
where (String
r',Int
p',Int
l') = Int -> Int -> Doc -> String -> (String, Int, Int)
put Int
p Int
l (Int -> Doc
f Int
l) String
s