-- |Conversion from 'GenericData' to 'Doc'
{-# 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)

----------------

-- |'IsString' instance for 'Doc'
-- instance IsString Doc where fromString = text

-------------------------

-- |Show a character literal. Unicode characters are not escaped.
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
""

-- |Show a character in a string literal. Unicode characters are not escaped.
showLitCharInString :: Char -> String
showLitCharInString :: Char -> String
showLitCharInString Char
'\''  = String
"'"
showLitCharInString Char
'"'   = String
"\\\""
showLitCharInString Char
c     = Char -> String
showLitCharInChar Char
c 

----------------------------------------------

-- |Convert 'GenericData' to 'Doc'.
toDoc :: GenericData -> Doc
toDoc :: GenericData -> Doc
toDoc {-text (<+>) fsep punctuate comma quotes doubleQuotes brackets parens -} 
    = 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
"…"       -- !!! ragadás
        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 -- showListEnd "[]" "\"" "[" s
        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]