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/Postdelay/TimeSpec/Utils.hs | |
| 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/Postdelay/TimeSpec/Utils.hs')
| -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) |
