{-# 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 #-}

-- | This module uses the python mini language detailed in
-- 'PyF.Internal.PythonSyntax' to build an template haskell expression
-- representing a formatted string.
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)
import Data.Proxy
import Data.String (fromString)
import GHC (GenLocated (L))

#if MIN_VERSION_ghc(9,0,0)
import GHC.Tc.Utils.Monad (addErrAt)
import GHC.Tc.Types (TcM)
import GHC.Tc.Gen.Splice (lookupThName_maybe)
#else
import TcRnTypes (TcM)
import TcSplice (lookupThName_maybe)
import TcRnMonad (addErrAt)
#endif

#if MIN_VERSION_ghc(9,3,0)
import GHC.Tc.Errors.Types
import GHC.Types.Error
import GHC.Driver.Errors.Types
import GHC.Parser.Errors.Types
import GHC.Utils.Outputable (text)
#endif



#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.Name.Reader
#else
import FastString
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
import HsLit
#endif

#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.SrcLoc
#else
import SrcLoc
#endif

#if MIN_VERSION_ghc(8,10,0)
import GHC.Hs
#else
import HsSyn
#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,
    newErrorMessage,
    setErrorPos,
    showErrorMessages,
  )
import Text.Parsec.Pos (newPos, initialPos)
import Text.ParserCombinators.Parsec.Error (Message (..))
import Unsafe.Coerce (unsafeCoerce)

-- | Configuration for the quasiquoter
data Config = Config
  { -- | What are the delimiters for interpolation. 'Nothing' means no
    -- interpolation / formatting.
    Config -> Maybe (Char, Char)
delimiters :: Maybe (Char, Char),
    -- | Post processing. The input 'Exp' represents a 'String'. Common use
    -- case includes using 'wrapFromString' to add 'fromString' in the context
    -- of 'OverloadedStrings'.
    Config -> Q Exp -> Q Exp
postProcess :: Q Exp -> Q Exp
  }

-- | Build a quasiquoter for expression
expQQ :: String -> (String -> Q Exp) -> QuasiQuoter
expQQ :: String -> (String -> Q Exp) -> QuasiQuoter
expQQ String
fName String -> Q Exp
qExp =
  QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
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 :: 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
"!")

-- | If 'OverloadedStrings' is enabled, from the input expression with
-- 'fromString'.
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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Extension]
exts
    then [|fromString $(e)|]
    else Q Exp
e

-- | Parse a string and return a formatter for it
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 :: Q Exp -> Q Exp
postProcess :: Config -> 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

  -- Setup the parser so it matchs the real original position in the source
  -- code.
  let filename :: String
filename = Loc -> String
loc_filename Loc
loc
  let initPos :: SourcePos
initPos = SourcePos -> Column -> SourcePos
setSourceColumn (SourcePos -> Column -> SourcePos
setSourceLine (String -> SourcePos
initialPos String
filename) ((Column, Column) -> Column
forall a b. (a, b) -> a
fst ((Column, Column) -> Column) -> (Column, Column) -> Column
forall a b. (a -> b) -> a -> b
$ Loc -> (Column, Column)
loc_start Loc
loc)) ((Column, Column) -> Column
forall a b. (a, b) -> b
snd ((Column, Column) -> Column) -> (Column, Column) -> Column
forall a b. (a -> b) -> a -> b
$ Loc -> (Column, Column)
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 () (Reader ParsingContext) [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 () (Reader ParsingContext) ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
initPos ParsecT String () (Reader ParsingContext) ()
-> ParsecT String () (Reader ParsingContext) [Item]
-> ParsecT String () (Reader ParsingContext) [Item]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String () (Reader ParsingContext) [Item]
parseGenericFormatString) () String
filename String
s) ParsingContext
context of
    Left ParseError
err -> do
      ParseError -> Q ()
reportParserErrorAt ParseError
err
      -- returns a dummy exp, so TH continues its life. This TH code won't be
      -- executed anyway, there is an error
      [|()|]
    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 Column
