summaryrefslogtreecommitdiff
path: root/lib/Postdelay/TimeSpec/Utils.hs
diff options
context:
space:
mode:
authorGregor Kleen <aethoago@141.li>2017-02-21 22:32:01 +0100
committerGregor Kleen <aethoago@141.li>2017-02-21 22:32:01 +0100
commit62e37cd4e2a3d1d6af9dcd9438c6e38c98b7f42d (patch)
tree80a27e3396bcaae7ecb34574a07bc5a41d574cfe /lib/Postdelay/TimeSpec/Utils.hs
parent347a2aa26ccefa5a543ba9dba75ac1aba1ed1497 (diff)
downloadpostdelay-62e37cd4e2a3d1d6af9dcd9438c6e38c98b7f42d.tar
postdelay-62e37cd4e2a3d1d6af9dcd9438c6e38c98b7f42d.tar.gz
postdelay-62e37cd4e2a3d1d6af9dcd9438c6e38c98b7f42d.tar.bz2
postdelay-62e37cd4e2a3d1d6af9dcd9438c6e38c98b7f42d.tar.xz
postdelay-62e37cd4e2a3d1d6af9dcd9438c6e38c98b7f42d.zip
Fix bounded numeric parsers
Diffstat (limited to 'lib/Postdelay/TimeSpec/Utils.hs')
-rw-r--r--lib/Postdelay/TimeSpec/Utils.hs19
1 files changed, 11 insertions, 8 deletions
diff --git a/lib/Postdelay/TimeSpec/Utils.hs b/lib/Postdelay/TimeSpec/Utils.hs
index 0bce51a..c49ba7a 100644
--- a/lib/Postdelay/TimeSpec/Utils.hs
+++ b/lib/Postdelay/TimeSpec/Utils.hs
@@ -60,10 +60,12 @@ sign = label "sign" $ choice [ char '+' $> id
60boundedNatural :: forall s n m. (Show n, Ord n, Num n, StringParser s m) 60boundedNatural :: forall s n m. (Show n, Ord n, Num n, StringParser s m)
61 => Bool -- ^ Require number to be padded with zeroes? 61 => Bool -- ^ Require number to be padded with zeroes?
62 -> Interval n -> m n 62 -> Interval n -> m n
63boundedNatural padded (I.intersection (0 <=..< PosInf) -> bounds) = do 63boundedNatural padded (I.intersection (0 <=..< PosInf) -> bounds)
64 n <- foldl' (\i l -> i * 10 + l) 0 <$> digitN (fromDigit <$> digitChar) <?> "Natural number cotained in: " ++ show bounds 64 | I.null bounds = empty
65 when (not $ n `I.member` bounds) $ fail "Natural number out of bounds" 65 | otherwise = do
66 return n 66 n <- foldl' (\i l -> i * 10 + l) 0 <$> digitN (fromDigit <$> digitChar) <?> "Natural number cotained in: " ++ show bounds
67 when (not $ n `I.member` bounds) $ fail "Natural number out of bounds"
68 return n
67 where 69 where
68 digitN :: m n -> m [n] 70 digitN :: m n -> m [n]
69 digitN p 71 digitN p
@@ -78,9 +80,9 @@ boundedNatural padded (I.intersection (0 <=..< PosInf) -> bounds) = do
78 | otherwise = error "boundedNatural in undefined state" 80 | otherwise = error "boundedNatural in undefined state"
79 81
80 minDigits, maxDigits :: Extended Int 82 minDigits, maxDigits :: Extended Int
81 (minDigits, maxDigits) = ( max 1 . fmap digits . I.lowerBound $ close bounds 83 (minDigits, maxDigits) = {- traceShowId -} ( max 1 . fmap digits . I.lowerBound $ close bounds
82 , fmap digits . I.upperBound $ close bounds 84 , fmap digits . I.upperBound $ close bounds
83 ) 85 )
84 where 86 where
85 close int 87 close int
86 | (Finite min, False) <- I.lowerBound' int = close $ interval (Finite $ min + 1, True) (I.upperBound' int) 88 | (Finite min, False) <- I.lowerBound' int = close $ interval (Finite $ min + 1, True) (I.upperBound' int)
@@ -95,7 +97,8 @@ boundedRational :: forall s m n. (Show n, RealFrac n, StringParser s m)
95 => Bool -- ^ Require number to be padded with zeroes 97 => Bool -- ^ Require number to be padded with zeroes
96 -> Interval n -> m n 98 -> Interval n -> m n
97boundedRational padded (I.intersection (0 <=..< PosInf) -> bounds) 99boundedRational padded (I.intersection (0 <=..< PosInf) -> bounds)
98 = (+) <$> boundedNatural padded wholeBounds <*> fractional <?> "Nonnegative rational contained in: " ++ show bounds 100 | I.null bounds = empty
101 | otherwise = (+) <$> boundedNatural padded wholeBounds <*> fractional <?> "Nonnegative rational contained in: " ++ show bounds
99 where 102 where
100 fractional :: m n 103 fractional :: m n
101 fractional = reqFractional $ char '.' $> (/ 10) . foldr' (\h t -> h + t / 10) 0 <*> some (fromDigit <$> digitChar) 104 fractional = reqFractional $ char '.' $> (/ 10) . foldr' (\h t -> h + t / 10) 0 <*> some (fromDigit <$> digitChar)