{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}

-- |
--
-- 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
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
import Data.Data (Data)

-- 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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SignMode] -> ShowS
$cshowList :: [SignMode] -> ShowS
show :: SignMode -> [Char]
$cshow :: SignMode -> [Char]
showsPrec :: Int -> SignMode -> ShowS
$cshowsPrec :: Int -> SignMode -> ShowS
Show, Typeable SignMode
SignMode -> DataType
SignMode -> Constr
(forall b. Data b => b -> b) -> SignMode -> SignMode
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SignMode -> u
forall u. (forall d. Data d => d -> u) -> SignMode -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignMode -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SignMode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SignMode -> m SignMode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SignMode -> m SignMode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SignMode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignMode -> c SignMode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SignMode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SignMode)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SignMode -> m SignMode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SignMode -> m SignMode
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SignMode -> m SignMode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SignMode -> m SignMode
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SignMode -> m SignMode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SignMode -> m SignMode
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SignMode -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SignMode -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SignMode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SignMode -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SignMode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SignMode -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignMode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignMode -> r
gmapT :: (forall b. Data b => b -> b) -> SignMode -> SignMode
$cgmapT :: (forall b. Data b => b -> b) -> SignMode -> SignMode
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SignMode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SignMode)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SignMode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SignMode)
dataTypeOf :: SignMode -> DataType
$cdataTypeOf :: SignMode -> DataType
toConstr :: SignMode -> Constr
$ctoConstr :: SignMode -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SignMode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SignMode
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignMode -> c SignMode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignMode -> c SignMode
Data)

