{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# 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.Applicative (some)
import Control.Monad.Reader
import qualified Data.Char
import Data.Maybe (fromMaybe)
import qualified Language.Haskell.TH.LanguageExtensions as ParseExtension
import Language.Haskell.TH.Syntax (Exp)
import PyF.Formatters
import PyF.Internal.Meta
import qualified PyF.Internal.Parser as ParseExp
import Text.Parsec

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

data ParsingContext = ParsingContext
  { ParsingContext -> Maybe (Char, Char)
delimiters :: Maybe (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 = do
  Maybe (Char, Char)
delimitersM <- (ParsingContext -> Maybe (Char, Char))
-> ParsecT String () (Reader ParsingContext) (Maybe (Char, Char))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingContext -> Maybe (Char, Char)
delimiters

  case Maybe (Char, Char)
delimitersM of
    Maybe (Char, Char)
Nothing -> ParsecT String () (Reader ParsingContext) Item -> Parser [Item]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Maybe (Char, Char)
-> ParsecT String () (Reader ParsingContext) Item
rawString Maybe (Char, Char)
forall a. Maybe a
Nothing)
    Just (Char, Char)
_ -> ParsecT String () (Reader ParsingContext) Item -> Parser [Item]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Maybe (Char, Char)
-> ParsecT String () (Reader ParsingContext) Item
rawString Maybe (Char, Char)
delimitersM ParsecT String () (Reader ParsingContext) Item
-> ParsecT String () (Reader ParsingContext) Item
-> ParsecT String () (Reader ParsingContext) Item
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () (Reader ParsingContext) Item
escapedParenthesis ParsecT String () (Reader ParsingContext) Item
-> ParsecT String () (Reader ParsingContext) Item
-> ParsecT String () (Reader ParsingContext) Item
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () (Reader ParsingContext) Item
replacementField) Parser [Item]
-> ParsecT String () (Reader ParsingContext) () -> Parser [Item]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () (Reader ParsingContext) ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof

rawString :: Maybe (Char, Char) -> Parser Item
rawString :: Maybe (Char, Char)
-> ParsecT String () (Reader ParsingContext) Item
rawString Maybe (Char, Char)
delimsM = do
  let delims :: String
delims = case Maybe (Char, Char)
delimsM of
                 Maybe (Char, Char)
Nothing -> []
                 Just (Char
openingChar, Char
closingChar) -> [Char
openingChar, Char
closingChar]

  -- lookahead
  let p :: ParsecT String () (Reader ParsingContext) String
p = ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (String -> ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
delims)
  String
chars <- ParsecT String () (Reader ParsingContext) String
-> ParsecT String () (Reader ParsingContext) String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT String () (Reader ParsingContext) String
p

  case String -> Either String String
escapeChars String
chars of
    Left String
remaining -> do
      -- Consume up to the error location
      ParsecT String () (Reader ParsingContext) String
-> ParsecT String () (Reader ParsingContext) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () (Reader ParsingContext) String
 -> ParsecT String () (Reader ParsingContext) ())
-> ParsecT String () (Reader ParsingContext) String
-> ParsecT String () (Reader ParsingContext) ()
forall a b. (a -> b) -> a -> b
$ Int
-> ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
chars Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
remaining) ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
      String -> ParsecT String () (Reader ParsingContext) Item
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Lexical error in literal section"
    Right String
escaped -> do
      -- Consumne everything
      ParsecT String () (Reader ParsingContext) String
-> ParsecT String () (Reader ParsingContext) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT String () (Reader ParsingContext) String
p
      Item -> ParsecT String () (Reader ParsingContext) Item
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Item
Raw String
escaped)

escapedParenthesis :: Parser Item
escapedParenthesis :: ParsecT String () (Reader ParsingContext) Item
escapedParenthesis = do
  Just (Char
openingChar, Char
closingChar) <- (ParsingContext -> Maybe (Char, Char))
-> ParsecT String () (Reader ParsingContext) (Maybe (Char, Char))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingContext -> Maybe (Char, Char)
delimiters
  String -> Item