eoi Maybe (Maybe Char, AnyAlign)
_ -> ExprOrValue Column -> [(SrcSpan, RdrName)]
forall a. Data a => a -> [(SrcSpan, RdrName)]
findFreeVariables ExprOrValue Column
eoi

checkOneItem :: Item -> Q (Maybe (SrcSpan, String))
checkOneItem :: Item -> Q (Maybe (SrcSpan, String))
checkOneItem (Raw String
_) = Maybe (SrcSpan, String) -> Q (Maybe (SrcSpan, String))
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)
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 (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 (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 :: a -> [(SrcSpan, RdrName)]
findFreeVariables a
item = [(SrcSpan, RdrName)]
allNames
  where
    -- Find all free Variables in an HsExpr
    f :: forall a. (Data a, Typeable a) => a -> [Located RdrName]
    f :: a -> [Located RdrName]
f a
e = case a -> Maybe (HsExpr GhcPs)
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 _ l@(L a b)) -> [L (locA a) (unLoc l)]
#else
      Just (HsVar XVar GhcPs
_ Located (IdP GhcPs)
l) -> [Located (IdP GhcPs)
Located RdrName
l]
#endif
      Just (HsLam XLam GhcPs
_ (MG XMG GhcPs (LHsExpr GhcPs)
_ (Located [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> ((LMatch GhcPs (LHsExpr GhcPs) -> Match GhcPs (LHsExpr GhcPs))
-> [LMatch GhcPs (LHsExpr GhcPs)] -> [Match GhcPs (LHsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map LMatch GhcPs (LHsExpr GhcPs) -> Match GhcPs (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> [Expr.Match XCMatch GhcPs (LHsExpr GhcPs)
_ HsMatchContext (NameOrRdrName (IdP GhcPs))
_ ((Located (Pat GhcPs) -> Pat GhcPs)
-> [Located (Pat GhcPs)] -> [Pat GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map Located (Pat GhcPs) -> Pat GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> [Pat GhcPs]
ps) (GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
_ [LGRHS GhcPs (LHsExpr GhcPs)
-> SrcSpanLess (LGRHS GhcPs (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> GRHS _ _ (unLoc -> e)] LHsLocalBinds GhcPs
_)])) Origin
_)) -> (Located RdrName -> Bool) -> [Located RdrName] -> [Located RdrName]
forall a. (a -> Bool) -> [a] -> [a]
filter Located RdrName -> Bool
keepVar [Located RdrName]
subVars
        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]
gmapQ forall d. Data d => d -> [Located RdrName]
forall a. (Data a, Typeable a) => a -> [Located RdrName]
f [HsExpr GhcPs
SrcSpanLess (LHsExpr 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]
gmapQ 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]
gmapQ forall d. Data d => d -> [Located RdrName]
forall a. (Data a, Typeable a) => a -> [Located RdrName]
f a
e

    -- Find all Variables bindings (i.e. patterns) in an HsExpr
    findPats :: forall a. (Data a, Typeable a) => a -> [RdrName]
    findPats :: a -> [RdrName]
findPats a
p = case a -> Maybe (Pat GhcPs)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast @_ @(Pat.Pat GhcPs) a
p of
      Just (VarPat XVarPat GhcPs
_ (Located (IdP GhcPs) -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> SrcSpanLess (Located RdrName)
name)) -> [RdrName
SrcSpanLess (Located 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]
gmapQ forall d. Data d => d -> [RdrName]
forall a. (Data a, Typeable a) => a -> [RdrName]
findPats a
p
    -- Be careful, we wrap hsExpr in a list, so the toplevel hsExpr will be
    -- seen by gmapQ. Otherwise it will miss variables if they are the top
    -- level expression: gmapQ only checks sub constructors.
    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]
gmapQ 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

doesExists :: (b, RdrName) -> Q (Maybe (String, b))
doesExists :: (b, RdrName) -> Q (Maybe (String, b))
doesExists (b
loc, RdrName
name) = do
  Maybe Name
res <- TcM (Maybe Name) -> Q (Maybe Name)
forall a. TcM a -> Q a
unsafeRunTcM (TcM (Maybe Name) -> Q (Maybe Name))
-> TcM (Maybe Name) -> Q (Maybe Name)
forall a b. (a -> b) -> a -> b
$ Name -> TcM (Maybe Name)
lookupThName_maybe (RdrName -> Name
toName RdrName
name)
  case Maybe Name
res of
    Maybe Name
Nothing -> Maybe (String, b) -> Q (Maybe (String, b))
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))
    Just Name
_ -> Maybe (String, b) -> Q (Maybe (String, b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (String, b)
forall a. Maybe a
Nothing

-- | Check that all variables used in 'Item' exists, otherwise, fail.
checkVariables :: [Item] -> Q (Maybe (SrcSpan, String))
checkVariables :: [Item] -> Q (Maybe (SrcSpan, String))
checkVariables [] = Maybe (SrcSpan, String) -> Q (Maybe (SrcSpan, String))
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 (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

-- Stolen from: https://www.tweag.io/blog/2021-01-07-haskell-dark-arts-part-i/
-- This allows to hack inside the the GHC api and use function not exported by template haskell.
unsafeRunTcM :: TcM a -> Q a
unsafeRunTcM :: 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)

-- | This function is similar to TH reportError, however it also provide
-- correct SrcSpan, so error are localised at the correct position in the TH
-- splice instead of being at the beginning.
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 -> MsgDoc -> TcM ()
addErrAt SrcSpan
loc MsgDoc
msg'
  where
#if MIN_VERSION_ghc(9,3,0)
    msg' = TcRnUnknownMessage (GhcPsMessage $ PsUnknownMessage $ mkPlainError noHints $
                         text msg)
#else
    msg' :: MsgDoc
msg' = String -> MsgDoc
forall a. IsString a => String -> a
fromString String
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 -> Column -> SourcePos
incSourceColumn (ParseError -> SourcePos
errorPos ParseError
err) Column
1)

srcLocFromParserError :: SourcePos -> SrcLoc
srcLocFromParserError :: SourcePos -> SrcLoc
srcLocFromParserError SourcePos
sourceLoc = SrcLoc
srcLoc
  where
    line :: Column
line = SourcePos -> Column
sourceLine SourcePos
sourceLoc
    column :: Column
column = SourcePos -> Column
sourceColumn SourcePos
sourceLoc
    name :: String
name = SourcePos -> String
sourceName SourcePos
sourceLoc

    srcLoc :: SrcLoc
srcLoc = FastString -> Column -> Column -> SrcLoc
mkSrcLoc (String -> FastString
forall a. IsString a => String -> a
fromString String
name) Column
line Column
column

formatErrorMessages :: ParseError -> [String]
formatErrorMessages :: ParseError -> [String]
formatErrorMessages ParseError
err
  -- If there is an explicit error message from parsec, use only that
  | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Message] -> 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
  -- Otherwise, uses parsec formatting
  | 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
{-
Note: Empty String Lifting

Empty string are lifted as [] instead of "", so I'm using LitE (String L) instead
-}

goFormat :: [Item] -> Q Exp
-- We special case on empty list in order to generate an empty string
goFormat :: [Item] -> Q Exp
goFormat [] = Exp -> Q Exp
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
"") -- see [Empty String Lifting]
goFormat [Item]
items = (Exp -> Exp -> Exp) -> [Exp] -> Exp
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)
mapM Item -> Q Exp
toFormat [Item]
items

-- | call `<>` between two 'Exp'
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)

-- Real formatting is here

toFormat :: Item -> Q Exp
toFormat :: Item -> Q Exp
toFormat (Raw String
x) = Exp -> Q Exp
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) -- see [Empty String Lifting]
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 (f :: * -> *) a. Applicative f => a -> f a
pure (Exp
formatExpr Exp -> Exp -> Exp
`AppE` Exp
expr)

