module Config.Pretty (pretty) where
import Data.Char (isPrint, isDigit,intToDigit)
import Data.List (mapAccumL)
import Data.Ratio (denominator)
import qualified Data.Text as Text
import Text.PrettyPrint
import Numeric(showIntAtBase)
import Prelude hiding ((<>))
import Config.Value
import Config.Number
pretty :: Value a -> Doc
pretty :: Value a -> Doc
pretty Value a
value =
case Value a
value of
Sections a
_ [] -> String -> Doc
text String
"{}"
Sections a
_ [Section a]
xs -> [Section a] -> Doc
forall a. [Section a] -> Doc
prettySections [Section a]
xs
Number a
_ Number
n -> Number -> Doc
prettyNumber Number
n
Text a
_ Text
t -> String -> Doc
prettyText (Text -> String
Text.unpack Text
t)
Atom a
_ Atom
t -> String -> Doc
text (Text -> String
Text.unpack (Atom -> Text
atomName Atom
t))
List a
_ [] -> String -> Doc
text String
"[]"
List a
_ [Value a]
xs -> [Doc] -> Doc
vcat [ Char -> Doc
char Char
'*' Doc -> Doc -> Doc
<+> Value a -> Doc
forall a. Value a -> Doc
pretty Value a
x | Value a
x <- [Value a]
xs ]
prettyNumber :: Number -> Doc
prettyNumber :: Number -> Doc
prettyNumber (MkNumber Radix
r Rational
c) =
case Radix
r of
Radix16 Integer
e -> Doc
pref Doc -> Doc -> Doc
<> String -> Doc
text String
"0x" Doc -> Doc -> Doc
<> Doc
num Doc -> Doc -> Doc
<> Char -> Integer -> Doc
forall a. (Eq a, Num a, Show a) => Char -> a -> Doc
expPart Char
'p' Integer
e
Radix10 Integer
e -> Doc
pref Doc -> Doc -> Doc
<> Doc
num Doc -> Doc -> Doc
<> Char -> Integer -> Doc
forall a. (Eq a, Num a, Show a) => Char -> a -> Doc
expPart Char
'e' Integer
e
Radix
Radix8 -> Doc
pref Doc -> Doc -> Doc
<> String -> Doc
text String
"0o" Doc -> Doc -> Doc
<> Doc
num
Radix
Radix2 -> Doc
pref Doc -> Doc -> Doc
<> String -> Doc
text String
"0b" Doc -> Doc -> Doc
<> Doc
num
where
radix :: Int
radix = Radix -> Int
radixToInt Radix
r
pref :: Doc
pref = if Rational
c Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0 then Char -> Doc
char Char
'-' else Doc
empty
num :: Doc
num = String -> Doc
text (Integer -> (Int -> Char) -> Integer -> ShowS
forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
radix) Int -> Char
intToDigit Integer
whole String
"")
Doc -> Doc -> Doc
<> Doc
fracPart
(Integer
whole,Rational
frac) = Rational -> (Integer, Rational)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Rational -> Rational
forall a. Num a => a -> a
abs Rational
c) :: (Integer, Rational)
expPart :: Char -> a -> Doc
expPart Char
_ a
0 = String -> Doc
text String
""
expPart Char
p a
i = String -> Doc
text (Char
p Char -> ShowS
forall a. a -> [a] -> [a]
: a -> String
forall a. Show a => a -> String
show a
i)
fracPart :: Doc
fracPart
| Rational
0 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
frac = String -> Doc
text String
""
| Bool
otherwise = String -> Doc
text (Char
'.' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> Rational -> String
showFrac Int
radix Rational
frac)
showFrac :: Int -> Rational -> String
showFrac :: Int -> Rational -> String
showFrac Int
_ Rational
0 = String
""
showFrac Int
radix Rational
x = Int -> Char
intToDigit Int
w Char -> ShowS
forall a. a -> [a] -> [a]
: String
rest
where
(Int
w,Rational
f) = Rational -> (Int, Rational)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
radix)
rest :: String
rest
| Rational -> Integer
forall a. Ratio a -> a
denominator Rational
f Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Rational -> Integer
forall a. Ratio a -> a
denominator Rational
x = Int -> Rational -> String
showFrac Int
radix Rational
f
| Bool
otherwise = String
""
prettyText :: String -> Doc
prettyText :: String -> Doc
prettyText = Doc -> Doc
doubleQuotes (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hcat ([Doc] -> Doc) -> (String -> [Doc]) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, [Doc]) -> [Doc]
forall a b. (a, b) -> b
snd ((Bool, [Doc]) -> [Doc])
-> (String -> (Bool, [Doc])) -> String -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Char -> (Bool, Doc)) -> Bool -> String -> (Bool, [Doc])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Bool -> Char -> (Bool, Doc)
ppChar Bool
True
where ppChar :: Bool -> Char -> (Bool, Doc)
ppChar Bool
s Char
x
| Char -> Bool
isDigit Char
x = (Bool
True, if Bool -> Bool
not Bool
s then String -> Doc
text String
"\\&" Doc -> Doc -> Doc
<> Char -> Doc
char Char
x else Char -> Doc
char Char
x)
| Char -> Bool
isPrint Char
x = (Bool
True, Char -> Doc
char Char
x)
| Bool
otherwise = (Bool
False, Char -> Doc
char Char
'\\' Doc -> Doc -> Doc
<> Int -> Doc
int (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
x))
prettySections :: [Section a] -> Doc
prettySections :: [Section a] -> Doc
prettySections [Section a]
ss = [Section a] -> Doc
forall a. [Section a] -> Doc
prettySmallSections [Section a]
small Doc -> Doc -> Doc
$$ Doc
rest
where
([Section a]
small,[Section a]
big) = (Section a -> Bool) -> [Section a] -> ([Section a], [Section a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Value a -> Bool
forall a. Value a -> Bool
isBig (Value a -> Bool) -> (Section a -> Value a) -> Section a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section a -> Value a
forall a. Section a -> Value a
sectionValue) [Section a]
ss
rest :: Doc
rest = case [Section a]
big of
[] -> Doc
empty
Section a
b : [Section a]
bs -> Section a -> Doc
forall a. Section a -> Doc
prettyBigSection Section a
b Doc -> Doc -> Doc
$$ [Section a] -> Doc
forall a. [Section a] -> Doc
prettySections [Section a]
bs
prettyBigSection :: Section a -> Doc
prettyBigSection :: Section a -> Doc
prettyBigSection Section a
s =
String -> Doc
text (Text -> String
Text.unpack (Section a -> Text
forall a. Section a -> Text
sectionName Section a
s)) Doc -> Doc -> Doc
<> Doc
colon
Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest Int
2 (Value a -> Doc
forall a. Value a -> Doc
pretty (Section a -> Value a
forall a. Section a -> Value a
sectionValue Section a
s))
prettySmallSections :: [Section a] -> Doc
prettySmallSections :: [Section a] -> Doc
prettySmallSections [Section a]
ss = [Doc] -> Doc
vcat (((Int, Section a) -> Doc) -> [(Int, Section a)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Section a) -> Doc
forall a. (Int, Section a) -> Doc
pp [(Int, Section a)]
annotated)
where
annotate :: Section a -> (Int, Section a)
annotate Section a
s = (Text -> Int
Text.length (Section a -> Text
forall a. Section a -> Text
sectionName Section a
s), Section a
s)
annotated :: [(Int, Section a)]
annotated = (Section a -> (Int, Section a))
-> [Section a] -> [(Int, Section a)]
forall a b. (a -> b) -> [a] -> [b]
map Section a -> (Int, Section a)
forall a. Section a -> (Int, Section a)
annotate [Section a]
ss
indent :: Int
indent = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ((Int, Section a) -> Int) -> [(Int, Section a)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Section a) -> Int
forall a b. (a, b) -> a
fst [(Int, Section a)]
annotated)
pp :: (Int, Section a) -> Doc
pp (Int
l,Section a
s) = Int -> Section a -> Doc
forall a. Int -> Section a -> Doc
prettySmallSection (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) Section a
s
prettySmallSection :: Int -> Section a -> Doc
prettySmallSection :: Int -> Section a -> Doc
prettySmallSection Int
n Section a
s =
String -> Doc
text (Text -> String
Text.unpack (Section a -> Text
forall a. Section a -> Text
sectionName Section a
s)) Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<>
String -> Doc
text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' ') Doc -> Doc -> Doc
<> Value a -> Doc
forall a. Value a -> Doc
pretty (Section a -> Value a
forall a. Section a -> Value a
sectionValue Section a
s)
isBig :: Value a -> Bool
isBig :: Value a -> Bool
isBig (Sections a
_ (Section a
_:[Section a]
_)) = Bool
True
isBig (List a
_ (Value a
_:[Value a]
_)) = Bool
True
isBig Value a
_ = Bool
False