{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}

-- |
--
-- Formatters for integral / fractional and strings.
--
-- Is support:
--
-- For all types:
--
--   * Grouping of the integral part (i.e: adding a custom char to separate groups of digits)
--   * Padding (left, right, around, and between the sign and the number)
--   * Sign handling (i.e: display the positive sign or not)
--
-- For floating:
--
--   * Precision
--   * Fixed / Exponential / Generic formatting
--
-- For integrals:
--
--    * Binary / Hexa / Octal / Character representation
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module PyF.Formatters
  ( -- * Generic formatting function
    formatString,
    formatIntegral,
    formatFractional,

    -- * Formatter details
    AltStatus (..),
    UpperStatus (..),
    FormatType (..),
    Format (..),
    SignMode (..),
    AnyAlign (..),

    -- * Internal usage only
    AlignMode (..),
    getAlignForString,
    AlignForString (..),
  )
where

import Data.Char (chr, toUpper)
import Data.List (intercalate)
import Language.Haskell.TH.Syntax
import qualified Numeric

-- ADT for API

-- | Sign handling
data SignMode
  = -- | Display '-' sign and '+' sign
    Plus
  | -- | Only display '-' sign
    Minus
  | -- | Display '-' sign and a space for positive numbers
    Space
  deriving (Int -> SignMode -> ShowS
[SignMode] -> ShowS
SignMode -> String
(Int -> SignMode -> ShowS)
-> (SignMode -> String) -> ([SignMode] -> ShowS) -> Show SignMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignMode] -> ShowS
$cshowList :: [SignMode] -> ShowS
show :: SignMode -> String
$cshow :: SignMode -> String
showsPrec :: Int -> SignMode -> ShowS
$cshowsPrec :: Int -> SignMode -> ShowS
Show)

data AlignForString = AlignAll | AlignNumber
  deriving (Int -> AlignForString -> ShowS
[AlignForString] -> ShowS
AlignForString -> String
(Int -> AlignForString -> ShowS)
-> (AlignForString -> String)
-> ([AlignForString] -> ShowS)
-> Show AlignForString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlignForString] -> ShowS
$cshowList :: [AlignForString] -> ShowS
show :: AlignForString -> String
$cshow :: AlignForString -> String
showsPrec :: Int -> AlignForString -> ShowS
$cshowsPrec :: Int -> AlignForString -> ShowS
Show)

-- | Alignement
data AlignMode (k :: AlignForString) where
  -- | Left padding
  AlignLeft :: AlignMode 'AlignAll
  -- | Right padding
  AlignRight :: AlignMode 'AlignAll
  -- | Padding will be added between the sign and the number
  AlignInside :: AlignMode 'AlignNumber
  -- | Padding will be added around the valueber
  AlignCenter :: AlignMode 'AlignAll

deriving instance Show (AlignMode k)

-- The generic version

-- | Existential version of 'AlignMode'
data AnyAlign where
  AnyAlign :: AlignMode (k :: AlignForString) -> AnyAlign

deriving instance Show AnyAlign

deriving instance Lift AnyAlign

-- I hate how a must list all cases, any solution ?
-- o = Just o does not work
getAlignForString :: AlignMode k -> Maybe (AlignMode 'AlignAll)
getAlignForString :: AlignMode k -> Maybe (AlignMode 'AlignAll)
getAlignForString AlignMode k
AlignInside = Maybe (AlignMode 'AlignAll)
forall a. Maybe a
Nothing
getAlignForString AlignMode k
AlignRight = AlignMode 'AlignAll -> Maybe (AlignMode 'AlignAll)
forall a. a -> Maybe a
Just AlignMode 'AlignAll
AlignRight
getAlignForString AlignMode k
AlignCenter = AlignMode 'AlignAll -> Maybe (AlignMode 'AlignAll)
forall a. a -> Maybe a
Just AlignMode 'AlignAll
AlignCenter
getAlignForString AlignMode k
AlignLeft = AlignMode 'AlignAll -> Maybe (AlignMode 'AlignAll)
forall a. a -> Maybe a
Just AlignMode 'AlignAll
AlignLeft

-- | This formatter support alternate version
data AltStatus = CanAlt | NoAlt

-- | This formatter support Upper case version
data UpperStatus = CanUpper | NoUpper

-- | This formatter formats an integral or a fractional
data FormatType = Fractional | Integral

