{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}

module THSH.Internal.PyFInternals
  ( checkOneItem
  , getFormatExpr
  , ParsingContext (..)
  , Item (..)
  , parseGenericFormatString
  ) where

-- ghc modules
import           GHC                        (SrcSpan)
import           GHC.TypeLits               (ErrorMessage (Text), TypeError)
import           Language.Haskell.TH.Syntax (Exp (..), Lit (..), Q (..))
-- baes module
import           Data.Kind                  (Type)
import           Data.Maybe                 (catMaybes, fromMaybe)
import           Data.Proxy                 (Proxy (Proxy))
-- PyF module (Note: we take the risks of using internal functions)
import           PyF.Class                  (PyFCategory (..), PyFClassify, PyFToString (..), PyfFormatFractional (..),
                                             PyfFormatIntegral (..))
import           PyF.Formatters             (AnyAlign (..))
import qualified PyF.Formatters             as Formatters
import           PyF.Internal.PythonSyntax  (AlternateForm (..), ExprOrValue (..), FormatMode (..), Item (..),
                                             Padding (..), ParsingContext (..), Precision (..), TypeFormat (..),
                                             parseGenericFormatString, pattern DefaultFormatMode)
--
import           THSH.Internal.HsExprUtils  (RdrName, findFreeVariables)
import           THSH.Internal.THUtils      (freeVariableByNameExists)


{- ========== checkOneItem ========== -}

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
  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))
freeVariableByNameExists [(SrcSpan, RdrName)]
allNames
  let resFinal = [Maybe (String, SrcSpan)] -> [(String, SrcSpan)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (String, SrcSpan)]
res

  case 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
srcSpan) : [(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
srcSpan, String
err)

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

{- ========== getFormatExpr ========== -}

getFormatExpr :: Maybe FormatMode -> Q Exp
getFormatExpr :: Maybe FormatMode -> Q Exp
getFormatExpr Maybe FormatMode
mode = let mode' :: FormatMode
mode' = FormatMode -> Maybe FormatMode -> FormatMode
forall a. a -> Maybe a -> a
fromMaybe FormatMode
DefaultFormatMode Maybe FormatMode
mode in FormatMode -> Q Exp
padAndFormat FormatMode
mode'

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 $(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)|]
  -- Floating
  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)|]
  -- Default / String
  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|]

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

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|]

-- | Precision to maybe
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

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, ' ')|] -- Right align and space is default for any object, except string
    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
-- Note: this is a literal provided integral. We use explicit case to ::Int so it won't warn about defaulting
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)|]

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
' ') -- 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 :: 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)

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

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
' ') -- default align left and fill with space for string
  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)

-- TODO: _s(ign) and _grouping should trigger errors
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"