{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

-- |
-- This module provides a parser for <https://docs.python.org/3.4/library/string.html#formatspec python format string mini language>.
module PyF.Internal.PythonSyntax
  ( parseGenericFormatString,
    Item (..),
    FormatMode (..),
    Padding (..),
    Precision (..),
    TypeFormat (..),
    AlternateForm (..),
    pattern DefaultFormatMode,
    Parser,
    ParsingContext (..),
    ExprOrValue (..),
  )
where

import Control.Monad.Reader
import qualified Data.Char
import Data.Maybe (fromMaybe)
import qualified Data.Set as Set -- For fancyFailure
import Data.Void (Void)
import qualified Language.Haskell.Exts.Extension as ParseExtension
import qualified Language.Haskell.Exts.Parser as ParseExp
import qualified Language.Haskell.Exts.SrcLoc as SrcLoc
import qualified Language.Haskell.Meta.Syntax.Translate as SyntaxTranslate
import Language.Haskell.TH.Syntax
import PyF.Formatters
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L

type Parser t = ParsecT Void String (Reader ParsingContext) t

data ParsingContext = ParsingContext
  { ParsingContext -> (Char, Char)
delimiters :: (Char, Char),
    ParsingContext -> [Extension]
enabledExtensions :: [ParseExtension.Extension]
  }
  deriving (Int -> ParsingContext -> ShowS
[ParsingContext] -> ShowS
ParsingContext -> String
(Int -> ParsingContext -> ShowS)
-> (ParsingContext -> String)
-> ([ParsingContext] -> ShowS)
-> Show ParsingContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParsingContext] -> ShowS
$cshowList :: [ParsingContext] -> ShowS
show :: ParsingContext -> String
$cshow :: ParsingContext -> String
showsPrec :: Int -> ParsingContext -> ShowS
$cshowsPrec :: Int -> ParsingContext -> ShowS
Show)

{-
-- TODO:
- Better parsing of integer
- Recursive replacement field, so "{string:.{precision}} can be parsed
- f_expression / conversion
- Not (Yet) implemented:
     - types: n
-}

{-
f_string          ::=  (literal_char | "{{" | "}}" | replacement_field)*
replacement_field ::=  "{" f_expression ["!" conversion] [":" format_spec] "}"
f_expression      ::=  (conditional_expression | "*" or_expr)
                         ("," conditional_expression | "," "*" or_expr)* [","]
                       | yield_expression
conversion        ::=  "s" | "r" | "a"
format_spec       ::=  (literal_char | NULL | replacement_field)*
literal_char      ::=  <any code point except "{", "}" or NULL>
-}

-- | A format string is composed of many chunks of raw string or replacement
data Item
  = -- | A raw string
    Raw String
  | -- | A replacement string, composed of an arbitrary Haskell expression followed by an optional formatter
    Replacement Exp (Maybe FormatMode)
  deriving (Int -> Item -> ShowS
[Item] -> ShowS
Item -> String
(Int -> Item -> ShowS)
-> (Item -> String) -> ([Item] -> ShowS) -> Show Item
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Item] -> ShowS
$cshowList :: [Item] -> ShowS
show :: Item -> String
$cshow :: Item -> String
showsPrec :: Int -> Item -> ShowS
$cshowsPrec :: Int -> Item -> ShowS
Show)

-- |
-- Parse a string, returns a list of raw string or replacement fields
--
-- >>> import Text.Megaparsec
-- >>> parse parsePythonFormatString "" "hello {1+1:>10.2f}"
-- Right [
--        Raw "hello ",
--        Replacement "1+1"
--        (
--        Just (FormatMode
--                       (Padding 10 (Just (Nothing,AnyAlign AlignRight)))
--                       (FixedF (Precision 2) NormalForm Minus)
--                        Nothing))]
parseGenericFormatString :: Parser [Item]
parseGenericFormatString :: Parser [Item]
parseGenericFormatString =
  ParsecT Void String (Reader ParsingContext) Item -> Parser [Item]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void String (Reader ParsingContext) Item
rawString ParsecT Void String (Reader ParsingContext) Item
-> ParsecT Void String (Reader ParsingContext) Item
-> ParsecT Void String (Reader ParsingContext) Item
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String (Reader ParsingContext) Item
escapedParenthesis ParsecT Void String (Reader ParsingContext) Item
-> ParsecT Void String (Reader ParsingContext) Item
-> ParsecT Void String (Reader ParsingContext) Item
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String (Reader ParsingContext) Item
replacementField) Parser [Item]
-> ParsecT Void String (Reader ParsingContext) () -> Parser [Item]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String (Reader ParsingContext) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

rawString :: Parser Item
rawString :: ParsecT Void String (Reader ParsingContext) Item
rawString = do
  (Char
openingChar, Char
closingChar) <- (ParsingContext -> (Char, Char))
-> ParsecT Void String (Reader ParsingContext) (Char, Char)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingContext -> (Char, Char)
delimiters
  String
chars <- ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ([Token String]
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
openingChar, Char
closingChar])
  case String -> Either String String
escapeChars String
chars of
    Left String
remaining -> do
      Int
offset <- ParsecT Void String (Reader ParsingContext) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
      Int -> ParsecT Void String (Reader ParsingContext) ()
forall e s (m :: * -> *). MonadParsec e s m => Int -> m ()
setOffset (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
remaining)
      Set (ErrorFancy Void)
-> ParsecT Void String (Reader ParsingContext) Item
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Set (ErrorFancy e) -> m a
fancyFailure (ErrorFancy Void -> Set (ErrorFancy Void)
forall a. a -> Set a
Set.singleton (String -> ErrorFancy Void
forall e. String -> ErrorFancy e
ErrorFail String
"lexical error in literal section"))
    Right String
