{-# LANGUAGE Safe #-}

module Data.Format (
    Productish (..),
    Summish (..),
    parseReader,
    Format (..),
    formatShow,
    formatParseM,
    isoMap,
    mapMFormat,
    filterFormat,
    clipFormat,
    enumMap,
    literalFormat,
    specialCaseShowFormat,
    specialCaseFormat,
    optionalFormat,
    casesFormat,
    optionalSignFormat,
    mandatorySignFormat,
    SignOption (..),
    integerFormat,
    decimalFormat,
) where

import Control.Monad.Fail
import Data.Char
import Data.Void
import Text.ParserCombinators.ReadP
import Prelude hiding (fail)

class IsoVariant f where
    isoMap :: (a -> b) -> (b -> a) -> f a -> f b

enumMap :: (IsoVariant f, Enum a) => f Int -> f a
enumMap :: forall (f :: * -> *) a. (IsoVariant f, Enum a) => f Int -> f a
enumMap = (Int -> a) -> (a -> Int) -> f Int -> f a
forall a b. (a -> b) -> (b -> a) -> f a -> f b
forall (f :: * -> *) a b.
IsoVariant f =>
(a -> b) -> (b -> a) -> f a -> f b
isoMap Int -> a
forall a. Enum a => Int -> a
toEnum a -> Int
forall a. Enum a => a -> Int
fromEnum

infixr 3 <**>, **>, <**

class IsoVariant f => Productish f where
    pUnit :: f ()
    (<**>) :: f a -> f b -> f (a, b)
    (**>) :: f () -> f a -> f a
    f ()
fu **> f a
fa = (((), a) -> a) -> (a -> ((), a)) -> f ((), a) -> f a
forall a b. (a -> b) -> (b -> a) -> f a -> f b
forall (f :: * -> *) a b.
IsoVariant f =>
(a -> b) -> (b -> a) -> f a -> f b
isoMap (\((), a
a) -> a
a) (\a
a -> ((), a
a)) (f ((), a) -> f a) -> f ((), a) -> f a
forall a b. (a -> b) -> a -> b
$ f ()
fu f () -> f a -> f ((), a)
forall a b. f a -> f b -> f (a, b)
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
<**> f a
fa
    (<**) :: f a -> f () -> f a
    f a
fa <** f ()
fu = ((a, ()) -> a) -> (a -> (a, ())) -> f (a, ()) -> f a
forall a b. (a -> b) -> (b -> a) -> f a -> f b
forall (f :: * -> *) a b.
IsoVariant f =>
(a -> b) -> (b -> a) -> f a -> f b
isoMap (\(a
a, ()) -> a
a) (\a
a -> (a
a, ())) (f (a, ()) -> f a) -> f (a, ()) -> f a
forall a b. (a -> b) -> a -> b
$ f a
fa f a -> f () -> f (a, ())
forall a b. f a -> f b -> f (a, b)
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
<**> f ()
fu

infixr 2 <++>

class IsoVariant f => Summish f where
    pVoid :: f Void
    (<++>) :: f a -> f b -> f (Either a b)

parseReader :: (MonadFail m) => ReadP t -> String -> m t
parseReader :: forall (m :: * -> *) t. MonadFail m => ReadP t -> String -> m t
parseReader ReadP t
readp String
s =
    case [t
t | (t
t, String
"") <- ReadP t -> ReadS t
forall a. ReadP a -> ReadS a
readP_to_S ReadP t
readp String
s] of
        [t
t] -> t -> m t
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return t
t
        [] -> String -> m t
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m t) -> String -> m t
forall a b. (a -> b) -> a -> b
$ String
"no parse of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s
        [t]
_ -> String -> m t
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m t) -> String -> m t
forall a b. (a -> b) -> a -> b
$ String
"multiple parses of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s

-- | A text format for a type
data Format t = MkFormat
    { forall t. Format t -> t -> Maybe String
formatShowM :: t -> Maybe String
    -- ^ Show a value in the format, if representable
    , forall t. Format t -> ReadP t
formatReadP :: ReadP t
    -- ^ Read a value in the format
    }

-- | Show a value in the format, or error if unrepresentable
formatShow :: Format t -> t -> String
formatShow :: forall t. Format t -> t -> String
formatShow Format t
fmt t
t =
    case Format t -> t -> Maybe String
forall t. Format t -> t -> Maybe String
formatShowM Format t
fmt t
t of
        Just String
str -> String
str
        Maybe String
Nothing -> String -> String
forall a. HasCallStack => String -> a
error String
"formatShow: bad value"

