{-|
Module      : Advent.Format.Show
Description : Rendering for the parser DSL
Copyright   : (c) Eric Mertens, 2018-2021
License     : ISC
Maintainer  : emertens@gmail.com

-}

module Advent.Format.Show where

import Advent.Format.Types (Format(..), Token(..))

-- | Render a parsed format string back to the input syntax.
showFormat :: Int {- ^ surrounding precedence -} -> Format -> ShowS
showFormat :: Int -> Format -> ShowS
showFormat Int
p Format
fmt =
  case Format
fmt of
    Many Format
x              -> Int -> Format -> ShowS
showFormat Int
3 Format
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'*'
    Some Format
x              -> Int -> Format -> ShowS
showFormat Int
3 Format
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'+'
    Gather Format
x            -> Int -> Format -> ShowS
showFormat Int
3 Format
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'!'
    SepBy Format
x Format
y           -> Int -> Format -> ShowS
showFormat Int
3 Format
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'&' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Format -> ShowS
showFormat Int
3 Format
y
    Alt Format
x Format
y             -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> Format -> ShowS
showFormat Int
1 Format
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'|' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Format -> ShowS
showFormat Int
2 Format
y
    Follow [Format]
xs           -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ \String
z -> (Format -> ShowS) -> String -> [Format] -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Format -> ShowS
showFormat Int
3) String
z [Format]
xs
    Group Format
x             -> Int -> Format -> ShowS
showFormat Int
3 Format
x
    Format
UnsignedInteger     -> String -> ShowS
showString String
"%lu"
    Format
SignedInteger       -> String -> ShowS
showString String
"%ld"
    Format
HexInteger          -> String -> ShowS
showString String
"%lx"
    Format
UnsignedInt         -> String -> ShowS
showString String
"%u"
    Format
SignedInt           -> String -> ShowS
showString String
"%d"
    Format
HexInt              -> String -> ShowS
showString String
"%x"
    Format
Word                -> String -> ShowS
showString String
"%s"
    Format
Char                -> String -> ShowS
showString String
"%c"
    Format
Letter              -> String -> ShowS
showString String
"%a"
    Named String
n             -> Char -> ShowS
showChar Char
'@' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
n
    Literal String
x           -> (String -> ShowS) -> String -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Char -> ShowS) -> String -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> ShowS
showLiteral) String
x

-- | Render a literal character match back to input syntax.
showLiteral :: Char -> ShowS
showLiteral :: Char -> ShowS
showLiteral Char
x
  | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' = String -> ShowS
showString String
"%n"
  | Char
x Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"()&!*+%@" = Char -> ShowS
showChar Char
'%' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
x
  | Bool
otherwise = Char -> ShowS
showChar Char
x

showToken :: Token -> String
showToken :: Token -> String
showToken Token
t =
  case Token
t of
    Token
TOpenGroup        -> String
"("
    Token
TCloseGroup       -> String
")"
    Token
TAnyChar          -> String
"%c"
    Token
TAnyLetter        -> String
"%a"
    Token
TAnyWord          -> String
"%s"
    Token
TUnsignedInteger  -> String
"%lu"
    Token
TSignedInteger    -> String
"%ld"
    Token
THexInteger       -> String
"%lx"
    Token
TUnsignedInt      -> String
"%u"
    Token
TSignedInt        -> String
"%d"
    Token
THexInt           -> String
"%x"
    Token
TMany             -> String
"*"
    Token
TSome             -> String
"+"
    Token
TSepBy            -> String
"&"
    Token
TAlt              -> String
"|"
    TAt String
x             -> String
"@" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
    Token
TBang             -> String
"!"
    TLiteral Char
c        -> Char -> ShowS
showLiteral Char
c String
""