escaped -> Item -> ParsecT Void String (Reader ParsingContext) Item
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Item
Raw String
escaped)

escapedParenthesis :: Parser Item
escapedParenthesis :: ParsecT Void String (Reader ParsingContext) Item
escapedParenthesis = do
  (Char
openingChar, Char
closingChar) <- (ParsingContext -> (Char, Char))
-> ParsecT Void String (Reader ParsingContext) (Char, Char)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingContext -> (Char, Char)
delimiters
  String -> Item
Raw (String -> Item)
-> ParsecT Void String (Reader ParsingContext) String
-> ParsecT Void String (Reader ParsingContext) Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT Void String (Reader ParsingContext) String
forall (f :: * -> *) e s a.
(MonadParsec e s f, Tokens s ~ [a]) =>
a -> f [a]
parseRaw Char
openingChar ParsecT Void String (Reader ParsingContext) String
-> ParsecT Void String (Reader ParsingContext) String
-> ParsecT Void String (Reader ParsingContext) String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT Void String (Reader ParsingContext) String
forall (f :: * -> *) e s a.
(MonadParsec e s f, Tokens s ~ [a]) =>
a -> f [a]
parseRaw Char
closingChar)
  where
    parseRaw :: a -> f [a]
parseRaw a
c = [a
c] [a] -> f [a] -> f [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens s -> f (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
2 a
c)

-- | Replace escape chars with their value. Results in a Left with the
-- remainder of the string on encountering a lexical error (such as a bad escape
-- sequence).
-- >>> escapeChars "hello \\n"
-- Right "hello \n"
-- >>> escapeChars "hello \\x"
-- Left "\\x"
escapeChars :: String -> Either String String
escapeChars :: String -> Either String String
escapeChars String
"" = String -> Either String String
forall a b. b -> Either a b
Right String
""
escapeChars (Char
'\\' : Char
'\n' : String
xs) = String -> Either String String
escapeChars String
xs
escapeChars (Char
'\\' : Char
'\\' : String
xs) = (Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> Either String String -> Either String String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String String
escapeChars String
xs
escapeChars String
s = case ReadS Char
Data.Char.readLitChar String
s of
  ((Char
c, String
xs) : [(Char, String)]
_) -> (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> Either String String -> Either String String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String String
escapeChars String
xs
  [(Char, String)]
_ -> String -> Either String String
forall a b. a -> Either a b
Left String
s

replacementField :: Parser Item
replacementField :: ParsecT Void String (Reader ParsingContext) Item
replacementField = do
  [Extension]
exts <- (ParsingContext -> [Extension])
-> ParsecT Void String (Reader ParsingContext) [Extension]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingContext -> [Extension]
enabledExtensions
  (Char
charOpening, Char
charClosing) <- (ParsingContext -> (Char, Char))
-> ParsecT Void String (Reader ParsingContext) (Char, Char)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingContext -> (Char, Char)
delimiters
  Char
_ <- Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
charOpening
  Exp
expr <- [Extension]
-> ParsecT Void String (Reader ParsingContext) String -> Parser Exp
evalExpr [Extension]
exts (ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ([Token String]
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf (Char
charClosing Char -> ShowS
forall a. a -> [a] -> [a]
: String
":" :: String)))
  Maybe FormatMode
fmt <- ParsecT Void String (Reader ParsingContext) FormatMode
-> ParsecT Void String (Reader ParsingContext) (Maybe FormatMode)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void String (Reader ParsingContext) FormatMode
 -> ParsecT Void String (Reader ParsingContext) (Maybe FormatMode))
-> ParsecT Void String (Reader ParsingContext) FormatMode
-> ParsecT Void String (Reader ParsingContext) (Maybe FormatMode)
forall a b. (a -> b) -> a -> b
$ do
    Char
_ <- Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
':'
    ParsecT Void String (Reader ParsingContext) FormatMode
formatSpec
  Char
_ <- Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
charClosing
  Item -> ParsecT Void String (Reader ParsingContext) Item
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Maybe FormatMode -> Item
Replacement Exp
expr Maybe FormatMode
fmt)

-- | Default formating mode, no padding, default precision, no grouping, no sign handling
pattern DefaultFormatMode :: FormatMode
pattern $bDefaultFormatMode :: FormatMode
$mDefaultFormatMode :: forall r. FormatMode -> (Void# -> r) -> (Void# -> r) -> r
DefaultFormatMode = FormatMode PaddingDefault (DefaultF PrecisionDefault Minus) Nothing

-- | A Formatter, listing padding, format and and grouping char
data FormatMode = FormatMode Padding TypeFormat (Maybe Char)
  deriving (Int -> FormatMode -> ShowS
[FormatMode] -> ShowS
FormatMode -> String
(Int -> FormatMode -> ShowS)
-> (FormatMode -> String)
-> ([FormatMode] -> ShowS)
-> Show FormatMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatMode] -> ShowS
$cshowList :: [FormatMode] -> ShowS
show :: FormatMode -> String
$cshow :: FormatMode -> String
showsPrec :: Int -> FormatMode -> ShowS
$cshowsPrec :: Int -> FormatMode -> ShowS
Show)

-- | Padding, containing the padding width, the padding char and the alignement mode
data Padding
  = PaddingDefault
  | Padding Integer (Maybe (Maybe Char, AnyAlign))
  deriving (Int -> Padding -> ShowS
[Padding] -> ShowS
Padding -> String
(Int -> Padding -> ShowS)
-> (Padding -> String) -> ([Padding] -> ShowS) -> Show Padding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Padding] -> ShowS
$cshowList :: [Padding] -> ShowS
show :: Padding -> String
$cshow :: Padding -> String
showsPrec :: Int -> Padding -> ShowS
$cshowsPrec :: Int -> Padding -> ShowS
Show)

