module Numeric.Lens
( base
, integral
, binary
, octal
, decimal
, hex
, adding
, subtracting
, multiplying
, dividing
, exponentiating
, negated
) where
import Control.Lens
import Data.Char (chr, ord, isAsciiLower, isAsciiUpper, isDigit)
import Data.Maybe (fromMaybe)
import Numeric (readInt, showIntAtBase)
integral :: (Integral a, Integral b) => Prism Integer Integer a b
integral = prism toInteger $ \ i -> let a = fromInteger i in
if toInteger a == i
then Right a
else Left i
base :: Integral a => Int -> Prism' String a
base b
| b < 2 || b > 36 = error ("base: Invalid base " ++ show b)
| otherwise = prism intShow intRead
where
intShow n = showSigned' (showIntAtBase (toInteger b) intToDigit') (toInteger n) ""
intRead s =
case readSigned' (readInt (fromIntegral b) (isDigit' b) digitToInt') s of
[(n,"")] -> Right n
_ -> Left s
intToDigit' :: Int -> Char
intToDigit' i
| i >= 0 && i < 10 = chr (ord '0' + i)
| i >= 10 && i < 36 = chr (ord 'a' + i 10)
| otherwise = error ("intToDigit': Invalid int " ++ show i)
digitToInt' :: Char -> Int
digitToInt' c = fromMaybe (error ("digitToInt': Invalid digit " ++ show c))
(digitToIntMay c)
digitToIntMay :: Char -> Maybe Int
digitToIntMay c
| isDigit c = Just (ord c ord '0')
| isAsciiLower c = Just (ord c ord 'a' + 10)
| isAsciiUpper c = Just (ord c ord 'A' + 10)
| otherwise = Nothing
isDigit' :: Int -> Char -> Bool
isDigit' b c = case digitToIntMay c of
Just i -> i < b
_ -> False
showSigned' :: Real a => (a -> ShowS) -> a -> ShowS
showSigned' f n
| n < 0 = showChar '-' . f (negate n)
| otherwise = f n
readSigned' :: Real a => ReadS a -> ReadS a
readSigned' f ('-':xs) = f xs & mapped . _1 %~ negate
readSigned' f xs = f xs
binary :: Integral a => Prism' String a
binary = base 2
octal :: Integral a => Prism' String a
octal = base 8
decimal :: Integral a => Prism' String a
decimal = base 10
hex :: Integral a => Prism' String a
hex = base 16
adding :: Num a => a -> Iso' a a
adding n = iso (+n) (subtract n)
subtracting :: Num a => a -> Iso' a a
subtracting n = iso (subtract n) (+n)
multiplying :: (Fractional a, Eq a) => a -> Iso' a a
multiplying 0 = error "Numeric.Lens.multiplying: factor 0"
multiplying n = iso (*n) (/n)
dividing :: (Fractional a, Eq a) => a -> Iso' a a
dividing 0 = error "Numeric.Lens.dividing: divisor 0"
dividing n = iso (/n) (*n)
exponentiating :: (Floating a, Eq a) => a -> Iso' a a
exponentiating 0 = error "Numeric.Lens.exponentiating: exponent 0"
exponentiating n = iso (**n) (**recip n)
negated :: Num a => Iso' a a
negated = iso negate negate