{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
-- |Prettyprint and compare 'Data' values.
module Data.PPrint
    ( pprint
    , pprintTo
    , (===)
    ) where

import Data.Data.GenRep.Functions (numberErrors)
import Data.Data.GenRep.Doc (Doc, toDoc)
import Data.Data.Eval (eval)
import Data.Data.Compare

import Text.PrettyPrint.HughesPJ (fsep, nest, text, vcat, (<>), (<+>), ($+$))
import Data.Data (Data)

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

-- |Prettyprint a 'Data' value.
--
-- There is a 1 second time limit and the output
-- contains at most approximately 500 characters.
--
-- The exceptions are shown as bottom signs
-- followed by explanations.
pprint :: Data a => a -> IO Doc
pprint :: a -> IO Doc
pprint = Int -> a -> IO Doc
forall a. Data a => Int -> a -> IO Doc
pprintTo Int
700

-- |Prettyprint a 'Data' value, showing up to approximately
-- the specified number of characters. Use this to show
-- more than the default pprint allows.
pprintTo :: Data a => Int -> a -> IO Doc
pprintTo :: Int -> a -> IO Doc
pprintTo Int
max a
x = do
    GenericData
x <- TimeLimit -> Int -> a -> IO GenericData
forall a. Data a => TimeLimit -> Int -> a -> IO GenericData
eval TimeLimit
1 Int
max a
x
    let ([GenericData
x'], [(String, String)]
es) = [GenericData] -> ([GenericData], [(String, String)])
numberErrors [GenericData
x]
    Doc -> IO Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> IO Doc) -> Doc -> IO Doc
forall a b. (a -> b) -> a -> b
$ GenericData -> Doc
toDoc GenericData
x' Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
nest Int
2 ([(String, String)] -> Doc
showBotts [(String, String)]
es)


infix 0 === 

-- |Compare two 'Data' values.
--
-- The can be yes, no or maybe.
-- The differences are highlighted.
--
-- There is a 1 second time limit and the output
-- contains at most approximately 500 characters.
--
-- The exceptions are shown as bottom signs
-- followed by explanations.
(===) :: Data a => a -> a -> IO Doc
a
a === :: a -> a -> IO Doc
=== a
b = do
    (Answer
ans, GenericData
a, GenericData
b) <- TimeLimit
-> TimeLimit
-> Int
-> a
-> a
-> IO (Answer, GenericData, GenericData)
forall a.
Data a =>
TimeLimit
-> TimeLimit
-> Int
-> a
-> a
-> IO (Answer, GenericData, GenericData)
compareData TimeLimit
0.8 TimeLimit
0.2 Int
700 a
a a
b
    let x :: String
x = Answer -> String
showAnswer Answer
ans
    let ([GenericData
a', GenericData
b'], [(String, String)]
es) = [GenericData] -> ([GenericData], [(String, String)])
numberErrors [GenericData
a, GenericData
b]
    Doc -> IO Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> IO Doc) -> Doc -> IO Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep [Int -> Doc -> Doc
nest (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (GenericData -> Doc
toDoc GenericData
a'), String -> Doc
text String
x Doc -> Doc -> Doc
<+> GenericData -> Doc
toDoc GenericData
b']
         Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
nest Int
2 ([(String, String)] -> Doc
showBotts [(String, String)]
es)

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

showBotts :: [(String, String)] -> Doc
showBotts :: [(String, String)] -> Doc
showBotts [(String, String)]
es = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((String, String) -> Doc) -> [(String, String)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> Doc
f [(String, String)]
es
 where
    f :: (String, String) -> Doc
f (String
i, String
e) = String -> Doc
text String
i Doc -> Doc -> Doc
Text.PrettyPrint.HughesPJ.<> String -> Doc
text String
":" Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text ([String] -> [Doc]) -> [String] -> [Doc]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
e)