-- | Represents a value of type @t@ or an Haskell expression supposed to represents that value
data ExprOrValue t
  = Value t
  | HaskellExpr Exp
  deriving (Int -> ExprOrValue t -> ShowS
[ExprOrValue t] -> ShowS
ExprOrValue t -> String
(Int -> ExprOrValue t -> ShowS)
-> (ExprOrValue t -> String)
-> ([ExprOrValue t] -> ShowS)
-> Show (ExprOrValue t)
forall t. Show t => Int -> ExprOrValue t -> ShowS
forall t. Show t => [ExprOrValue t] -> ShowS
forall t. Show t => ExprOrValue t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExprOrValue t] -> ShowS
$cshowList :: forall t. Show t => [ExprOrValue t] -> ShowS
show :: ExprOrValue t -> String
$cshow :: forall t. Show t => ExprOrValue t -> String
showsPrec :: Int -> ExprOrValue t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> ExprOrValue t -> ShowS
Show)

-- | Floating point precision
data Precision
  = PrecisionDefault
  | Precision (ExprOrValue Integer)
  deriving (Int -> Precision -> ShowS
[Precision] -> ShowS
Precision -> String
(Int -> Precision -> ShowS)
-> (Precision -> String)
-> ([Precision] -> ShowS)
-> Show Precision
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Precision] -> ShowS
$cshowList :: [Precision] -> ShowS
show :: Precision -> String
$cshow :: Precision -> String
showsPrec :: Int -> Precision -> ShowS
$cshowsPrec :: Int -> Precision -> ShowS
Show)

{-

Python format mini language

format_spec     ::=  [[fill]align][sign][#][0][width][grouping_option][.precision][type]
fill            ::=  <any character>
align           ::=  "<" | ">" | "=" | "^"
sign            ::=  "+" | "-" | " "
width           ::=  integer
grouping_option ::=  "_" | ","
precision       ::=  integer
type            ::=  "b" | "c" | "d" | "e" | "E" | "f" | "F" | "g" | "G" | "n" | "o" | "s" | "x" | "X" | "%"
-}

data TypeFlag = Flagb | Flagc | Flagd | Flage | FlagE | Flagf | FlagF | Flagg | FlagG | Flagn | Flago | Flags | Flagx | FlagX | FlagPercent
  deriving (Int -> TypeFlag -> ShowS
[TypeFlag] -> ShowS
TypeFlag -> String
(Int -> TypeFlag -> ShowS)
-> (TypeFlag -> String) -> ([TypeFlag] -> ShowS) -> Show TypeFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeFlag] -> ShowS
$cshowList :: [TypeFlag] -> ShowS
show :: TypeFlag -> String
$cshow :: TypeFlag -> String
showsPrec :: Int -> TypeFlag -> ShowS
$cshowsPrec :: Int -> TypeFlag -> ShowS
Show)

-- | All formating type
data TypeFormat
  = -- | Default, depends on the infered type of the expression
    DefaultF Precision SignMode
  | -- | Binary, such as `0b0121`
    BinaryF AlternateForm SignMode
  | -- | Character, will convert an integer to its character representation
    CharacterF
  | -- | Decimal, base 10 integer formatting
    DecimalF SignMode
  | -- | Exponential notation for floatting points
    ExponentialF Precision AlternateForm SignMode
  | -- | Exponential notation with capitalised @e@
    ExponentialCapsF Precision AlternateForm SignMode
  | -- | Fixed number of digits floating point
    FixedF Precision AlternateForm SignMode
  | -- | Capitalized version of the previous
    FixedCapsF Precision AlternateForm SignMode
  | -- | General formatting: `FixedF` or `ExponentialF` depending on the number magnitude
    GeneralF Precision AlternateForm SignMode
  | -- | Same as `GeneralF` but with upper case @E@ and infinite / NaN
    GeneralCapsF Precision AlternateForm SignMode
  | -- | Octal, such as 00245
    OctalF AlternateForm SignMode
  | -- | Simple string
    StringF Precision
  | -- | Hexadecimal, such as 0xaf3e
    HexF AlternateForm SignMode
  | -- | Hexadecimal with capitalized letters, such as 0XAF3E
    HexCapsF AlternateForm SignMode
  | -- | Percent representation
    PercentF Precision AlternateForm SignMode
  deriving (Int -> TypeFormat -> ShowS
[TypeFormat] -> ShowS
TypeFormat -> String
(Int -> TypeFormat -> ShowS)
-> (TypeFormat -> String)
-> ([TypeFormat] -> ShowS)
-> Show TypeFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeFormat] -> ShowS
$cshowList :: [TypeFormat] -> ShowS
show :: TypeFormat -> String
$cshow :: TypeFormat -> String
showsPrec :: Int -> TypeFormat -> ShowS
$cshowsPrec :: Int -> TypeFormat -> ShowS
Show)

-- | If the formatter use its alternate form
data AlternateForm = AlternateForm | NormalForm
  deriving (Int -> AlternateForm -> ShowS
[AlternateForm] -> ShowS
AlternateForm -> String
(Int -> AlternateForm -> ShowS)
-> (AlternateForm -> String)
-> ([AlternateForm] -> ShowS)
-> Show AlternateForm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlternateForm] -> ShowS
$cshowList :: [AlternateForm] -> ShowS
show :: AlternateForm -> String
$cshow :: AlternateForm -> String
showsPrec :: Int -> AlternateForm -> ShowS
$cshowsPrec :: Int -> AlternateForm -> ShowS
Show)

