-- | Pretty-printing implementation for 'Value'
module Config.Pretty (pretty) where

import           Data.Char (isPrint, isDigit,intToDigit)
import           Data.List (mapAccumL)
import           Data.Ratio (numerator, denominator)
import qualified Data.Text as Text
import           Text.PrettyPrint
import           Numeric(showIntAtBase)
import           Prelude hiding ((<>))

import           Config.Value
import           Config.Number

-- | Pretty-print a 'Value' as shown in the example.
-- Sections will nest complex values underneath with
-- indentation and simple values will be rendered on
-- the same line as their section.
pretty :: Value a -> Doc
pretty :: Value a -> Doc
pretty value :: Value a
value =
  case Value a
value of
    Sections _ [] -> String -> Doc
text "{}"
    Sections _ xs :: [Section a]
xs -> [Section a] -> Doc
forall a. [Section a] -> Doc
prettySections [Section a]
xs
    Number _ n :: Number
n    -> Number -> Doc
prettyNumber Number
n
    Text _ t :: Text
t      -> String -> Doc
prettyText (Text -> String
Text.unpack Text
t)
    Atom _ t :: Atom
t      -> String -> Doc
text (Text -> String
Text.unpack (Atom -> Text
atomName Atom
t))
    List _ []     -> String -> Doc
text "[]"
    List _ xs :: [Value a]
xs     -> [Doc] -> Doc
vcat [ Char -> Doc
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 r :: Radix
r c :: Rational
c) =
  case Radix
r of
    Radix16 e :: Integer
e -> Doc
pref Doc -> Doc -> Doc
<> String -> Doc
text "0x" Doc -> Doc -> Doc
<> Doc
num Doc -> Doc -> Doc
<> Char -> Integer -> Doc
forall a. (Eq a, Num a, Show a) => Char -> a -> Doc
expPart 'p' Integer
e
    Radix10 e :: 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 'e' Integer
e
    Radix8    -> Doc
pref Doc -> Doc -> Doc
<> String -> Doc
text "0o" Doc -> Doc -> Doc
<> Doc
num
    Radix2    -> Doc
pref Doc -> Doc -> Doc
<> String -> Doc
text "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
< 0 then Char -> Doc
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 "") -- XXX
           Doc -> Doc -> Doc
<> Rational -> Doc
forall a. (Eq a, Num a) => a -> Doc
fracPart Rational
frac
    (whole :: Integer
whole,frac :: 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)
    expPart :: Char -> a -> Doc
expPart _ 0 = String -> Doc
text ""
    expPart c :: Char
c i :: a
i = String -> Doc
text (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: a -> String
forall a. Show a => a -> String
show a
i)
    fracPart :: a -> Doc
fracPart 0 = String -> Doc
text ""
    fracPart i :: a
i = String -> Doc
text ('.' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> Rational -> String
showFrac Int
radix Rational
frac)

showFrac :: Int -> Rational -> String
showFrac :: Int -> Rational -> String
showFrac radix :: Int
radix 0 = ""
showFrac radix :: Int
radix x :: Rational
x = Integer -> String
forall a. Show a => a -> String
show Integer
w String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest
  where
    (w :: Integer
w,f :: Rational
f) = Rational -> (Integer, 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 = ""

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
cat ([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 s :: Bool
s x :: Char
x
          | Char -> Bool
isDigit Char
x = (Bool
True, if Bool -> Bool
not Bool
s then String -> Doc
text "\\&" 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 '\\' 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 ss :: [Section a]
ss = [Section a] -> Doc
forall a. [Section a] -> Doc
prettySmallSections [Section a]
small Doc -> Doc -> Doc
$$ Doc
rest
  where
  (small :: [Section a]
small,big :: [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
                  b :: Section a
b : bs :: [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 s :: 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 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 ss :: [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 s :: 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     = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (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 (l :: Int
l,s :: 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 n :: Int
n s :: 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 ' ') 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 _ (_:_)) = Bool
True
isBig (List _ (_:_))     = Bool
True
isBig _                  = Bool
False