diff options
author | Gregor Kleen <aethoago@141.li> | 2017-02-21 22:32:01 +0100 |
---|---|---|
committer | Gregor Kleen <aethoago@141.li> | 2017-02-21 22:32:01 +0100 |
commit | 62e37cd4e2a3d1d6af9dcd9438c6e38c98b7f42d (patch) | |
tree | 80a27e3396bcaae7ecb34574a07bc5a41d574cfe /lib | |
parent | 347a2aa26ccefa5a543ba9dba75ac1aba1ed1497 (diff) | |
download | postdelay-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')
-rw-r--r-- | lib/Postdelay/TimeSpec/Utils.hs | 19 |
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 | |||
60 | boundedNatural :: forall s n m. (Show n, Ord n, Num n, StringParser s m) | 60 | boundedNatural :: 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 |
63 | boundedNatural padded (I.intersection (0 <=..< PosInf) -> bounds) = do | 63 | boundedNatural 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 |
97 | boundedRational padded (I.intersection (0 <=..< PosInf) -> bounds) | 99 | boundedRational 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) |