lastCharFailed :: String -> Parser t
lastCharFailed :: String -> Parser t
lastCharFailed String
err = do
  Int
offset <- ParsecT Void String (Reader ParsingContext) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  Int -> ParsecT Void String (Reader ParsingContext) ()
forall e s (m :: * -> *). MonadParsec e s m => Int -> m ()
setOffset (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  Set (ErrorFancy Void) -> Parser t
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Set (ErrorFancy e) -> m a
fancyFailure (ErrorFancy Void -> Set (ErrorFancy Void)
forall a. a -> Set a
Set.singleton (String -> ErrorFancy Void
forall e. String -> ErrorFancy e
ErrorFail String
err))

evalExpr :: [ParseExtension.Extension] -> Parser String -> Parser Exp
evalExpr :: [Extension]
-> ParsecT Void String (Reader ParsingContext) String -> Parser Exp
evalExpr [Extension]
exts ParsecT Void String (Reader ParsingContext) String
exprParser = do
  Int
offset <- ParsecT Void String (Reader ParsingContext) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  String
s <- ParsecT Void String (Reader ParsingContext) String
exprParser
  -- Setup the parser using the provided list of extensions
  -- Which are detected by template haskell at splice position
  let parseMode :: ParseMode
parseMode = ParseMode
ParseExp.defaultParseMode {extensions :: [Extension]
ParseExp.extensions = [Extension]
exts}
  case Exp SrcSpanInfo -> Exp
forall a. ToExp a => a -> Exp
SyntaxTranslate.toExp (Exp SrcSpanInfo -> Exp)
-> ParseResult (Exp SrcSpanInfo) -> ParseResult Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseMode -> String -> ParseResult (Exp SrcSpanInfo)
ParseExp.parseExpWithMode ParseMode
parseMode String
s of
    ParseExp.ParseOk Exp
expr -> Exp -> Parser Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
expr
    ParseExp.ParseFailed (SrcLoc.SrcLoc String
_name' Int
line Int
col) String
err -> do
      let linesBefore :: [String]
linesBefore = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (String -> [String]
lines String
s)
          currentOffset :: Int
currentOffset = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> String
unlines [String]
linesBefore) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      Int -> ParsecT Void String (Reader ParsingContext) ()
forall e s (m :: * -> *). MonadParsec e s m => Int -> m ()
setOffset (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
currentOffset)
      Set (ErrorFancy Void) -> Parser Exp
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Set (ErrorFancy e) -> m a
fancyFailure (ErrorFancy Void -> Set (ErrorFancy Void)
forall a. a -> Set a
Set.singleton (String -> ErrorFancy Void
forall e. String -> ErrorFancy e
ErrorFail String
err))

overrideAlignmentIfZero :: Bool -> Maybe (Maybe Char, AnyAlign) -> Maybe (Maybe Char, AnyAlign)
overrideAlignmentIfZero :: Bool
-> Maybe (Maybe Char, AnyAlign) -> Maybe (Maybe Char, AnyAlign)
overrideAlignmentIfZero Bool
True Maybe (Maybe Char, AnyAlign)
Nothing = (Maybe Char, AnyAlign) -> Maybe (Maybe Char, AnyAlign)
forall a. a -> Maybe a
Just (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'0', AlignMode 'AlignNumber -> AnyAlign
forall (k :: AlignForString). AlignMode k -> AnyAlign
AnyAlign AlignMode 'AlignNumber
AlignInside)
overrideAlignmentIfZero Bool
True (Just (Maybe Char
Nothing, AnyAlign
al)) = (Maybe Char, AnyAlign) -> Maybe (Maybe Char, AnyAlign)
forall a. a -> Maybe a
Just (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'0', AnyAlign
al)
overrideAlignmentIfZero Bool
_ Maybe (Maybe Char, AnyAlign)
v = Maybe (Maybe Char, AnyAlign)
v

formatSpec :: Parser FormatMode
formatSpec :: ParsecT Void String (Reader ParsingContext) FormatMode
formatSpec = do
  Maybe (Maybe Char, AnyAlign)
al' <- ParsecT Void String (Reader ParsingContext) (Maybe Char, AnyAlign)
-> ParsecT
     Void String (Reader ParsingContext) (Maybe (Maybe Char, AnyAlign))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void String (Reader ParsingContext) (Maybe Char, AnyAlign)
alignment
  Maybe SignMode
s <- ParsecT Void String (Reader ParsingContext) SignMode
-> ParsecT Void String (Reader ParsingContext) (Maybe SignMode)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void String (Reader ParsingContext) SignMode
sign
  AlternateForm
alternateForm <- AlternateForm
-> ParsecT Void String (Reader ParsingContext) AlternateForm
-> ParsecT Void String (Reader ParsingContext) AlternateForm
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option AlternateForm
NormalForm (AlternateForm
AlternateForm AlternateForm
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) AlternateForm
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'#')
  Bool
hasZero <- Bool
-> ParsecT Void String (Reader ParsingContext) Bool
-> ParsecT Void String (Reader ParsingContext) Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True Bool
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'0')
  let al :: Maybe (Maybe Char, AnyAlign)
al = Bool
-> Maybe (Maybe Char, AnyAlign) -> Maybe (Maybe Char, AnyAlign)
overrideAlignmentIfZero Bool
hasZero Maybe (Maybe Char, AnyAlign)
al'
  Maybe Integer