Raw (String -> Item)
-> ParsecT String () (Reader ParsingContext) String
-> ParsecT String () (Reader ParsingContext) Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT String () (Reader ParsingContext) String
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m String
parseRaw Char
openingChar ParsecT String () (Reader ParsingContext) String
-> ParsecT String () (Reader ParsingContext) String
-> ParsecT String () (Reader ParsingContext) String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String () (Reader ParsingContext) String
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m String
parseRaw Char
closingChar)
  where
    parseRaw :: Char -> ParsecT s u m String
parseRaw Char
c = [Char
c] String -> ParsecT s u m String -> ParsecT s u m String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
2 Char
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 String () (Reader ParsingContext) Item
replacementField = do
  [Extension]
exts <- (ParsingContext -> [Extension])
-> ParsecT String () (Reader ParsingContext) [Extension]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingContext -> [Extension]
enabledExtensions
  Just (Char
charOpening, Char
charClosing) <- (ParsingContext -> Maybe (Char, Char))
-> ParsecT String () (Reader ParsingContext) (Maybe (Char, Char))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingContext -> Maybe (Char, Char)
delimiters
  Char
_ <- Char -> ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
charOpening
  Exp
expr <- [Extension]
-> ParsecT String () (Reader ParsingContext) String -> Parser Exp
evalExpr [Extension]
exts (ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (String -> ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf (Char
charClosing Char -> ShowS
forall a. a -> [a] -> [a]
: String
":" :: String)) ParsecT String () (Reader ParsingContext) String
-> String -> ParsecT String () (Reader ParsingContext) String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"an haskell expression")
  Maybe FormatMode
fmt <- ParsecT String () (Reader ParsingContext) FormatMode
-> ParsecT String () (Reader ParsingContext) (Maybe FormatMode)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT String () (Reader ParsingContext) FormatMode
 -> ParsecT String () (Reader ParsingContext) (Maybe FormatMode))
-> ParsecT String () (Reader ParsingContext) FormatMode
-> ParsecT String () (Reader ParsingContext) (Maybe FormatMode)
forall a b. (a -> b) -> a -> b
$ do
    Char
_ <- Char -> ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
    ParsecT String () (Reader ParsingContext) FormatMode
formatSpec
  Char
_ <- Char -> ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
charClosing
  Item -> ParsecT String () (Reader ParsingContext) Item
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Maybe FormatMode -> Item
Replacement Exp
expr Maybe FormatMode
fmt)

-- | Default formatting 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 formatting 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)

evalExpr :: [ParseExtension.Extension] -> Parser String -> Parser Exp
evalExpr :: [Extension]
-> ParsecT String () (Reader ParsingContext) String -> Parser Exp
evalExpr [Extension]
exts ParsecT String () (Reader ParsingContext) String
exprParser = do
  String
s <- ParsecT String () (Reader ParsingContext) String
-> ParsecT String () (Reader ParsingContext) String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT String () (Reader ParsingContext) String
exprParser
  -- Setup the dyn flags using the provided list of extensions
  let exts' :: [Extension]
exts' = (Extension -> Extension) -> [Extension] -> [Extension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Extension -> Extension
translateTHtoGHCExt [Extension]
exts
  let dynFlags :: DynFlags
dynFlags = [Extension] -> DynFlags
baseDynFlags [Extension]
exts'
  case String -> DynFlags -> Either (Int, Int, String) (HsExpr GhcPs)
ParseExp.parseExpression String
s DynFlags
dynFlags of
    Right HsExpr GhcPs
expr -> do
      -- Consumne the expression
      ParsecT String () (Reader ParsingContext) String
-> ParsecT String () (Reader ParsingContext) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT String () (Reader ParsingContext) String
exprParser
      Exp -> Parser Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
