    {-# Language Safe #-}
    -- | Pretty-printing implementation for 'Value'
    module Config.Pretty (pretty, prettyInline) 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-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 :: forall a. 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 => 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 b. Integral b => Rational -> (b, 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 b. Integral b => Rational -> (b, 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 :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    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 :: forall a. [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 :: forall a. 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 :: forall a. [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 a. Ord a => [a] -> a
    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 :: forall a. 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 :: forall a. 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

    -- | Pretty-printer that uses no layout for sections or lists.
    prettyInline :: Value a -> Doc
    prettyInline :: forall a. Value a -> Doc
    prettyInline Value a
    value =
      case Value a
    value of
        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
    _ [Value a]
    xs     -> Doc -> Doc
    brackets ([Doc] -> Doc
    list ((Value a -> Doc) -> [Value a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Value a -> Doc
    forall a. Value a -> Doc
    prettyInline [Value a]
    xs))
        Sections a
    _ [Section a]
    xs -> Doc -> Doc
    braces ([Doc] -> Doc
    list [String -> Doc
    text (Text -> String
    Text.unpack Text
    k) Doc -> Doc -> Doc
    <> Doc
    colon Doc -> Doc -> Doc
    <> Value a -> Doc
    forall a. Value a -> Doc
    prettyInline Value a
    v | Section a
    _ Text
    k Value a
    v <- [Section a]
    xs])
      where
        list :: [Doc] -> Doc
    list = [Doc] -> Doc
    hcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> [Doc] -> [Doc]
    punctuate Doc
    comma