w <- ParsecT Void String (Reader ParsingContext) Integer
-> ParsecT Void String (Reader ParsingContext) (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void String (Reader ParsingContext) Integer
width
  Maybe Char
grouping <- ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void String (Reader ParsingContext) Char
groupingOption
  Precision
prec <- Precision
-> ParsecT Void String (Reader ParsingContext) Precision
-> ParsecT Void String (Reader ParsingContext) Precision
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Precision
PrecisionDefault ParsecT Void String (Reader ParsingContext) Precision
parsePrecision
  Maybe TypeFlag
t <- ParsecT Void String (Reader ParsingContext) TypeFlag
-> ParsecT Void String (Reader ParsingContext) (Maybe TypeFlag)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void String (Reader ParsingContext) TypeFlag
type_
  let padding :: Padding
padding = case Maybe Integer
w of
        Just Integer
p -> Integer -> Maybe (Maybe Char, AnyAlign) -> Padding
Padding Integer
p Maybe (Maybe Char, AnyAlign)
al
        Maybe Integer
Nothing -> Padding
PaddingDefault
  case Maybe TypeFlag
t of
    Maybe TypeFlag
Nothing -> FormatMode
-> ParsecT Void String (Reader ParsingContext) FormatMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Padding -> TypeFormat -> Maybe Char -> FormatMode
FormatMode Padding
padding (Precision -> SignMode -> TypeFormat
DefaultF Precision
prec (SignMode -> Maybe SignMode -> SignMode
forall a. a -> Maybe a -> a
fromMaybe SignMode
Minus Maybe SignMode
s)) Maybe Char
grouping)
    Just TypeFlag
flag -> case TypeFlag
-> Padding
-> Maybe Char
-> Precision
-> AlternateForm
-> Maybe SignMode
-> Either String TypeFormat
evalFlag TypeFlag
flag Padding
padding Maybe Char
grouping Precision
prec AlternateForm
alternateForm Maybe SignMode
s of
      Right TypeFormat
fmt -> FormatMode
-> ParsecT Void String (Reader ParsingContext) FormatMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Padding -> TypeFormat -> Maybe Char -> FormatMode
FormatMode Padding
padding TypeFormat
fmt Maybe Char
grouping)
      Left String
typeError ->
        String -> ParsecT Void String (Reader ParsingContext) FormatMode
forall t. String -> Parser t
lastCharFailed String
typeError

parsePrecision :: Parser Precision
parsePrecision :: ParsecT Void String (Reader ParsingContext) Precision
parsePrecision = do
  [Extension]
exts <- (ParsingContext -> [Extension])
-> ParsecT Void String (Reader ParsingContext) [Extension]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingContext -> [Extension]
enabledExtensions
  (Char
charOpening, Char
charClosing) <- (ParsingContext -> (Char, Char))
-> ParsecT Void String (Reader ParsingContext) (Char, Char)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingContext -> (Char, Char)
delimiters
  Char
_ <- Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'.'
  [ParsecT Void String (Reader ParsingContext) Precision]
-> ParsecT Void String (Reader ParsingContext) Precision
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ ExprOrValue Integer -> Precision
Precision (ExprOrValue Integer -> Precision)
-> (Integer -> ExprOrValue Integer) -> Integer -> Precision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ExprOrValue Integer
forall t. t -> ExprOrValue t
Value (Integer -> Precision)
-> ParsecT Void String (Reader ParsingContext) Integer
-> ParsecT Void String (Reader ParsingContext) Precision
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String (Reader ParsingContext) Integer
precision,
      Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
charOpening ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) Precision
-> ParsecT Void String (Reader ParsingContext) Precision
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ExprOrValue Integer -> Precision
Precision (ExprOrValue Integer -> Precision)
-> (Exp -> ExprOrValue Integer) -> Exp -> Precision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> ExprOrValue Integer
forall t. Exp -> ExprOrValue t
HaskellExpr (Exp -> Precision)
-> Parser Exp
-> ParsecT Void String (Reader ParsingContext) Precision
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Extension]
-> ParsecT Void String (Reader ParsingContext) String -> Parser Exp
evalExpr [Extension]
exts (ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void String (Reader ParsingContext) Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
charClosing)))
    ]

