{-# LANGUAGE OverloadedStrings, PatternGuards #-}
module Data.Data.GenRep.Doc
( Doc
, showLitCharInChar
, showLitCharInString
, toDoc
) where
import Data.Data.GenRep
import Data.Char (ord, showLitChar)
import Text.PrettyPrint.HughesPJ
import Data.List (intersperse)
showLitCharInChar :: Char -> String
showLitCharInChar :: Char -> String
showLitCharInChar Char
c | Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
161 = [Char
c]
showLitCharInChar Char
c = Char -> ShowS
showLitChar Char
c String
""
showLitCharInString :: Char -> String
showLitCharInString :: Char -> String
showLitCharInString Char
'\'' = String
"'"
showLitCharInString Char
'"' = String
"\\\""
showLitCharInString Char
c = Char -> String
showLitCharInChar Char
c
toDoc :: GenericData -> Doc
toDoc :: GenericData -> Doc
toDoc
= Int -> GenericData -> Doc
showsP Int
0
where
showsP :: Int -> GenericData -> Doc
showsP Int
j GenericData
x = case GenericData
x of
GenericData
Hole -> String -> Doc
text String
"…"
GenericData
ListHole -> String -> Doc
text String
"……"
Timeout Double
_ -> String -> Doc
text String
"⊥"
NestedError GenericData
e -> String -> Doc
text String
"⊥(" Doc -> Doc -> Doc
<+> GenericData -> Doc
toDoc GenericData
e Doc -> Doc -> Doc
<+> String -> Doc
text String
")"
Error String
e -> String -> Doc
text String
e
Detail GenericData
s -> Bool -> Doc -> Doc
showParen_ (Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"……" Doc -> Doc -> Doc
<+> Int -> GenericData -> Doc
showsP Int
0 GenericData
s Doc -> Doc -> Doc
<+> String -> Doc
text String
"……"
Constructor (Char Char
c) [] -> Doc -> Doc
quotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> String
showLitCharInChar Char
c
Constructor ConstructorName
Nil [] -> String -> Doc
text String
"[]"
Constructor (Prefix String
f) [] -> String -> Doc
text String
f
Constructor (Infix Int
i String
f) [GenericData
a,GenericData
b] -> Bool -> Doc -> Doc
showParen_ (Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> GenericData -> Doc
showsP (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) GenericData
a Doc -> Doc -> Doc
<+> String -> Doc
text String
f Doc -> Doc -> Doc
<+> Int -> GenericData -> Doc
showsP (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) GenericData
b
Constructor (Infixr Int
i String
f) [GenericData
a,GenericData
b] -> Bool -> Doc -> Doc
showParen_ (Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> GenericData -> Doc
showsP (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) GenericData
a Doc -> Doc -> Doc
<+> String -> Doc
text String
f Doc -> Doc -> Doc
<+> Int -> GenericData -> Doc
showsP Int
i GenericData
b
Constructor (Infixl Int
i String
f) [GenericData
a,GenericData
b] -> Bool -> Doc -> Doc
showParen_ (Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> GenericData -> Doc
showsP Int
i GenericData
a Doc -> Doc -> Doc
<+> String -> Doc
text String
f Doc -> Doc -> Doc
<+> Int -> GenericData -> Doc
showsP (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) GenericData
b
Constructor (Tuple Int
_) [GenericData]
xs -> Bool -> Doc -> Doc
showParen_ Bool
True (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
list ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (GenericData -> Doc) -> [GenericData] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> GenericData -> Doc
showsP Int
0) [GenericData]
xs
Constructor ConstructorName
Cons [GenericData
_,GenericData
_] -> [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (String -> Doc
text String
"++") ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ GenericData -> [Doc]
elems GenericData
x
Constructor (Prefix String
f) [GenericData]
l -> Bool -> Doc -> Doc
showParen_ (Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
f Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep ((GenericData -> Doc) -> [GenericData] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> GenericData -> Doc
showsP Int
11) [GenericData]
l)
GenericData
_ -> String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"showsP: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GenericData -> String
forall a. Show a => a -> String
show GenericData
x
showParen_ :: Bool -> Doc -> Doc
showParen_ Bool
True = Doc -> Doc
parens
showParen_ Bool
False = Doc -> Doc
forall a. a -> a
id
list :: [Doc] -> Doc
list = [Doc] -> Doc
fsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma
collectChars :: GenericData -> (String, GenericData)
collectChars (Constructor ConstructorName
Cons [Constructor (Char Char
c) [],GenericData
b])
| (String
cs, GenericData
x) <- GenericData -> (String, GenericData)
collectChars GenericData
b
= (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
: String
cs, GenericData
x)
collectChars GenericData
x = ([], GenericData
x)
collectElems :: GenericData -> ([GenericData], GenericData)
collectElems x :: GenericData
x@(Constructor ConstructorName
Cons [Constructor (Char Char
_) [], GenericData
_]) = ([], GenericData
x)
collectElems (Constructor ConstructorName
Cons [GenericData
a,GenericData
b])
| ([GenericData]
cs, GenericData
x) <- GenericData -> ([GenericData], GenericData)
collectElems GenericData
b
= (GenericData
aGenericData -> [GenericData] -> [GenericData]
forall a. a -> [a] -> [a]
: [GenericData]
cs, GenericData
x)
collectElems (Detail GenericData
b)
| ([GenericData]
cs, GenericData
x) <- GenericData -> ([GenericData], GenericData)
collectElems GenericData
b
= (GenericData
ListHoleGenericData -> [GenericData] -> [GenericData]
forall a. a -> [a] -> [a]
: [GenericData]
cs, GenericData
x)
collectElems GenericData
Hole
= ([GenericData
ListHole], ConstructorName -> [GenericData] -> GenericData
Constructor ConstructorName
Nil [])
collectElems GenericData
x = ([], GenericData
x)
elems :: GenericData -> [Doc]
elems GenericData
x
| (es :: String
es@(Char
_:String
_), GenericData
y) <- GenericData -> (String, GenericData)
collectChars GenericData
x
= Doc -> Doc
doubleQuotes (String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
showLitCharInString String
es)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: GenericData -> [Doc]
elems GenericData
y
| (es :: [GenericData]
es@(GenericData
_:[GenericData]
_), GenericData
y) <- GenericData -> ([GenericData], GenericData)
collectElems GenericData
x
= (Doc -> Doc
brackets (Doc -> Doc) -> ([GenericData] -> Doc) -> [GenericData] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
list ([Doc] -> Doc) -> ([GenericData] -> [Doc]) -> [GenericData] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericData -> Doc) -> [GenericData] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> GenericData -> Doc
showsP Int
0) ([GenericData] -> Doc) -> [GenericData] -> Doc
forall a b. (a -> b) -> a -> b
$ [GenericData]
es)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: GenericData -> [Doc]
elems GenericData
y
elems (Constructor ConstructorName
Nil []) = []
elems (Detail GenericData
x) = [String -> Doc
text String
"...", Int -> GenericData -> Doc
showsP Int
0 GenericData
x]
elems GenericData
x = [Int -> GenericData -> Doc
showsP Int
0 GenericData
x]