module Penny.Copper.Qty (
RadGroup, periodComma, periodSpace, commaPeriod,
commaSpace,
GroupingSpec(NoGrouping, GroupLarge, GroupAll),
renderUnquoted,
quote,
qtyUnquoted,
qtyQuoted,
qty) where
import Control.Applicative ((<$>), (<*>), (<$), (*>), optional)
import qualified Data.Decimal as D
import Data.List (intercalate)
import Data.List.Split (splitEvery, splitOn)
import qualified Data.Text as X
import Data.Text (snoc, cons)
import Text.Parsec ( char, (<|>), many1, (<?>),
sepBy1, digit, between)
import qualified Text.Parsec as P
import Text.Parsec.Text ( Parser )
import Penny.Lincoln.Bits.Qty ( Qty, partialNewQty, unQty )
data Radix = RComma | RPeriod deriving (Eq, Show)
data Grouper = GComma | GPeriod | GSpace deriving (Eq, Show)
data RadGroup = RadGroup Radix Grouper deriving (Eq, Show)
periodComma :: RadGroup
periodComma = RadGroup RPeriod GComma
periodSpace :: RadGroup
periodSpace = RadGroup RPeriod GSpace
commaPeriod :: RadGroup
commaPeriod = RadGroup RComma GPeriod
commaSpace :: RadGroup
commaSpace = RadGroup RComma GSpace
parseRadix :: Radix -> Parser ()
parseRadix r = () <$ char c <?> "radix point" where
c = case r of RComma -> ','; RPeriod -> '.'
parseGrouper :: Grouper -> Parser ()
parseGrouper g = () <$ char c <?> "grouping character" where
c = case g of
GComma -> ','
GPeriod -> '.'
GSpace -> ' '
wholeGrouped :: Grouper -> Parser String
wholeGrouped g = p <$> group1 <*> optional groupRest <?> e where
e = "whole number"
group1 = many1 digit
groupRest = parseGrouper g *> sepBy1 (many1 digit) (parseGrouper g)
p g1 gr = case gr of
Nothing -> g1
Just groups -> g1 ++ concat groups
fractionalGrouped :: Grouper -> Parser String
fractionalGrouped g =
p <$> group1 <*> optional groupRest <?> e where
e = "fractional number"
group1 = many1 digit
groupRest = parseGrouper g *> sepBy1 (many1 digit) (parseGrouper g)
p g1 gr = case gr of
Nothing -> g1
Just groups -> g1 ++ concat groups
wholeNonGrouped :: Parser String
wholeNonGrouped = many1 digit
fractionalOnly :: Radix -> Parser String
fractionalOnly r = parseRadix r *> many1 P.digit
numberStrGrouped :: Radix -> Grouper -> Parser NumberStr
numberStrGrouped r g = startsWhole <|> fracOnly <?> e where
e = "quantity, with optional grouping"
startsWhole = p <?> "whole number" where
p = do
wholeStr <- wholeGrouped g
mayRad <- optional (parseRadix r)
case mayRad of
Nothing -> return $ Whole wholeStr
Just _ -> do
mayFrac <- optional $ fractionalGrouped g
case mayFrac of
Nothing -> return $ WholeRad wholeStr
Just frac -> return $ WholeRadFrac wholeStr frac
fracOnly = RadFrac <$> fractionalOnly r
numberStrNonGrouped :: Radix -> Parser NumberStr
numberStrNonGrouped r = startsWhole <|> fracOnly <?> e where
e = "quantity, no grouping"
startsWhole = p <?> "whole number" where
p = do
wholeStr <- wholeNonGrouped
mayRad <- optional (parseRadix r)
case mayRad of
Nothing -> return $ Whole wholeStr
Just _ -> do
mayFrac <- optional $ many1 P.digit
case mayFrac of
Nothing -> return $ WholeRad wholeStr
Just frac -> return $ WholeRadFrac wholeStr frac
fracOnly = RadFrac <$> fractionalOnly r
data NumberStr =
Whole String
| WholeRad String
| WholeRadFrac String String
| RadFrac String
deriving Show
toDecimal :: NumberStr -> Maybe D.Decimal
toDecimal ns = case ns of
Whole s -> Just $ D.Decimal 0 (readWithErr s)
WholeRad s -> Just $ D.Decimal 0 (readWithErr s)
WholeRadFrac w f -> fromWholeRadFrac w f
RadFrac f -> fromWholeRadFrac "0" f
where
fromWholeRadFrac w f = let
len = length f
in if len > 255
then Nothing
else Just $ D.Decimal (fromIntegral len) (readWithErr (w ++ f))
readWithErr :: String -> Integer
readWithErr s = let
readSresult = reads s
in case readSresult of
(i, ""):[] -> i
_ -> error $ "readWithErr failed. String being read: " ++ s
++ " Result of reads: " ++ show readSresult
qtyUnquoted :: RadGroup -> Parser Qty
qtyUnquoted (RadGroup r g) = do
nStr <- case g of
GSpace -> numberStrNonGrouped r
_ -> numberStrGrouped r g
d <- case toDecimal nStr of
Nothing -> fail $ "fractional part too big: " ++ show nStr
Just dec -> return dec
return $ partialNewQty d
qtyQuoted :: RadGroup -> Parser Qty
qtyQuoted (RadGroup r g) = between (char '^') (char '^') p where
p = do
nStr <- numberStrGrouped r g
d <- case toDecimal nStr of
Nothing -> fail $ "fractional part too big: " ++ show nStr
Just dec -> return dec
return $ partialNewQty d
qty :: RadGroup -> Parser Qty
qty r = qtyQuoted r <|> qtyUnquoted r <?> "quantity"
data GroupingSpec =
NoGrouping
| GroupLarge
| GroupAll
deriving (Eq, Show)
quote :: X.Text -> X.Text
quote t = case X.find (== ' ') t of
Nothing -> t
Just _ -> '^' `cons` t `snoc` '^'
renderUnquoted ::
RadGroup
-> (GroupingSpec, GroupingSpec)
-> Qty
-> X.Text
renderUnquoted (RadGroup r g) (gl, gr) q = let
qs = show . unQty $ q
in X.pack $ case splitOn "." qs of
w:[] -> groupWhole g gl w
w:d:[] ->
groupWhole g gl w ++ renderRadix r ++ groupDecimal g gr d
_ -> error "Qty.hs: rendering error"
renderGrouper :: Grouper -> String
renderGrouper g = case g of
GComma -> ","
GPeriod -> "."
GSpace -> " "
renderRadix :: Radix -> String
renderRadix r = case r of
RComma -> ","
RPeriod -> "."
groupWhole :: Grouper -> GroupingSpec -> String -> String
groupWhole g gs o = let
grouped = intercalate (renderGrouper g)
. reverse
. map reverse
. splitEvery 3
. reverse
$ o
in case gs of
NoGrouping -> o
GroupLarge -> if length o > 4 then grouped else o
GroupAll -> grouped
groupDecimal :: Grouper -> GroupingSpec -> String -> String
groupDecimal g gs o = let
grouped = intercalate (renderGrouper g)
. splitEvery 3
$ o
in case gs of
NoGrouping -> o
GroupLarge -> if length o > 4 then grouped else o
GroupAll -> grouped