-- | Parse a value in the format
formatParseM :: (MonadFail m) => Format t -> String -> m t
formatParseM :: forall (m :: * -> *) t. MonadFail m => Format t -> String -> m t
formatParseM Format t
format = ReadP t -> String -> m t
forall (m :: * -> *) t. MonadFail m => ReadP t -> String -> m t
parseReader (ReadP t -> String -> m t) -> ReadP t -> String -> m t
forall a b. (a -> b) -> a -> b
$ Format t -> ReadP t
forall t. Format t -> ReadP t
formatReadP Format t
format

instance IsoVariant Format where
    isoMap :: forall a b. (a -> b) -> (b -> a) -> Format a -> Format b
isoMap a -> b
ab b -> a
ba (MkFormat a -> Maybe String
sa ReadP a
ra) = (b -> Maybe String) -> ReadP b -> Format b
forall t. (t -> Maybe String) -> ReadP t -> Format t
MkFormat (\b
b -> a -> Maybe String
sa (a -> Maybe String) -> a -> Maybe String
forall a b. (a -> b) -> a -> b
$ b -> a
ba b
b) ((a -> b) -> ReadP a -> ReadP b
forall a b. (a -> b) -> ReadP a -> ReadP b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
ab ReadP a
ra)

mapMFormat :: (a -> Maybe b) -> (b -> Maybe a) -> Format a -> Format b
mapMFormat :: forall a b.
(a -> Maybe b) -> (b -> Maybe a) -> Format a -> Format b
mapMFormat a -> Maybe b
amb b -> Maybe a
bma (MkFormat a -> Maybe String
sa ReadP a
ra) =
    (b -> Maybe String) -> ReadP b -> Format b
forall t. (t -> Maybe String) -> ReadP t -> Format t
MkFormat (\b
b -> b -> Maybe a
bma b
b Maybe a -> (a -> Maybe String) -> Maybe String
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Maybe String
sa) (ReadP b -> Format b) -> ReadP b -> Format b
forall a b. (a -> b) -> a -> b
$ do
        a
a <- ReadP a
ra
        case a -> Maybe b
amb a
a of
            Just b
b -> b -> ReadP b
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
            Maybe b
Nothing -> ReadP b
forall a. ReadP a
pfail

filterFormat :: (a -> Bool) -> Format a -> Format a
filterFormat :: forall a. (a -> Bool) -> Format a -> Format a
filterFormat a -> Bool
test =
    (a -> Maybe a) -> (a -> Maybe a) -> Format a -> Format a
forall a b.
(a -> Maybe b) -> (b -> Maybe a) -> Format a -> Format b
mapMFormat
        ( \a
a ->
            if a -> Bool
test a
a
                then a -> Maybe a
forall a. a -> Maybe a
Just a
a
                else Maybe a
forall a. Maybe a
Nothing
        )
        ( \a
a ->
            if a -> Bool
test a
a
                then a -> Maybe a
forall a. a -> Maybe a
Just a
a
                else Maybe a
forall a. Maybe a
Nothing
        )

-- | Limits are inclusive
clipFormat :: Ord a => (a, a) -> Format a -> Format a
clipFormat :: forall a. Ord a => (a, a) -> Format a -> Format a
clipFormat (a
lo, a
hi) = (a -> Bool) -> Format a -> Format a
forall a. (a -> Bool) -> Format a -> Format a
filterFormat (\a
a -> a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
lo Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
hi)

instance Productish Format where
    pUnit :: Format ()
pUnit = MkFormat{formatShowM :: () -> Maybe String
formatShowM = \()
_ -> String -> Maybe String
forall a. a -> Maybe a
Just String
"", formatReadP :: ReadP ()
formatReadP = () -> ReadP ()
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()}
    <**> :: forall a b. Format a -> Format b -> Format (a, b)
(<**>) (MkFormat a -> Maybe String
sa ReadP a
ra) (MkFormat b -> Maybe String
sb ReadP b
rb) =
        let
            sab :: (a, b) -> Maybe String
sab (a
a, b
b) = do
                String
astr <- a -> Maybe String
sa a
a
                String
bstr <- b -> Maybe String
sb b
b
                String -> Maybe String
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
astr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bstr
            rab :: ReadP (a, b)
rab = do
                a
a <- ReadP a
ra
                b
b <- ReadP b
rb
                (a, b) -> ReadP (a, b)
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)
            in ((a, b) -> Maybe String) -> ReadP (a, b) -> Format (a, b)
forall t. (t -> Maybe String) -> ReadP t -> Format t
MkFormat (a, b) -> Maybe String
sab ReadP (a, b)
rab
    (MkFormat () -> Maybe String
sa ReadP ()
ra) **> :: forall a. Format () -> Format a -> Format a
**> (MkFormat a -> Maybe String
sb ReadP a
rb) =
        let
            s :: a -> Maybe String
