module Language.Ginger.StringFormatting
where

import Control.Applicative ( (<|>) )
import qualified Text.Megaparsec as P
import qualified Text.Megaparsec.Char as P
import Text.Printf (printf, PrintfArg)
import Data.Maybe (fromMaybe)
import Data.Void (Void)
import Data.Char (isDigit)

printfList :: PrintfArg a => String -> [a] -> String
printfList :: forall a. PrintfArg a => [Char] -> [a] -> [Char]
printfList [Char]
fmt [a]
args =
  [Char]
leader [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (([Char] -> a -> [Char]) -> [[Char]] -> [a] -> [[Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Char] -> a -> [Char]
forall r. PrintfType r => [Char] -> r
printf [[Char]]
fmts [a]
args)
  where
    ([Char]
leader, [[Char]]
fmts) = [Char] -> ([Char], [[Char]])
splitPrintfFormat [Char]
fmt

splitPrintfFormat :: String -> (String, [String])
splitPrintfFormat :: [Char] -> ([Char], [[Char]])
splitPrintfFormat [Char]
fmt =
  ([Char], [[Char]])
-> Maybe ([Char], [[Char]]) -> ([Char], [[Char]])
forall a. a -> Maybe a -> a
fromMaybe ([Char]
"", []) (Maybe ([Char], [[Char]]) -> ([Char], [[Char]]))
-> Maybe ([Char], [[Char]]) -> ([Char], [[Char]])
forall a b. (a -> b) -> a -> b
$ Parsec Void [Char] ([Char], [[Char]])
-> [Char] -> Maybe ([Char], [[Char]])
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
P.parseMaybe Parsec Void [Char] ([Char], [[Char]])
pPrintfFormats [Char]
fmt

type P a = P.Parsec Void String a

pPrintfFormats :: P (String, [String])
pPrintfFormats :: Parsec Void [Char] ([Char], [[Char]])
pPrintfFormats = (,) ([Char] -> [[Char]] -> ([Char], [[Char]]))
-> ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity ([[Char]] -> ([Char], [[Char]]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void [Char] Identity [Char]
pLeader ParsecT Void [Char] Identity ([[Char]] -> ([Char], [[Char]]))
-> ParsecT Void [Char] Identity [[Char]]
-> Parsec Void [Char] ([Char], [[Char]])
forall a b.
ParsecT Void [Char] Identity (a -> b)
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity [[Char]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many ParsecT Void [Char] Identity [Char]
pPrintfFormat

pLeader :: P String
pLeader :: ParsecT Void [Char] Identity [Char]
pLeader = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char])
-> ParsecT Void [Char] Identity [[Char]]
-> ParsecT Void [Char] Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity [[Char]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many (([Char]
"%" [Char]
-> ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity [Char]
forall a b.
a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void [Char] Identity [Char]
pDoublePercent) ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity [Char]
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity [Char]
pPrintfPlainChars)

pTrailer :: P String
pTrailer :: ParsecT Void [Char] Identity [Char]
pTrailer = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char])
-> ParsecT Void [Char] Identity [[Char]]
-> ParsecT Void [Char] Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity [[Char]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many (ParsecT Void [Char] Identity [Char]
pDoublePercent ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity [Char]
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity [Char]
pPrintfPlainChars)

pDoublePercent :: P String
pDoublePercent :: ParsecT Void [Char] Identity [Char]
pDoublePercent = Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.chunk [Char]
Tokens [Char]
"%%"

pPrintfPlainChars :: P String
pPrintfPlainChars :: ParsecT Void [Char] Identity [Char]
pPrintfPlainChars = Maybe [Char]
-> (Token [Char] -> Bool)
-> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
P.takeWhile1P ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"plain characters") (Token [Char] -> Token [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token [Char]
'%')

pPrintfFormat :: P String
pPrintfFormat :: ParsecT Void [Char] Identity [Char]
pPrintfFormat = do
  [Char]
leadingPercent <- Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.chunk [Char]
Tokens [Char]
"%"
  [Char]
flags <- Maybe [Char]
-> (Token [Char] -> Bool)
-> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"flags") (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
flagChars)
  [Char]
fieldWidth <- ParsecT Void [Char] Identity [Char]
pFieldWidth
  [Char]
precision <- [Char]
-> ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity [Char]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option [Char]
"" (ParsecT Void [Char] Identity [Char]
 -> ParsecT Void [Char] Identity [Char])
-> ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity [Char]
forall a b. (a -> b) -> a -> b
$ (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.chunk [Char]
Tokens [Char]
"." ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity [Char]
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void [Char] Identity [Char]
pFieldWidth)
  [Char]
widthModifier <- Maybe [Char]
-> (Token [Char] -> Bool)
-> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"width modifier") (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
widthChars)
  Char
formatChar <- [ParsecT Void [Char] Identity Char]
-> ParsecT Void [Char] Identity Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
    [ Char
'd' Char
-> ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity Char
forall a b.
a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token [Char] -> ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token [Char]
'i'
    , Char
'v' Char
-> ParsecT Void [Char] Identity (Token [Char])
-> ParsecT Void [Char] Identity Char
forall a b.
a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Token [Char] -> Bool)
-> ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
stringFormatChars)
    , (Token [Char] -> Bool)
-> ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
formatChars)
    , Char -> ParsecT Void [Char] Identity Char
forall a. a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'v'
    ]
  [Char]
remaining <- ParsecT Void [Char] Identity [Char]
pTrailer
  [Char] -> ParsecT Void [Char] Identity [Char]
forall a. a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> ParsecT Void [Char] Identity [Char])
-> [Char] -> ParsecT Void [Char] Identity [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Char]
leadingPercent
    , [Char]
flags
    , [Char]
fieldWidth
    , [Char]
precision
    , [Char]
widthModifier
    , [Char
formatChar]
    , [Char]
remaining
    ]

  where
    pFieldWidth :: P String
    pFieldWidth :: ParsecT Void [Char] Identity [Char]
pFieldWidth = Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.chunk [Char]
Tokens [Char]
"*" ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity [Char]
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity [Char]
pNumericFieldWidth

    pNumericFieldWidth :: P String
    pNumericFieldWidth :: ParsecT Void [Char] Identity [Char]
pNumericFieldWidth =
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
(++) ([Char] -> [Char] -> [Char])
-> ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity ([Char] -> [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity [Char]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option [Char]
"" (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.chunk [Char]
Tokens [Char]
"-")
           ParsecT Void [Char] Identity ([Char] -> [Char])
-> ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity [Char]
forall a b.
ParsecT Void [Char] Identity (a -> b)
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [Char]
-> (Token [Char] -> Bool)
-> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"numeric field width") Char -> Bool
Token [Char] -> Bool
isDigit

    flagChars :: [Char]
    flagChars :: [Char]
flagChars = [Char]
" +-0#"

    widthChars :: [Char]
    widthChars :: [Char]
widthChars = [Char]
"lLhH"

    stringFormatChars :: [Char]
    stringFormatChars :: [Char]
stringFormatChars = [Char]
"rsa"

    formatChars :: [Char]
    formatChars :: [Char]
formatChars = [Char]
"cdobuxXfFgGeEsv"