module Numeric.Optics
( base
, integral
, binary
, octal
, decimal
, hex
, adding
, subtracting
, multiplying
, dividing
, exponentiating
, negated
, pattern Integral
) where
import Data.Char (chr, ord, isAsciiLower, isAsciiUpper, isDigit)
import Data.Maybe (fromMaybe)
import GHC.Stack
import Numeric (readInt, showIntAtBase)
import Data.Tuple.Optics
import Optics.AffineFold
import Optics.Iso
import Optics.Optic
import Optics.Prism
import Optics.Review
import Optics.Setter
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
{-# INLINE integral #-}
pattern Integral :: forall a. 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 k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> 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 a -> String
intShow String -> Either String a
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 a
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
[(a
n,String
"")] -> forall a b. b -> Either a b
Right a
n
[(a, 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)
{-# INLINE intToDigit' #-}
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)
{-# INLINE digitToInt' #-}
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
{-# INLINE digitToIntMay #-}
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
{-# INLINE isDigit' #-}
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
{-# INLINE showSigned' #-}
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 k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall s t a b. Field1 s t a b => Lens s t a b
_1 forall a. Num a => a -> a
negate
readSigned' ReadS a
f String
xs = ReadS a
f String
xs
{-# INLINE readSigned' #-}
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
{-# INLINE binary #-}
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
{-# INLINE octal #-}
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
{-# INLINE decimal #-}
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
{-# INLINE hex #-}
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)
{-# INLINE adding #-}
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)
{-# INLINE subtracting #-}
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.Optics.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)
{-# INLINE multiplying #-}
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.Optics.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)
{-# INLINE dividing #-}
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.Optics.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)
{-# INLINE exponentiating #-}
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
{-# INLINE negated #-}