s a
b = do
                String
astr <- () -> Maybe String
sa ()
                String
bstr <- a -> Maybe String
sb a
b
                String -> Maybe String
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
astr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bstr
            r :: ReadP a
r = do
                ReadP ()
ra
                ReadP a
rb
            in (a -> Maybe String) -> ReadP a -> Format a
forall t. (t -> Maybe String) -> ReadP t -> Format t
MkFormat a -> Maybe String
s ReadP a
r
    (MkFormat a -> Maybe String
sa ReadP a
ra) <** :: forall a. Format a -> Format () -> Format a
<** (MkFormat () -> Maybe String
sb ReadP ()
rb) =
        let
            s :: a -> Maybe String
s a
a = do
                String
astr <- a -> Maybe String
sa a
a
                String
bstr <- () -> Maybe String
sb ()
                String -> Maybe String
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
astr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bstr
            r :: ReadP a
r = do
                a
a <- ReadP a
ra
                ReadP ()
rb
                a -> ReadP a
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
            in (a -> Maybe String) -> ReadP a -> Format a
forall t. (t -> Maybe String) -> ReadP t -> Format t
MkFormat a -> Maybe String
s ReadP a
r

instance Summish Format where
    pVoid :: Format Void
pVoid = (Void -> Maybe String) -> ReadP Void -> Format Void
forall t. (t -> Maybe String) -> ReadP t -> Format t
MkFormat Void -> Maybe String
forall a. Void -> a
absurd ReadP Void
forall a. ReadP a
pfail
    (MkFormat a -> Maybe String
sa ReadP a
ra) <++> :: forall a b. Format a -> Format b -> Format (Either a b)
<++> (MkFormat b -> Maybe String
sb ReadP b
rb) =
        let
            sab :: Either a b -> Maybe String
sab (Left a
a) = a -> Maybe String
sa a
a
            sab (Right b
b) = b -> Maybe String
sb b
b
            rab :: ReadP (Either a b)
rab = ((a -> Either a b) -> ReadP a -> ReadP (Either a b)
forall a b. (a -> b) -> ReadP a -> ReadP b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a b
forall a b. a -> Either a b
Left ReadP a
ra) ReadP (Either a b) -> ReadP (Either a b) -> ReadP (Either a b)
forall a. ReadP a -> ReadP a -> ReadP a
+++ ((b -> Either a b) -> ReadP b -> ReadP (Either a b)
forall a b. (a -> b) -> ReadP a -> ReadP b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either a b
forall a b. b -> Either a b
Right ReadP b
rb)
            in (Either a b -> Maybe String)
-> ReadP (Either a b) -> Format (Either a b)
forall t. (t -> Maybe String) -> ReadP t -> Format t
MkFormat Either a b -> Maybe String
sab ReadP (Either a b)
rab

literalFormat :: String -> Format ()
literalFormat :: String -> Format ()
literalFormat String
s = MkFormat{formatShowM :: () -> Maybe String
formatShowM = \()
_ -> String -> Maybe String
forall a. a -> Maybe a
Just String
s, formatReadP :: ReadP ()
formatReadP = String -> ReadP String
string String
s ReadP String -> ReadP () -> ReadP ()
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ReadP ()
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()}

specialCaseShowFormat :: Eq a => (a, String) -> Format a -> Format a
specialCaseShowFormat :: forall a. Eq a => (a, String) -> Format a -> Format a
specialCaseShowFormat (a
val, String
str) (MkFormat a -> Maybe String
s ReadP a
r) =
    let
        s' :: a -> Maybe String
s' a
t
            | a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
val = String -> Maybe String
forall a. a -> Maybe a
Just String
str
        s' a
t = a -> Maybe String
s a
t
        in (a -> Maybe String) -> ReadP a -> Format a
forall t. (t -> Maybe String) -> ReadP t -> Format t
MkFormat a -> Maybe String
s' ReadP a
r

specialCaseFormat :: Eq a => (a, String) -> Format a -> Format a
specialCaseFormat :: forall a. Eq a => (a, String) -> Format a -> Format a
specialCaseFormat (a
val, String
str) (MkFormat a -> Maybe String
s ReadP a
r) =
    let
        s' :: a -> Maybe String
s' a
t
            | a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
val = String -> Maybe String
forall a. a -> Maybe a
Just String
str
        s' a
t = a -> Maybe String
s a
t
        r' :: ReadP a
