{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | 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,
    toExpPython,
  )
where

import Control.Monad.Reader
import Data.Maybe (fromMaybe)
import qualified Data.Maybe
import Data.Proxy
import Data.String (fromString)
import GHC.TypeLits
import Language.Haskell.TH
import PyF.Class
import PyF.Formatters (AnyAlign (..))
import qualified PyF.Formatters as Formatters
import PyF.Internal.Extensions
import PyF.Internal.PythonSyntax
import Text.Megaparsec

-- Be Careful: empty format string

-- | Parse a string and return a formatter for it
toExp :: (Char, Char) -> String -> Q Exp
toExp :: (Char, Char) -> String -> Q Exp
toExp (Char, Char)
expressionDelimiters String
s = do
  String
filename <- Loc -> String
loc_filename (Loc -> String) -> Q Loc -> Q String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Loc
location
  [Extension]
thExts <- Q [Extension]
extsEnabled
  let exts :: [Extension]
exts = (Extension -> Maybe Extension) -> [Extension] -> [Extension]
forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe Extension -> Maybe Extension
thExtToMetaExt [Extension]
thExts
  let wrapFromString :: Q Exp -> Q Exp
wrapFromString Q Exp
e =
        if Extension
OverloadedStrings Extension -> [Extension] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Extension]
thExts
          then [|fromString $(e)|]
          else Q Exp
e
  let context :: ParsingContext
context = (Char, Char) -> [Extension] -> ParsingContext
ParsingContext (Char, Char)
expressionDelimiters [Extension]
exts
  case Reader
  ParsingContext (Either (ParseErrorBundle String Void) [Item])
-> ParsingContext -> Either (ParseErrorBundle String Void) [Item]
forall r a. Reader r a -> r -> a
runReader (ParsecT Void String (Reader ParsingContext) [Item]
-> String
-> String
-> Reader
     ParsingContext (Either (ParseErrorBundle String Void) [Item])
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> s -> m (Either (ParseErrorBundle s e) a)
runParserT ParsecT Void String (Reader ParsingContext) [Item]
parseGenericFormatString String
filename String
s) ParsingContext
context of
    Left ParseErrorBundle String Void
err -> do
      ParseErrorBundle String Void
err' <- String
-> ParseErrorBundle String Void -> Q (ParseErrorBundle String Void)
forall e.
String
-> ParseErrorBundle String e -> Q (ParseErrorBundle String e)
overrideErrorForFile String
filename ParseErrorBundle String Void
err
      String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ParseErrorBundle String Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle String Void
err')
    Right [Item]
items -> Q Exp -> Q Exp
wrapFromString ([Item] -> Q Exp
goFormat [Item]
items)

