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

-- | 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.Kind
import Data.Maybe (fromMaybe)
import Data.Proxy
import Data.String (fromString)
import GHC.TypeLits
import Language.Haskell.TH hiding (Type)
import Language.Haskell.TH.Quote
import PyF.Class
import PyF.Formatters (AnyAlign (..))
import qualified PyF.Formatters as Formatters
import PyF.Internal.PythonSyntax
import Text.Parsec
import Text.Parsec.Error (errorMessages, messageString, setErrorPos, showErrorMessages)
import Text.ParserCombinators.Parsec.Error (Message (..))

-- | 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
  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]
exts <- Q [Extension]
extsEnabled
  let context :: ParsingContext
context = Maybe (Char, Char) -> [Extension] -> ParsingContext
ParsingContext Maybe (Char, Char)
expressionDelimiters [Extension]
exts
  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 ParsecT String () (Reader ParsingContext) [Item]
parseGenericFormatString () String
filename String
s) ParsingContext
context of
    Left ParseError
err -> do
      ParseError
err' <- String -> ParseError -> Q ParseError
overrideErrorForFile String
filename ParseError
err
      String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> Q String -> Q Exp
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> ParseError -> Q String
prettyError String
filename String
s ParseError
err'
    Right [Item]
items -> Q Exp -> Q Exp
postProcess ([Item] -> Q Exp
goFormat [Item]
items)

-- | Display a pretty version of an error, with caret and file context.
prettyError ::
  -- | Filename of the file which contains the error
  FilePath ->
  -- | Content of the file
  String ->
  -- | Parse error from parsec
  ParseError ->
  Q String
prettyError :: String -> String -> ParseError -> Q String
prettyError String
filename String
s ParseError
err = do
  let sourceLoc :: SourcePos
sourceLoc = ParseError -> SourcePos
errorPos ParseError
err
      line :: Line
line = SourcePos -> Line
sourceLine SourcePos
sourceLoc
      column :: Line
column = SourcePos -> Line
sourceColumn SourcePos
sourceLoc
      name :: String
name = SourcePos -> String
sourceName SourcePos
sourceLoc
      carretOffset :: Line
carretOffset = Line
column Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
1
      carret :: String
carret = Line -> Char -> String
forall a. Line -> a -> [a]
replicate Line
carretOffset Char
' ' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"^"
      colIndicator :: String
colIndicator = Line -> String
forall a. Show a => a -> String
show Line
line String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" | "
      colPrefix :: String
colPrefix = Line -> Char -> String
forall a. Line -> a -> [a]
replicate (String -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
length (Line -> String
forall a. Show a => a -> String
show Line
line)) Char
' ' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" |"

  String
code <- case String
filename of
    -- If that's an interectavi file, we don't know much, so just dump the string.
    String
"<interactive>" -> String -> Q String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
s
    String
_ -> do
      String
content <- IO String -> Q String
forall a. IO a -> Q a
runIO (String -> IO String
readFile String
filename)
      String -> Q String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Q String) -> String -> Q String
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
content [String] -> Line -> String
forall a. [a] -> Line -> a
!! (Line
line Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
1)

  String -> Q String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Q String) -> String -> Q String