data AlignForString = AlignAll | AlignNumber
  deriving (Int -> AlignForString -> ShowS
[AlignForString] -> ShowS
AlignForString -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [AlignForString] -> ShowS
$cshowList :: [AlignForString] -> ShowS
show :: AlignForString -> [Char]
$cshow :: AlignForString -> [Char]
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 value
  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 :: forall (k :: AlignForString).
AlignMode k -> Maybe (AlignMode 'AlignAll)
getAlignForString AlignMode k
AlignInside = forall a. Maybe a
Nothing
getAlignForString AlignMode k
AlignRight = forall a. a -> Maybe a
Just AlignMode 'AlignAll
AlignRight
getAlignForString AlignMode k
AlignCenter = forall a. a -> Maybe a
Just AlignMode 'AlignAll
AlignCenter
getAlignForString AlignMode k
AlignLeft = 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 (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
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]
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, 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
Ord, ShowIntegral i -> ShowIntegral i -> Bool
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
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, 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
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 -> [Char]
show ShowIntegral i
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"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 :: forall i (t :: AltStatus) (t' :: UpperStatus).
Integral i =>
Format t t' 'Integral -> i -> Repr
reprIntegral Format t t' 'Integral
fmt i
i = Sign -> [Char] -> Repr
IntegralRepr Sign
sign forall a b. (a -> b) -> a -> b
$ forall (t :: AltStatus) (t' :: UpperStatus).
Format t t' 'Integral -> [Char]
format Format t t' 'Integral
fmt
  where
    format :: Format t t' 'Integral -> String
    format :: forall (t :: AltStatus) (t' :: UpperStatus).
Format t t' 'Integral -> [Char]
format = \case
      Format t t' 'Integral
Decimal -> forall a. Integral a => a -> ShowS
Numeric.showInt i
iAbs [Char]
""
      Format t t' 'Integral
Octal -> forall a. (Integral a, Show a) => a -> ShowS
Numeric.showOct (forall i. i -> ShowIntegral i
ShowIntegral i
iAbs) [Char]
""
      Format t t' 'Integral
Binary -> forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
Numeric.showIntAtBase ShowIntegral i
2 (\Int
digit -> if Int
digit forall a. Eq a => a -> a -> Bool
== Int
0 then Char
'0' else Char
'1') (forall i. i -> ShowIntegral i
ShowIntegral i
iAbs) [Char]
""
      Format t t' 'Integral
Hexa -> forall a. (Integral a, Show a) => a -> ShowS
Numeric.showHex (forall i. i -> ShowIntegral i
ShowIntegral i
iAbs) [Char]
""
      Upper Format alt 'CanUpper 'Integral
fmt' -> forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper forall a b. (a -> b) -> a -> b
$ forall (t :: AltStatus) (t' :: UpperStatus).
Format t t' 'Integral -> [Char]
format Format alt 'CanUpper 'Integral
fmt'
      Format t t' 'Integral
Character -> [Int -> Char
chr (forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i)]
      Alternate Format 'CanAlt t' 'Integral
fmt' -> forall (t :: AltStatus) (t' :: UpperStatus).
Format t t' 'Integral -> [Char]
format Format 'CanAlt t' 'Integral
fmt'
    (Sign
sign, i
iAbs) = forall b. (Num b, Ord b) => b -> (Sign, b)
splitSign i
i

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

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

-- Internal Fractional
reprFractional :: (RealFloat f) => Format t t' 'Fractional -> Maybe Int -> f -> Repr
reprFractional :: 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. RealFloat a => a -> Bool
isInfinite f
f = Sign -> [Char] -> Repr
Infinite Sign
sign (ShowS
upperIt [Char]
"inf")
  | forall a. RealFloat a => a -> Bool
isNaN f
f = [Char] -> Repr
NaN (ShowS
upperIt [Char]
"nan")
  | forall a. RealFloat a => a -> Bool
isNegativeZero f
f = case 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 (forall a. Num a => a -> a
abs f
f) of
       FractionalRepr Sign
Positive [Char]
aa [Char]
bb [Char]
cc -> Sign -> [Char] -> [Char] -> [Char] -> Repr
FractionalRepr Sign
Negative [Char]
aa [Char]
bb [Char]
cc
       Repr
other -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"reprFractional (isNegativeZero f): The impossible happened : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Repr
other forall a. [a] -> [a] -> [a]
++ [Char]
". Please open an issue at https://github.com/guibou/PyF/issues/"
  | Bool
otherwise = Sign -> [Char] -> [Char] -> [Char] -> Repr
FractionalRepr Sign
sign [Char]
decimalPart [Char]
fractionalPart [Char]
suffixPart
  where
    upperIt :: ShowS
upperIt [Char]
s = case Format t t' 'Fractional
fmt of
      Upper Format alt 'CanUpper 'Fractional
_ -> Char -> Char
toUpper forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
s
      Format t t' 'Fractional
_ -> [Char]
s
    (Sign
sign, f
iAbs) = forall b. (Num b, Ord b) => b -> (Sign, b)
splitSign f
f
    ([Char]
decimalPart, [Char]
fractionalPart, [Char]
suffixPart) = forall (t :: AltStatus) (t' :: UpperStatus).
Format t t' 'Fractional -> ([Char], [Char], [Char])
format Format t t' 'Fractional
fmt
    format :: Format t t' 'Fractional -> (String, String, String)
    format :: forall (t :: AltStatus) (t' :: UpperStatus).
Format t t' 'Fractional -> ([Char], [Char], [Char])
format = \case
      Format t t' 'Fractional
Fixed -> [Char] -> ([Char], [Char], [Char])
splitFractional (forall a. RealFloat a => Maybe Int -> a -> ShowS
Numeric.showFFloatAlt Maybe Int
precision f
iAbs [Char]
"")
      Format t t' 'Fractional
Exponent -> Maybe Int -> ([Char], [Char], [Char]) -> ([Char], [Char], [Char])
overrideExponent Maybe Int
precision forall a b. (a -> b) -> a -> b
$ [Char] -> ([Char], [Char], [Char])
splitFractionalExp (forall a. RealFloat a => Maybe Int -> a -> ShowS
Numeric.showEFloat Maybe Int
precision f
iAbs [Char]
"")
      Format t t' 'Fractional
Generic -> [Char] -> ([Char], [Char], [Char])
splitFractionalExp (forall a. RealFloat a => Maybe Int -> a -> ShowS
Numeric.showGFloatAlt Maybe Int
precision f
iAbs [Char]
"")
      Format t t' 'Fractional
Percent -> case [Char] -> ([Char], [Char], [Char])
splitFractional (forall a. RealFloat a => Maybe Int -> a -> ShowS
Numeric.showFFloatAlt Maybe Int
precision (f
iAbs forall a. Num a => a -> a -> a
* f
100) [Char]
"") of
                  ([Char]
a, [Char]
b, [Char]
"") -> ([Char]
a, [Char]
b, [Char]
"%")
                  ([Char], [Char], [Char])
other -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"reprFractional (format): The impossible happened : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ([Char], [Char], [Char])
other forall a. [a] -> [a] -> [a]
++ [Char]
". Please open an issue at https://github.com/guibou/PyF/issues/"
      Alternate Format 'CanAlt t' 'Fractional
fmt' -> forall (t :: AltStatus) (t' :: UpperStatus).
Format t t' 'Fractional -> ([Char], [Char], [Char])
format Format 'CanAlt t' 'Fractional
fmt'
      Upper Format alt 'CanUpper 'Fractional
fmt' ->
        let ([Char]
a, [Char]
b, [Char]
c) = forall (t :: AltStatus) (t' :: UpperStatus).
Format t t' 'Fractional -> ([Char], [Char], [Char])
format Format alt 'CanUpper 'Fractional
fmt'
         in ([Char]
a, [Char]
b, forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
c)
    splitFractional :: String -> (String, String, String)
    splitFractional :: [Char] -> ([Char], [Char], [Char])
splitFractional [Char]
s =
      let ([Char]
a, [Char]
b) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'.') [Char]
s
       in ([Char]
a, forall a. Int -> [a] -> [a]
drop Int
1 [Char]
b, [Char]
"")

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

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

-- Cases Integral / Fractional

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

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

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

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

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

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

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

-- Final formatters

-- | Format an integral number
formatIntegral ::
  Integral paddingWidth =>
  Integral i =>
  Format t t' 'Integral ->
  SignMode ->
  -- | Padding
  Maybe (paddingWidth, AlignMode k, Char) ->
  -- | Grouping
  Maybe (Int, Char) ->
  i ->
  String
formatIntegral :: forall paddingWidth i (t :: AltStatus) (t' :: UpperStatus)
       (k :: AlignForString).
(Integral paddingWidth, Integral i) =>
Format t t' 'Integral
-> SignMode
-> Maybe (paddingWidth, AlignMode k, Char)
-> Maybe (Int, Char)
-> i
-> [Char]
formatIntegral Format t t' 'Integral
f SignMode
sign Maybe (paddingWidth, AlignMode k, Char)
padding Maybe (Int, Char)
grouping i
i = forall paddingWidth (t :: AltStatus) (t' :: UpperStatus)
       (t'' :: FormatType) (k :: AlignForString).
Integral paddingWidth =>
Format t t' t''
-> [Char]
-> SignMode
-> Maybe (paddingWidth, AlignMode k, Char)
-> Repr
-> [Char]
padAndSign Format t t' 'Integral
f (forall (t :: AltStatus) (t' :: UpperStatus).
Format t t' 'Integral -> [Char]
prefixIntegral Format t t' 'Integral
f) SignMode
sign Maybe (paddingWidth, AlignMode k, Char)
padding (Repr -> Maybe (Int, Char) -> Repr
group (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, Integral paddingWidth, Integral precision) =>
  Format t t' 'Fractional ->
  SignMode ->
  -- | Padding
  Maybe (paddingWidth, AlignMode k, Char) ->
  -- | Grouping
  Maybe (Int, Char) ->
  -- | Precision
  Maybe precision ->
  f ->
  String
formatFractional :: forall f paddingWidth precision (t :: AltStatus)
       (t' :: UpperStatus) (k :: AlignForString).
(RealFloat f, Integral paddingWidth, Integral precision) =>
Format t t' 'Fractional
-> SignMode
-> Maybe (paddingWidth, AlignMode k, Char)
-> Maybe (Int, Char)
-> Maybe precision
-> f
-> [Char]
formatFractional Format t t' 'Fractional
f SignMode
sign Maybe (paddingWidth, AlignMode k, Char)
padding Maybe (Int, Char)
grouping Maybe precision
precision f
i = forall paddingWidth (t :: AltStatus) (t' :: UpperStatus)
       (t'' :: FormatType) (k :: AlignForString).
Integral paddingWidth =>
Format t t' t''
-> [Char]
-> SignMode
-> Maybe (paddingWidth, AlignMode k, Char)
-> Repr
-> [Char]
padAndSign Format t t' 'Fractional
f [Char]
"" SignMode
sign Maybe (paddingWidth, AlignMode k, Char)
padding (Repr -> Maybe (Int, Char) -> Repr
group (forall f (t :: AltStatus) (t' :: UpperStatus).
RealFloat f =>
Format t t' 'Fractional -> Maybe Int -> f -> Repr
reprFractional Format t t' 'Fractional
f (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe precision
precision) f
i) Maybe (Int, Char)
grouping)

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