r' = (String -> ReadP String
string String
str ReadP String -> ReadP a -> ReadP a
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> ReadP a
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val) ReadP a -> ReadP a -> ReadP a
forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP a
r
        in (a -> Maybe String) -> ReadP a -> Format a
forall t. (t -> Maybe String) -> ReadP t -> Format t
MkFormat a -> Maybe String
s' ReadP a
r'

optionalFormat :: Eq a => a -> Format a -> Format a
optionalFormat :: forall a. Eq a => a -> Format a -> Format a
optionalFormat a
val = (a, String) -> Format a -> Format a
forall a. Eq a => (a, String) -> Format a -> Format a
specialCaseFormat (a
val, String
"")

casesFormat :: Eq a => [(a, String)] -> Format a
casesFormat :: forall a. Eq a => [(a, String)] -> Format a
casesFormat [(a, String)]
pairs =
    let
        s :: a -> Maybe String
s a
t = a -> [(a, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
t [(a, String)]
pairs
        r :: [(a, String)] -> ReadP a
r [] = ReadP a
forall a. ReadP a
pfail
        r ((a
v, String
str) : [(a, String)]
pp) = (String -> ReadP String
string String
str ReadP String -> ReadP a -> ReadP a
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> ReadP a
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v) ReadP a -> ReadP a -> ReadP a
forall a. ReadP a -> ReadP a -> ReadP a
<++ [(a, String)] -> ReadP a
r [(a, String)]
pp
        in (a -> Maybe String) -> ReadP a -> Format a
forall t. (t -> Maybe String) -> ReadP t -> Format t
MkFormat a -> Maybe String
s (ReadP a -> Format a) -> ReadP a -> Format a
forall a b. (a -> b) -> a -> b
$ [(a, String)] -> ReadP a
forall {a}. [(a, String)] -> ReadP a
r [(a, String)]
pairs

optionalSignFormat :: (Eq t, Num t) => Format t
optionalSignFormat :: forall t. (Eq t, Num t) => Format t
optionalSignFormat = [(t, String)] -> Format t
forall a. Eq a => [(a, String)] -> Format a
casesFormat [(t
1, String
""), (t
1, String
"+"), (t
0, String
""), (-t
1, String
"-")]

mandatorySignFormat :: (Eq t, Num t) => Format t
mandatorySignFormat :: forall t. (Eq t, Num t) => Format t
mandatorySignFormat = [(t, String)] -> Format t
forall a. Eq a => [(a, String)] -> Format a
casesFormat [(t
1, String
"+"), (t
0, String
"+"), (-t
1, String
"-")]

data SignOption
    = NoSign
    | NegSign
    | PosNegSign

readSign :: Num t => SignOption -> ReadP (t -> t)
readSign :: forall t. Num t => SignOption -> ReadP (t -> t)
readSign SignOption
NoSign = (t -> t) -> ReadP (t -> t)
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return t -> t
forall a. a -> a
id
readSign SignOption
NegSign = (t -> t) -> ReadP (t -> t) -> ReadP (t -> t)
forall a. a -> ReadP a -> ReadP a
option t -> t
forall a. a -> a
id (ReadP (t -> t) -> ReadP (t -> t))
-> ReadP (t -> t) -> ReadP (t -> t)
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
char Char
'-' ReadP Char -> ReadP (t -> t) -> ReadP (t -> t)
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (t -> t) -> ReadP (t -> t)
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return t -> t
forall a. Num a => a -> a
negate
readSign SignOption
PosNegSign = (Char -> ReadP Char
char Char
'+' ReadP Char -> ReadP (t -> t) -> ReadP (t -> t)
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (t -> t) -> ReadP (t -> t)
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return t -> t
forall a. a -> a
id) ReadP (t -> t) -> ReadP (t -> t) -> ReadP (t -> t)
forall a. ReadP a -> ReadP a -> ReadP a
+++ (Char -> ReadP Char
char Char
'-' ReadP Char -> ReadP (t -> t) -> ReadP (t -> t)
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (t -> t) -> ReadP (t -> t)
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return t -> t
forall a. Num a => a -> a
negate)

readNumber :: (Num t, Read t) => SignOption -> Maybe Int -> Bool -> ReadP t
readNumber :: forall t.
(Num t, Read t) =>
SignOption -> Maybe Int -> Bool -> ReadP t
readNumber SignOption
signOpt Maybe Int
mdigitcount Bool
allowDecimal = do
    t -> t
sign <- SignOption -> ReadP (t -> t)
forall t. Num t => SignOption -> ReadP (t -> t)
readSign SignOption
signOpt
    String
digits <-
        case Maybe Int
mdigitcount of
            Just Int
digitcount -> Int -> ReadP Char -> ReadP String
forall a. Int -> ReadP a -> ReadP [a]
count Int
digitcount (ReadP Char -> ReadP String) -> ReadP Char -> ReadP String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isDigit
            Maybe Int
Nothing -> ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
many1 (ReadP Char -> ReadP String) -> ReadP Char -> ReadP String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isDigit
    String
moredigits <-
        case Bool
allowDecimal of
            Bool
False -> String -> ReadP String
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
            Bool
True ->
                String -> ReadP String -> ReadP String
forall a. a -> ReadP a -> ReadP a
option String
"" (ReadP String -> ReadP String) -> ReadP String -> ReadP String
forall a b. (a -> b) -> a -> b
$ do
                    Char
_ <- Char -> ReadP Char
char Char
'.' ReadP Char -> ReadP Char -> ReadP Char
forall a. ReadP a -> ReadP a -> ReadP a
+++ Char -> ReadP Char
char Char
','
                    String
dd <- ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
many1 ((Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isDigit)
                    String -> ReadP String
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadP String) -> String -> ReadP String
forall a b. (a -> b) -> a -> b
$ Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: String
dd
    t -> ReadP t
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> ReadP t) -> t -> ReadP t
forall a b. (a -> b) -> a -> b
$ t -> t
sign (t -> t) -> t -> t
forall a b. (a -> b) -> a -> b
$ String -> t
forall a. Read a => String -> a
read (String -> t) -> String -> t
forall a b. (a -> b) -> a -> b
$ String
digits String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
moredigits

zeroPad :: Maybe Int -> String -> String
zeroPad :: Maybe Int -> String -> String
zeroPad Maybe Int
Nothing String
s = String
s
zeroPad (Just Int
i) String
s = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
'0' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

trimTrailing :: String -> String
trimTrailing :: String -> String
trimTrailing String
"" = String
""
trimTrailing String
"." = String
""
trimTrailing String
s
    | String -> Char
forall a. HasCallStack => [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' = String -> String
trimTrailing (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. HasCallStack => [a] -> [a]
init String
s
trimTrailing String
s = String
s

showNumber :: Show t => SignOption -> Maybe Int -> t -> Maybe String
showNumber :: forall t. Show t => SignOption -> Maybe Int -> t -> Maybe String
showNumber SignOption
signOpt Maybe Int
mdigitcount t
t =
    let
        showIt :: String -> String
showIt String
str =
            let
                (String
intPart, String
decPart) = (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
str
                in (Maybe Int -> String -> String
zeroPad Maybe Int
mdigitcount String
intPart) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
trimTrailing String
decPart
        in case t -> String
forall a. Show a => a -> String
show t
t of
            (Char
'-' : String
str) ->
                case SignOption
signOpt of
                    SignOption
NoSign -> Maybe String
forall a. Maybe a
Nothing
                    SignOption
_ -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
showIt String
str
            String
str ->
                String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$
                    case SignOption
signOpt of
                        SignOption
PosNegSign -> Char
'+' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
showIt String
str
                        SignOption
_ -> String -> String
showIt String
str

integerFormat :: (Show t, Read t, Num t) => SignOption -> Maybe Int -> Format t
integerFormat :: forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
signOpt Maybe Int
mdigitcount = (t -> Maybe String) -> ReadP t -> Format t
forall t. (t -> Maybe String) -> ReadP t -> Format t
MkFormat (SignOption -> Maybe Int -> t -> Maybe String
forall t. Show t => SignOption -> Maybe Int -> t -> Maybe String
showNumber SignOption
signOpt Maybe Int
mdigitcount) (SignOption -> Maybe Int -> Bool -> ReadP t
forall t.
(Num t, Read t) =>
SignOption -> Maybe Int -> Bool -> ReadP t
readNumber SignOption
signOpt Maybe Int
mdigitcount Bool
False)

decimalFormat :: (Show t, Read t, Num t) => SignOption -> Maybe Int -> Format t
decimalFormat :: forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
decimalFormat SignOption
signOpt Maybe Int
mdigitcount = (t -> Maybe String) -> ReadP t -> Format t
forall t. (t -> Maybe String) -> ReadP t -> Format t
MkFormat (SignOption -> Maybe Int -> t -> Maybe String
forall t. Show t => SignOption -> Maybe Int -> t -> Maybe String
showNumber SignOption
signOpt Maybe Int
mdigitcount) (SignOption -> Maybe Int -> Bool -> ReadP t
forall t.
(Num t, Read t) =>
SignOption -> Maybe Int -> Bool -> ReadP t
readNumber SignOption
signOpt Maybe Int
mdigitcount Bool
True)