-- | All the Formatters
data Format (k :: AltStatus) (k' :: UpperStatus) (k'' :: FormatType) where
  -- Integrals
  Decimal :: Format 'NoAlt 'NoUpper 'Integral
  Character :: Format 'NoAlt 'NoUpper 'Integral
  Binary :: Format 'CanAlt 'NoUpper 'Integral
  Hexa :: Format 'CanAlt 'CanUpper 'Integral
  Octal :: Format 'CanAlt 'NoUpper 'Integral
  -- Fractionals
  Fixed :: Format 'CanAlt 'CanUpper 'Fractional
  Exponent :: Format 'CanAlt 'CanUpper 'Fractional
  Generic :: Format 'CanAlt 'CanUpper 'Fractional
  Percent :: Format 'CanAlt 'NoUpper 'Fractional
  -- Meta formats
  Alternate :: Format 'CanAlt u f -> Format 'NoAlt u f
  -- Upper should come AFTER Alt, so this disallow any future alt
  Upper :: Format alt 'CanUpper f -> Format 'NoAlt 'NoUpper f


newtype ShowIntegral i = ShowIntegral i
  deriving (Num (ShowIntegral i)
Ord (ShowIntegral i)
Num (ShowIntegral i)
-> Ord (ShowIntegral i)
-> (ShowIntegral i -> Rational)
-> Real (ShowIntegral i)
ShowIntegral i -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall i. Real i => Num (ShowIntegral i)
forall i. Real i => Ord (ShowIntegral i)
forall i. Real i => ShowIntegral i -> Rational
toRational :: ShowIntegral i -> Rational
$ctoRational :: forall i. Real i => ShowIntegral i -> Rational
$cp2Real :: forall i. Real i => Ord (ShowIntegral i)
$cp1Real :: forall i. Real i => Num (ShowIntegral i)
Real, Int -> ShowIntegral i
ShowIntegral i -> Int
ShowIntegral i -> [ShowIntegral i]
ShowIntegral i -> ShowIntegral i
ShowIntegral i -> ShowIntegral i -> [ShowIntegral i]
ShowIntegral i
-> ShowIntegral i -> ShowIntegral i -> [ShowIntegral i]
(ShowIntegral i -> ShowIntegral i)
-> (ShowIntegral i -> ShowIntegral i)
-> (Int -> ShowIntegral i)
-> (ShowIntegral i -> Int)
-> (ShowIntegral i -> [ShowIntegral i])
-> (ShowIntegral i -> ShowIntegral i -> [ShowIntegral i])
-> (ShowIntegral i -> ShowIntegral i -> [ShowIntegral i])
-> (ShowIntegral i
    -> ShowIntegral i -> ShowIntegral i -> [ShowIntegral i])
-> Enum (ShowIntegral i)
forall i. Enum i => Int -> ShowIntegral i
forall i. Enum i => ShowIntegral i -> Int
forall i. Enum i => ShowIntegral i -> [ShowIntegral i]
forall i. Enum i => ShowIntegral i -> ShowIntegral i
forall i.
Enum i =>
ShowIntegral i -> ShowIntegral i -> [ShowIntegral i]
forall i.
Enum i =>
ShowIntegral i
-> ShowIntegral i -> ShowIntegral i -> [ShowIntegral i]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ShowIntegral i
-> ShowIntegral i -> ShowIntegral i -> [ShowIntegral i]
$cenumFromThenTo :: forall i.
Enum i =>
ShowIntegral i
-> ShowIntegral i -> ShowIntegral i -> [ShowIntegral i]
enumFromTo :: ShowIntegral i -> ShowIntegral i -> [ShowIntegral i]
$cenumFromTo :: forall i.
Enum i =>
ShowIntegral i -> ShowIntegral i -> [ShowIntegral i]
enumFromThen :: ShowIntegral i -> ShowIntegral i -> [ShowIntegral i]
$cenumFromThen :: forall i.
Enum i =>
ShowIntegral i -> ShowIntegral i -> [ShowIntegral i]
enumFrom :: ShowIntegral i -> [ShowIntegral i]
$cenumFrom :: forall i. Enum i => ShowIntegral i -> [ShowIntegral i]
fromEnum :: ShowIntegral i -> Int
$cfromEnum :: forall i. Enum i => ShowIntegral i -> Int
toEnum :: Int -> ShowIntegral i
$ctoEnum :: forall i. Enum i => Int -> ShowIntegral i
pred :: ShowIntegral i -> ShowIntegral i
$cpred :: forall i. Enum i => ShowIntegral i -> ShowIntegral i
succ :: ShowIntegral i -> ShowIntegral i
$csucc :: forall i. Enum i => ShowIntegral i -> ShowIntegral i
Enum, Eq (ShowIntegral i)
Eq (ShowIntegral i)
-> (ShowIntegral i -> ShowIntegral i -> Ordering)
-> (ShowIntegral i -> ShowIntegral i -> Bool)
-> (ShowIntegral i -> ShowIntegral i -> Bool)
-> (ShowIntegral i -> ShowIntegral i -> Bool)
-> (ShowIntegral i -> ShowIntegral i -> Bool)
-> (ShowIntegral i -> ShowIntegral i -> ShowIntegral i)
-> (ShowIntegral i -> ShowIntegral i -> ShowIntegral i)
-> Ord (ShowIntegral i)
ShowIntegral i -> ShowIntegral i -> Bool
ShowIntegral i -> ShowIntegral i -> Ordering
ShowIntegral i -> ShowIntegral i -> ShowIntegral i
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall i. Ord i => Eq (ShowIntegral i)
forall i. Ord i => ShowIntegral i -> ShowIntegral i -> Bool
forall i. Ord i => ShowIntegral i -> ShowIntegral i -> Ordering
forall i.
Ord i =>
ShowIntegral i -> ShowIntegral i -> ShowIntegral i
min :: ShowIntegral i -> ShowIntegral i -> ShowIntegral i
$cmin :: forall i.
Ord i =>
ShowIntegral i -> ShowIntegral i -> ShowIntegral i
max :: ShowIntegral i -> ShowIntegral i -> ShowIntegral i
$cmax :: forall i.
Ord i =>
ShowIntegral i -> ShowIntegral i -> ShowIntegral i
>= :: ShowIntegral i -> ShowIntegral i -> Bool
$c>= :: forall i. Ord i => ShowIntegral i -> ShowIntegral i -> Bool
> :: ShowIntegral i -> ShowIntegral i -> Bool
$c> :: forall i. Ord i => ShowIntegral i -> ShowIntegral i -> Bool
<= :: ShowIntegral i -> ShowIntegral i -> Bool
$c<= :: forall i. Ord i => ShowIntegral i -> ShowIntegral i -> Bool
< :: ShowIntegral i -> ShowIntegral i -> Bool
$c< :: forall i. Ord i => ShowIntegral i -> ShowIntegral i -> Bool
compare :: ShowIntegral i -> ShowIntegral i -> Ordering
$ccompare :: forall i. Ord i => ShowIntegral i -> ShowIntegral i -> Ordering
$cp1Ord :: forall i. Ord i => Eq (ShowIntegral i)
Ord, ShowIntegral i -> ShowIntegral i -> Bool
(ShowIntegral i -> ShowIntegral i -> Bool)
-> (ShowIntegral i -> ShowIntegral i -> Bool)
-> Eq (ShowIntegral i)
forall i. Eq i => ShowIntegral i -> ShowIntegral i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShowIntegral i -> ShowIntegral i -> Bool
$c/= :: forall i. Eq i => ShowIntegral i -> ShowIntegral i -> Bool
== :: ShowIntegral i -> ShowIntegral i -> Bool
$c== :: forall i. Eq i => ShowIntegral i -> ShowIntegral i -> Bool
Eq, Integer -> ShowIntegral i
ShowIntegral i -> ShowIntegral i
ShowIntegral i -> ShowIntegral i -> ShowIntegral i
(ShowIntegral i -> ShowIntegral i -> ShowIntegral i)
-> (ShowIntegral i -> ShowIntegral i -> ShowIntegral i)
-> (ShowIntegral i -> ShowIntegral i -> ShowIntegral i)
-> (ShowIntegral i -> ShowIntegral i)
-> (ShowIntegral i -> ShowIntegral i)
-> (ShowIntegral i -> ShowIntegral i)
-> (Integer -> ShowIntegral i)
-> Num (ShowIntegral i)
forall i. Num i => Integer -> ShowIntegral i
forall i. Num i => ShowIntegral i -> ShowIntegral i
forall i.
Num i =>
ShowIntegral i -> ShowIntegral i -> ShowIntegral i
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ShowIntegral i
$cfromInteger :: forall i. Num i => Integer -> ShowIntegral i
signum :: ShowIntegral i -> ShowIntegral i
$csignum :: forall i. Num i => ShowIntegral i -> ShowIntegral i
abs :: ShowIntegral i -> ShowIntegral i
$cabs :: forall i. Num i => ShowIntegral i -> ShowIntegral i
negate :: ShowIntegral i -> ShowIntegral i
$cnegate :: forall i. Num i => ShowIntegral i -> ShowIntegral i
* :: ShowIntegral i -> ShowIntegral i -> ShowIntegral i
$c* :: forall i.
Num i =>
ShowIntegral i -> ShowIntegral i -> ShowIntegral i
- :: ShowIntegral i -> ShowIntegral i -> ShowIntegral i
$c- :: forall i.
Num i =>
ShowIntegral i -> ShowIntegral i -> ShowIntegral i
+ :: ShowIntegral i -> ShowIntegral i -> ShowIntegral i
$c+ :: forall i.
Num i =>
ShowIntegral i -> ShowIntegral i -> ShowIntegral i
Num, Enum (ShowIntegral i)
Real (ShowIntegral i)
Real (ShowIntegral i)
-> Enum (ShowIntegral i)
-> (ShowIntegral i -> ShowIntegral i -> ShowIntegral i)
-> (ShowIntegral i -> ShowIntegral i -> ShowIntegral i)
-> (ShowIntegral i -> ShowIntegral i -> ShowIntegral i)
-> (ShowIntegral i -> ShowIntegral i -> ShowIntegral i)
-> (ShowIntegral i
    -> ShowIntegral i -> (ShowIntegral i, ShowIntegral i))
-> (ShowIntegral i
    -> ShowIntegral i -> (ShowIntegral i, ShowIntegral i))
-> (ShowIntegral i -> Integer)
-> Integral (ShowIntegral i)
ShowIntegral i -> Integer
ShowIntegral i
-> ShowIntegral i -> (ShowIntegral i, ShowIntegral i)
ShowIntegral i -> ShowIntegral i -> ShowIntegral i
forall i. Integral i => Enum (ShowIntegral i)
forall i. Integral i => Real (ShowIntegral i)
forall i. Integral i => ShowIntegral i -> Integer
forall i.
Integral i =>
ShowIntegral i
-> ShowIntegral i -> (ShowIntegral i, ShowIntegral i)
forall i.
Integral i =>
ShowIntegral i -> ShowIntegral i -> ShowIntegral i
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: ShowIntegral i -> Integer
$ctoInteger :: forall i. Integral i => ShowIntegral i -> Integer
divMod :: ShowIntegral i
-> ShowIntegral i -> (ShowIntegral i, ShowIntegral i)
$cdivMod :: forall i.
Integral i =>
ShowIntegral i
-> ShowIntegral i -> (ShowIntegral i, ShowIntegral i)
quotRem :: ShowIntegral i
-> ShowIntegral i -> (ShowIntegral i, ShowIntegral i)
$cquotRem :: forall i.
Integral i =>
ShowIntegral i
-> ShowIntegral i -> (ShowIntegral i, ShowIntegral i)
mod :: ShowIntegral i -> ShowIntegral i -> ShowIntegral i
$cmod :: forall i.
Integral i =>
ShowIntegral i -> ShowIntegral i -> ShowIntegral i
div :: ShowIntegral i -> ShowIntegral i -> ShowIntegral i
$cdiv :: forall i.
Integral i =>
ShowIntegral i -> ShowIntegral i -> ShowIntegral i
rem :: ShowIntegral i -> ShowIntegral i -> ShowIntegral i
$crem :: forall i.
Integral i =>
ShowIntegral i -> ShowIntegral i -> ShowIntegral i
quot :: ShowIntegral i -> ShowIntegral i -> ShowIntegral i
$cquot :: forall i.
Integral i =>
ShowIntegral i -> ShowIntegral i -> ShowIntegral i
$cp2Integral :: forall i. Integral i => Enum (ShowIntegral i)
$cp1Integral :: forall i. Integral i => Real (ShowIntegral i)
Integral)

-- | Stupid instance in order to use 'Numeric.showIntAtBase' which needs a
-- 'Show' constraint for error reporting when number are negative.
-- However, in 'reprIntegral', there is no negative number, so the case is
-- impossible, but it allows the removal of the 'Show' constraint.
instance Show (ShowIntegral i) where
  show :: ShowIntegral i -> String
show ShowIntegral i
_ = ShowS
forall a. HasCallStack => String -> a
error String
"show should not be called on ShowIntegral"

-- Internal Integral
-- Needed for debug in Numeric function, this is painful
reprIntegral :: (Integral i) => Format t t' 'Integral -> i -> Repr
reprIntegral :: Format t t' 'Integral -> i -> Repr
reprIntegral Format t t' 'Integral
fmt i
i = Sign -> String -> Repr
IntegralRepr Sign
sign (String -> Repr) -> String -> Repr
forall a b. (a -> b) -> a -> b
$ Format t t' 'Integral -> String
forall (t :: AltStatus) (t' :: UpperStatus).
Format t t' 'Integral -> String
format Format t t' 'Integral
fmt
  where
    format :: Format t t' 'Integral -> String
    format :: Format t t' 'Integral -> String
format = \case
      Format t t' 'Integral
Decimal -> i -> ShowS
forall a. Integral a => a -> ShowS
Numeric.showInt i
iAbs String
""
      Format t t' 'Integral
Octal -> ShowIntegral i -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
Numeric.showOct (i -> ShowIntegral i
forall i. i -> ShowIntegral i
ShowIntegral i
iAbs) String
""
      Format t t' 'Integral
Binary -> ShowIntegral i -> (Int -> Char) -> ShowIntegral i -> ShowS
forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
Numeric.showIntAtBase ShowIntegral i
2 (\Int
digit -> if Int
digit Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Char
'0' else Char
'1') (i -> ShowIntegral i
forall i. i -> ShowIntegral i
ShowIntegral i
iAbs) String
""
      Format t t' 'Integral
Hexa -> ShowIntegral i -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
Numeric.showHex (i -> ShowIntegral i
forall i. i -> ShowIntegral i
ShowIntegral i
iAbs) String
""
      Upper Format alt 'CanUpper 'Integral
fmt' -> (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Format alt 'CanUpper 'Integral -> String
forall (t :: AltStatus) (t' :: UpperStatus).
Format t t' 'Integral -> String
format Format alt 'CanUpper 'Integral
fmt'
      Format t t' 'Integral
Character -> [Int -> Char
chr (i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i)]
      Alternate Format 'CanAlt t' 'Integral
fmt' -> Format 'CanAlt t' 'Integral -> String
forall (t :: AltStatus) (t' :: UpperStatus).
Format t t' 'Integral -> String
format Format 'CanAlt t' 'Integral
fmt'
    (Sign
sign, i
iAbs) = i -> (Sign, i)
forall b. (Num b, Ord b) => b -> (Sign, b)
splitSign i
i

prefixIntegral :: Format t t' 'Integral -> String
prefixIntegral :: Format t t' 'Integral -> String
prefixIntegral (Alternate Format 'CanAlt t' 'Integral
Octal) = String
"0o"
prefixIntegral (Alternate Format 'CanAlt t' 'Integral
Binary) = String
"0b"
prefixIntegral (Alternate Format 'CanAlt t' 'Integral
Hexa) = String
"0x"
prefixIntegral (Upper Format alt 'CanUpper 'Integral
f) = Char -> Char
toUpper (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Format alt 'CanUpper 'Integral -> String
forall (t :: AltStatus) (t' :: UpperStatus).
Format t t' 'Integral -> String
prefixIntegral Format alt 'CanUpper 'Integral
f
prefixIntegral Format t t' 'Integral
_ = String
""

splitSign :: (Num b, Ord b) => b -> (Sign, b)
splitSign :: b -> (Sign, b)
splitSign b
v = (if b
v b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
0 then Sign
Negative else Sign
Positive, b -> b
forall a. Num a => a -> a
abs b
v)

-- Internal Fractional
reprFractional :: (RealFloat f) => Format t t' 'Fractional -> Maybe Int -> f -> Repr
reprFractional :: Format t t' 'Fractional -> Maybe Int -> f -> Repr
reprFractional Format t t' 'Fractional
fmt Maybe Int
precision f
f
  | f -> Bool
forall a. RealFloat a => a -> Bool
isInfinite f
f = Sign -> String -> Repr
Infinite Sign
sign (ShowS
upperIt String
"inf")
  | f -> Bool
forall a. RealFloat a => a -> Bool
isNaN f
f = String -> Repr
NaN (ShowS
upperIt String
"nan")
  | f -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero f
f =
    let (FractionalRepr Sign
Positive String
aa String
bb String
cc) = Format t t' 'Fractional -> Maybe Int -> f -> Repr
forall f (t :: AltStatus) (t' :: UpperStatus).
RealFloat f =>
Format t t' 'Fractional -> Maybe Int -> f -> Repr
reprFractional Format t t' 'Fractional
fmt Maybe Int
precision (f -> f
forall a. Num a => a -> a
abs f
f)
     in Sign -> String -> String -> String -> Repr
FractionalRepr Sign
Negative String
aa String
bb String
cc
  | Bool
otherwise = Sign -> String -> String -> String -> Repr
FractionalRepr Sign
sign String
decimalPart String
fractionalPart String
suffixPart
  where
    upperIt :: ShowS
upperIt String
s = case Format t t' 'Fractional
fmt of
      Upper Format alt 'CanUpper 'Fractional
_ -> Char -> Char
toUpper (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
s
      Format t t' 'Fractional
_ -> String
s
    (Sign
sign, f
iAbs) = f -> (Sign, f)
forall b. (Num b, Ord b) => b -> (Sign, b)
splitSign f
f
    (String
decimalPart, String
fractionalPart, String
suffixPart) = Format t t' 'Fractional -> (String, String, String)
forall (t :: AltStatus) (t' :: UpperStatus).
Format t t' 'Fractional -> (String, String, String)
format Format t t' 'Fractional
fmt
    format :: Format t t' 'Fractional -> (String, String, String)
    format :: Format t t' 'Fractional -> (String, String, String)
format = \case
      Format t t' 'Fractional
Fixed -> String -> (String, String, String)
splitFractional (Maybe Int -> f -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
Numeric.showFFloatAlt Maybe Int
precision f
iAbs String
"")
      Format t t' 'Fractional
Exponent -> Maybe Int -> (String, String, String) -> (String, String, String)
overrideExponent Maybe Int
precision ((String, String, String) -> (String, String, String))
-> (String, String, String) -> (String, String, String)
forall a b. (a -> b) -> a -> b
$ String -> (String, String, String)
splitFractionalExp (Maybe Int -> f -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
Numeric.showEFloat Maybe Int
precision f
iAbs String
"")
      Format t t' 'Fractional
Generic -> String -> (String, String, String)
splitFractionalExp (Maybe Int -> f -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
Numeric.showGFloatAlt Maybe Int
precision f
iAbs String
"")
      Format t t' 'Fractional
Percent -> let (String
a, String
b, String
"") = String -> (String, String, String)
splitFractional (Maybe Int -> f -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
Numeric.showFFloatAlt Maybe Int
precision (f
iAbs f -> f -> f
forall a. Num a => a -> a -> a
* f
100) String
"") in (String
a, String
b, String
"%")
      Alternate Format 'CanAlt t' 'Fractional
fmt' -> Format 'CanAlt t' 'Fractional -> (String, String, String)
forall (t :: AltStatus) (t' :: UpperStatus).
Format t t' 'Fractional -> (String, String, String)
format Format 'CanAlt t' 'Fractional
fmt'
      Upper Format alt 'CanUpper 'Fractional
fmt' ->
        let (String
a, String
b, String
c) = Format alt 'CanUpper 'Fractional -> (String, String, String)
forall (t :: AltStatus) (t' :: UpperStatus).
Format t t' 'Fractional -> (String, String, String)
format Format alt 'CanUpper 'Fractional
fmt'
         in (String
a, String
b, (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
c)
    splitFractional :: String -> (String, String, String)
    splitFractional :: String -> (String, String, String)
splitFractional String
s =
      let (String
a, String
b) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') String
s
       in (String
a, Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
b, String
"")

overrideExponent :: Maybe Int -> (String, String, String) -> (String, String, String)
overrideExponent :: Maybe Int -> (String, String, String) -> (String, String, String)
overrideExponent (Just Int
0) (String
a, String
"0", String
c) = (String
a, String
"", String
c)
overrideExponent Maybe Int
_ (String, String, String)
o = (String, String, String)
o

splitFractionalExp :: String -> (String, String, String)
splitFractionalExp :: String -> (String, String, String)
splitFractionalExp String
s =
  let (String
a, String
b') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'e') String
s
      b :: String
b = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
b'
      (String
fpart, String
e) = case String
b' of
        Char
'e' : String
_ -> (String
"", String
b')
        String
_ -> (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'e') String
b
   in ( String
a,
        String
fpart,
        case String
e of
          Char
'e' : Char
'-' : String
n -> String
"e-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
pad String
n
          Char
'e' : String
n -> String
"e+" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
pad String
n
          String
leftover -> String
leftover
      )
  where
    pad :: ShowS
pad n :: String
n@[Char
_] = Char
'0' Char -> ShowS
forall a. a -> [a] -> [a]
: String
n
    pad String
n = String
n

-- Cases Integral / Fractional

group :: Repr -> Maybe (Int, Char) -> Repr
group :: Repr -> Maybe (Int, Char) -> Repr
group (IntegralRepr Sign
s String
str) (Just (Int
size, Char
c)) = Sign -> String -> Repr
IntegralRepr Sign
s (Char -> Int -> ShowS
groupIntercalate Char
c Int
size String
str)
group (FractionalRepr Sign
s String
a String
b String
d) (Just (Int
size, Char
c)) = Sign -> String -> String -> String -> Repr
FractionalRepr Sign
s (Char -> Int -> ShowS
groupIntercalate Char
c Int
size String
a) String
b String
d
group Repr
i Maybe (Int, Char)
_ = Repr
i

padAndSign :: Format t t' t'' -> String -> SignMode -> Maybe (Int, AlignMode k, Char) -> Repr -> String
padAndSign :: Format t t' t''
-> String
-> SignMode
-> Maybe (Int, AlignMode k, Char)
-> Repr
-> String
padAndSign Format t t' t''
format String
prefix SignMode
sign Maybe (Int, AlignMode k, Char)
padding Repr
repr = String
leftAlignMode String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
prefixStr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
middleAlignMode String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
content String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
rightAlignMode
  where
    (String
signStr, String
content) = case Repr
repr of
      IntegralRepr Sign
s String
str -> (Sign -> SignMode -> String
formatSign Sign
s SignMode
sign, String
str)
      FractionalRepr Sign
s String
a String
b String
c -> (Sign -> SignMode -> String
formatSign Sign
s SignMode
sign, Format t t' t'' -> String -> ShowS
forall (t :: AltStatus) (t' :: UpperStatus) (t'' :: FormatType).
Format t t' t'' -> String -> ShowS
joinPoint Format t t' t''
format String
a String
b String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
c)
      Infinite Sign
s String
str -> (Sign -> SignMode -> String
formatSign Sign
s SignMode
sign, String
str)
      NaN String
str -> (String
"", String
str)
    prefixStr :: String
prefixStr = String
signStr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
prefix
    len :: Int
len = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
prefixStr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
content
    (String
leftAlignMode, String
rightAlignMode, String
middleAlignMode) = case Maybe (Int, AlignMode k, Char)
padding of
      Maybe (Int, AlignMode k, Char)
Nothing -> (String
"", String
"", String
"")
      Just (Int
pad, AlignMode k
padMode, Char
padC) ->
        let padNeeded :: Int
padNeeded = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
pad Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len)
         in case AlignMode k
padMode of
              AlignMode k
AlignLeft -> (String
"", Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
padNeeded Char
padC, String
"")
              AlignMode k
AlignRight -> (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
padNeeded Char
padC, String
"", String
"")
              AlignMode k
AlignCenter -> (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
padNeeded Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Char
padC, Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
padNeeded Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
padNeeded Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Char
padC, String
"")
              AlignMode k
AlignInside -> (String
"", String
"", Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
padNeeded Char
padC)

joinPoint :: Format t t' t'' -> String -> String -> String
joinPoint :: Format t t' t'' -> String -> ShowS
joinPoint (Upper Format alt 'CanUpper t''
f) String
a String
b = Format alt 'CanUpper t'' -> String -> ShowS
forall (t :: AltStatus) (t' :: UpperStatus) (t'' :: FormatType).
Format t t' t'' -> String -> ShowS
joinPoint Format alt 'CanUpper t''
f String
a String
b
joinPoint (Alternate Format 'CanAlt t' t''
_) String
a String
b = String
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
b
joinPoint Format t t' t''
_ String
a String
"" = String
a
joinPoint Format t t' t''
_ String
a String
b = String
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
b

-- Generic
data Repr
  = IntegralRepr Sign String
  | FractionalRepr Sign String String String
  | Infinite Sign String
  | NaN String
  deriving (Int -> Repr -> ShowS
[Repr] -> ShowS
Repr -> String
(Int -> Repr -> ShowS)
-> (Repr -> String) -> ([Repr] -> ShowS) -> Show Repr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Repr] -> ShowS
$cshowList :: [Repr] -> ShowS
show :: Repr -> String
$cshow :: Repr -> String
showsPrec :: Int -> Repr -> ShowS
$cshowsPrec :: Int -> Repr -> ShowS
Show)

data Sign = Negative | Positive
  deriving (Int -> Sign -> ShowS
[Sign] -> ShowS
Sign -> String
(Int -> Sign -> ShowS)
-> (Sign -> String) -> ([Sign] -> ShowS) -> Show Sign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sign] -> ShowS
$cshowList :: [Sign] -> ShowS
show :: Sign -> String
$cshow :: Sign -> String
showsPrec :: Int -> Sign -> ShowS
$cshowsPrec :: Int -> Sign -> ShowS
Show)

formatSign :: Sign -> SignMode -> String
formatSign :: Sign -> SignMode -> String
formatSign Sign
Positive SignMode
Plus = String
"+"
formatSign Sign
Positive SignMode
Minus = String
""
formatSign Sign
Positive SignMode
Space = String
" "
formatSign Sign
Negative SignMode
_ = String
"-"

groupIntercalate :: Char -> Int -> String -> String
groupIntercalate :: Char -> Int -> ShowS
groupIntercalate Char
c Int
i String
s = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate [Char
c] ([String] -> [String]
forall a. [a] -> [a]
reverse (String -> [String]
pack (ShowS
forall a. [a] -> [a]
reverse String
s)))
  where
    pack :: String -> [String]
pack String
"" = []
    pack String
l = ShowS
forall a. [a] -> [a]
reverse (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
i String
l) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
pack (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
i String
l)

-- Final formatters

-- | Format an integral number
formatIntegral ::
  Integral i =>
  Format t t' 'Integral ->
  SignMode ->
  -- | Padding
  Maybe (Int, AlignMode k, Char) ->
  -- | Grouping
  Maybe (Int, Char) ->
  i ->
  String
formatIntegral :: Format t t' 'Integral
-> SignMode
-> Maybe (Int, AlignMode k, Char)
-> Maybe (Int, Char)
-> i
-> String
formatIntegral Format t t' 'Integral
f SignMode
sign Maybe (Int, AlignMode k, Char)
padding Maybe (Int, Char)
grouping i
i = Format t t' 'Integral
-> String
-> SignMode
-> Maybe (Int, AlignMode k, Char)
-> Repr
-> String
forall (t :: AltStatus) (t' :: UpperStatus) (t'' :: FormatType)
       (k :: AlignForString).
Format t t' t''
-> String
-> SignMode
-> Maybe (Int, AlignMode k, Char)
-> Repr
-> String
padAndSign Format t t' 'Integral
f (Format t t' 'Integral -> String
forall (t :: AltStatus) (t' :: UpperStatus).
Format t t' 'Integral -> String
prefixIntegral Format t t' 'Integral
f) SignMode
sign Maybe (Int, AlignMode k, Char)
padding (Repr -> Maybe (Int, Char) -> Repr
group (Format t t' 'Integral -> i -> Repr
forall i (t :: AltStatus) (t' :: UpperStatus).
Integral i =>
Format t t' 'Integral -> i -> Repr
reprIntegral Format t t' 'Integral
f i
i) Maybe (Int, Char)
grouping)

-- | Format a fractional number
formatFractional ::
  (RealFloat f) =>
  Format t t' 'Fractional ->
  SignMode ->
  -- | Padding
  Maybe (Int, AlignMode k, Char) ->
  -- | Grouping
  Maybe (Int, Char) ->
  -- | Precision
  Maybe Int ->
  f ->
  String
formatFractional :: Format t t' 'Fractional
-> SignMode
-> Maybe (Int, AlignMode k, Char)
-> Maybe (Int, Char)
-> Maybe Int
-> f
-> String
formatFractional Format t t' 'Fractional
f SignMode
sign Maybe (Int, AlignMode k, Char)
padding Maybe (Int, Char)
grouping Maybe Int
precision f
i = Format t t' 'Fractional
-> String
-> SignMode
-> Maybe (Int, AlignMode k, Char)
-> Repr
-> String
forall (t :: AltStatus) (t' :: UpperStatus) (t'' :: FormatType)
       (k :: AlignForString).
Format t t' t''
-> String
-> SignMode
-> Maybe (Int, AlignMode k, Char)
-> Repr
-> String
padAndSign Format t t' 'Fractional
f String
"" SignMode
sign Maybe (Int, AlignMode k, Char)
padding (Repr -> Maybe (Int, Char) -> Repr
group (Format t t' 'Fractional -> Maybe Int -> f -> Repr
forall f (t :: AltStatus) (t' :: UpperStatus).
RealFloat f =>
Format t t' 'Fractional -> Maybe Int -> f -> Repr
reprFractional Format t t' 'Fractional
f Maybe Int
precision f
i) Maybe (Int, Char)
grouping)

-- | Format a string
formatString ::
  -- | Padding
  Maybe (Int, AlignMode 'AlignAll, Char) ->
  -- | Precision (will truncate before padding)
  Maybe Int ->
  String ->
  String
formatString :: Maybe (Int, AlignMode 'AlignAll, Char) -> Maybe Int -> ShowS
formatString Maybe (Int, AlignMode 'AlignAll, Char)
Nothing Maybe Int
Nothing String
s = String
s
formatString Maybe (Int, AlignMode 'AlignAll, Char)
Nothing (Just Int
i) String
s = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
i String
s
formatString (Just (Int
padSize, AlignMode 'AlignAll
padMode, Char
padC)) Maybe Int
size String
s = String
padLeft String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
str String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
padRight
  where
    str :: String
str = Maybe (Int, AlignMode 'AlignAll, Char) -> Maybe Int -> ShowS
formatString Maybe (Int, AlignMode 'AlignAll, Char)
forall a. Maybe a
Nothing Maybe Int
size String
s
    paddingLength :: Int
paddingLength = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
padSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str)
    (String
padLeft, String
padRight) = case AlignMode 'AlignAll
padMode of
      AlignMode 'AlignAll
AlignLeft -> (String
"", Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
paddingLength Char
padC)
      AlignMode 'AlignAll
AlignRight -> (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
paddingLength Char
padC, String
"")
      AlignMode 'AlignAll
AlignCenter -> (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
paddingLength Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Char
padC, Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
paddingLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
paddingLength Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Char
padC)

-- TODO
{-
the .
-}

deriving instance Lift (AlignMode k)

deriving instance Lift SignMode

deriving instance Lift (Format k k' k'')