evalFlag :: TypeFlag -> Padding -> Maybe Char -> Precision -> AlternateForm -> Maybe SignMode -> Either String TypeFormat
evalFlag :: TypeFlag
-> Padding
-> Maybe Char
-> Precision
-> AlternateForm
-> Maybe SignMode
-> Either String TypeFormat
evalFlag TypeFlag
Flagb Padding
_pad Maybe Char
_grouping Precision
prec AlternateForm
alt Maybe SignMode
s = Precision -> TypeFormat -> Either String TypeFormat
failIfPrec Precision
prec (AlternateForm -> SignMode -> TypeFormat
BinaryF AlternateForm
alt (Maybe SignMode -> SignMode
defSign Maybe SignMode
s))
evalFlag TypeFlag
Flagc Padding
_pad Maybe Char
_grouping Precision
prec AlternateForm
alt Maybe SignMode
s = Maybe SignMode -> TypeFormat -> Either String TypeFormat
failIfS Maybe SignMode
s (TypeFormat -> Either String TypeFormat)
-> Either String TypeFormat -> Either String TypeFormat
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Precision -> TypeFormat -> Either String TypeFormat
failIfPrec Precision
prec (TypeFormat -> Either String TypeFormat)
-> Either String TypeFormat -> Either String TypeFormat
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AlternateForm -> TypeFormat -> Either String TypeFormat
failIfAlt AlternateForm
alt TypeFormat
CharacterF
evalFlag TypeFlag
Flagd Padding
_pad Maybe Char
_grouping Precision
prec AlternateForm
alt Maybe SignMode
s = Precision -> TypeFormat -> Either String TypeFormat
failIfPrec Precision
prec (TypeFormat -> Either String TypeFormat)
-> Either String TypeFormat -> Either String TypeFormat
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AlternateForm -> TypeFormat -> Either String TypeFormat
failIfAlt AlternateForm
alt (SignMode -> TypeFormat
DecimalF (Maybe SignMode -> SignMode
defSign Maybe SignMode
s))
evalFlag TypeFlag
Flage Padding
_pad Maybe Char
_grouping Precision
prec AlternateForm
alt Maybe SignMode
s = TypeFormat -> Either String TypeFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeFormat -> Either String TypeFormat)
-> TypeFormat -> Either String TypeFormat
forall a b. (a -> b) -> a -> b
$ Precision -> AlternateForm -> SignMode -> TypeFormat
ExponentialF Precision
prec AlternateForm
alt (Maybe SignMode -> SignMode
defSign Maybe SignMode
s)
evalFlag TypeFlag
FlagE Padding
_pad Maybe Char
_grouping Precision
prec AlternateForm
alt Maybe SignMode
s = TypeFormat -> Either String TypeFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeFormat -> Either String TypeFormat)
-> TypeFormat -> Either String TypeFormat
forall a b. (a -> b) -> a -> b
$ Precision -> AlternateForm -> SignMode -> TypeFormat
ExponentialCapsF Precision
prec AlternateForm
alt (Maybe SignMode -> SignMode
defSign Maybe SignMode
s)
evalFlag TypeFlag
Flagf Padding
_pad Maybe Char
_grouping Precision
prec AlternateForm
alt Maybe SignMode
s = TypeFormat -> Either String TypeFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeFormat -> Either String TypeFormat)
-> TypeFormat -> Either String TypeFormat
forall a b. (a -> b) -> a -> b
$ Precision -> AlternateForm -> SignMode -> TypeFormat
FixedF Precision
prec AlternateForm
alt (Maybe SignMode -> SignMode
defSign Maybe SignMode
s)
evalFlag TypeFlag
FlagF Padding
_pad Maybe Char
_grouping Precision
prec AlternateForm
alt Maybe SignMode
s = TypeFormat -> Either String TypeFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeFormat -> Either String TypeFormat)
-> TypeFormat -> Either String TypeFormat
forall a b. (a -> b) -> a -> b
$ Precision -> AlternateForm -> SignMode -> TypeFormat
FixedCapsF Precision
prec AlternateForm
alt (Maybe SignMode -> SignMode
defSign Maybe SignMode
s)
evalFlag TypeFlag
Flagg Padding
_pad Maybe Char
_grouping Precision
prec AlternateForm
alt Maybe SignMode
s = TypeFormat -> Either String TypeFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeFormat -> Either String TypeFormat)
-> TypeFormat -> Either String TypeFormat
forall a b. (a -> b) -> a -> b
$ Precision -> AlternateForm -> SignMode -> TypeFormat
GeneralF Precision
prec AlternateForm
alt (Maybe SignMode -> SignMode
defSign Maybe SignMode
s)
evalFlag TypeFlag
FlagG Padding
_pad Maybe Char
_grouping Precision
prec AlternateForm
alt Maybe SignMode
s = TypeFormat -> Either String TypeFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeFormat -> Either String TypeFormat)
-> TypeFormat -> Either String TypeFormat
forall a b. (a -> b) -> a -> b
$ Precision -> AlternateForm -> SignMode -> TypeFormat
GeneralCapsF Precision
prec AlternateForm
alt (Maybe SignMode -> SignMode
defSign Maybe SignMode
s)
evalFlag TypeFlag
Flagn Padding
_pad Maybe Char
_grouping Precision
_prec AlternateForm
_alt Maybe SignMode
_s = String -> Either String TypeFormat
forall a b. a -> Either a b
Left (String
"Type 'n' not handled (yet). " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
errgGn)
evalFlag TypeFlag
Flago Padding
_pad Maybe Char
_grouping Precision
prec AlternateForm
alt Maybe SignMode
s = Precision -> TypeFormat -> Either String TypeFormat
failIfPrec Precision
prec (TypeFormat -> Either String TypeFormat)
-> TypeFormat -> Either String TypeFormat
forall a b. (a -> b) -> a -> b
$ AlternateForm -> SignMode -> TypeFormat
OctalF AlternateForm
alt (Maybe SignMode -> SignMode
defSign Maybe SignMode
s)
evalFlag TypeFlag
Flags Padding
pad Maybe Char
grouping Precision
prec AlternateForm
alt Maybe SignMode
s = Maybe Char -> TypeFormat -> Either String TypeFormat
failIfGrouping Maybe Char
grouping (TypeFormat -> Either String TypeFormat)
-> Either String TypeFormat -> Either String TypeFormat
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Padding -> TypeFormat -> Either String TypeFormat
failIfInsidePadding Padding
pad (TypeFormat -> Either String TypeFormat)
-> Either String TypeFormat -> Either String TypeFormat
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe SignMode -> TypeFormat -> Either String TypeFormat
failIfS Maybe SignMode
s (TypeFormat -> Either String TypeFormat)
-> Either String TypeFormat -> Either String TypeFormat
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AlternateForm -> TypeFormat -> Either String TypeFormat
failIfAlt AlternateForm
alt (Precision -> TypeFormat
StringF Precision
prec)
evalFlag TypeFlag
Flagx Padding
_pad Maybe Char
_grouping Precision
prec AlternateForm
alt Maybe SignMode
s = Precision -> TypeFormat -> Either String TypeFormat
failIfPrec Precision
prec (TypeFormat -> Either String TypeFormat)
-> TypeFormat -> Either String TypeFormat
forall a b. (a -> b) -> a -> b
$ AlternateForm -> SignMode -> TypeFormat
HexF AlternateForm
alt (Maybe SignMode -> SignMode
defSign Maybe SignMode
s)
evalFlag TypeFlag
FlagX Padding
_pad Maybe Char
_grouping Precision
prec AlternateForm
alt Maybe SignMode
s = Precision -> TypeFormat -> Either String TypeFormat
failIfPrec Precision
prec (TypeFormat -> Either String TypeFormat)
-> TypeFormat -> Either String TypeFormat
forall a b. (a -> b) -> a -> b
$ AlternateForm -> SignMode -> TypeFormat
HexCapsF AlternateForm
alt (Maybe SignMode -> SignMode
defSign Maybe SignMode
s)
evalFlag TypeFlag
FlagPercent Padding
_pad Maybe Char
_grouping Precision
prec AlternateForm
alt Maybe SignMode
s = TypeFormat -> Either String TypeFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeFormat -> Either String TypeFormat)
-> TypeFormat -> Either String TypeFormat
forall a b. (a -> b) -> a -> b
$ Precision -> AlternateForm -> SignMode -> TypeFormat
PercentF Precision
prec AlternateForm
alt (Maybe SignMode -> SignMode
defSign Maybe SignMode
s)

