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