{-# LANGUAGE
        ParallelListComp, ViewPatterns,
        FlexibleInstances, FlexibleContexts, IncoherentInstances,
        CPP
  #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
-- This code is a big ugly mess, but it more or less works.  Someday I might
-- get around to cleaning it up.

-- |This module exports a 'Pretty' instance for the 'Poly' type.
module Math.Polynomial.Pretty () where

#if MIN_VERSION_base(4,11,0)
import Prelude hiding ((<>))
#endif
import Math.Polynomial.Type

import Data.Complex

import Text.PrettyPrint
import Text.PrettyPrint.HughesPJClass

instance (Pretty a, Num a, Ord a) => Pretty (Poly a) where
    pPrintPrec :: PrettyLevel -> Rational -> Poly a -> Doc
pPrintPrec l :: PrettyLevel
l p :: Rational
p x :: Poly a
x = Doc
ppr
        where
            ppr :: Doc
ppr    = Rational
-> Endianness -> (Bool -> a -> Int -> Doc) -> Poly a -> Doc
forall a t t.
(Ord a, Num a, Num t, Num t, Enum t, Eq t) =>
a -> Endianness -> (Bool -> t -> t -> Doc) -> Poly t -> Doc
pPrintPolyWith Rational
p Endianness
BE ((a -> Doc) -> Char -> Bool -> a -> Int -> Doc
forall a.
(Num a, Ord a) =>
(a -> Doc) -> Char -> Bool -> a -> Int -> Doc
pPrintOrdTerm a -> Doc
pPrNum 'x') Poly a
x
            pPrNum :: a -> Doc
pPrNum = PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l 11

instance (RealFloat a, Pretty a) => Pretty (Complex a) where
    pPrintPrec :: PrettyLevel -> Rational -> Complex a -> Doc
pPrintPrec l :: PrettyLevel
l p :: Rational
p (a :: a
a :+ b :: a
b) = Doc
ppr
        where
            x :: Poly a
x = Endianness -> [a] -> Poly a
forall a. (Num a, Eq a) => Endianness -> [a] -> Poly a
poly Endianness
LE [a
a,a
b]
            ppr :: Doc
ppr = Rational
-> Endianness -> (Bool -> a -> Int -> Doc) -> Poly a -> Doc
forall a t t.
(Ord a, Num a, Num t, Num t, Enum t, Eq t) =>
a -> Endianness -> (Bool -> t -> t -> Doc) -> Poly t -> Doc
pPrintPolyWith Rational
p Endianness
LE ((a -> Doc) -> Char -> Bool -> a -> Int -> Doc
forall a.
(Num a, Ord a) =>
(a -> Doc) -> Char -> Bool -> a -> Int -> Doc
pPrintOrdTerm a -> Doc
pPrNum 'i') Poly a
x
            pPrNum :: a -> Doc
pPrNum = PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l 11

instance (RealFloat a, Pretty (Complex a)) => Pretty (Poly (Complex a)) where
    pPrintPrec :: PrettyLevel -> Rational -> Poly (Complex a) -> Doc
pPrintPrec l :: PrettyLevel
l p :: Rational
p x :: Poly (Complex a)
x = Doc
ppr
        where
            ppr :: Doc
ppr    = Rational
-> Endianness
-> (Bool -> Complex a -> Int -> Doc)
-> Poly (Complex a)
-> Doc
forall a t t.
(Ord a, Num a, Num t, Num t, Enum t, Eq t) =>
a -> Endianness -> (Bool -> t -> t -> Doc) -> Poly t -> Doc
pPrintPolyWith Rational
p Endianness
BE ((Complex a -> Doc) -> Char -> Bool -> Complex a -> Int -> Doc
forall a.
(Num a, Eq a) =>
(a -> Doc) -> Char -> Bool -> a -> Int -> Doc
pPrintUnOrdTerm Complex a -> Doc
pPrNum 'x') Poly (Complex a)
x
            pPrNum :: Complex a -> Doc
pPrNum = PrettyLevel -> Rational -> Complex a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l 11

pPrintPolyWith :: a -> Endianness -> (Bool -> t -> t -> Doc) -> Poly t -> Doc
pPrintPolyWith prec :: a
prec end :: Endianness
end v :: Bool -> t -> t -> Doc
v p :: Poly t
p = Bool -> [Doc] -> Doc
parenSep (a
prec a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> 5) ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc -> Bool) -> [Doc] -> [Doc]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Doc -> Bool) -> Doc -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Bool
isEmpty)
    [ Bool -> t -> t -> Doc
v Bool
first t
coeff t
exp
    | (coeff :: t
coeff, exp :: t
exp) <-
        (if Endianness
end Endianness -> Endianness -> Bool
forall a. Eq a => a -> a -> Bool
== Endianness
BE then [(t, t)] -> [(t, t)]
forall a. [a] -> [a]
reverse else ((t, t) -> Bool) -> [(t, t)] -> [(t, t)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((0t -> t -> Bool
forall a. Eq a => a -> a -> Bool
==)(t -> Bool) -> ((t, t) -> t) -> (t, t) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(t, t) -> t
forall a b. (a, b) -> a
fst))
        ([t] -> [t] -> [(t, t)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Endianness -> Poly t -> [t]
forall a. (Num a, Eq a) => Endianness -> Poly a -> [a]
polyCoeffs Endianness
LE Poly t
p) [0..])
    | Bool
first <- Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False
    ]

parenSep :: Bool -> [Doc] -> Doc
parenSep p :: Bool
p xs :: [Doc]
xs =
    Bool -> Doc -> Doc
prettyParen (Bool
p Bool -> Bool -> Bool
&& Bool -> Bool
not ([Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Int -> [Doc] -> [Doc]
forall a. Int -> [a] -> [a]
drop 1 [Doc]
xs)))
        ([Doc] -> Doc
hsep [Doc]
xs)

pPrintOrdTerm :: (a -> Doc) -> Char -> Bool -> a -> Int -> Doc
pPrintOrdTerm   _ _ _ 0 _ = Doc
empty
pPrintOrdTerm num :: a -> Doc
num _ f :: Bool
f c :: a
c 0 = Bool -> a -> Doc
forall a. (Ord a, Num a) => Bool -> a -> Doc
sign Bool
f a
c Doc -> Doc -> Doc
<> a -> Doc
num (a -> a
forall a. Num a => a -> a
abs a
c)
pPrintOrdTerm   _ v :: Char
v f :: Bool
f c :: a
c 1   | a -> a
forall a. Num a => a -> a
abs a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1    = Bool -> a -> Doc
forall a. (Ord a, Num a) => Bool -> a -> Doc
sign Bool
f a
c Doc -> Doc -> Doc
<> Char -> Doc
char Char
v
pPrintOrdTerm num :: a -> Doc
num v :: Char
v f :: Bool
f c :: a
c 1 = Bool -> a -> Doc
forall a. (Ord a, Num a) => Bool -> a -> Doc
sign Bool
f a
c Doc -> Doc -> Doc
<> a -> Doc
num (a -> a
forall a. Num a => a -> a
abs a
c) Doc -> Doc -> Doc
<> Char -> Doc
char Char
v
pPrintOrdTerm   _ v :: Char
v f :: Bool
f c :: a
c e :: Int
e   | a -> a
forall a. Num a => a -> a
abs a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1    = Bool -> a -> Doc
forall a. (Ord a, Num a) => Bool -> a -> Doc
sign Bool
f a
c Doc -> Doc -> Doc
<> Char -> Doc
char Char
v Doc -> Doc -> Doc
<> String -> Doc
text "^" Doc -> Doc -> Doc
<> Int -> Doc
int Int
e
pPrintOrdTerm num :: a -> Doc
num v :: Char
v f :: Bool
f c :: a
c e :: Int
e = Bool -> a -> Doc
forall a. (Ord a, Num a) => Bool -> a -> Doc
sign Bool
f a
c Doc -> Doc -> Doc
<> a -> Doc
num (a -> a
forall a. Num a => a -> a
abs a
c) Doc -> Doc -> Doc
<> Char -> Doc
char Char
v Doc -> Doc -> Doc
<> String -> Doc
text "^" Doc -> Doc -> Doc
<> Int -> Doc
int Int
e

sign :: Bool -> a -> Doc
sign True x :: a
x
    | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0     = Char -> Doc
char '-'
    | Bool
otherwise = Doc
empty
sign False x :: a
x
    | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0     = String -> Doc
text "- "
    | Bool
otherwise = String -> Doc
text "+ "

pPrintUnOrdTerm :: (a -> Doc) -> Char -> Bool -> a -> Int -> Doc
pPrintUnOrdTerm   _ _ _ 0 _ = Doc
empty
pPrintUnOrdTerm num :: a -> Doc
num _ f :: Bool
f c :: a
c 0 = Bool -> Integer -> Doc
forall a. (Ord a, Num a) => Bool -> a -> Doc
sign Bool
f 1 Doc -> Doc -> Doc
<> a -> Doc
num a
c
pPrintUnOrdTerm   _ v :: Char
v f :: Bool
f 1 1 = Bool -> Integer -> Doc
forall a. (Ord a, Num a) => Bool -> a -> Doc
sign Bool
f 1 Doc -> Doc -> Doc
<> Char -> Doc
char Char
v
pPrintUnOrdTerm num :: a -> Doc
num v :: Char
v f :: Bool
f c :: a
c 1 = Bool -> Integer -> Doc
forall a. (Ord a, Num a) => Bool -> a -> Doc
sign Bool
f 1 Doc -> Doc -> Doc
<> a -> Doc
num a
c Doc -> Doc -> Doc
<> Char -> Doc
char Char
v
pPrintUnOrdTerm   _ v :: Char
v f :: Bool
f 1 e :: Int
e = Bool -> Integer -> Doc
forall a. (Ord a, Num a) => Bool -> a -> Doc
sign Bool
f 1 Doc -> Doc -> Doc
<> Char -> Doc
char Char
v Doc -> Doc -> Doc
<> String -> Doc
text "^" Doc -> Doc -> Doc
<> Int -> Doc
int Int
e
pPrintUnOrdTerm num :: a -> Doc
num v :: Char
v f :: Bool
f c :: a
c e :: Int
e = Bool -> Integer -> Doc
forall a. (Ord a, Num a) => Bool -> a -> Doc
sign Bool
f 1 Doc -> Doc -> Doc
<> a -> Doc
num a
c Doc -> Doc -> Doc
<> Char -> Doc
char Char
v Doc -> Doc -> Doc
<> String -> Doc
text "^" Doc -> Doc -> Doc
<> Int -> Doc
int Int
e