dynFlags HsExpr GhcPs
expr)
    Left (Int
lineError, Int
colError, String
err) -> do
      -- Skip lines
      Int
-> ParsecT String () (Reader ParsingContext) String
-> ParsecT String () (Reader ParsingContext) ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
lineError Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline)
      -- Skip columns
      ParsecT String () (Reader ParsingContext) String
-> ParsecT String () (Reader ParsingContext) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () (Reader ParsingContext) String
 -> ParsecT String () (Reader ParsingContext) ())
-> ParsecT String () (Reader ParsingContext) String
-> ParsecT String () (Reader ParsingContext) ()
forall a b. (a -> b) -> a -> b
$ Int
-> ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count (Int
colError Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar

      String -> Parser Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Exp) -> String -> Parser Exp
forall a b. (a -> b) -> a -> b
$ String
err String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" in haskell expression"

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 String () (Reader ParsingContext) FormatMode
formatSpec = do
  Maybe (Maybe Char, AnyAlign)
al' <- ParsecT String () (Reader ParsingContext) (Maybe Char, AnyAlign)
-> ParsecT
     String () (Reader ParsingContext) (Maybe (Maybe Char, AnyAlign))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT String () (Reader ParsingContext) (Maybe Char, AnyAlign)
alignment
  Maybe SignMode
s <- ParsecT String () (Reader ParsingContext) SignMode
-> ParsecT String () (Reader ParsingContext) (Maybe SignMode)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT String () (Reader ParsingContext) SignMode
sign
  AlternateForm
alternateForm <- AlternateForm
-> ParsecT String () (Reader ParsingContext) AlternateForm
-> ParsecT String () (Reader ParsingContext) AlternateForm
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option AlternateForm
NormalForm (AlternateForm
AlternateForm AlternateForm
-> ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) AlternateForm
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#')
  Bool
hasZero <- Bool
-> ParsecT String () (Reader ParsingContext) Bool
-> ParsecT String () (Reader ParsingContext) Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (Bool
True Bool
-> ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'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 String () (Reader ParsingContext) Integer
-> ParsecT String () (Reader ParsingContext) (Maybe Integer)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT String () (Reader ParsingContext) Integer
width
  Maybe Char
grouping <- ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) (Maybe Char)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT String () (Reader ParsingContext) Char
groupingOption
  Precision
prec <- Precision
-> ParsecT String () (Reader ParsingContext) Precision
-> ParsecT String () (Reader ParsingContext) Precision
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Precision
PrecisionDefault ParsecT String () (Reader ParsingContext) Precision
parsePrecision

  Maybe TypeFlag
t <- ParsecT String () (Reader ParsingContext) TypeFlag
-> ParsecT String () (Reader ParsingContext) (Maybe TypeFlag)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT String () (Reader ParsingContext) TypeFlag
 -> ParsecT String () (Reader ParsingContext) (Maybe TypeFlag))
-> ParsecT String () (Reader ParsingContext) TypeFlag
-> ParsecT String () (Reader ParsingContext) (Maybe TypeFlag)
forall a b. (a -> b) -> a -> b
$ ParsecT String () (Reader ParsingContext) TypeFlag
-> ParsecT String () (Reader ParsingContext) TypeFlag
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT 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 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 -> do
        -- Consumne the parser
        ParsecT String () (Reader ParsingContext) TypeFlag
-> ParsecT String () (Reader ParsingContext) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT String () (Reader ParsingContext) TypeFlag
type_
        FormatMode -> ParsecT 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 String () (Reader ParsingContext) FormatMode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
typeError

parsePrecision :: Parser Precision
parsePrecision :: ParsecT String () (Reader ParsingContext) Precision
parsePrecision = do
  [Extension]
