    -- |
    -- Module: Numeric.Optics
    -- Description: Optics for working with numeric types.
    --
    module Numeric.Optics
      ( base
      , integral
        -- * Predefined bases
      , binary
      , octal
      , decimal
      , hex
        -- * Arithmetic lenses
      , 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

    -- | This 'Prism' can be used to model the fact that every 'Prelude.Integral'
    -- type is a subset of 'Integer'.
    --
    -- Embedding through the 'Prism' only succeeds if the 'Integer' would pass
    -- through unmodified when re-extracted.
    integral :: (Integral a, Integral b) => Prism Integer Integer a b
    integral :: forall a b. (Integral a, Integral b) => 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) -> Prism Integer Integer a b)
    -> (Integer -> Either Integer a) -> Prism Integer Integer a b
    forall a b. (a -> b) -> a -> b
    $ \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
    {-# INLINE integral #-}

    -- | Pattern synonym that can be used to construct or pattern match on an
    -- 'Integer' as if it were of any 'Prelude.Integral' type.
    pattern Integral :: forall a. Integral a => a -> Integer
    pattern $mIntegral :: forall {r} {a}.
    Integral a =>
    Integer -> (a -> r) -> ((# #) -> r) -> r
    $bIntegral :: forall a. Integral a => a -> Integer
    Integral a <- (preview integral -> Just a) where
      Integral a
    a = Optic' A_Prism NoIx Integer a -> a -> Integer
    forall k (is :: IxList) t b.
    Is k A_Review =>
    Optic' k is t b -> b -> t
    review Optic' A_Prism NoIx Integer a
    forall a b. (Integral a, Integral b) => Prism Integer Integer a b
    integral a
    a

    -- | A prism that shows and reads integers in base-2 through base-36
    --
    -- Note: This is an improper prism, since leading 0s are stripped when reading.
    --
    -- >>> "100" ^? base 16
    -- Just 256
    --
    -- >>> 1767707668033969 ^. re (base 36)
    -- "helloworld"
    base :: (HasCallStack, Integral a) => Int -> Prism' String a
    base :: forall a. (HasCallStack, Integral a) => Int -> Prism' String a
    base Int
    b
      | Int
    b Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    2 Bool -> Bool -> Bool
    || Int
    b Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    36 = String -> Prism' String a
    forall a. HasCallStack => String -> a
    error (String
    "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
    intShow String -> Either String a
    intRead
      where
        intShow :: a -> String
    intShow 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 => 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) String
    ""

        intRead :: String -> Either String a
    intRead String
    s =
          case ReadS a -> ReadS a
    forall a. Real a => ReadS a -> ReadS a
    readSigned' (a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
    forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
    readInt (Int -> a
    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
            [(a
    n,String
    "")] -> a -> Either String a
    forall a b. b -> Either a b
    Right a
    n
            [(a, String)]
    _ -> String -> Either String a
    forall a b. a -> Either a b
    Left String
    s
    {-# INLINE base #-}

    -- | Like 'Data.Char.intToDigit', but handles up to base-36
    intToDigit' :: HasCallStack => Int -> Char
    intToDigit' :: HasCallStack => Int -> Char
    intToDigit' Int
    i
      | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0  Bool -> Bool -> Bool
    && Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    10 = Int -> Char
    chr (Char -> Int
    ord Char
    '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
    >= Int
    10 Bool -> Bool -> Bool
    && Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    36 = Int -> Char
    chr (Char -> Int
    ord Char
    'a' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    10)
      | Bool
    otherwise = String -> Char
    forall a. HasCallStack => String -> a
    error (String
    "intToDigit': Invalid int " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    i)
    {-# INLINE intToDigit' #-}

    -- | Like 'Data.Char.digitToInt', but handles up to base-36
    digitToInt' :: HasCallStack => Char -> Int
    digitToInt' :: HasCallStack => Char -> Int
    digitToInt' Char
    c = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Int
    forall a. HasCallStack => String -> a
    error (String
    "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)
    {-# INLINE digitToInt' #-}

    -- | A safe variant of 'digitToInt''
    digitToIntMay :: Char -> Maybe Int
    digitToIntMay :: Char -> Maybe Int
    digitToIntMay 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 Char
    '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 Char
    'a' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    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 Char
    'A' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    10)
      | Bool
    otherwise = Maybe Int
    forall a. Maybe a
    Nothing
    {-# INLINE digitToIntMay #-}

    -- | Select digits that fall into the given base
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    b
      Maybe Int
    _ -> Bool
    False
    {-# INLINE isDigit' #-}

    -- | A simpler variant of 'Numeric.showSigned' that only prepends a dash and
    -- doesn't know about parentheses
    showSigned' :: Real a => (a -> ShowS) -> a -> ShowS
    showSigned' :: forall a.
    Real a =>
    (a -> String -> String) -> a -> String -> String
    showSigned' a -> String -> String
    f a
    n
      | a
    n a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    0     = Char -> String -> String
    showChar Char
    '-' (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
    {-# INLINE showSigned' #-}

    -- | A simpler variant of 'Numeric.readSigned' that supports any base, only
    -- recognizes an initial dash and doesn't know about parentheses
    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 [(a, String)] -> ((a, String) -> (a, String)) -> [(a, String)]
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    <&> Optic A_Lens NoIx (a, String) (a, String) a a
    -> (a -> a) -> (a, String) -> (a, String)
    forall k (is :: IxList) s t a b.
    Is k A_Setter =>
    Optic k is s t a b -> (a -> b) -> s -> t
    over Optic A_Lens NoIx (a, String) (a, String) a a
    forall s t a b. Field1 s t a b => Lens s t a b
    _1 a -> a
    forall a. Num a => a -> a
    negate
    readSigned' ReadS a
    f String
    xs       = ReadS a
    f String
    xs
    {-# INLINE readSigned' #-}

    -- | @'binary' = 'base' 2@
    binary :: Integral a => Prism' String a
    binary :: forall a. Integral a => Prism' String a
    binary = Int -> Prism' String a
    forall a. (HasCallStack, Integral a) => Int -> Prism' String a
    base Int
    2
    {-# INLINE binary #-}

    -- | @'octal' = 'base' 8@
    octal :: Integral a => Prism' String a
    octal :: forall a. Integral a => Prism' String a
    octal = Int -> Prism' String a
    forall a. (HasCallStack, Integral a) => Int -> Prism' String a
    base Int
    8
    {-# INLINE octal #-}

    -- | @'decimal' = 'base' 10@
    decimal :: Integral a => Prism' String a
    decimal :: forall a. Integral a => Prism' String a
    decimal = Int -> Prism' String a
    forall a. (HasCallStack, Integral a) => Int -> Prism' String a
    base Int
    10
    {-# INLINE decimal #-}

    -- | @'hex' = 'base' 16@
    hex :: Integral a => Prism' String a
    hex :: forall a. Integral a => Prism' String a
    hex = Int -> Prism' String a
    forall a. (HasCallStack, Integral a) => Int -> Prism' String a
    base Int
    16
    {-# INLINE hex #-}

    -- | @'adding' n = 'iso' (+n) (subtract n)@
    --
    -- >>> [1..3] ^.. traversed % adding 1000
    -- [1001,1002,1003]
    adding :: Num a => a -> Iso' a a
    adding :: forall a. Num a => a -> Iso' a a
    adding a
    n = (a -> a) -> (a -> a) -> Iso a a 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)
    {-# INLINE adding #-}

    -- | @
    -- 'subtracting' n = 'iso' (subtract n) ((+n)
    -- 'subtracting' n = 'Optics.Re.re' ('adding' n)
    -- @
    subtracting :: Num a => a -> Iso' a a
    subtracting :: forall a. Num a => a -> Iso' a a
    subtracting a
    n = (a -> a) -> (a -> a) -> Iso a a 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)
    {-# INLINE subtracting #-}

    -- | @'multiplying' n = iso (*n) (/n)@
    --
    -- Note: This errors for n = 0
    --
    -- >>> 5 & multiplying 1000 %~ (+3)
    -- 5.003
    --
    -- >>> let fahrenheit = multiplying (9/5) % adding 32 in 230 ^. re fahrenheit
    -- 110.0
    multiplying :: (Fractional a, Eq a) => a -> Iso' a a
    multiplying :: forall a. (Fractional a, Eq a) => a -> Iso' a a
    multiplying a
    0 = String -> Iso' a a
    forall a. HasCallStack => String -> a
    error String
    "Numeric.Optics.multiplying: factor 0"
    multiplying 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)
    {-# INLINE multiplying #-}

    -- | @
    -- 'dividing' n = 'iso' (/n) (*n)
    -- 'dividing' n = 'Optics.Re.re' ('multiplying' n)@
    --
    -- Note: This errors for n = 0
    dividing :: (Fractional a, Eq a) => a -> Iso' a a
    dividing :: forall a. (Fractional a, Eq a) => a -> Iso' a a
    dividing a
    0 = String -> Iso' a a
    forall a. HasCallStack => String -> a
    error String
    "Numeric.Optics.dividing: divisor 0"
    dividing 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)
    {-# INLINE dividing #-}

    -- | @'exponentiating' n = 'iso' (**n) (**recip n)@
    --
    -- Note: This errors for n = 0
    --
    -- >>> au (coerced1 @Sum % re (exponentiating 2)) (foldMapOf each) (3,4) == 5
    -- True
    exponentiating :: (Floating a, Eq a) => a -> Iso' a a
    exponentiating :: forall a. (Floating a, Eq a) => a -> Iso' a a
    exponentiating a
    0 = String -> Iso' a a
    forall a. HasCallStack => String -> a
    error String
    "Numeric.Optics.exponentiating: exponent 0"
    exponentiating 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)
    {-# INLINE exponentiating #-}

    -- | @'negated' = 'iso' 'negate' 'negate'@
    --
    -- >>> au (coerced1 @Sum % negated) (foldMapOf each) (3,4) == 7
    -- True
    --
    -- >>> au (coerced1 @Sum) (foldMapOf (each % negated)) (3,4) == -7
    -- True
    negated :: Num a => Iso' a a
    negated :: forall a. Num a => Iso' a a
    negated = (a -> a) -> (a -> a) -> Iso a a 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
    {-# INLINE negated #-}

    -- $setup
    -- >>> import Data.Monoid
    -- >>> import Optics.Core