module Autolib.ToDoc.Frame where

-- import Text.PrettyPrint.HughesPJ
import Autolib.Multilingual.Doc

frame :: Doc -> Doc
frame :: Doc -> Doc
frame Doc
d = 
    let ls :: [String]
ls = String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Doc -> String
render Doc
d
	wl :: Int
wl = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls
        fill :: String -> String
fill String
w = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
wl (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. a -> [a]
repeat Char
' '
        clip :: String -> String -> String -> Doc
clip String
l String
r String
w = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
r
        String
pre : [String]
midpost = [String]
ls
	mid :: [String]
mid = [String] -> [String]
forall a. HasCallStack => [a] -> [a]
init [String]
midpost
	post :: String
post = [String] -> String
forall a. HasCallStack => [a] -> a
last [String]
midpost
    in  if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ls then Doc
empty
	else if Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls then Doc -> Doc
parens Doc
d
	else [Doc] -> Doc
vcat [ String -> String -> String -> Doc
clip String
"/" String
"\\" (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
fill String
pre 
		  , [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String -> Doc
clip String
"|" String
"|" (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
fill) [String]
mid
		  , String -> String -> String -> Doc
clip String
"\\" String
"/" (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
fill String
post
		  ]