{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module PyF.Internal.QQ
( toExp,
Config (..),
wrapFromString,
expQQ,
)
where
import Control.Monad.Reader
import Data.Data (Data (gmapQ), Typeable, cast)
import Data.Kind
import Data.List (intercalate)
import Data.Maybe (catMaybes, fromMaybe, isJust)
import Data.Proxy
import Data.String (fromString)
#if MIN_VERSION_ghc(9,0,0)
import GHC.Tc.Utils.Monad (addErrAt)
import GHC.Tc.Types (TcM)
import GHC.Types.Name (occNameString)
#else
import OccName
import TcRnTypes (TcM)
import TcRnMonad (addErrAt)
#endif
#if MIN_VERSION_ghc(9,6,0)
#else
import GHC (moduleNameString)
#endif
#if MIN_VERSION_ghc(9,3,0)
import GHC.Tc.Errors.Types
import GHC.Types.Error
import GHC.Utils.Outputable (text)
#if MIN_VERSION_ghc(9,6,0)
#else
import GHC.Driver.Errors.Types
import GHC.Parser.Errors.Types
#endif
#endif
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.Name.Reader
#else
import RdrName
#endif
#if MIN_VERSION_ghc(8,10,0)
import GHC.Hs.Expr as Expr
import GHC.Hs.Extension as Ext
import GHC.Hs.Pat as Pat
#else
import HsExpr as Expr
import HsExtension as Ext
import HsPat as Pat
#endif
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.SrcLoc
#else
import SrcLoc
#endif
#if MIN_VERSION_ghc(9,2,0)
import GHC.Hs
#endif
import GHC.TypeLits
import Language.Haskell.TH hiding (Type)
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax (Q (Q))
import PyF.Class
import PyF.Formatters (AnyAlign (..))
import qualified PyF.Formatters as Formatters
import PyF.Internal.Meta (toName)
import PyF.Internal.PythonSyntax
import Text.Parsec
import Text.Parsec.Error
( errorMessages,
messageString,
showErrorMessages,
)
import Text.Parsec.Pos (initialPos)
import Text.ParserCombinators.Parsec.Error (Message (..))
import Unsafe.Coerce (unsafeCoerce)
data Config = Config
{
Config -> Maybe (Char, Char)
delimiters :: Maybe (Char, Char),
Config -> Q Exp -> Q Exp
postProcess :: Q Exp -> Q Exp
}
expQQ :: String -> (String -> Q Exp) -> QuasiQuoter
expQQ :: String -> (String -> Q Exp) -> QuasiQuoter
expQQ String
fName String -> Q Exp
qExp =
QuasiQuoter
{ quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
qExp,
quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall t. String -> t
err String
"pattern",
quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall t. String -> t
err String
"type",
quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall t. String -> t
err String
"declaration"
}
where
err :: String -> t
err :: forall t. String -> t
err String
name = String -> t
forall a. HasCallStack => String -> a
error (String
fName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": This QuasiQuoter can not be used as a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"!")
wrapFromString :: ExpQ -> Q Exp
wrapFromString :: Q Exp -> Q Exp
wrapFromString Q Exp
e = do
[Extension]
exts <- Q [Extension]
extsEnabled
if Extension
OverloadedStrings Extension -> [Extension] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Extension]
exts
then [|fromString $(Q Exp
e)|]
else Q Exp
e
toExp :: Config -> String -> Q Exp
toExp :: Config -> String -> Q Exp
toExp Config {delimiters :: Config -> Maybe (Char, Char)
delimiters = Maybe (Char, Char)
expressionDelimiters, Q Exp -> Q Exp
postProcess :: Config -> Q Exp -> Q Exp
postProcess :: Q Exp -> Q Exp
postProcess} String
s = do
Loc
loc <- Q Loc
location
[Extension]
exts <- Q [Extension]
extsEnabled
let context :: ParsingContext
context = Maybe (Char, Char) -> [Extension] -> ParsingContext
ParsingContext Maybe (Char, Char)
expressionDelimiters [Extension]
exts
let filename :: String
filename = Loc -> String
loc_filename Loc
loc
let initPos :: SourcePos
initPos = SourcePos -> Int -> SourcePos
setSourceColumn (SourcePos -> Int -> SourcePos
setSourceLine (String -> SourcePos
initialPos String
filename) ((Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Loc -> (Int, Int)
loc_start Loc
loc)) ((Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Loc -> (Int, Int)
loc_start Loc
loc)
case Reader ParsingContext (Either ParseError [Item])
-> ParsingContext -> Either ParseError [Item]
forall r a. Reader r a -> r -> a
runReader (ParsecT String () (ReaderT ParsingContext Identity) [Item]
-> ()
-> String
-> String
-> Reader ParsingContext (Either ParseError [Item])
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT (SourcePos -> ParsecT String () (ReaderT ParsingContext Identity) ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
initPos ParsecT String () (ReaderT ParsingContext Identity) ()
-> ParsecT String () (ReaderT ParsingContext Identity) [Item]
-> ParsecT String () (ReaderT ParsingContext Identity) [Item]
forall a b.
ParsecT String () (ReaderT ParsingContext Identity) a
-> ParsecT String () (ReaderT ParsingContext Identity) b
-> ParsecT String () (ReaderT ParsingContext Identity) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String () (ReaderT ParsingContext Identity) [Item]
parseGenericFormatString) () String
filename String
s) ParsingContext
context of
Left ParseError
err -> do
ParseError -> Q ()
reportParserErrorAt ParseError
err
[|()|]
Right [Item]
items -> do
Maybe (SrcSpan, String)
checkResult <- [Item] -> Q (Maybe (SrcSpan, String))
checkVariables [Item]
items
case Maybe (SrcSpan, String)
checkResult of
Maybe (SrcSpan, String)
Nothing -> Q Exp -> Q Exp
postProcess ([Item] -> Q Exp
goFormat [Item]
items)
Just (SrcSpan
srcSpan, String
msg) -> do
SrcSpan -> String -> Q ()
reportErrorAt SrcSpan
srcSpan String
msg
[|()|]
findFreeVariablesInFormatMode :: Maybe FormatMode -> [(SrcSpan, RdrName)]
findFreeVariablesInFormatMode :: Maybe FormatMode -> [(SrcSpan, RdrName)]
findFreeVariablesInFormatMode Maybe FormatMode
Nothing = []
findFreeVariablesInFormatMode (Just (FormatMode Padding
padding TypeFormat
tf Maybe Char
_ )) = TypeFormat -> [(SrcSpan, RdrName)]
forall a. Data a => a -> [(SrcSpan, RdrName)]
findFreeVariables TypeFormat
tf [(SrcSpan, RdrName)]
-> [(SrcSpan, RdrName)] -> [(SrcSpan, RdrName)]
forall a. Semigroup a => a -> a -> a
<> case Padding
padding of
Padding
PaddingDefault -> []
Padding ExprOrValue Int
eoi Maybe (Maybe Char, AnyAlign)
_ -> ExprOrValue Int -> [(SrcSpan, RdrName)]
forall a. Data a => a -> [(SrcSpan, RdrName)]
findFreeVariables ExprOrValue Int
eoi
checkOneItem :: Item -> Q (Maybe (SrcSpan, String))
checkOneItem :: Item -> Q (Maybe (SrcSpan, String))
checkOneItem (Raw String
_) = Maybe (SrcSpan, String) -> Q (Maybe (SrcSpan, String))
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (SrcSpan, String)
forall a. Maybe a
Nothing
checkOneItem (Replacement (HsExpr GhcPs
hsExpr, Exp
_) Maybe FormatMode
formatMode) = do
let allNames :: [(SrcSpan, RdrName)]
allNames = HsExpr GhcPs -> [(SrcSpan, RdrName)]
forall a. Data a => a -> [(SrcSpan, RdrName)]
findFreeVariables HsExpr GhcPs
hsExpr [(SrcSpan, RdrName)]
-> [(SrcSpan, RdrName)] -> [(SrcSpan, RdrName)]
forall a. Semigroup a => a -> a -> a
<> Maybe FormatMode -> [(SrcSpan, RdrName)]
findFreeVariablesInFormatMode Maybe FormatMode
formatMode
[Maybe (String, SrcSpan)]
res <- ((SrcSpan, RdrName) -> Q (Maybe (String, SrcSpan)))
-> [(SrcSpan, RdrName)] -> Q [Maybe (String, SrcSpan)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (SrcSpan, RdrName) -> Q (Maybe (String, SrcSpan))
forall b. (b, RdrName) -> Q (Maybe (String, b))
doesExists [(SrcSpan, RdrName)]
allNames
let resFinal :: [(String, SrcSpan)]
resFinal = [Maybe (String, SrcSpan)] -> [(String, SrcSpan)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (String, SrcSpan)]
res
case [(String, SrcSpan)]
resFinal of
[] -> Maybe (SrcSpan, String) -> Q (Maybe (SrcSpan, String))
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (SrcSpan, String)
forall a. Maybe a
Nothing
((String
err, SrcSpan
span) : [(String, SrcSpan)]
_) -> Maybe (SrcSpan, String) -> Q (Maybe (SrcSpan, String))
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (SrcSpan, String) -> Q (Maybe (SrcSpan, String)))
-> Maybe (SrcSpan, String) -> Q (Maybe (SrcSpan, String))
forall a b. (a -> b) -> a -> b
$ (SrcSpan, String) -> Maybe (SrcSpan, String)
forall a. a -> Maybe a
Just (SrcSpan
span, String
err)
findFreeVariables :: Data a => a -> [(SrcSpan, RdrName)]
findFreeVariables :: forall a. Data a => a -> [(SrcSpan, RdrName)]
findFreeVariables a
item = [(SrcSpan, RdrName)]
allNames
where
f :: forall a. (Data a, Typeable a) => a -> [Located RdrName]
f :: forall a. (Data a, Typeable a) => a -> [Located RdrName]
f a
e = case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast @_ @(HsExpr GhcPs) a
e of
#if MIN_VERSION_ghc(9,2,0)
Just (HsVar XVar GhcPs
_ l :: LIdP GhcPs
l@(L SrcSpanAnn' (EpAnn NameAnn)
a RdrName
_)) -> [SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnn' (EpAnn NameAnn) -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' (EpAnn NameAnn)
a) (GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
l)]
#else
Just (HsVar _ l) -> [l]
#endif
#if MIN_VERSION_ghc(9,10,0)
Just (HsLam _ _ (MG _ (unLoc -> (map unLoc -> [Expr.Match _ _ (map unLoc -> ps) (GRHSs _ [unLoc -> GRHS _ _ (unLoc -> e)] _)])))) -> filter keepVar subVars
#elif MIN_VERSION_ghc(9,6,0)
Just (HsLam XLam GhcPs
_ (MG XMG GhcPs (LHsExpr GhcPs)
_ (XRec GhcPs [LMatch GhcPs (LHsExpr GhcPs)]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. GenLocated l e -> e
unLoc -> ((GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall l e. GenLocated l e -> e
unLoc -> [Expr.Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ HsMatchContext GhcPs
_ ((GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs)
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [Pat GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
unLoc -> [Pat GhcPs]
ps) (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall l e. GenLocated l e -> e
unLoc -> GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [GuardLStmt GhcPs]
_ (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc -> HsExpr GhcPs
e)] HsLocalBinds GhcPs
_)])))) -> (Located RdrName -> Bool) -> [Located RdrName] -> [Located RdrName]
forall a. (a -> Bool) -> [a] -> [a]
filter Located RdrName -> Bool
keepVar [Located RdrName]
subVars
#else
Just (HsLam _ (MG _ (unLoc -> (map unLoc -> [Expr.Match _ _ (map unLoc -> ps) (GRHSs _ [unLoc -> GRHS _ _ (unLoc -> e)] _)])) _)) -> filter keepVar subVars
#endif
where
keepVar :: Located RdrName -> Bool
keepVar (L SrcSpan
_ RdrName
n) = RdrName
n RdrName -> [RdrName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [RdrName]
subPats
subVars :: [Located RdrName]
subVars = [[Located RdrName]] -> [Located RdrName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Located RdrName]] -> [Located RdrName])
-> [[Located RdrName]] -> [Located RdrName]
forall a b. (a -> b) -> a -> b
$ (forall d. Data d => d -> [Located RdrName])
-> [HsExpr GhcPs] -> [[Located RdrName]]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
forall u. (forall d. Data d => d -> u) -> [HsExpr GhcPs] -> [u]
gmapQ d -> [Located RdrName]
forall d. Data d => d -> [Located RdrName]
forall a. (Data a, Typeable a) => a -> [Located RdrName]
f [HsExpr GhcPs
e]
subPats :: [RdrName]
subPats = [[RdrName]] -> [RdrName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[RdrName]] -> [RdrName]) -> [[RdrName]] -> [RdrName]
forall a b. (a -> b) -> a -> b
$ (forall d. Data d => d -> [RdrName]) -> [Pat GhcPs] -> [[RdrName]]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
forall u. (forall d. Data d => d -> u) -> [Pat GhcPs] -> [u]
gmapQ d -> [RdrName]
forall d. Data d => d -> [RdrName]
forall a. (Data a, Typeable a) => a -> [RdrName]
findPats [Pat GhcPs]
ps
Maybe (HsExpr GhcPs)
_ -> [[Located RdrName]] -> [Located RdrName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Located RdrName]] -> [Located RdrName])
-> [[Located RdrName]] -> [Located RdrName]
forall a b. (a -> b) -> a -> b
$ (forall d. Data d => d -> [Located RdrName])
-> a -> [[Located RdrName]]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
forall u. (forall d. Data d => d -> u) -> a -> [u]
gmapQ d -> [Located RdrName]
forall d. Data d => d -> [Located RdrName]
forall a. (Data a, Typeable a) => a -> [Located RdrName]
f a
e
findPats :: forall a. (Data a, Typeable a) => a -> [RdrName]
findPats :: forall a. (Data a, Typeable a) => a -> [RdrName]
findPats a
p = case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast @_ @(Pat.Pat GhcPs) a
p of
Just (VarPat XVarPat GhcPs
_ (LIdP GhcPs -> RdrName
GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc -> RdrName
name)) -> [RdrName
name]
Maybe (Pat GhcPs)
_ -> [[RdrName]] -> [RdrName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[RdrName]] -> [RdrName]) -> [[RdrName]] -> [RdrName]
forall a b. (a -> b) -> a -> b
$ (forall d. Data d => d -> [RdrName]) -> a -> [[RdrName]]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
forall u. (forall d. Data d => d -> u) -> a -> [u]
gmapQ d -> [RdrName]
forall d. Data d => d -> [RdrName]
forall a. (Data a, Typeable a) => a -> [RdrName]
findPats a
p
allVars :: [Located RdrName]
allVars = [[Located RdrName]] -> [Located RdrName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Located RdrName]] -> [Located RdrName])
-> [[Located RdrName]] -> [Located RdrName]
forall a b. (a -> b) -> a -> b
$ (forall d. Data d => d -> [Located RdrName])
-> [a] -> [[Located RdrName]]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
forall u. (forall d. Data d => d -> u) -> [a] -> [u]
gmapQ d -> [Located RdrName]
forall d. Data d => d -> [Located RdrName]
forall a. (Data a, Typeable a) => a -> [Located RdrName]
f [a
item]
allNames :: [(SrcSpan, RdrName)]
allNames = (Located RdrName -> (SrcSpan, RdrName))
-> [Located RdrName] -> [(SrcSpan, RdrName)]
forall a b. (a -> b) -> [a] -> [b]
map (\(L SrcSpan
l RdrName
e) -> (SrcSpan
l, RdrName
e)) [Located RdrName]
allVars
lookupName :: RdrName -> Q Bool
lookupName :: RdrName -> Q Bool
lookupName RdrName
n = case RdrName
n of
(Unqual OccName
o) -> Maybe Name -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Name -> Bool) -> Q (Maybe Name) -> Q Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q (Maybe Name)
lookupValueName (OccName -> String
occNameString OccName
o)
(Qual ModuleName
m OccName
o) -> Maybe Name -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Name -> Bool) -> Q (Maybe Name) -> Q Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q (Maybe Name)
lookupValueName (ModuleName -> String
moduleNameString ModuleName
m String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> OccName -> String
occNameString OccName
o)
(Orig Module
_m OccName
_o) -> Bool -> Q Bool
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
(Exact Name
_) -> Bool -> Q Bool
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
doesExists :: (b, RdrName) -> Q (Maybe (String, b))
doesExists :: forall b. (b, RdrName) -> Q (Maybe (String, b))
doesExists (b
loc, RdrName
name) = do
Bool
res <- RdrName -> Q Bool
lookupName RdrName
name
if Bool
res
then Maybe (String, b) -> Q (Maybe (String, b))
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (String, b)
forall a. Maybe a
Nothing
else Maybe (String, b) -> Q (Maybe (String, b))
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String, b) -> Maybe (String, b)
forall a. a -> Maybe a
Just (String
"Variable not in scope: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Name -> String
forall a. Show a => a -> String
show (RdrName -> Name
toName RdrName
name), b
loc))
checkVariables :: [Item] -> Q (Maybe (SrcSpan, String))
checkVariables :: [Item] -> Q (Maybe (SrcSpan, String))
checkVariables [] = Maybe (SrcSpan, String) -> Q (Maybe (SrcSpan, String))
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (SrcSpan, String)
forall a. Maybe a
Nothing
checkVariables (Item
x : [Item]
xs) = do
Maybe (SrcSpan, String)
r <- Item -> Q (Maybe (SrcSpan, String))
checkOneItem Item
x
case Maybe (SrcSpan, String)
r of
Maybe (SrcSpan, String)
Nothing -> [Item] -> Q (Maybe (SrcSpan, String))
checkVariables [Item]
xs
Just (SrcSpan, String)
err -> Maybe (SrcSpan, String) -> Q (Maybe (SrcSpan, String))
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (SrcSpan, String) -> Q (Maybe (SrcSpan, String)))
-> Maybe (SrcSpan, String) -> Q (Maybe (SrcSpan, String))
forall a b. (a -> b) -> a -> b
$ (SrcSpan, String) -> Maybe (SrcSpan, String)
forall a. a -> Maybe a
Just (SrcSpan, String)
err
unsafeRunTcM :: TcM a -> Q a
unsafeRunTcM :: forall a. TcM a -> Q a
unsafeRunTcM TcM a
m = (forall (m :: * -> *). Quasi m => m a) -> Q a
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (TcM a -> m a
forall a b. a -> b
unsafeCoerce TcM a
m)
reportErrorAt :: SrcSpan -> String -> Q ()
reportErrorAt :: SrcSpan -> String -> Q ()
reportErrorAt SrcSpan
loc String
msg = TcM () -> Q ()
forall a. TcM a -> Q a
unsafeRunTcM (TcM () -> Q ()) -> TcM () -> Q ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> TcRnMessage -> TcM ()
addErrAt SrcSpan
loc TcRnMessage
msg'
where
#if MIN_VERSION_ghc(9,7,0)
msg' = TcRnUnknownMessage (UnknownDiagnostic (const NoDiagnosticOpts) (mkPlainError noHints (text msg)))
#elif MIN_VERSION_ghc(9,6,0)
msg' :: TcRnMessage
msg' = UnknownDiagnostic -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> UnknownDiagnostic
forall a.
(DiagnosticOpts a ~ NoDiagnosticOpts, Diagnostic a, Typeable a) =>
a -> UnknownDiagnostic
UnknownDiagnostic (DiagnosticMessage -> UnknownDiagnostic)
-> DiagnosticMessage -> UnknownDiagnostic
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
msg)
#elif MIN_VERSION_ghc(9,3,0)
msg' = TcRnUnknownMessage (GhcPsMessage $ PsUnknownMessage $ mkPlainError noHints $
text msg)
#else
msg' = fromString msg
#endif
reportParserErrorAt :: ParseError -> Q ()
reportParserErrorAt :: ParseError -> Q ()
reportParserErrorAt ParseError
err = SrcSpan -> String -> Q ()
reportErrorAt SrcSpan
span String
msg
where
msg :: String
msg = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ParseError -> [String]
formatErrorMessages ParseError
err
span :: SrcSpan
span :: SrcSpan
span = SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
loc SrcLoc
loc'
loc :: SrcLoc
loc = SourcePos -> SrcLoc
srcLocFromParserError (ParseError -> SourcePos
errorPos ParseError
err)
loc' :: SrcLoc
loc' = SourcePos -> SrcLoc
srcLocFromParserError (SourcePos -> Int -> SourcePos
incSourceColumn (ParseError -> SourcePos
errorPos ParseError
err) Int
1)
srcLocFromParserError :: SourcePos -> SrcLoc
srcLocFromParserError :: SourcePos -> SrcLoc
srcLocFromParserError SourcePos
sourceLoc = SrcLoc
srcLoc
where
line :: Int
line = SourcePos -> Int
sourceLine SourcePos
sourceLoc
column :: Int
column = SourcePos -> Int
sourceColumn SourcePos
sourceLoc
name :: String
name = SourcePos -> String
sourceName SourcePos
sourceLoc
srcLoc :: SrcLoc
srcLoc = FastString -> Int -> Int -> SrcLoc
mkSrcLoc (String -> FastString
forall a. IsString a => String -> a
fromString String
name) Int
line Int
column
formatErrorMessages :: ParseError -> [String]
formatErrorMessages :: ParseError -> [String]
formatErrorMessages ParseError
err
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Message] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
messages = (Message -> String) -> [Message] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Message -> String
messageString [Message]
messages
| Bool
otherwise = [String
-> String -> String -> String -> String -> [Message] -> String
showErrorMessages String
"or" String
"unknown parse error" String
"expecting" String
"unexpected" String
"end of input" (ParseError -> [Message]
errorMessages ParseError
err)]
where
([Message]
_sysUnExpect, [Message]
msgs1) = (Message -> Bool) -> [Message] -> ([Message], [Message])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (String -> Message
SysUnExpect String
"" Message -> Message -> Bool
forall a. Eq a => a -> a -> Bool
==) (ParseError -> [Message]
errorMessages ParseError
err)
([Message]
_unExpect, [Message]
msgs2) = (Message -> Bool) -> [Message] -> ([Message], [Message])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (String -> Message
UnExpect String
"" Message -> Message -> Bool
forall a. Eq a => a -> a -> Bool
==) [Message]
msgs1
([Message]
_expect, [Message]
messages) = (Message -> Bool) -> [Message] -> ([Message], [Message])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (String -> Message
Expect String
"" Message -> Message -> Bool
forall a. Eq a => a -> a -> Bool
==) [Message]
msgs2
goFormat :: [Item] -> Q Exp
goFormat :: [Item] -> Q Exp
goFormat [] = Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Lit -> Exp
LitE (String -> Lit
StringL String
"")
goFormat [Item]
items = (Exp -> Exp -> Exp) -> [Exp] -> Exp
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Exp -> Exp -> Exp
sappendQ ([Exp] -> Exp) -> Q [Exp] -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Item -> Q Exp) -> [Item] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Item -> Q Exp
toFormat [Item]
items
sappendQ :: Exp -> Exp -> Exp
sappendQ :: Exp -> Exp -> Exp
sappendQ Exp
s0 Exp
s1 = Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
s0) (Name -> Exp
VarE '(<>)) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
s1)
toFormat :: Item -> Q Exp
toFormat :: Item -> Q Exp
toFormat (Raw String
x) = Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Lit -> Exp
LitE (String -> Lit
StringL String
x)
toFormat (Replacement ( HsExpr GhcPs
_, Exp
expr) Maybe FormatMode
y) = do
Exp
formatExpr <- FormatMode -> Q Exp
padAndFormat (FormatMode -> Maybe FormatMode -> FormatMode
forall a. a -> Maybe a -> a
fromMaybe FormatMode
DefaultFormatMode Maybe FormatMode
y)
Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp
formatExpr Exp -> Exp -> Exp
`AppE` Exp
expr)
defaultFloatPrecision :: Maybe Int
defaultFloatPrecision :: Maybe Int
defaultFloatPrecision = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
6
splicePrecision :: Maybe Int -> Precision -> Q Exp
splicePrecision :: Maybe Int -> Precision -> Q Exp
splicePrecision Maybe Int
def Precision
PrecisionDefault = [|def :: Maybe Int|]
splicePrecision Maybe Int
_ (Precision ExprOrValue Int
p) = [|Just $(ExprOrValue Int -> Q Exp
exprToInt ExprOrValue Int
p)|]
toGrp :: Maybe Char -> Int -> Q Exp
toGrp :: Maybe Char -> Int -> Q Exp
toGrp Maybe Char
mb Int
a = [|grp|]
where
grp :: Maybe (Int, Char)
grp = (Int
a,) (Char -> (Int, Char)) -> Maybe Char -> Maybe (Int, Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char
mb
withAlt :: AlternateForm -> Formatters.Format t t' t'' -> Q Exp
withAlt :: forall (t :: AltStatus) (t' :: UpperStatus) (t'' :: FormatType).
AlternateForm -> Format t t' t'' -> Q Exp
withAlt AlternateForm
NormalForm Format t t' t''
e = [|e|]
withAlt AlternateForm
AlternateForm Format t t' t''
e = [|Formatters.Alternate e|]
padAndFormat :: FormatMode -> Q Exp
padAndFormat :: FormatMode -> Q Exp
padAndFormat (FormatMode Padding
padding TypeFormat
tf Maybe Char
grouping) = case TypeFormat
tf of
BinaryF AlternateForm
alt SignMode
s -> [|formatAnyIntegral $(AlternateForm -> Format 'CanAlt 'NoUpper 'Integral -> Q Exp
forall (t :: AltStatus) (t' :: UpperStatus) (t'' :: FormatType).
AlternateForm -> Format t t' t'' -> Q Exp
withAlt AlternateForm
alt Format 'CanAlt 'NoUpper 'Integral
Formatters.Binary) s $(Padding -> Q Exp
newPaddingQ Padding
padding) $(Maybe Char -> Int -> Q Exp
toGrp Maybe Char
grouping Int
4)|]
TypeFormat
CharacterF -> [|formatAnyIntegral Formatters.Character Formatters.Minus $(Padding -> Q Exp
newPaddingQ Padding
padding) Nothing|]
DecimalF SignMode
s -> [|formatAnyIntegral Formatters.Decimal s $(Padding -> Q Exp
newPaddingQ Padding
padding) $(Maybe Char -> Int -> Q Exp
toGrp Maybe Char
grouping Int
3)|]
HexF AlternateForm
alt SignMode
s -> [|formatAnyIntegral $(AlternateForm -> Format 'CanAlt 'CanUpper 'Integral -> Q Exp
forall (t :: AltStatus) (t' :: UpperStatus) (t'' :: FormatType).
AlternateForm -> Format t t' t'' -> Q Exp
withAlt AlternateForm
alt Format 'CanAlt 'CanUpper 'Integral
Formatters.Hexa) s $(Padding -> Q Exp
newPaddingQ Padding
padding) $(Maybe Char -> Int -> Q Exp
toGrp Maybe Char
grouping Int
4)|]
OctalF AlternateForm
alt SignMode
s -> [|formatAnyIntegral $(AlternateForm -> Format 'CanAlt 'NoUpper 'Integral -> Q Exp
forall (t :: AltStatus) (t' :: UpperStatus) (t'' :: FormatType).
AlternateForm -> Format t t' t'' -> Q Exp
withAlt AlternateForm
alt Format 'CanAlt 'NoUpper 'Integral
Formatters.Octal) s $(Padding -> Q Exp
newPaddingQ Padding
padding) $(Maybe Char -> Int -> Q Exp
toGrp Maybe Char
grouping Int
4)|]
HexCapsF AlternateForm
alt SignMode
s -> [|formatAnyIntegral (Formatters.Upper $(AlternateForm -> Format 'CanAlt 'CanUpper 'Integral -> Q Exp
forall (t :: AltStatus) (t' :: UpperStatus) (t'' :: FormatType).
AlternateForm -> Format t t' t'' -> Q Exp
withAlt AlternateForm
alt Format 'CanAlt 'CanUpper 'Integral
Formatters.Hexa)) s $(Padding -> Q Exp
newPaddingQ Padding
padding) $(Maybe Char -> Int -> Q Exp
toGrp Maybe Char
grouping Int
4)|]
ExponentialF Precision
prec AlternateForm
alt SignMode
s -> [|formatAnyFractional $(AlternateForm -> Format 'CanAlt 'CanUpper 'Fractional -> Q Exp
forall (t :: AltStatus) (t' :: UpperStatus) (t'' :: FormatType).
AlternateForm -> Format t t' t'' -> Q Exp
withAlt AlternateForm
alt Format 'CanAlt 'CanUpper 'Fractional
Formatters.Exponent) s $(Padding -> Q Exp
newPaddingQ Padding
padding) $(Maybe Char -> Int -> Q Exp
toGrp Maybe Char
grouping Int
3) $(Maybe Int -> Precision -> Q Exp
splicePrecision Maybe Int
defaultFloatPrecision Precision
prec)|]
ExponentialCapsF Precision
prec AlternateForm
alt SignMode
s -> [|formatAnyFractional (Formatters.Upper $(AlternateForm -> Format 'CanAlt 'CanUpper 'Fractional -> Q Exp
forall (t :: AltStatus) (t' :: UpperStatus) (t'' :: FormatType).
AlternateForm -> Format t t' t'' -> Q Exp
withAlt AlternateForm
alt Format 'CanAlt 'CanUpper 'Fractional
Formatters.Exponent)) s $(Padding -> Q Exp
newPaddingQ Padding
padding) $(Maybe Char -> Int -> Q Exp
toGrp Maybe Char
grouping Int
3) $(Maybe Int -> Precision -> Q Exp
splicePrecision Maybe Int
defaultFloatPrecision Precision
prec)|]
GeneralF Precision
prec AlternateForm
alt SignMode
s -> [|formatAnyFractional $(AlternateForm -> Format 'CanAlt 'CanUpper 'Fractional -> Q Exp
forall (t :: AltStatus) (t' :: UpperStatus) (t'' :: FormatType).
AlternateForm -> Format t t' t'' -> Q Exp
withAlt AlternateForm
alt Format 'CanAlt 'CanUpper 'Fractional
Formatters.Generic) s $(Padding -> Q Exp
newPaddingQ Padding
padding) $(Maybe Char -> Int -> Q Exp
toGrp Maybe Char
grouping Int
3) $(Maybe Int -> Precision -> Q Exp
splicePrecision Maybe Int
defaultFloatPrecision Precision
prec)|]
GeneralCapsF Precision
prec AlternateForm
alt SignMode
s -> [|formatAnyFractional (Formatters.Upper $(AlternateForm -> Format 'CanAlt 'CanUpper 'Fractional -> Q Exp
forall (t :: AltStatus) (t' :: UpperStatus) (t'' :: FormatType).
AlternateForm -> Format t t' t'' -> Q Exp
withAlt AlternateForm
alt Format 'CanAlt 'CanUpper 'Fractional
Formatters.Generic)) s $(Padding -> Q Exp
newPaddingQ Padding
padding) $(Maybe Char -> Int -> Q Exp
toGrp Maybe Char
grouping Int
3) $(Maybe Int -> Precision -> Q Exp
splicePrecision Maybe Int
defaultFloatPrecision Precision
prec)|]
FixedF Precision
prec AlternateForm
alt SignMode
s -> [|formatAnyFractional $(AlternateForm -> Format 'CanAlt 'CanUpper 'Fractional -> Q Exp
forall (t :: AltStatus) (t' :: UpperStatus) (t'' :: FormatType).
AlternateForm -> Format t t' t'' -> Q Exp
withAlt AlternateForm
alt Format 'CanAlt 'CanUpper 'Fractional
Formatters.Fixed) s $(Padding -> Q Exp
newPaddingQ Padding
padding) $(Maybe Char -> Int -> Q Exp
toGrp Maybe Char
grouping Int
3) $(Maybe Int -> Precision -> Q Exp
splicePrecision Maybe Int
defaultFloatPrecision Precision
prec)|]
FixedCapsF Precision
prec AlternateForm
alt SignMode
s -> [|formatAnyFractional (Formatters.Upper $(AlternateForm -> Format 'CanAlt 'CanUpper 'Fractional -> Q Exp
forall (t :: AltStatus) (t' :: UpperStatus) (t'' :: FormatType).
AlternateForm -> Format t t' t'' -> Q Exp
withAlt AlternateForm
alt Format 'CanAlt 'CanUpper 'Fractional
Formatters.Fixed)) s $(Padding -> Q Exp
newPaddingQ Padding
padding) $(Maybe Char -> Int -> Q Exp
toGrp Maybe Char
grouping Int
3) $(Maybe Int -> Precision -> Q Exp
splicePrecision Maybe Int
defaultFloatPrecision Precision
prec)|]
PercentF Precision
prec AlternateForm
alt SignMode
s -> [|formatAnyFractional $(AlternateForm -> Format 'CanAlt 'NoUpper 'Fractional -> Q Exp
forall (t :: AltStatus) (t' :: UpperStatus) (t'' :: FormatType).
AlternateForm -> Format t t' t'' -> Q Exp
withAlt AlternateForm
alt Format 'CanAlt 'NoUpper 'Fractional
Formatters.Percent) s $(Padding -> Q Exp
newPaddingQ Padding
padding) $(Maybe Char -> Int -> Q Exp
toGrp Maybe Char
grouping Int
3) $(Maybe Int -> Precision -> Q Exp
splicePrecision Maybe Int
defaultFloatPrecision Precision
prec)|]
DefaultF Precision
prec SignMode
s -> [|formatAny s $(Padding -> Q Exp
paddingToPaddingK Padding
padding) $(Maybe Char -> Int -> Q Exp
toGrp Maybe Char
grouping Int
3) $(Maybe Int -> Precision -> Q Exp
splicePrecision Maybe Int
forall a. Maybe a
Nothing Precision
prec)|]
StringF Precision
prec -> [|Formatters.formatString (newPaddingKForString $(Padding -> Q Exp
paddingToPaddingK Padding
padding)) $(Maybe Int -> Precision -> Q Exp
splicePrecision Maybe Int
forall a. Maybe a
Nothing Precision
prec) . pyfToString|]
newPaddingQ :: Padding -> Q Exp
newPaddingQ :: Padding -> Q Exp
newPaddingQ Padding
padding = case Padding
padding of
Padding
PaddingDefault -> [|Nothing :: Maybe (Int, AnyAlign, Char)|]
(Padding ExprOrValue Int
i Maybe (Maybe Char, AnyAlign)
al) -> case Maybe (Maybe Char, AnyAlign)
al of
Maybe (Maybe Char, AnyAlign)
Nothing -> [|Just ($(ExprOrValue Int -> Q Exp
exprToInt ExprOrValue Int
i), AnyAlign Formatters.AlignRight, ' ')|]
Just (Maybe Char
Nothing, AnyAlign
a) -> [|Just ($(ExprOrValue Int -> Q Exp
exprToInt ExprOrValue Int
i), a, ' ')|]
Just (Just Char
c, AnyAlign
a) -> [|Just ($(ExprOrValue Int -> Q Exp
exprToInt ExprOrValue Int
i), a, c)|]
exprToInt :: ExprOrValue Int -> Q Exp
exprToInt :: ExprOrValue Int -> Q Exp
exprToInt (Value Int
i) = [|$(Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Lit -> Exp
LitE (Integer -> Lit
IntegerL (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i))) :: Int|]
exprToInt (HaskellExpr (HsExpr GhcPs
_, Exp
e)) = [|$(Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
e)|]
data PaddingK k i where
PaddingDefaultK :: PaddingK 'Formatters.AlignAll Int
PaddingK :: i -> Maybe (Maybe Char, Formatters.AlignMode k) -> PaddingK k i
paddingToPaddingK :: Padding -> Q Exp
paddingToPaddingK :: Padding -> Q Exp
paddingToPaddingK Padding
p = case Padding
p of
Padding
PaddingDefault -> [|PaddingDefaultK|]
Padding ExprOrValue Int
i Maybe (Maybe Char, AnyAlign)
Nothing -> [|PaddingK ($(ExprOrValue Int -> Q Exp
exprToInt ExprOrValue Int
i)) Nothing :: PaddingK 'Formatters.AlignAll Int|]
Padding ExprOrValue Int
i (Just (Maybe Char
c, AnyAlign AlignMode k
a)) -> [|PaddingK $(ExprOrValue Int -> Q Exp
exprToInt ExprOrValue Int
i) (Just (c, a))|]
paddingKToPadding :: PaddingK k i -> Maybe (i, AnyAlign, Char)
paddingKToPadding :: forall (k :: AlignForString) i.
PaddingK k i -> Maybe (i, AnyAlign, Char)
paddingKToPadding PaddingK k i
p = case PaddingK k i
p of
PaddingK k i
PaddingDefaultK -> Maybe (i, AnyAlign, Char)
forall a. Maybe a
Nothing
(PaddingK i
i Maybe (Maybe Char, AlignMode k)
al) -> case Maybe (Maybe Char, AlignMode k)
al of
Maybe (Maybe Char, AlignMode k)
Nothing -> (i, AnyAlign, Char) -> Maybe (i, AnyAlign, Char)
forall a. a -> Maybe a
Just (i
i, AlignMode 'AlignAll -> AnyAlign
forall (k :: AlignForString). AlignMode k -> AnyAlign
AnyAlign AlignMode 'AlignAll
Formatters.AlignRight, Char
' ')
Just (Maybe Char
Nothing, AlignMode k
a) -> (i, AnyAlign, Char) -> Maybe (i, AnyAlign, Char)
forall a. a -> Maybe a
Just (i
i, AlignMode k -> AnyAlign
forall (k :: AlignForString). AlignMode k -> AnyAlign
AnyAlign AlignMode k
a, Char
' ')
Just (Just Char
c, AlignMode k
a) -> (i, AnyAlign, Char) -> Maybe (i, AnyAlign, Char)
forall a. a -> Maybe a
Just (i
i, AlignMode k -> AnyAlign
forall (k :: AlignForString). AlignMode k -> AnyAlign
AnyAlign AlignMode k
a, Char
c)
formatAnyIntegral :: forall i paddingWidth t t'. Integral paddingWidth => PyfFormatIntegral i => Formatters.Format t t' 'Formatters.Integral -> Formatters.SignMode -> Maybe (paddingWidth, AnyAlign, Char) -> Maybe (Int, Char) -> i -> String
formatAnyIntegral :: forall i paddingWidth (t :: AltStatus) (t' :: UpperStatus).
(Integral paddingWidth, PyfFormatIntegral i) =>
Format t t' 'Integral
-> SignMode
-> Maybe (paddingWidth, AnyAlign, Char)
-> Maybe (Int, Char)
-> i
-> String
formatAnyIntegral Format t t' 'Integral
f SignMode
s Maybe (paddingWidth, AnyAlign, Char)
Nothing Maybe (Int, Char)
grouping i
i = forall i paddingWidth (t :: AltStatus) (t' :: UpperStatus)
(k :: AlignForString).
(PyfFormatIntegral i, Integral paddingWidth) =>
Format t t' 'Integral
-> SignMode
-> Maybe (paddingWidth, AlignMode k, Char)
-> Maybe (Int, Char)
-> i
-> String
pyfFormatIntegral @i @paddingWidth Format t t' 'Integral
f SignMode
s Maybe (paddingWidth, AlignMode Any, Char)
forall a. Maybe a
Nothing Maybe (Int, Char)
grouping i
i
formatAnyIntegral Format t t' 'Integral
f SignMode
s (Just (paddingWidth
padSize, AnyAlign AlignMode k
alignMode, Char
c)) Maybe (Int, Char)
grouping i
i = Format t t' 'Integral
-> SignMode
-> Maybe (paddingWidth, AlignMode k, Char)
-> Maybe (Int, Char)
-> i
-> String
forall i paddingWidth (t :: AltStatus) (t' :: UpperStatus)
(k :: AlignForString).
(PyfFormatIntegral i, Integral paddingWidth) =>
Format t t' 'Integral
-> SignMode
-> Maybe (paddingWidth, AlignMode k, Char)
-> Maybe (Int, Char)
-> i
-> String
forall paddingWidth (t :: AltStatus) (t' :: UpperStatus)
(k :: AlignForString).
Integral paddingWidth =>
Format t t' 'Integral
-> SignMode
-> Maybe (paddingWidth, AlignMode k, Char)
-> Maybe (Int, Char)
-> i
-> String
pyfFormatIntegral Format t t' 'Integral
f SignMode
s ((paddingWidth, AlignMode k, Char)
-> Maybe (paddingWidth, AlignMode k, Char)
forall a. a -> Maybe a
Just (paddingWidth
padSize, AlignMode k
alignMode, Char
c)) Maybe (Int, Char)
grouping i
i
formatAnyFractional :: forall paddingWidth precision i t t'. (Integral paddingWidth, Integral precision, PyfFormatFractional i) => Formatters.Format t t' 'Formatters.Fractional -> Formatters.SignMode -> Maybe (paddingWidth, AnyAlign, Char) -> Maybe (Int, Char) -> Maybe precision -> i -> String
formatAnyFractional :: forall paddingWidth precision i (t :: AltStatus)
(t' :: UpperStatus).
(Integral paddingWidth, Integral precision,
PyfFormatFractional i) =>
Format t t' 'Fractional
-> SignMode
-> Maybe (paddingWidth, AnyAlign, Char)
-> Maybe (Int, Char)
-> Maybe precision
-> i
-> String
formatAnyFractional Format t t' 'Fractional
f SignMode
s Maybe (paddingWidth, AnyAlign, Char)
Nothing Maybe (Int, Char)
grouping Maybe precision
p i
i = forall a paddingWidth precision (t :: AltStatus)
(t' :: UpperStatus) (k :: AlignForString).
(PyfFormatFractional a, Integral paddingWidth,
Integral precision) =>
Format t t' 'Fractional
-> SignMode
-> Maybe (paddingWidth, AlignMode k, Char)
-> Maybe (Int, Char)
-> Maybe precision
-> a
-> String
pyfFormatFractional @i @paddingWidth @precision Format t t' 'Fractional
f SignMode
s Maybe (paddingWidth, AlignMode Any, Char)
forall a. Maybe a
Nothing Maybe (Int, Char)
grouping Maybe precision
p i
i
formatAnyFractional Format t t' 'Fractional
f SignMode
s (Just (paddingWidth
padSize, AnyAlign AlignMode k
alignMode, Char
c)) Maybe (Int, Char)
grouping Maybe precision
p i
i = Format t t' 'Fractional
-> SignMode
-> Maybe (paddingWidth, AlignMode k, Char)
-> Maybe (Int, Char)
-> Maybe precision
-> i
-> String
forall a paddingWidth precision (t :: AltStatus)
(t' :: UpperStatus) (k :: AlignForString).
(PyfFormatFractional a, Integral paddingWidth,
Integral precision) =>
Format t t' 'Fractional
-> SignMode
-> Maybe (paddingWidth, AlignMode k, Char)
-> Maybe (Int, Char)
-> Maybe precision
-> a
-> String
forall paddingWidth precision (t :: AltStatus) (t' :: UpperStatus)
(k :: AlignForString).
(Integral paddingWidth, Integral precision) =>
Format t t' 'Fractional
-> SignMode
-> Maybe (paddingWidth, AlignMode k, Char)
-> Maybe (Int, Char)
-> Maybe precision
-> i
-> String
pyfFormatFractional Format t t' 'Fractional
f SignMode
s ((paddingWidth, AlignMode k, Char)
-> Maybe (paddingWidth, AlignMode k, Char)
forall a. a -> Maybe a
Just (paddingWidth
padSize, AlignMode k
alignMode, Char
c)) Maybe (Int, Char)
grouping Maybe precision
p i
i
class FormatAny i k where
formatAny :: forall paddingWidth precision. (Integral paddingWidth, Integral precision) => Formatters.SignMode -> PaddingK k paddingWidth -> Maybe (Int, Char) -> Maybe precision -> i -> String
instance (FormatAny2 (PyFClassify t) t k) => FormatAny t k where
formatAny :: forall paddingWidth precision.
(Integral paddingWidth, Integral precision) =>
SignMode
-> PaddingK k paddingWidth
-> Maybe (Int, Char)
-> Maybe precision
-> t
-> String
formatAny = Proxy (PyFClassify t)
-> SignMode
-> PaddingK k paddingWidth
-> Maybe (Int, Char)
-> Maybe precision
-> t
-> String
forall paddingWidth precision.
(Integral paddingWidth, Integral precision) =>
Proxy (PyFClassify t)
-> SignMode
-> PaddingK k paddingWidth
-> Maybe (Int, Char)
-> Maybe precision
-> t
-> String
forall (c :: PyFCategory) i (k :: AlignForString) paddingWidth
precision.
(FormatAny2 c i k, Integral paddingWidth, Integral precision) =>
Proxy c
-> SignMode
-> PaddingK k paddingWidth
-> Maybe (Int, Char)
-> Maybe precision
-> i
-> String
formatAny2 (Proxy (PyFClassify t)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (PyFClassify t))
class FormatAny2 (c :: PyFCategory) (i :: Type) (k :: Formatters.AlignForString) where
formatAny2 :: forall paddingWidth precision. (Integral paddingWidth, Integral precision) => Proxy c -> Formatters.SignMode -> PaddingK k paddingWidth -> Maybe (Int, Char) -> Maybe precision -> i -> String
instance (Show t, Integral t) => FormatAny2 'PyFIntegral t k where
formatAny2 :: forall paddingWidth precision.
(Integral paddingWidth, Integral precision) =>
Proxy 'PyFIntegral
-> SignMode
-> PaddingK k paddingWidth
-> Maybe (Int, Char)
-> Maybe precision
-> t
-> String
formatAny2 Proxy 'PyFIntegral
_ SignMode
s PaddingK k paddingWidth
a Maybe (Int, Char)
p Maybe precision
_precision = Format 'NoAlt 'NoUpper 'Integral
-> SignMode
-> Maybe (paddingWidth, AnyAlign, Char)
-> Maybe (Int, Char)
-> t
-> String
forall i paddingWidth (t :: AltStatus) (t' :: UpperStatus).
(Integral paddingWidth, PyfFormatIntegral i) =>
Format t t' 'Integral
-> SignMode
-> Maybe (paddingWidth, AnyAlign, Char)
-> Maybe (Int, Char)
-> i
-> String
formatAnyIntegral Format 'NoAlt 'NoUpper 'Integral
Formatters.Decimal SignMode
s (PaddingK k paddingWidth -> Maybe (paddingWidth, AnyAlign, Char)
forall (k :: AlignForString) i.
PaddingK k i -> Maybe (i, AnyAlign, Char)
paddingKToPadding PaddingK k paddingWidth
a) Maybe (Int, Char)
p
instance (PyfFormatFractional t) => FormatAny2 'PyFFractional t k where
formatAny2 :: forall paddingWidth precision.
(Integral paddingWidth, Integral precision) =>
Proxy 'PyFFractional
-> SignMode
-> PaddingK k paddingWidth
-> Maybe (Int, Char)
-> Maybe precision
-> t
-> String
formatAny2 Proxy 'PyFFractional
_ SignMode
s PaddingK k paddingWidth
a = Format 'CanAlt 'CanUpper 'Fractional
-> SignMode
-> Maybe (paddingWidth, AnyAlign, Char)
-> Maybe (Int, Char)
-> Maybe precision
-> t
-> String
forall paddingWidth precision i (t :: AltStatus)
(t' :: UpperStatus).
(Integral paddingWidth, Integral precision,
PyfFormatFractional i) =>
Format t t' 'Fractional
-> SignMode
-> Maybe (paddingWidth, AnyAlign, Char)
-> Maybe (Int, Char)
-> Maybe precision
-> i
-> String
formatAnyFractional Format 'CanAlt 'CanUpper 'Fractional
Formatters.Generic SignMode
s (PaddingK k paddingWidth -> Maybe (paddingWidth, AnyAlign, Char)
forall (k :: AlignForString) i.
PaddingK k i -> Maybe (i, AnyAlign, Char)
paddingKToPadding PaddingK k paddingWidth
a)
newPaddingKForString :: Integral i => PaddingK 'Formatters.AlignAll i -> Maybe (Int, Formatters.AlignMode 'Formatters.AlignAll, Char)
newPaddingKForString :: forall i.
Integral i =>
PaddingK 'AlignAll i -> Maybe (Int, AlignMode 'AlignAll, Char)
newPaddingKForString PaddingK 'AlignAll i
padding = case PaddingK 'AlignAll i
padding of
PaddingK 'AlignAll i
PaddingDefaultK -> Maybe (Int, AlignMode 'AlignAll, Char)
forall a. Maybe a
Nothing
PaddingK i
i Maybe (Maybe Char, AlignMode 'AlignAll)
Nothing -> (Int, AlignMode 'AlignAll, Char)
-> Maybe (Int, AlignMode 'AlignAll, Char)
forall a. a -> Maybe a
Just (i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i, AlignMode 'AlignAll
Formatters.AlignLeft, Char
' ')
PaddingK i
i (Just (Maybe Char
mc, AlignMode 'AlignAll
a)) -> (Int, AlignMode 'AlignAll, Char)
-> Maybe (Int, AlignMode 'AlignAll, Char)
forall a. a -> Maybe a
Just (i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i, AlignMode 'AlignAll
a, Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
' ' Maybe Char
mc)
instance (PyFToString t) => FormatAny2 'PyFString t 'Formatters.AlignAll where
formatAny2 :: forall paddingWidth precision.
(Integral paddingWidth, Integral precision) =>
Proxy 'PyFString
-> SignMode
-> PaddingK 'AlignAll paddingWidth
-> Maybe (Int, Char)
-> Maybe precision
-> t
-> String
formatAny2 Proxy 'PyFString
_ SignMode
_s PaddingK 'AlignAll paddingWidth
a Maybe (Int, Char)
_grouping Maybe precision
precision t
t = Maybe (Int, AlignMode 'AlignAll, Char)
-> Maybe precision -> String -> String
forall paddingWidth precision.
(Integral paddingWidth, Integral precision) =>
Maybe (paddingWidth, AlignMode 'AlignAll, Char)
-> Maybe precision -> String -> String
Formatters.formatString (PaddingK 'AlignAll paddingWidth
-> Maybe (Int, AlignMode 'AlignAll, Char)
forall i.
Integral i =>
PaddingK 'AlignAll i -> Maybe (Int, AlignMode 'AlignAll, Char)
newPaddingKForString PaddingK 'AlignAll paddingWidth
a) Maybe precision
precision (t -> String
forall t. PyFToString t => t -> String
pyfToString t
t)
instance TypeError ('Text "String type is incompatible with inside padding (=).") => FormatAny2 'PyFString t 'Formatters.AlignNumber where
formatAny2 :: forall paddingWidth precision.
(Integral paddingWidth, Integral precision) =>
Proxy 'PyFString
-> SignMode
-> PaddingK 'AlignNumber paddingWidth
-> Maybe (Int, Char)
-> Maybe precision
-> t
-> String
formatAny2 = String
-> Proxy 'PyFString
-> SignMode
-> PaddingK 'AlignNumber paddingWidth
-> Maybe (Int, Char)
-> Maybe precision
-> t
-> String
forall a. HasCallStack => String -> a
error String
"Unreachable"