    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE ConstraintKinds #-}
    {-# LANGUAGE Rank2Types #-}
    {-# LANGUAGE PatternSynonyms #-}
    {-# LANGUAGE ViewPatterns #-}
    --------------------------------------------------------------------------------
    -- |
    -- Module      :  Numeric.Lens
    -- Copyright   :  (C) 2012-16 Edward Kmett
    -- License     :  BSD-style (see the file LICENSE)
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  provisional
    -- Portability :  portable
    -------------------------------------------------------------------------------
    module Numeric.Lens
      ( base
      , integral
        -- * Predefined bases
      , binary
      , octal
      , decimal
      , hex
        -- * Arithmetic lenses
      , 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)

    -- $setup
    -- >>> :set -XNoOverloadedStrings
    -- >>> import Control.Lens
    -- >>> import Data.Monoid (Sum(..))

    -- | This t'Prism' can be used to model the fact that every t'Integral'
    -- type is a subset of 'Integer'.
    --
    -- Embedding through the t'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

    pattern Integral :: 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 = 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
    Prism Integer Integer a a
    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 -> p a (f a) -> p String (f String)
    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 String a 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 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 b
    intRead 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
            [(b
    n,String
    "")] -> b -> Either String b
    forall a b. b -> Either a b
    Right b
    n
            [(b, String)]
    _ -> String -> Either String b
    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)

    -- | 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)

    -- | 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

    -- | 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

    -- | 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

    -- | 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
    <&> (a -> Identity a) -> (a, String) -> Identity (a, String)
    forall s t a b. Field1 s t a b => Lens s t a b
    Lens (a, String) (a, String) a a
    _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' ReadS a
    f String
    xs       = ReadS a
    f String
    xs

    -- | @'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

    -- | @'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

    -- | @'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

    -- | @'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

    -- | @'adding' n = 'iso' (+n) (subtract n)@
    --
    -- >>> [1..3]^..traverse.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)

    -- | @
    -- 'subtracting' n = 'iso' (subtract n) ((+n)
    -- 'subtracting' n = 'from' ('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)

    -- | @'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^.from 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 -> p a (f a) -> p a (f a)
    forall a. HasCallStack => String -> a
    error String
    "Numeric.Lens.multiplying: factor 0"
    multiplying 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. Fractional a => a -> a -> a
    /a
    n)

    -- | @
    -- 'dividing' n = 'iso' (/n) (*n)
    -- 'dividing' n = 'from' ('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 -> p a (f a) -> p a (f a)
    forall a. HasCallStack => String -> a
    error String
    "Numeric.Lens.dividing: divisor 0"
    dividing 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. Fractional a => a -> a -> a
    /a
    n) (a -> a -> a
    forall a. Num a => a -> a -> a
    *a
    n)

    -- | @'exponentiating' n = 'iso' (**n) (**recip n)@
    --
    -- Note: This errors for n = 0
    --
    -- >>> au (_Wrapping Sum . from (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 -> p a (f a) -> p a (f a)
    forall a. HasCallStack => String -> a
    error String
    "Numeric.Lens.exponentiating: exponent 0"
    exponentiating 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. 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' = 'iso' 'negate' 'negate'@
    --
    -- >>> au (_Wrapping Sum . negated) (foldMapOf each) (3,4) == 7
    -- True
    --
    -- >>> au (_Wrapping 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