defSign :: Maybe SignMode -> SignMode
defSign :: Maybe SignMode -> SignMode
defSign Maybe SignMode
Nothing = SignMode
Minus
defSign (Just SignMode
s) = SignMode
s

failIfGrouping :: Maybe Char -> TypeFormat -> Either String TypeFormat
failIfGrouping :: Maybe Char -> TypeFormat -> Either String TypeFormat
failIfGrouping (Just Char
_) TypeFormat
_t = String -> Either String TypeFormat
forall a b. a -> Either a b
Left String
"String type is incompatible with grouping (_ or ,)."
failIfGrouping Maybe Char
Nothing TypeFormat
t = TypeFormat -> Either String TypeFormat
forall a b. b -> Either a b
Right TypeFormat
t

failIfInsidePadding :: Padding -> TypeFormat -> Either String TypeFormat
failIfInsidePadding :: Padding -> TypeFormat -> Either String TypeFormat
failIfInsidePadding (Padding Integer
_ (Just (Maybe Char
_, AnyAlign AlignMode k
AlignInside))) TypeFormat
_t = String -> Either String TypeFormat
forall a b. a -> Either a b
Left String
"String type is incompatible with inside padding (=)."
failIfInsidePadding Padding
_ TypeFormat
t = TypeFormat -> Either String TypeFormat
forall a b. b -> Either a b
Right TypeFormat
t

errgGn :: String
errgGn :: String
errgGn = String
"Use one of {'b', 'c', 'd', 'e', 'E', 'f', 'F', 'g', 'G', 'n', 'o', 's', 'x', 'X', '%'}."

failIfPrec :: Precision -> TypeFormat -> Either String TypeFormat
failIfPrec :: Precision -> TypeFormat -> Either String TypeFormat
failIfPrec Precision
PrecisionDefault TypeFormat
i = TypeFormat -> Either String TypeFormat
forall a b. b -> Either a b
Right TypeFormat
i
failIfPrec (Precision ExprOrValue Integer
e) TypeFormat
_ = String -> Either String TypeFormat
forall a b. a -> Either a b
Left (String
"Type incompatible with precision (." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
showExpr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"), use any of {'e', 'E', 'f', 'F', 'g', 'G', 'n', 's', '%'} or remove the precision field.")
  where
    showExpr :: String
showExpr = case ExprOrValue Integer
e of
      Value Integer
v -> Integer -> String
forall a. Show a => a -> String
show Integer
v
      HaskellExpr Exp
expr -> Exp -> String
forall a. Show a => a -> String
show Exp
expr

failIfAlt :: AlternateForm -> TypeFormat -> Either String TypeFormat
failIfAlt :: AlternateForm -> TypeFormat -> Either String TypeFormat
failIfAlt AlternateForm
NormalForm TypeFormat
i = TypeFormat -> Either String TypeFormat
forall a b. b -> Either a b
Right TypeFormat
i
failIfAlt AlternateForm
_ TypeFormat
_ = String -> Either String TypeFormat
forall a b. a -> Either a b
Left String
"Type incompatible with alternative form (#), use any of {'e', 'E', 'f', 'F', 'g', 'G', 'n', 'o', 'x', 'X', '%'} or remove the alternative field."

failIfS :: Maybe SignMode -> TypeFormat -> Either String TypeFormat
failIfS :: Maybe SignMode -> TypeFormat -> Either String TypeFormat
failIfS Maybe SignMode
Nothing TypeFormat
i = TypeFormat -> Either String TypeFormat
forall a b. b -> Either a b
Right TypeFormat
i
failIfS (Just SignMode
s) TypeFormat
_ = String -> Either String TypeFormat
forall a b. a -> Either a b
Left (String
"Type incompatible with sign field (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [SignMode -> Char
toSignMode SignMode
s] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"), use any of {'b', 'd', 'e', 'E', 'f', 'F', 'g', 'G', 'n', 'o', 'x', 'X', '%'} or remove the sign field.")

toSignMode :: SignMode -> Char
toSignMode :: SignMode -> Char
toSignMode SignMode
Plus = Char
'+'
toSignMode SignMode
Minus = Char
'-'
toSignMode SignMode
Space = Char
' '

alignment :: Parser (Maybe Char, AnyAlign)
alignment :: ParsecT Void String (Reader ParsingContext) (Maybe Char, AnyAlign)
alignment =
  [ParsecT
   Void String (Reader ParsingContext) (Maybe Char, AnyAlign)]