exts <- (ParsingContext -> [Extension])
-> ParsecT String () (Reader ParsingContext) [Extension]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingContext -> [Extension]
enabledExtensions
  Just (Char
charOpening, Char
charClosing) <- (ParsingContext -> Maybe (Char, Char))
-> ParsecT String () (Reader ParsingContext) (Maybe (Char, Char))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingContext -> Maybe (Char, Char)
delimiters
  Char
_ <- Char -> ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
  [ParsecT String () (Reader ParsingContext) Precision]
-> ParsecT String () (Reader ParsingContext) Precision
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u 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 String () (Reader ParsingContext) Integer
-> ParsecT String () (Reader ParsingContext) Precision
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () (Reader ParsingContext) Integer
precision,
      Char -> ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
charOpening ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) Precision
-> ParsecT 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 String () (Reader ParsingContext) Precision
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Extension]
-> ParsecT String () (Reader ParsingContext) String -> Parser Exp
evalExpr [Extension]
exts (ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
someTill ((Char -> Bool) -> ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
charClosing)) (Char -> ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
charClosing) ParsecT String () (Reader ParsingContext) String
-> String -> ParsecT String () (Reader ParsingContext) String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"an haskell expression"))
    ]

-- | Similar to 'manyTill' but always parse one element.
-- Be careful, @someTill p e@ may parse @e@ as first element if @e@ is a subset of @p@.
someTill :: Stream s m t => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
someTill :: ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
someTill ParsecT s u m a
p ParsecT s u m end
e = (:) (a -> [a] -> [a]) -> ParsecT s u m a -> ParsecT s u m ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m a
p ParsecT s u m ([a] -> [a])
-> ParsecT s u m [a] -> ParsecT s u m [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT s u m a
p ParsecT s u m end
e

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 String () (Reader ParsingContext) (Maybe Char, AnyAlign)
alignment =
  [ParsecT String () (Reader ParsingContext) (Maybe Char, AnyAlign)]
-> ParsecT String () (Reader ParsingContext) (Maybe Char, AnyAlign)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
    [ ParsecT String () (Reader ParsingContext) (Maybe Char, AnyAlign)
-> ParsecT String () (Reader ParsingContext) (Maybe Char, AnyAlign)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () (Reader ParsingContext) (Maybe Char, AnyAlign)
 -> ParsecT
      String () (Reader ParsingContext) (Maybe Char, AnyAlign))
-> ParsecT String () (Reader ParsingContext) (Maybe Char, AnyAlign)
-> ParsecT String () (Reader ParsingContext) (Maybe Char, AnyAlign)
forall a b. (a -> b) -> a -> b
$ do
        Char
c <- ParsecT String () (Reader ParsingContext) Char
fill
        AnyAlign
mode <- Parser AnyAlign
align
        (Maybe Char, AnyAlign)
-> ParsecT 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 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 String () (Reader ParsingContext) Char
fill = ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar

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

sign :: Parser SignMode
sign :: ParsecT String () (Reader ParsingContext) SignMode
sign =
  [ParsecT String () (Reader ParsingContext) SignMode]
-> ParsecT String () (Reader ParsingContext) SignMode
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
    [ SignMode
Plus SignMode
-> ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) SignMode
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+',
      SignMode
Minus SignMode
-> ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) SignMode
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-',
      SignMode
Space SignMode
-> ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) SignMode
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '
    ]

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

integer :: Parser Integer
integer :: ParsecT String () (Reader ParsingContext) Integer
integer = String -> Integer
forall a. Read a => String -> a
read (String -> Integer)
-> ParsecT String () (Reader ParsingContext) String
-> ParsecT String () (Reader ParsingContext) Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (String -> ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'0' .. Char
'9']) -- incomplete: see: https://docs.python.org/3/reference/lexical_analysis.html#grammar-token-integer

groupingOption :: Parser Char
groupingOption :: ParsecT String () (Reader ParsingContext) Char
groupingOption = String -> ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf (String
"_," :: String)

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

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