forall a b. (a -> b) -> a -> b
$
    [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
      [ String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Line -> String
forall a. Show a => a -> String
show Line
line String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Line -> String
forall a. Show a => a -> String
show Line
column String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":",
        String
colPrefix,
        String
colIndicator String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
code,
        String
colPrefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
carret
      ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ParseError -> [String]
formatErrorMessages ParseError
err

-- | Format a bunch of error
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

-- Parsec 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 -> ParseError -> Q ParseError
-- We have no may to recover interactive content
-- So we won't do better than displaying the Parsec
-- error relative to the quasi quote content
overrideErrorForFile :: String -> ParseError -> Q ParseError
overrideErrorForFile String
"<interactive>" ParseError
err = ParseError -> Q ParseError
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParseError
err
-- We know the content of the file here
overrideErrorForFile String
_ ParseError
err = do
  (Line
line, Line
col) <- Loc -> (Line, Line)
loc_start (Loc -> (Line, Line)) -> Q Loc -> Q (Line, Line)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Loc
location
  let sourcePos :: SourcePos
sourcePos = ParseError -> SourcePos
errorPos ParseError
err
      sourcePos' :: SourcePos
sourcePos'
        | SourcePos -> Line
sourceLine SourcePos
sourcePos Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
== Line
1 = SourcePos -> Line -> SourcePos
incSourceColumn (SourcePos -> Line -> SourcePos
incSourceLine SourcePos
sourcePos (Line
line Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
1)) (Line
col Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
1)
        | Bool
otherwise = SourcePos -> Line -> SourcePos
setSourceColumn (SourcePos -> Line -> SourcePos
incSourceLine SourcePos
sourcePos (Line
line Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
1)) (SourcePos -> Line
sourceColumn SourcePos
sourcePos)
  ParseError -> Q ParseError
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseError -> Q ParseError) -> ParseError -> Q ParseError
forall a b. (a -> b) -> a -> b
$ SourcePos -> ParseError -> ParseError
setErrorPos SourcePos
sourcePos' ParseError
err

{-
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 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 Line
defaultFloatPrecision = Line -> Maybe Line
forall a. a -> Maybe a
Just Line
6

-- | Precision to maybe
splicePrecision :: Maybe Int -> Precision -> Q Exp
splicePrecision :: Maybe Line -> Precision -> Q Exp
splicePrecision Maybe Line
def Precision
PrecisionDefault = [|def|]
splicePrecision Maybe Line
_ (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 -> Line -> Q Exp
toGrp Maybe Char
mb Line
a = [|grp|]
  where
    grp :: Maybe (Line, Char)
grp = (Line
a,) (Char -> (Line, Char)) -> Maybe Char -> Maybe (Line, 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 :: PyfFormatIntegral 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 (Line, Char)
-> i
-> String
formatAnyIntegral Format t t' 'Integral
f SignMode
s Maybe (Integer, AnyAlign, Char)
Nothing Maybe (Line, Char)
grouping i
i = Format t t' 'Integral
-> SignMode
-> Maybe (Line, AlignMode Any, Char)
-> Maybe (Line, Char)
-> i
-> String
forall i (t :: AltStatus) (t' :: UpperStatus)
       (k :: AlignForString).
PyfFormatIntegral i =>
Format t t' 'Integral
-> SignMode
-> Maybe (Line, AlignMode k, Char)
-> Maybe (Line, Char)
-> i
-> String
pyfFormatIntegral Format t t' 'Integral
f SignMode
s Maybe (Line, AlignMode Any, Char)
forall a. Maybe a
Nothing Maybe (Line, Char)
grouping i
i
formatAnyIntegral Format t t' 'Integral
f SignMode
s (Just (Integer
padSize, AnyAlign AlignMode k
alignMode, Char
c)) Maybe (Line, Char)
grouping i
i = Format t t' 'Integral
-> SignMode
-> Maybe (Line, AlignMode k, Char)
-> Maybe (Line, Char)
-> i
-> String
forall i (t :: AltStatus) (t' :: UpperStatus)
       (k :: AlignForString).
PyfFormatIntegral i =>
Format t t' 'Integral
-> SignMode
-> Maybe (Line, AlignMode k, Char)
-> Maybe (Line, Char)
-> i
-> String
pyfFormatIntegral Format t t' 'Integral
f SignMode
s ((Line, AlignMode k, Char) -> Maybe (Line, AlignMode k, Char)
forall a. a -> Maybe a
Just (Integer -> Line
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
padSize, AlignMode k
alignMode, Char
c)) Maybe (Line, Char)
grouping i
i

formatAnyFractional :: (PyfFormatFractional 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 (Line, Char)
-> Maybe Line
-> i
-> String
formatAnyFractional Format t t' 'Fractional
f SignMode
s Maybe (Integer, AnyAlign, Char)
Nothing Maybe (Line, Char)
grouping Maybe Line
p i
i = Format t t' 'Fractional
-> SignMode
-> Maybe (Line, AlignMode Any, Char)
-> Maybe (Line, Char)
-> Maybe Line
-> i
-> String
forall a (t :: AltStatus) (t' :: UpperStatus)
       (k :: AlignForString).
PyfFormatFractional a =>
Format t t' 'Fractional
-> SignMode
-> Maybe (Line, AlignMode k, Char)
-> Maybe (Line, Char)
-> Maybe Line
-> a
-> String
pyfFormatFractional Format t t' 'Fractional
f SignMode
s Maybe (Line, AlignMode Any, Char)
forall a. Maybe a
Nothing Maybe (Line, Char)
grouping Maybe Line
p i
i
formatAnyFractional Format t t' 'Fractional
f SignMode
s (Just (Integer
padSize, AnyAlign AlignMode k
alignMode, Char
c)) Maybe (Line, Char)
grouping Maybe Line
p i
i = Format t t' 'Fractional
-> SignMode
-> Maybe (Line, AlignMode k, Char)
-> Maybe (Line, Char)
-> Maybe Line
-> i
-> String
forall a (t :: AltStatus) (t' :: UpperStatus)
       (k :: AlignForString).
PyfFormatFractional a =>
Format t t' 'Fractional
-> SignMode
-> Maybe (Line, AlignMode k, Char)
-> Maybe (Line, Char)
-> Maybe Line
-> a
-> String
pyfFormatFractional Format t t' 'Fractional
f SignMode
s ((Line, AlignMode k, Char) -> Maybe (Line, AlignMode k, Char)
forall a. a -> Maybe a
Just (Integer -> Line
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
padSize, AlignMode k
alignMode, Char
c)) Maybe (Line, Char)
grouping Maybe Line
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 (Line, Char) -> Maybe Line -> t -> String
formatAny = Proxy (PyFClassify t)
-> SignMode
-> PaddingK k
-> Maybe (Line, Char)
-> Maybe Line
-> t
-> String
forall (c :: PyFCategory) i (k :: AlignForString).
FormatAny2 c i k =>
Proxy c
-> SignMode
-> PaddingK k
-> Maybe (Line, Char)
-> Maybe Line
-> 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 :: 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 (Line, Char)
-> Maybe Line
-> t
-> String
formatAny2 Proxy 'PyFIntegral
_ SignMode
s PaddingK k
a Maybe (Line, Char)
p Maybe Line
_precision = Format 'NoAlt 'NoUpper 'Integral
-> SignMode
-> Maybe (Integer, AnyAlign, Char)
-> Maybe (Line, Char)
-> t
-> String
forall i (t :: AltStatus) (t' :: UpperStatus).
PyfFormatIntegral i =>
Format t t' 'Integral
-> SignMode
-> Maybe (Integer, AnyAlign, Char)
-> Maybe (Line, 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 (Line, Char)
p

instance (PyfFormatFractional t) => FormatAny2 'PyFFractional t k where
  formatAny2 :: Proxy 'PyFFractional
-> SignMode
-> PaddingK k
-> Maybe (Line, Char)
-> Maybe Line
-> t
-> String
formatAny2 Proxy 'PyFFractional
_ SignMode
s PaddingK k
a = Format 'CanAlt 'CanUpper 'Fractional
-> SignMode
-> Maybe (Integer, AnyAlign, Char)
-> Maybe (Line, Char)
-> Maybe Line
-> t
-> String
forall i (t :: AltStatus) (t' :: UpperStatus).
PyfFormatFractional i =>
Format t t' 'Fractional
-> SignMode
-> Maybe (Integer, AnyAlign, Char)
-> Maybe (Line, Char)
-> Maybe Line
-> 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 (Line, AlignMode 'AlignAll, Char)
newPaddingKForString PaddingK 'AlignAll
padding = case PaddingK 'AlignAll
padding of
  PaddingK 'AlignAll
PaddingDefaultK -> Maybe (Line, AlignMode 'AlignAll, Char)
forall a. Maybe a
Nothing
  PaddingK Integer
i Maybe (Maybe Char, AlignMode 'AlignAll)
Nothing -> (Line, AlignMode 'AlignAll, Char)
-> Maybe (Line, AlignMode 'AlignAll, Char)
forall a. a -> Maybe a
Just (Integer -> Line
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)) -> (Line, AlignMode 'AlignAll, Char)
-> Maybe (Line, AlignMode 'AlignAll, Char)
forall a. a -> Maybe a
Just (Integer -> Line
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 (Line, Char)
-> Maybe Line
-> t
-> String
formatAny2 Proxy 'PyFString
_ SignMode
_s PaddingK 'AlignAll
a Maybe (Line, Char)
_grouping Maybe Line
precision t
t = Maybe (Line, AlignMode 'AlignAll, Char)
-> Maybe Line -> String -> String
Formatters.formatString (PaddingK 'AlignAll -> Maybe (Line, AlignMode 'AlignAll, Char)
newPaddingKForString PaddingK 'AlignAll
a) Maybe Line
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 (Line, Char)
-> Maybe Line
-> t
-> String
formatAny2 = String
-> Proxy 'PyFString
-> SignMode
-> PaddingK 'AlignNumber
-> Maybe (Line, Char)
-> Maybe Line
-> t
-> String
forall a. HasCallStack => String -> a
error String
"Unreachable"