-> ParsecT
     Void String (Reader ParsingContext) (Maybe Char, AnyAlign)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ ParsecT Void String (Reader ParsingContext) (Maybe Char, AnyAlign)
-> ParsecT
     Void String (Reader ParsingContext) (Maybe Char, AnyAlign)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void String (Reader ParsingContext) (Maybe Char, AnyAlign)
 -> ParsecT
      Void String (Reader ParsingContext) (Maybe Char, AnyAlign))
-> ParsecT
     Void String (Reader ParsingContext) (Maybe Char, AnyAlign)
-> ParsecT
     Void String (Reader ParsingContext) (Maybe Char, AnyAlign)
forall a b. (a -> b) -> a -> b
$ do
        Char
c <- ParsecT Void String (Reader ParsingContext) Char
fill
        AnyAlign
mode <- Parser AnyAlign
align
        (Maybe Char, AnyAlign)
-> ParsecT
     Void String (Reader ParsingContext) (Maybe Char, AnyAlign)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c, AnyAlign
mode),
      do
        AnyAlign
mode <- Parser AnyAlign
align
        (Maybe Char, AnyAlign)
-> ParsecT
     Void String (Reader ParsingContext) (Maybe Char, AnyAlign)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Char
forall a. Maybe a
Nothing, AnyAlign
mode)
    ]

fill :: Parser Char
fill :: ParsecT Void String (Reader ParsingContext) Char
fill = ParsecT Void String (Reader ParsingContext) Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle

align :: Parser AnyAlign
align :: Parser AnyAlign
align =
  [Parser AnyAlign] -> Parser AnyAlign
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ AlignMode 'AlignAll -> AnyAlign
forall (k :: AlignForString). AlignMode k -> AnyAlign
AnyAlign AlignMode 'AlignAll
AlignLeft AnyAlign
-> ParsecT Void String (Reader ParsingContext) Char
-> Parser AnyAlign
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'<',
      AlignMode 'AlignAll -> AnyAlign
forall (k :: AlignForString). AlignMode k -> AnyAlign
AnyAlign AlignMode 'AlignAll
AlignRight AnyAlign
-> ParsecT Void String (Reader ParsingContext) Char
-> Parser AnyAlign
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'>',
      AlignMode 'AlignAll -> AnyAlign
forall (k :: AlignForString). AlignMode k -> AnyAlign
AnyAlign AlignMode 'AlignAll
AlignCenter AnyAlign
-> ParsecT Void String (Reader ParsingContext) Char
-> Parser AnyAlign
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'^',
      AlignMode 'AlignNumber -> AnyAlign
forall (k :: AlignForString). AlignMode k -> AnyAlign
AnyAlign AlignMode 'AlignNumber
AlignInside AnyAlign
-> ParsecT Void String (Reader ParsingContext) Char
-> Parser AnyAlign
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'='
    ]

sign :: Parser SignMode
sign :: ParsecT Void String (Reader ParsingContext) SignMode
sign =
  [ParsecT Void String (Reader ParsingContext) SignMode]
-> ParsecT Void String (Reader ParsingContext) SignMode
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ SignMode
Plus SignMode
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) SignMode
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'+',
      SignMode
Minus SignMode
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) SignMode
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'-',
      SignMode
Space SignMode
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) SignMode
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
' '
    ]

width :: Parser Integer
width :: ParsecT Void String (Reader ParsingContext) Integer
width = ParsecT Void String (Reader ParsingContext) Integer
integer

integer :: Parser Integer
integer :: ParsecT Void String (Reader ParsingContext) Integer
integer = ParsecT Void String (Reader ParsingContext) Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal -- incomplete: see: https://docs.python.org/3/reference/lexical_analysis.html#grammar-token-integer

groupingOption :: Parser Char
groupingOption :: ParsecT Void String (Reader ParsingContext) Char
groupingOption = [Token String]
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
"_," :: String)

precision :: Parser Integer
precision :: ParsecT Void String (Reader ParsingContext) Integer
precision = ParsecT Void String (Reader ParsingContext) Integer
integer

type_ :: Parser TypeFlag
type_ :: ParsecT Void String (Reader ParsingContext) TypeFlag
type_ =
  [ParsecT Void String (Reader ParsingContext) TypeFlag]
-> ParsecT Void String (Reader ParsingContext) TypeFlag
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ TypeFlag
Flagb TypeFlag
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) TypeFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'b',
      TypeFlag
Flagc TypeFlag
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) TypeFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'c',
      TypeFlag
Flagd TypeFlag
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) TypeFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'd',
      TypeFlag
Flage TypeFlag
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) TypeFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'e',
      TypeFlag
FlagE TypeFlag
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) TypeFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'E',
      TypeFlag
Flagf TypeFlag
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) TypeFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'f',
      TypeFlag
FlagF TypeFlag
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) TypeFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'F',
      TypeFlag
Flagg TypeFlag
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) TypeFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'g',
      TypeFlag
FlagG TypeFlag
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) TypeFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'G',
      TypeFlag
Flagn TypeFlag
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) TypeFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'n',
      TypeFlag
Flago TypeFlag
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) TypeFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'o',
      TypeFlag
Flags TypeFlag
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) TypeFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
's',
      TypeFlag
Flagx TypeFlag
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) TypeFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'x',
      TypeFlag
FlagX TypeFlag
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) TypeFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'X',
      TypeFlag
FlagPercent TypeFlag
-> ParsecT Void String (Reader ParsingContext) Char
-> ParsecT Void String (Reader ParsingContext) TypeFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT Void String (Reader ParsingContext) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'%'
    ]