-- | Default precision for floating point
defaultFloatPrecision :: Maybe Int
defaultFloatPrecision :: Maybe Column
defaultFloatPrecision = Column -> Maybe Column
forall a. a -> Maybe a
Just Column
6

-- | Precision to maybe
splicePrecision :: Maybe Int -> Precision -> Q Exp
splicePrecision :: Maybe Column -> Precision -> Q Exp
splicePrecision Maybe Column
def Precision
PrecisionDefault = [|def :: Maybe Int|]
splicePrecision Maybe Column
_ (Precision ExprOrValue Column
p) = [|Just $(exprToInt p)|]

toGrp :: Maybe Char -> Int -> Q Exp
toGrp :: Maybe Char -> Column -> Q Exp
toGrp Maybe Char
mb Column
a = [|grp|]
  where
    grp :: Maybe (Column, Char)
grp = (Column
a,) (Char -> (Column, Char)) -> Maybe Char -> Maybe (Column, 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 :: 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
  -- Integrals
  BinaryF AlternateForm
alt SignMode
s -> [|formatAnyIntegral $(withAlt alt Formatters.Binary) s $(newPaddingQ padding) $(toGrp grouping 4)|]
  TypeFormat
CharacterF -> [|formatAnyIntegral Formatters.Character Formatters.Minus $(newPaddingQ padding) Nothing|]
  DecimalF SignMode
s -> [|formatAnyIntegral Formatters.Decimal s $(newPaddingQ padding) $(toGrp grouping 3)|]
  HexF AlternateForm
alt SignMode
s -> [|formatAnyIntegral $(withAlt alt Formatters.Hexa) s $(newPaddingQ padding) $(toGrp grouping 4)|]
  OctalF AlternateForm
alt SignMode
s -> [|formatAnyIntegral $(withAlt alt Formatters.Octal) s $(newPaddingQ padding) $(toGrp grouping 4)|]
  HexCapsF AlternateForm
alt SignMode
s -> [|formatAnyIntegral (Formatters.Upper $(withAlt alt Formatters.Hexa)) s $(newPaddingQ padding) $(toGrp grouping 4)|]
  -- Floating
  ExponentialF Precision
prec AlternateForm
alt SignMode
s -> [|formatAnyFractional $(withAlt alt Formatters.Exponent) s $(newPaddingQ padding) $(toGrp grouping 3) $(splicePrecision defaultFloatPrecision prec)|]
  ExponentialCapsF Precision
prec AlternateForm
alt SignMode
s -> [|formatAnyFractional (Formatters.Upper $(withAlt alt Formatters.Exponent)) s $(newPaddingQ padding) $(toGrp grouping 3) $(splicePrecision defaultFloatPrecision prec)|]
  GeneralF Precision
prec AlternateForm
alt SignMode
s -> [|formatAnyFractional $(withAlt alt Formatters.Generic) s $(newPaddingQ padding) $(toGrp grouping 3) $(splicePrecision defaultFloatPrecision prec)|]
  GeneralCapsF Precision
prec AlternateForm
alt SignMode
s -> [|formatAnyFractional (Formatters.Upper $(withAlt alt Formatters.Generic)) s $(newPaddingQ padding) $(toGrp grouping 3) $(splicePrecision defaultFloatPrecision prec)|]
  FixedF Precision
prec AlternateForm
alt SignMode
s -> [|formatAnyFractional $(withAlt alt Formatters.Fixed) s $(newPaddingQ padding) $(toGrp grouping 3) $(splicePrecision defaultFloatPrecision prec)|]
  FixedCapsF Precision
prec AlternateForm
alt SignMode
s -> [|formatAnyFractional (Formatters.Upper $(withAlt alt Formatters.Fixed)) s $(newPaddingQ padding) $(toGrp grouping 3) $(splicePrecision defaultFloatPrecision prec)|]
  PercentF Precision
prec AlternateForm
alt SignMode
s -> [|formatAnyFractional $(withAlt alt Formatters.Percent) s $(newPaddingQ padding) $(toGrp grouping 3) $(splicePrecision defaultFloatPrecision prec)|]
  -- Default / String
  DefaultF Precision
prec SignMode
s -> [|formatAny s $(paddingToPaddingK padding) $(toGrp grouping 3) $(splicePrecision Nothing prec)|]
  StringF Precision
prec -> [|Formatters.formatString (newPaddingKForString $(paddingToPaddingK padding)) $(splicePrecision Nothing 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 Column
i Maybe (Maybe Char, AnyAlign)
al) -> case Maybe (Maybe Char, AnyAlign)
al of
    Maybe (Maybe Char, AnyAlign)
Nothing -> [|Just ($(exprToInt i), AnyAlign Formatters.AlignRight, ' ')|] -- Right align and space is default for any object, except string
    Just (Maybe Char
Nothing, AnyAlign
a) -> [|Just ($(exprToInt i), a, ' ')|]
    Just (Just Char
c, AnyAlign
a) -> [|Just ($(exprToInt i), a, c)|]

exprToInt :: ExprOrValue Int -> Q Exp
-- Note: this is a literal provided integral. We use explicit case to ::Int so it won't warn about defaulting
exprToInt :: ExprOrValue Column -> Q Exp
exprToInt (Value Column
i) = [|$(pure $ LitE (IntegerL (fromIntegral i))) :: Int|]
exprToInt (HaskellExpr (HsExpr GhcPs
_, Exp
e)) = [|$(pure 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 Column
i Maybe (Maybe Char, AnyAlign)
Nothing -> [|PaddingK ($(exprToInt i)) Nothing :: PaddingK 'Formatters.AlignAll Int|]
  Padding ExprOrValue Column
i (Just (Maybe Char
c, AnyAlign AlignMode k
a)) -> [|PaddingK $(exprToInt i) (Just (c, a))|]

paddingKToPadding :: PaddingK k i -> Maybe (i, AnyAlign, Char)
paddingKToPadding :: 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
' ') -- Right align and space is default for any object, except string
    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 :: Format t t' 'Integral
-> SignMode
-> Maybe (paddingWidth, AnyAlign, Char)
-> Maybe (Column, Char)
-> i
-> String
formatAnyIntegral Format t t' 'Integral
f SignMode
s Maybe (paddingWidth, AnyAlign, Char)
Nothing Maybe (Column, Char)
grouping i
i = Format t t' 'Integral
-> SignMode
-> Maybe (paddingWidth, AlignMode Any, Char)
-> Maybe (Column, 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 (Column, Char)
-> i
-> String
pyfFormatIntegral @i @paddingWidth Format t t' 'Integral
f SignMode
s Maybe (paddingWidth, AlignMode Any, Char)
forall a. Maybe a
Nothing Maybe (Column, Char)
grouping i
i
formatAnyIntegral Format t t' 'Integral
f SignMode
s (Just (paddingWidth
padSize, AnyAlign AlignMode k
alignMode, Char
c)) Maybe (Column, Char)
grouping i
i = Format t t' 'Integral
-> SignMode
-> Maybe (paddingWidth, AlignMode k, Char)
-> Maybe (Column, 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 (Column, 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 (Column, 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 :: Format t t' 'Fractional
-> SignMode
-> Maybe (paddingWidth, AnyAlign, Char)
-> Maybe (Column, Char)
-> Maybe precision
-> i
-> String
formatAnyFractional Format t t' 'Fractional
f SignMode
s Maybe (paddingWidth, AnyAlign, Char)
Nothing Maybe (Column, Char)
grouping Maybe precision
p i
i = Format t t' 'Fractional
-> SignMode
-> Maybe (paddingWidth, AlignMode Any, Char)
-> Maybe (Column, 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 (Column, 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 (Column, 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 (Column, Char)
grouping Maybe precision
p i
i = Format t t' 'Fractional
-> SignMode
-> Maybe (paddingWidth, AlignMode k, Char)
-> Maybe (Column, 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 (Column, Char)
-> Maybe precision
-> a
-> 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 (Column, 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 :: SignMode
-> PaddingK k paddingWidth
-> Maybe (Column, Char)
-> Maybe precision
-> t
-> String
formatAny = Proxy (PyFClassify t)
-> SignMode
-> PaddingK k paddingWidth
-> Maybe (Column, 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 (Column, 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 :: Proxy 'PyFIntegral
-> SignMode
-> PaddingK k paddingWidth
-> Maybe (Column, Char)
-> Maybe precision
-> t
-> String
formatAny2 Proxy 'PyFIntegral
_ SignMode
s PaddingK k paddingWidth
a Maybe (Column, Char)
p Maybe precision
_precision = Format 'NoAlt 'NoUpper 'Integral
-> SignMode
-> Maybe (paddingWidth, AnyAlign, Char)
-> Maybe (Column, Char)
-> t
-> String
forall i paddingWidth (t :: AltStatus) (t' :: UpperStatus).
(Integral paddingWidth, PyfFormatIntegral i) =>
Format t t' 'Integral
-> SignMode
-> Maybe (paddingWidth, AnyAlign, Char)
-> Maybe (Column, 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 (Column, Char)
p

instance (PyfFormatFractional t) => FormatAny2 'PyFFractional t k where
  formatAny2 :: Proxy 'PyFFractional
-> SignMode
-> PaddingK k paddingWidth
-> Maybe (Column, Char)
-> Maybe precision
-> t
-> String
formatAny2 Proxy 'PyFFractional
_ SignMode
s PaddingK k paddingWidth
a = Format 'CanAlt 'CanUpper 'Fractional
-> SignMode
-> Maybe (paddingWidth, AnyAlign, Char)
-> Maybe (Column, 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 (Column, 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 :: PaddingK 'AlignAll i -> Maybe (Column, AlignMode 'AlignAll, Char)
newPaddingKForString PaddingK 'AlignAll i
padding = case PaddingK 'AlignAll i
padding of
  PaddingK 'AlignAll i
PaddingDefaultK -> Maybe (Column, AlignMode 'AlignAll, Char)
forall a. Maybe a
Nothing
  PaddingK i
i Maybe (Maybe Char, AlignMode 'AlignAll)
Nothing -> (Column, AlignMode 'AlignAll, Char)
-> Maybe (Column, AlignMode 'AlignAll, Char)
forall a. a -> Maybe a
Just (i -> Column
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i, AlignMode 'AlignAll
Formatters.AlignLeft, Char
' ') -- default align left and fill with space for string
  PaddingK i
i (Just (Maybe Char
mc, AlignMode 'AlignAll
a)) -> (Column, AlignMode 'AlignAll, Char)
-> Maybe (Column, AlignMode 'AlignAll, Char)
forall a. a -> Maybe a
Just (i -> Column
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)

-- TODO: _s(ign) and _grouping should trigger errors
instance (PyFToString t) => FormatAny2 'PyFString t 'Formatters.AlignAll where
  formatAny2 :: Proxy 'PyFString
-> SignMode
-> PaddingK 'AlignAll paddingWidth
-> Maybe (Column, Char)
-> Maybe precision
-> t
-> String
formatAny2 Proxy 'PyFString
_ SignMode
_s PaddingK 'AlignAll paddingWidth
a Maybe (Column, Char)
_grouping Maybe precision
precision t
t = Maybe (Column, 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 (Column, AlignMode 'AlignAll, Char)
forall i.
Integral i =>
PaddingK 'AlignAll i -> Maybe (Column, 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 :: Proxy 'PyFString
-> SignMode
-> PaddingK 'AlignNumber paddingWidth
-> Maybe (Column, Char)
-> Maybe precision
-> t
-> String
formatAny2 = String
-> Proxy 'PyFString
-> SignMode
-> PaddingK 'AlignNumber paddingWidth
-> Maybe (Column, Char)
-> Maybe precision
-> t
-> String
forall a. HasCallStack => String -> a
error String
"Unreachable"