{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
module Numeric.Lens
( base
, integral
, binary
, octal
, decimal
, hex
, adding
, subtracting
, multiplying
, dividing
, exponentiating
, negated
, pattern Integral
) where
import Control.Lens
import Data.CallStack
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 :: forall a b. (Integral a, Integral b) => Prism Integer Integer a b
integral = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ \ Integer
i -> let a :: a
a = forall a. Num a => Integer -> a
fromInteger Integer
i in
if forall a. Integral a => a -> Integer
toInteger a
a forall a. Eq a => a -> a -> Bool
== Integer
i
then forall a b. b -> Either a b
Right a
a
else forall a b. a -> Either a b
Left Integer
i
pattern Integral :: Integral a => a -> Integer
pattern $bIntegral :: forall a. Integral a => a -> Integer
$mIntegral :: forall {r} {a}.
Integral a =>
Integer -> (a -> r) -> ((# #) -> r) -> r
Integral a <- (preview integral -> Just a) where
Integral a
a = forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review forall a b. (Integral a, Integral b) => Prism Integer Integer a b
integral a
a
base :: (HasCallStack, Integral a) => Int -> Prism' String a
base :: forall a. (HasCallStack, Integral a) => Int -> Prism' String a
base Int
b
| Int
b forall a. Ord a => a -> a -> Bool
< Int
2 Bool -> Bool -> Bool
|| Int
b forall a. Ord a => a -> a -> Bool
> Int
36 = forall a. HasCallStack => String -> a
error (String
"base: Invalid base " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b)
| Bool
otherwise = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism forall {a}. Integral a => a -> String
intShow forall {b}. Real b => String -> Either String b
intRead
where
intShow :: a -> String
intShow a
n = forall a. Real a => (a -> ShowS) -> a -> ShowS
showSigned' (forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase (forall a. Integral a => a -> Integer
toInteger Int
b) HasCallStack => Int -> Char
intToDigit') (forall a. Integral a => a -> Integer
toInteger a
n) String
""
intRead :: String -> Either String b
intRead String
s =
case forall a. Real a => ReadS a -> ReadS a
readSigned' (forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b) (Int -> Char -> Bool
isDigit' Int
b) HasCallStack => Char -> Int
digitToInt') String
s of
[(b
n,String
"")] -> forall a b. b -> Either a b
Right b
n
[(b, String)]
_ -> forall a b. a -> Either a b
Left String
s
{-# INLINE base #-}
intToDigit' :: HasCallStack => Int -> Char
intToDigit' :: HasCallStack => Int -> Char
intToDigit' Int
i
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
< Int
10 = Int -> Char
chr (Char -> Int
ord Char
'0' forall a. Num a => a -> a -> a
+ Int
i)
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
10 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
< Int
36 = Int -> Char
chr (Char -> Int
ord Char
'a' forall a. Num a => a -> a -> a
+ Int
i forall a. Num a => a -> a -> a
- Int
10)
| Bool
otherwise = forall a. HasCallStack => String -> a
error (String
"intToDigit': Invalid int " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i)
digitToInt' :: HasCallStack => Char -> Int
digitToInt' :: HasCallStack => Char -> Int
digitToInt' Char
c = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error (String
"digitToInt': Invalid digit " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c))
(Char -> Maybe Int
digitToIntMay Char
c)
digitToIntMay :: Char -> Maybe Int
digitToIntMay :: Char -> Maybe Int
digitToIntMay Char
c
| Char -> Bool
isDigit Char
c = forall a. a -> Maybe a
Just (Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
| Char -> Bool
isAsciiLower Char
c = forall a. a -> Maybe a
Just (Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' forall a. Num a => a -> a -> a
+ Int
10)
| Char -> Bool
isAsciiUpper Char
c = forall a. a -> Maybe a
Just (Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' forall a. Num a => a -> a -> a
+ Int
10)
| Bool
otherwise = forall a. Maybe a
Nothing
isDigit' :: Int -> Char -> Bool
isDigit' :: Int -> Char -> Bool
isDigit' Int
b Char
c = case Char -> Maybe Int
digitToIntMay Char
c of
Just Int
i -> Int
i forall a. Ord a => a -> a -> Bool
< Int
b
Maybe Int
_ -> Bool
False
showSigned' :: Real a => (a -> ShowS) -> a -> ShowS
showSigned' :: forall a. Real a => (a -> ShowS) -> a -> ShowS
showSigned' a -> ShowS
f a
n
| a
n forall a. Ord a => a -> a -> Bool
< a
0 = Char -> ShowS
showChar Char
'-' forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f (forall a. Num a => a -> a
negate a
n)
| Bool
otherwise = a -> ShowS
f a
n
readSigned' :: Real a => ReadS a -> ReadS a
readSigned' :: forall a. Real a => ReadS a -> ReadS a
readSigned' ReadS a
f (Char
'-':String
xs) = ReadS a
f String
xs forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall s t a b. Field1 s t a b => Lens s t a b
_1 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. Num a => a -> a
negate
readSigned' ReadS a
f String
xs = ReadS a
f String
xs
binary :: Integral a => Prism' String a
binary :: forall a. Integral a => Prism' String a
binary = forall a. (HasCallStack, Integral a) => Int -> Prism' String a
base Int
2
octal :: Integral a => Prism' String a
octal :: forall a. Integral a => Prism' String a
octal = forall a. (HasCallStack, Integral a) => Int -> Prism' String a
base Int
8
decimal :: Integral a => Prism' String a
decimal :: forall a. Integral a => Prism' String a
decimal = forall a. (HasCallStack, Integral a) => Int -> Prism' String a
base Int
10
hex :: Integral a => Prism' String a
hex :: forall a. Integral a => Prism' String a
hex = forall a. (HasCallStack, Integral a) => Int -> Prism' String a
base Int
16
adding :: Num a => a -> Iso' a a
adding :: forall a. Num a => a -> Iso' a a
adding a
n = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall a. Num a => a -> a -> a
+a
n) (forall a. Num a => a -> a -> a
subtract a
n)
subtracting :: Num a => a -> Iso' a a
subtracting :: forall a. Num a => a -> Iso' a a
subtracting a
n = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall a. Num a => a -> a -> a
subtract a
n) (forall a. Num a => a -> a -> a
+a
n)
multiplying :: (Fractional a, Eq a) => a -> Iso' a a
multiplying :: forall a. (Fractional a, Eq a) => a -> Iso' a a
multiplying a
0 = forall a. HasCallStack => String -> a
error String
"Numeric.Lens.multiplying: factor 0"
multiplying a
n = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall a. Num a => a -> a -> a
*a
n) (forall a. Fractional a => a -> a -> a
/a
n)
dividing :: (Fractional a, Eq a) => a -> Iso' a a
dividing :: forall a. (Fractional a, Eq a) => a -> Iso' a a
dividing a
0 = forall a. HasCallStack => String -> a
error String
"Numeric.Lens.dividing: divisor 0"
dividing a
n = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall a. Fractional a => a -> a -> a
/a
n) (forall a. Num a => a -> a -> a
*a
n)
exponentiating :: (Floating a, Eq a) => a -> Iso' a a
exponentiating :: forall a. (Floating a, Eq a) => a -> Iso' a a
exponentiating a
0 = forall a. HasCallStack => String -> a
error String
"Numeric.Lens.exponentiating: exponent 0"
exponentiating a
n = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall a. Floating a => a -> a -> a
**a
n) (forall a. Floating a => a -> a -> a
**forall a. Fractional a => a -> a
recip a
n)
negated :: Num a => Iso' a a
negated :: forall a. Num a => Iso' a a
negated = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall a. Num a => a -> a
negate forall a. Num a => a -> a
negate