-- Megaparsec displays error relative to what they parsed
-- However the formatting string is part of a more complex file and we
-- want error reporting relative to that file
overrideErrorForFile :: FilePath -> ParseErrorBundle String e -> Q (ParseErrorBundle String e)
-- We have no may to recover interactive content
-- So we won't do better than displaying the megaparsec
-- error relative to the quasi quote content
overrideErrorForFile :: String
-> ParseErrorBundle String e -> Q (ParseErrorBundle String e)
overrideErrorForFile String
"<interactive>" ParseErrorBundle String e
err = ParseErrorBundle String e -> Q (ParseErrorBundle String e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParseErrorBundle String e
err
-- We know the content of the file here
overrideErrorForFile String
filename ParseErrorBundle String e
err = do
  (Int
line, Int
col) <- Loc -> (Int, Int)
loc_start (Loc -> (Int, Int)) -> Q Loc -> Q (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Loc
location
  String
fileContent <- IO String -> Q String
forall a. IO a -> Q a
runIO (String -> IO String
readFile String
filename)
  let -- drop the first lines of the file up to the line containing the quasiquote
      -- then, split in what is before the QQ and what is after.
      -- e.g.  blablabla [fmt|hello|] will split to
      -- "blablabla [fmt|" and "hello|]"
      (String
prefix, String
postfix) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (String -> [String]
lines String
fileContent)
  ParseErrorBundle String e -> Q (ParseErrorBundle String e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseErrorBundle String e -> Q (ParseErrorBundle String e))
-> ParseErrorBundle String e -> Q (ParseErrorBundle String e)
forall a b. (a -> b) -> a -> b
$
    ParseErrorBundle String e
err
      { bundlePosState :: PosState String
bundlePosState =
          (ParseErrorBundle String e -> PosState String
forall s e. ParseErrorBundle s e -> PosState s
bundlePosState ParseErrorBundle String e
err)
            { pstateInput :: String
pstateInput = String
postfix,
              pstateSourcePos :: SourcePos
pstateSourcePos = String -> Pos -> Pos -> SourcePos
SourcePos String
filename (Int -> Pos
mkPos Int
line) (Int -> Pos
mkPos Int
col),
              pstateOffset :: Int
pstateOffset = Int
0,
              pstateLinePrefix :: String
pstateLinePrefix = String
prefix
            }
      }

toExpPython :: String -> Q Exp
toExpPython :: String -> Q Exp
toExpPython = (Char, Char) -> String -> Q Exp
toExp (Char
'{', Char
'}')

{-
Note: Empty String Lifting

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

goFormat :: [Item] -> Q Exp
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
fofo ([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

fofo :: Exp -> Exp -> Exp
fofo :: Exp -> Exp -> Exp
fofo 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 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 Int
defaultFloatPrecision = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
6

-- | Precision to maybe
splicePrecision :: Maybe Int -> Precision -> Q Exp
splicePrecision :: Maybe Int -> Precision -> Q Exp
splicePrecision Maybe Int
def Precision
PrecisionDefault = [|def|]
splicePrecision Maybe Int
_ (Precision ExprOrValue Integer
p) = case ExprOrValue Integer
p of
  Value Integer
n -> [|Just n|]
  HaskellExpr Exp
e -> [|Just $(pure e)|]

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 :: 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
pad = [|pad'|]
  where
    pad' :: Maybe (Integer, AnyAlign, Char)
pad' = Padding -> Maybe (Integer, AnyAlign, Char)
newPaddingUnQ Padding
pad

newPaddingUnQ :: Padding -> Maybe (Integer, AnyAlign, Char)
newPaddingUnQ :: Padding -> Maybe (Integer, AnyAlign, Char)
newPaddingUnQ Padding
padding = case Padding
padding of
  Padding
PaddingDefault -> Maybe (Integer, AnyAlign, Char)
forall a. Maybe a
Nothing
  (Padding Integer
i Maybe (Maybe Char, AnyAlign)
al) -> case Maybe (Maybe Char, AnyAlign)
al of
    Maybe (Maybe Char, AnyAlign)
Nothing -> (Integer, AnyAlign, Char) -> Maybe (Integer, AnyAlign, Char)
forall a. a -> Maybe a
Just (Integer
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, AnyAlign
a) -> (Integer, AnyAlign, Char) -> Maybe (Integer, AnyAlign, Char)
forall a. a -> Maybe a
Just (Integer
i, AnyAlign
a, Char
' ')
    Just (Just Char
c, AnyAlign
a) -> (Integer, AnyAlign, Char) -> Maybe (Integer, AnyAlign, Char)
forall a. a -> Maybe a
Just (Integer
i, AnyAlign
a, Char
c)

data PaddingK k where
  PaddingDefaultK :: PaddingK 'Formatters.AlignAll
  PaddingK :: Integer -> Maybe (Maybe Char, Formatters.AlignMode k) -> PaddingK k

paddingToPaddingK :: Padding -> Q Exp
paddingToPaddingK :: Padding -> Q Exp
paddingToPaddingK Padding
p = case Padding
p of
  Padding
PaddingDefault -> [|PaddingDefaultK|]
  Padding Integer
i Maybe (Maybe Char, AnyAlign)
Nothing -> [|PaddingK i Nothing :: PaddingK 'Formatters.AlignAll|]
  Padding Integer
i (Just (Maybe Char
c, AnyAlign AlignMode k
a)) -> [|PaddingK i (Just (c, a))|]

paddingKToPadding :: PaddingK k -> Padding
paddingKToPadding :: PaddingK k -> Padding
paddingKToPadding PaddingK k
p = case PaddingK k
p of
  PaddingK k
PaddingDefaultK -> Padding
PaddingDefault
  PaddingK Integer
i Maybe (Maybe Char, AlignMode k)
Nothing -> Integer -> Maybe (Maybe Char, AnyAlign) -> Padding
Padding Integer
i Maybe (Maybe Char, AnyAlign)
forall a. Maybe a
Nothing
  PaddingK Integer
i (Just (Maybe Char
c, AlignMode k
a)) -> Integer -> Maybe (Maybe Char, AnyAlign) -> Padding
Padding Integer
i ((Maybe Char, AnyAlign) -> Maybe (Maybe Char, AnyAlign)
forall a. a -> Maybe a
Just (Maybe Char
c, AlignMode k -> AnyAlign
forall (k :: AlignForString). AlignMode k -> AnyAlign
AnyAlign AlignMode k
a))

formatAnyIntegral :: (Show i, Integral i) => Formatters.Format t t' 'Formatters.Integral -> Formatters.SignMode -> Maybe (Integer, AnyAlign, Char) -> Maybe (Int, Char) -> i -> String
formatAnyIntegral :: Format t t' 'Integral
-> SignMode
-> Maybe (Integer, AnyAlign, Char)
-> Maybe (Int, Char)
-> i
-> String
formatAnyIntegral Format t t' 'Integral
f SignMode
s Maybe (Integer, AnyAlign, Char)
Nothing Maybe (Int, Char)
grouping i
i = Format t t' 'Integral
-> SignMode
-> Maybe (Int, AlignMode Any, Char)
-> Maybe (Int, Char)
-> i
-> String
forall i (t :: AltStatus) (t' :: UpperStatus)
       (k :: AlignForString).
(Show i, Integral i) =>
Format t t' 'Integral
-> SignMode
-> Maybe (Int, AlignMode k, Char)
-> Maybe (Int, Char)
-> i
-> String
Formatters.formatIntegral Format t t' 'Integral
f SignMode
s Maybe (Int, AlignMode Any, Char)
forall a. Maybe a
Nothing Maybe (Int, Char)
grouping i
i
formatAnyIntegral Format t t' 'Integral
f SignMode
s (Just (Integer
padSize, AnyAlign AlignMode k
alignMode, Char
c)) Maybe (Int, Char)
grouping i
i = Format t t' 'Integral
-> SignMode
-> Maybe (Int, AlignMode k, Char)
-> Maybe (Int, Char)
-> i
-> String
forall i (t :: AltStatus) (t' :: UpperStatus)
       (k :: AlignForString).
(Show i, Integral i) =>
Format t t' 'Integral
-> SignMode
-> Maybe (Int, AlignMode k, Char)
-> Maybe (Int, Char)
-> i
-> String
Formatters.formatIntegral Format t t' 'Integral
f SignMode
s ((Int, AlignMode k, Char) -> Maybe (Int, AlignMode k, Char)
forall a. a -> Maybe a
Just (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
padSize, AlignMode k
alignMode, Char
c)) Maybe (Int, Char)
grouping i
i

formatAnyFractional :: (RealFloat i) => Formatters.Format t t' 'Formatters.Fractional -> Formatters.SignMode -> Maybe (Integer, AnyAlign, Char) -> Maybe (Int, Char) -> Maybe Int -> i -> String
formatAnyFractional :: Format t t' 'Fractional
-> SignMode
-> Maybe (Integer, AnyAlign, Char)
-> Maybe (Int, Char)
-> Maybe Int
-> i
-> String
formatAnyFractional Format t t' 'Fractional
f SignMode
s Maybe (Integer, AnyAlign, Char)
Nothing Maybe (Int, Char)
grouping Maybe Int
p i
i = Format t t' 'Fractional
-> SignMode
-> Maybe (Int, AlignMode Any, Char)
-> Maybe (Int, Char)
-> Maybe Int
-> i
-> String
forall f (t :: AltStatus) (t' :: UpperStatus)
       (k :: AlignForString).
RealFloat f =>
Format t t' 'Fractional
-> SignMode
-> Maybe (Int, AlignMode k, Char)
-> Maybe (Int, Char)
-> Maybe Int
-> f
-> String
Formatters.formatFractional Format t t' 'Fractional
f SignMode
s Maybe (Int, AlignMode Any, Char)
forall a. Maybe a
Nothing Maybe (Int, Char)
grouping Maybe Int
p i
i
formatAnyFractional Format t t' 'Fractional
f SignMode
s (Just (Integer
padSize, AnyAlign AlignMode k
alignMode, Char
c)) Maybe (Int, Char)
grouping Maybe Int
p i
i = Format t t' 'Fractional
-> SignMode
-> Maybe (Int, AlignMode k, Char)
-> Maybe (Int, Char)
-> Maybe Int
-> i
-> String
forall f (t :: AltStatus) (t' :: UpperStatus)
       (k :: AlignForString).
RealFloat f =>
Format t t' 'Fractional
-> SignMode
-> Maybe (Int, AlignMode k, Char)
-> Maybe (Int, Char)
-> Maybe Int
-> f
-> String
Formatters.formatFractional Format t t' 'Fractional
f SignMode
s ((Int, AlignMode k, Char) -> Maybe (Int, AlignMode k, Char)
forall a. a -> Maybe a
Just (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
padSize, AlignMode k
alignMode, Char
c)) Maybe (Int, Char)
grouping Maybe Int
p i
i

class FormatAny i k where
  formatAny :: Formatters.SignMode -> PaddingK k -> Maybe (Int, Char) -> Maybe Int -> i -> String

instance (FormatAny2 (PyFClassify t) t k) => FormatAny t k where
  formatAny :: SignMode
-> PaddingK k -> Maybe (Int, Char) -> Maybe Int -> t -> String
formatAny = Proxy (PyFClassify t)
-> SignMode
-> PaddingK k
-> Maybe (Int, Char)
-> Maybe Int
-> t
-> String
forall (c :: PyFCategory) i (k :: AlignForString).
FormatAny2 c i k =>
Proxy c
-> SignMode
-> PaddingK k
-> Maybe (Int, Char)
-> Maybe Int
-> i
-> String
formatAny2 (Proxy (PyFClassify t)
forall k (t :: k). Proxy t
Proxy :: Proxy (PyFClassify t))

class FormatAny2 (c :: PyFCategory) (i :: *) (k :: Formatters.AlignForString) where
  formatAny2 :: Proxy c -> Formatters.SignMode -> PaddingK k -> Maybe (Int, Char) -> Maybe Int -> i -> String

instance (Show t, Integral t) => FormatAny2 'PyFIntegral t k where
  formatAny2 :: Proxy 'PyFIntegral
-> SignMode
-> PaddingK k
-> Maybe (Int, Char)
-> Maybe Int
-> t
-> String
formatAny2 Proxy 'PyFIntegral
_ SignMode
s PaddingK k
a Maybe (Int, Char)
p Maybe Int
_precision = Format 'NoAlt 'NoUpper 'Integral
-> SignMode
-> Maybe (Integer, AnyAlign, Char)
-> Maybe (Int, Char)
-> t
-> String
forall i (t :: AltStatus) (t' :: UpperStatus).
(Show i, Integral i) =>
Format t t' 'Integral
-> SignMode
-> Maybe (Integer, AnyAlign, Char)
-> Maybe (Int, Char)
-> i
-> String
formatAnyIntegral Format 'NoAlt 'NoUpper 'Integral
Formatters.Decimal SignMode
s (Padding -> Maybe (Integer, AnyAlign, Char)
newPaddingUnQ (PaddingK k -> Padding
forall (k :: AlignForString). PaddingK k -> Padding
paddingKToPadding PaddingK k
a)) Maybe (Int, Char)
p

instance (RealFloat t) => FormatAny2 'PyFFractional t k where
  formatAny2 :: Proxy 'PyFFractional
-> SignMode
-> PaddingK k
-> Maybe (Int, Char)
-> Maybe Int
-> t
-> String
formatAny2 Proxy 'PyFFractional
_ SignMode
s PaddingK k
a = Format 'CanAlt 'CanUpper 'Fractional
-> SignMode
-> Maybe (Integer, AnyAlign, Char)
-> Maybe (Int, Char)
-> Maybe Int
-> t
-> String
forall i (t :: AltStatus) (t' :: UpperStatus).
RealFloat i =>
Format t t' 'Fractional
-> SignMode
-> Maybe (Integer, AnyAlign, Char)
-> Maybe (Int, Char)
-> Maybe Int
-> i
-> String
formatAnyFractional Format 'CanAlt 'CanUpper 'Fractional
Formatters.Generic SignMode
s (Padding -> Maybe (Integer, AnyAlign, Char)
newPaddingUnQ (PaddingK k -> Padding
forall (k :: AlignForString). PaddingK k -> Padding
paddingKToPadding PaddingK k
a))

newPaddingKForString :: PaddingK 'Formatters.AlignAll -> Maybe (Int, Formatters.AlignMode 'Formatters.AlignAll, Char)
newPaddingKForString :: PaddingK 'AlignAll -> Maybe (Int, AlignMode 'AlignAll, Char)
newPaddingKForString PaddingK 'AlignAll
padding = case PaddingK 'AlignAll
padding of
  PaddingK 'AlignAll
PaddingDefaultK -> Maybe (Int, AlignMode 'AlignAll, Char)
forall a. Maybe a
Nothing
  PaddingK Integer
i Maybe (Maybe Char, AlignMode 'AlignAll)
Nothing -> (Int, AlignMode 'AlignAll, Char)
-> Maybe (Int, AlignMode 'AlignAll, Char)
forall a. a -> Maybe a
Just (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i, AlignMode 'AlignAll
Formatters.AlignLeft, Char
' ') -- default align left and fill with space for string
  PaddingK Integer
i (Just (Maybe Char
mc, AlignMode 'AlignAll
a)) -> (Int, AlignMode 'AlignAll, Char)
-> Maybe (Int, AlignMode 'AlignAll, Char)
forall a. a -> Maybe a
Just (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
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
-> Maybe (Int, Char)
-> Maybe Int
-> t
-> String
formatAny2 Proxy 'PyFString
_ SignMode
_s PaddingK 'AlignAll
a Maybe (Int, Char)
_grouping Maybe Int
precision t
t = Maybe (Int, AlignMode 'AlignAll, Char)
-> Maybe Int -> String -> String
Formatters.formatString (PaddingK 'AlignAll -> Maybe (Int, AlignMode 'AlignAll, Char)
newPaddingKForString PaddingK 'AlignAll
a) Maybe Int
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
-> Maybe (Int, Char)
-> Maybe Int
-> t
-> String
formatAny2 = String
-> Proxy 'PyFString
-> SignMode
-> PaddingK 'AlignNumber
-> Maybe (Int, Char)
-> Maybe Int
-> t
-> String
forall a. HasCallStack => String -> a
error String
"Unreachable"

type family ToFmt t where
  ToFmt 'PyFIntegral = 'Formatters.Integral
  ToFmt 'PyFFractional = 'Formatters.Fractional