{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE CPP #-}
module PyF.Internal.PythonSyntax
( parseGenericFormatString,
Item (..),
FormatMode (..),
Padding (..),
Precision (..),
TypeFormat (..),
AlternateForm (..),
pattern DefaultFormatMode,
Parser,
ParsingContext (..),
ExprOrValue (..),
)
where
import Control.Applicative (some)
import Control.Monad (replicateM_, void)
import Control.Monad.Reader (Reader, asks)
import qualified Data.Char
import Data.Maybe (fromMaybe)
import GHC (GhcPs, HsExpr)
import Language.Haskell.TH.LanguageExtensions (Extension (..))
import Language.Haskell.TH.Syntax (Exp)
import PyF.Formatters
import PyF.Internal.Meta
import qualified PyF.Internal.Parser as ParseExp
import Text.Parsec
import Data.Data (Data)
#if MIN_VERSION_ghc(9,7,0)
#elif MIN_VERSION_ghc(9,6,0)
import Data.Functor (void)
import Control.Monad (replicateM_)
#endif
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.SrcLoc
import GHC.Data.FastString
#else
import SrcLoc
import FastString
#endif
type Parser t = ParsecT String () (Reader ParsingContext) t
data ParsingContext = ParsingContext
{ ParsingContext -> Maybe (Char, Char)
delimiters :: Maybe (Char, Char),
ParsingContext -> [Extension]
enabledExtensions :: [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
$cshowsPrec :: Int -> ParsingContext -> ShowS
showsPrec :: Int -> ParsingContext -> ShowS
$cshow :: ParsingContext -> String
show :: ParsingContext -> String
$cshowList :: [ParsingContext] -> ShowS
showList :: [ParsingContext] -> ShowS
Show)
data Item
=
Raw String
|
Replacement (HsExpr GhcPs, Exp) (Maybe FormatMode)
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 a b.
ParsecT String () (Reader ParsingContext) a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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]
let p :: ParsecT String () (Reader ParsingContext) String
p = ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) String
forall a.
ParsecT String () (Reader ParsingContext) a
-> ParsecT String () (Reader ParsingContext) [a]
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
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 a. [a] -> 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 a. [a] -> 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 a. String -> ParsecT String () (Reader ParsingContext) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Lexical error in literal section"
Right String
escaped -> do
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 a. a -> ParsecT String () (Reader ParsingContext) a
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 a b. a -> ParsecT s u m b -> ParsecT s u m a
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))
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
parseExpressionString :: Parser String
parseExpressionString :: ParsecT String () (Reader ParsingContext) String
parseExpressionString = do
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
[String]
res <- ParsecT String () (Reader ParsingContext) String
-> ParsecT String () (Reader ParsingContext) [String]
forall a.
ParsecT String () (Reader ParsingContext) a
-> ParsecT String () (Reader ParsingContext) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (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
try (String -> ParsecT String () (Reader ParsingContext) String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"::" ParsecT String () (Reader ParsingContext) String
-> ParsecT String () (Reader ParsingContext) ()
-> ParsecT String () (Reader ParsingContext) String
forall a b.
ParsecT String () (Reader ParsingContext) a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (String -> ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"<>=^")) 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 -> String
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> String)
-> ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)))
String -> ParsecT String () (Reader ParsingContext) String
forall a. a -> ParsecT String () (Reader ParsingContext) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> ParsecT String () (Reader ParsingContext) String)
-> String -> ParsecT String () (Reader ParsingContext) String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
res
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
(HsExpr GhcPs, Exp)
expr <- [Extension]
-> ParsecT String () (Reader ParsingContext) String
-> Parser (HsExpr GhcPs, Exp)
evalExpr [Extension]
exts (ParsecT String () (Reader ParsingContext) String
parseExpressionString 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 a. a -> ParsecT String () (Reader ParsingContext) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((HsExpr GhcPs, Exp) -> Maybe FormatMode -> Item
Replacement (HsExpr GhcPs, Exp)
expr Maybe FormatMode
fmt)
pattern DefaultFormatMode :: FormatMode
pattern $mDefaultFormatMode :: forall {r}. FormatMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bDefaultFormatMode :: FormatMode
DefaultFormatMode = FormatMode PaddingDefault (DefaultF PrecisionDefault Minus) Nothing
data FormatMode = FormatMode Padding TypeFormat (Maybe Char)
data Padding
= PaddingDefault
| Padding (ExprOrValue Int) (Maybe (Maybe Char, AnyAlign))
data ExprOrValue t
= Value t
| HaskellExpr (HsExpr GhcPs, Exp)
deriving (Typeable (ExprOrValue t)
Typeable (ExprOrValue t) =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExprOrValue t -> c (ExprOrValue t))
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ExprOrValue t))
-> (ExprOrValue t -> Constr)
-> (ExprOrValue t -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ExprOrValue t)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ExprOrValue t)))
-> ((forall b. Data b => b -> b) -> ExprOrValue t -> ExprOrValue t)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExprOrValue t -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExprOrValue t -> r)
-> (forall u. (forall d. Data d => d -> u) -> ExprOrValue t -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> ExprOrValue t -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ExprOrValue t -> m (ExprOrValue t))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExprOrValue t -> m (ExprOrValue t))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExprOrValue t -> m (ExprOrValue t))
-> Data (ExprOrValue t)
ExprOrValue t -> Constr
ExprOrValue t -> DataType
(forall b. Data b => b -> b) -> ExprOrValue t -> ExprOrValue t
forall t. Data t => Typeable (ExprOrValue t)
forall t. Data t => ExprOrValue t -> Constr
forall t. Data t => ExprOrValue t -> DataType
forall t.
Data t =>
(forall b. Data b => b -> b) -> ExprOrValue t -> ExprOrValue t
forall t u.
Data t =>
Int -> (forall d. Data d => d -> u) -> ExprOrValue t -> u
forall t u.
Data t =>
(forall d. Data d => d -> u) -> ExprOrValue t -> [u]
forall t r r'.
Data t =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExprOrValue t -> r
forall t r r'.
Data t =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExprOrValue t -> r
forall t (m :: * -> *).
(Data t, Monad m) =>
(forall d. Data d => d -> m d)
-> ExprOrValue t -> m (ExprOrValue t)
forall t (m :: * -> *).
(Data t, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ExprOrValue t -> m (ExprOrValue t)
forall t (c :: * -> *).
Data t =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ExprOrValue t)
forall t (c :: * -> *).
Data t =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExprOrValue t -> c (ExprOrValue t)
forall t (t :: * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ExprOrValue t))
forall t (t :: * -> * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ExprOrValue t))
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ExprOrValue t -> u
forall u. (forall d. Data d => d -> u) -> ExprOrValue t -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExprOrValue t -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExprOrValue t -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ExprOrValue t -> m (ExprOrValue t)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExprOrValue t -> m (ExprOrValue t)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ExprOrValue t)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExprOrValue t -> c (ExprOrValue t)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ExprOrValue t))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ExprOrValue t))
$cgfoldl :: forall t (c :: * -> *).
Data t =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExprOrValue t -> c (ExprOrValue t)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExprOrValue t -> c (ExprOrValue t)
$cgunfold :: forall t (c :: * -> *).
Data t =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ExprOrValue t)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ExprOrValue t)
$ctoConstr :: forall t. Data t => ExprOrValue t -> Constr
toConstr :: ExprOrValue t -> Constr
$cdataTypeOf :: forall t. Data t => ExprOrValue t -> DataType
dataTypeOf :: ExprOrValue t -> DataType
$cdataCast1 :: forall t (t :: * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ExprOrValue t))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ExprOrValue t))
$cdataCast2 :: forall t (t :: * -> * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ExprOrValue t))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ExprOrValue t))
$cgmapT :: forall t.
Data t =>
(forall b. Data b => b -> b) -> ExprOrValue t -> ExprOrValue t
gmapT :: (forall b. Data b => b -> b) -> ExprOrValue t -> ExprOrValue t
$cgmapQl :: forall t r r'.
Data t =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExprOrValue t -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExprOrValue t -> r
$cgmapQr :: forall t r r'.
Data t =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExprOrValue t -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExprOrValue t -> r
$cgmapQ :: forall t u.
Data t =>
(forall d. Data d => d -> u) -> ExprOrValue t -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ExprOrValue t -> [u]
$cgmapQi :: forall t u.
Data t =>
Int -> (forall d. Data d => d -> u) -> ExprOrValue t -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ExprOrValue t -> u
$cgmapM :: forall t (m :: * -> *).
(Data t, Monad m) =>
(forall d. Data d => d -> m d)
-> ExprOrValue t -> m (ExprOrValue t)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ExprOrValue t -> m (ExprOrValue t)
$cgmapMp :: forall t (m :: * -> *).
(Data t, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ExprOrValue t -> m (ExprOrValue t)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExprOrValue t -> m (ExprOrValue t)
$cgmapMo :: forall t (m :: * -> *).
(Data t, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ExprOrValue t -> m (ExprOrValue t)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExprOrValue t -> m (ExprOrValue t)
Data)
data Precision
= PrecisionDefault
| Precision (ExprOrValue Int)
deriving (Typeable Precision
Typeable Precision =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Precision -> c Precision)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Precision)
-> (Precision -> Constr)
-> (Precision -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Precision))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Precision))
-> ((forall b. Data b => b -> b) -> Precision -> Precision)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Precision -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Precision -> r)
-> (forall u. (forall d. Data d => d -> u) -> Precision -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> Precision -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Precision -> m Precision)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Precision -> m Precision)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Precision -> m Precision)
-> Data Precision
Precision -> Constr
Precision -> DataType
(forall b. Data b => b -> b) -> Precision -> Precision
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Precision -> u
forall u. (forall d. Data d => d -> u) -> Precision -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Precision -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Precision -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Precision -> m Precision
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Precision -> m Precision
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Precision
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Precision -> c Precision
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Precision)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Precision)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Precision -> c Precision
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Precision -> c Precision
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Precision
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Precision
$ctoConstr :: Precision -> Constr
toConstr :: Precision -> Constr
$cdataTypeOf :: Precision -> DataType
dataTypeOf :: Precision -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Precision)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Precision)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Precision)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Precision)
$cgmapT :: (forall b. Data b => b -> b) -> Precision -> Precision
gmapT :: (forall b. Data b => b -> b) -> Precision -> Precision
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Precision -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Precision -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Precision -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Precision -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Precision -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Precision -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Precision -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Precision -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Precision -> m Precision
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Precision -> m Precision
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Precision -> m Precision
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Precision -> m Precision
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Precision -> m Precision
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Precision -> m Precision
Data)
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
$cshowsPrec :: Int -> TypeFlag -> ShowS
showsPrec :: Int -> TypeFlag -> ShowS
$cshow :: TypeFlag -> String
show :: TypeFlag -> String
$cshowList :: [TypeFlag] -> ShowS
showList :: [TypeFlag] -> ShowS
Show)
data TypeFormat
=
DefaultF Precision SignMode
|
BinaryF AlternateForm SignMode
|
CharacterF
|
DecimalF SignMode
|
ExponentialF Precision AlternateForm SignMode
|
ExponentialCapsF Precision AlternateForm SignMode
|
FixedF Precision AlternateForm SignMode
|
FixedCapsF Precision AlternateForm SignMode
|
GeneralF Precision AlternateForm SignMode
|
GeneralCapsF Precision AlternateForm SignMode
|
OctalF AlternateForm SignMode
|
StringF Precision
|
HexF AlternateForm SignMode
|
HexCapsF AlternateForm SignMode
|
PercentF Precision AlternateForm SignMode
deriving (Typeable TypeFormat
Typeable TypeFormat =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeFormat -> c TypeFormat)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeFormat)
-> (TypeFormat -> Constr)
-> (TypeFormat -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeFormat))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TypeFormat))
-> ((forall b. Data b => b -> b) -> TypeFormat -> TypeFormat)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeFormat -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeFormat -> r)
-> (forall u. (forall d. Data d => d -> u) -> TypeFormat -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> TypeFormat -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeFormat -> m TypeFormat)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeFormat -> m TypeFormat)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeFormat -> m TypeFormat)
-> Data TypeFormat
TypeFormat -> Constr
TypeFormat -> DataType
(forall b. Data b => b -> b) -> TypeFormat -> TypeFormat
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TypeFormat -> u
forall u. (forall d. Data d => d -> u) -> TypeFormat -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeFormat -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeFormat -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeFormat -> m TypeFormat
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeFormat -> m TypeFormat
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeFormat
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeFormat -> c TypeFormat
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeFormat)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeFormat)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeFormat -> c TypeFormat
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeFormat -> c TypeFormat
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeFormat
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeFormat
$ctoConstr :: TypeFormat -> Constr
toConstr :: TypeFormat -> Constr
$cdataTypeOf :: TypeFormat -> DataType
dataTypeOf :: TypeFormat -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeFormat)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeFormat)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeFormat)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeFormat)
$cgmapT :: (forall b. Data b => b -> b) -> TypeFormat -> TypeFormat
gmapT :: (forall b. Data b => b -> b) -> TypeFormat -> TypeFormat
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeFormat -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeFormat -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeFormat -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeFormat -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TypeFormat -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TypeFormat -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeFormat -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeFormat -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeFormat -> m TypeFormat
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeFormat -> m TypeFormat
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeFormat -> m TypeFormat
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeFormat -> m TypeFormat
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeFormat -> m TypeFormat
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeFormat -> m TypeFormat
Data)
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
$cshowsPrec :: Int -> AlternateForm -> ShowS
showsPrec :: Int -> AlternateForm -> ShowS
$cshow :: AlternateForm -> String
show :: AlternateForm -> String
$cshowList :: [AlternateForm] -> ShowS
showList :: [AlternateForm] -> ShowS
Show, Typeable AlternateForm
Typeable AlternateForm =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AlternateForm -> c AlternateForm)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AlternateForm)
-> (AlternateForm -> Constr)
-> (AlternateForm -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AlternateForm))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AlternateForm))
-> ((forall b. Data b => b -> b) -> AlternateForm -> AlternateForm)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AlternateForm -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AlternateForm -> r)
-> (forall u. (forall d. Data d => d -> u) -> AlternateForm -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> AlternateForm -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AlternateForm -> m AlternateForm)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AlternateForm -> m AlternateForm)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AlternateForm -> m AlternateForm)
-> Data AlternateForm
AlternateForm -> Constr
AlternateForm -> DataType
(forall b. Data b => b -> b) -> AlternateForm -> AlternateForm
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> AlternateForm -> u
forall u. (forall d. Data d => d -> u) -> AlternateForm -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AlternateForm -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AlternateForm -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AlternateForm -> m AlternateForm
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AlternateForm -> m AlternateForm
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AlternateForm
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AlternateForm -> c AlternateForm
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AlternateForm)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AlternateForm)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AlternateForm -> c AlternateForm
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AlternateForm -> c AlternateForm
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AlternateForm
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AlternateForm
$ctoConstr :: AlternateForm -> Constr
toConstr :: AlternateForm -> Constr
$cdataTypeOf :: AlternateForm -> DataType
dataTypeOf :: AlternateForm -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AlternateForm)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AlternateForm)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AlternateForm)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AlternateForm)
$cgmapT :: (forall b. Data b => b -> b) -> AlternateForm -> AlternateForm
gmapT :: (forall b. Data b => b -> b) -> AlternateForm -> AlternateForm
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AlternateForm -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AlternateForm -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AlternateForm -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AlternateForm -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AlternateForm -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> AlternateForm -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AlternateForm -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AlternateForm -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AlternateForm -> m AlternateForm
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AlternateForm -> m AlternateForm
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AlternateForm -> m AlternateForm
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AlternateForm -> m AlternateForm
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AlternateForm -> m AlternateForm
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AlternateForm -> m AlternateForm
Data)
evalExpr :: [Extension] -> Parser String -> Parser (HsExpr GhcPs, Exp)
evalExpr :: [Extension]
-> ParsecT String () (Reader ParsingContext) String
-> Parser (HsExpr GhcPs, Exp)
evalExpr [Extension]
exts ParsecT String () (Reader ParsingContext) String
exprParser = do
SourcePos
exprPos <- ParsecT String () (Reader ParsingContext) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
let initLoc :: RealSrcLoc
initLoc = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (String -> FastString
mkFastString (SourcePos -> String
sourceName SourcePos
exprPos)) (SourcePos -> Int
sourceLine SourcePos
exprPos) (SourcePos -> Int
sourceColumn SourcePos
exprPos)
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
let dynFlags :: DynFlags
dynFlags = [Extension] -> DynFlags
baseDynFlags [Extension]
exts
case RealSrcLoc
-> String -> DynFlags -> Either (Int, Int, String) (HsExpr GhcPs)
ParseExp.parseExpression RealSrcLoc
initLoc String
s DynFlags
dynFlags of
Right HsExpr GhcPs
expr -> do
ParsecT String () (Reader ParsingContext) String
-> ParsecT String () (Reader ParsingContext) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT String () (Reader ParsingContext) String
exprParser
(HsExpr GhcPs, Exp) -> Parser (HsExpr GhcPs, Exp)
forall a. a -> ParsecT String () (Reader ParsingContext) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr GhcPs
expr, DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
dynFlags HsExpr GhcPs
expr)
Left (Int
lineError, Int
colError, String
err) -> do
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
- SourcePos -> Int
sourceLine SourcePos
exprPos) (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)
let columnSkip :: Int
columnSkip
| Int
lineError Int -> Int -> Int
forall a. Num a => a -> a -> a
- SourcePos -> Int
sourceLine SourcePos
exprPos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int
colError Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- SourcePos -> Int
sourceColumn SourcePos
exprPos
| Bool
otherwise = Int
colError Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
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
columnSkip ParsecT String () (Reader ParsingContext) Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
String -> Parser (HsExpr GhcPs, Exp)
forall a. String -> ParsecT String () (Reader ParsingContext) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (HsExpr GhcPs, Exp))
-> String -> Parser (HsExpr GhcPs, 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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 (ExprOrValue Int)
w <- ParsecT String () (Reader ParsingContext) (ExprOrValue Int)
-> ParsecT
String () (Reader ParsingContext) (Maybe (ExprOrValue Int))
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) (ExprOrValue Int)
parseWidth
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 (ExprOrValue Int)
w of
Just ExprOrValue Int
p -> ExprOrValue Int -> Maybe (Maybe Char, AnyAlign) -> Padding
Padding ExprOrValue Int
p Maybe (Maybe Char, AnyAlign)
al
Maybe (ExprOrValue Int)
Nothing -> Padding
PaddingDefault
case Maybe TypeFlag
t of
Maybe TypeFlag
Nothing -> FormatMode -> ParsecT String () (Reader ParsingContext) FormatMode
forall a. a -> ParsecT String () (Reader ParsingContext) a
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
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 a. a -> ParsecT String () (Reader ParsingContext) a
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 a. String -> ParsecT String () (Reader ParsingContext) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
typeError
parseWidth :: Parser (ExprOrValue Int)
parseWidth :: ParsecT String () (Reader ParsingContext) (ExprOrValue Int)
parseWidth = 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
[ParsecT String () (Reader ParsingContext) (ExprOrValue Int)]
-> ParsecT String () (Reader ParsingContext) (ExprOrValue Int)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
[ Int -> ExprOrValue Int
forall t. t -> ExprOrValue t
Value (Int -> ExprOrValue Int)
-> ParsecT String () (Reader ParsingContext) Int
-> ParsecT String () (Reader ParsingContext) (ExprOrValue Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () (Reader ParsingContext) Int
width,
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) (ExprOrValue Int)
-> ParsecT String () (Reader ParsingContext) (ExprOrValue Int)
forall a b.
ParsecT String () (Reader ParsingContext) a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((HsExpr GhcPs, Exp) -> ExprOrValue Int
forall t. (HsExpr GhcPs, Exp) -> ExprOrValue t
HaskellExpr ((HsExpr GhcPs, Exp) -> ExprOrValue Int)
-> Parser (HsExpr GhcPs, Exp)
-> ParsecT String () (Reader ParsingContext) (ExprOrValue Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Extension]
-> ParsecT String () (Reader ParsingContext) String
-> Parser (HsExpr GhcPs, 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"))
]
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 Int -> Precision
Precision (ExprOrValue Int -> Precision)
-> (Int -> ExprOrValue Int) -> Int -> Precision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ExprOrValue Int
forall t. t -> ExprOrValue t
Value (Int -> Precision)
-> ParsecT String () (Reader ParsingContext) Int
-> ParsecT String () (Reader ParsingContext) Precision
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () (Reader ParsingContext) Int
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 a b.
ParsecT String () (Reader ParsingContext) a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ExprOrValue Int -> Precision
Precision (ExprOrValue Int -> Precision)
-> ((HsExpr GhcPs, Exp) -> ExprOrValue Int)
-> (HsExpr GhcPs, Exp)
-> Precision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsExpr GhcPs, Exp) -> ExprOrValue Int
forall t. (HsExpr GhcPs, Exp) -> ExprOrValue t
HaskellExpr ((HsExpr GhcPs, Exp) -> Precision)
-> Parser (HsExpr GhcPs, 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 (HsExpr GhcPs, 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"))
]
someTill :: Stream s m t => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
someTill :: 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 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 a b.
ParsecT s u m (a -> b) -> ParsecT s u m a -> ParsecT s u m b
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 a. a -> Either String a
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 a. a -> Either String a
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 a. a -> Either String a
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 a. a -> Either String a
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 a. a -> Either String a
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 a. a -> Either String a
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 a. a -> Either String a
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 ExprOrValue Int
_ (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 Int
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 Int
e of
Value Int
v -> Int -> String
forall a. Show a => a -> String
show Int
v
HaskellExpr (HsExpr GhcPs
_, 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 a. a -> ParsecT String () (Reader ParsingContext) a
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 a. a -> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 Int
width :: ParsecT String () (Reader ParsingContext) Int
width = ParsecT String () (Reader ParsingContext) Int
integer
integer :: Parser Int
integer :: ParsecT String () (Reader ParsingContext) Int
integer = String -> Int
forall a. Read a => String -> a
read (String -> Int)
-> ParsecT String () (Reader ParsingContext) String
-> ParsecT String () (Reader ParsingContext) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () (Reader ParsingContext) Char
-> ParsecT String () (Reader ParsingContext) String
forall a.
ParsecT String () (Reader ParsingContext) a
-> ParsecT String () (Reader ParsingContext) [a]
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'])
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 Int
precision :: ParsecT String () (Reader ParsingContext) Int
precision = ParsecT String () (Reader ParsingContext) Int
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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 a b.
a
-> ParsecT String () (Reader ParsingContext) b
-> ParsecT String () (Reader ParsingContext) a
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
'%'
]