{-# language Trustworthy #-} module NatOptics.Signed ( Signed (..), intIso, intNatIso, ) where import Data.Eq ( Eq ) import Data.Ord ( Ord, compare, Ordering (..) ) import Numeric.Natural ( Natural ) import Optics.Core ( Iso', iso ) import Prelude ( Integer, abs, negate, fromIntegral ) import Text.Show ( Show ) import NatOptics.Positive.Unsafe ( Positive (..) ) data Signed n = Zero | Minus (Positive n) | Plus (Positive n) deriving stock (Signed n -> Signed n -> Bool (Signed n -> Signed n -> Bool) -> (Signed n -> Signed n -> Bool) -> Eq (Signed n) forall n. Eq n => Signed n -> Signed n -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: forall n. Eq n => Signed n -> Signed n -> Bool == :: Signed n -> Signed n -> Bool $c/= :: forall n. Eq n => Signed n -> Signed n -> Bool /= :: Signed n -> Signed n -> Bool Eq, Eq (Signed n) Eq (Signed n) => (Signed n -> Signed n -> Ordering) -> (Signed n -> Signed n -> Bool) -> (Signed n -> Signed n -> Bool) -> (Signed n -> Signed n -> Bool) -> (Signed n -> Signed n -> Bool) -> (Signed n -> Signed n -> Signed n) -> (Signed n -> Signed n -> Signed n) -> Ord (Signed n) Signed n -> Signed n -> Bool Signed n -> Signed n -> Ordering Signed n -> Signed n -> Signed n forall a. Eq a => (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a forall n. Ord n => Eq (Signed n) forall n. Ord n => Signed n -> Signed n -> Bool forall n. Ord n => Signed n -> Signed n -> Ordering forall n. Ord n => Signed n -> Signed n -> Signed n $ccompare :: forall n. Ord n => Signed n -> Signed n -> Ordering compare :: Signed n -> Signed n -> Ordering $c< :: forall n. Ord n => Signed n -> Signed n -> Bool < :: Signed n -> Signed n -> Bool $c<= :: forall n. Ord n => Signed n -> Signed n -> Bool <= :: Signed n -> Signed n -> Bool $c> :: forall n. Ord n => Signed n -> Signed n -> Bool > :: Signed n -> Signed n -> Bool $c>= :: forall n. Ord n => Signed n -> Signed n -> Bool >= :: Signed n -> Signed n -> Bool $cmax :: forall n. Ord n => Signed n -> Signed n -> Signed n max :: Signed n -> Signed n -> Signed n $cmin :: forall n. Ord n => Signed n -> Signed n -> Signed n min :: Signed n -> Signed n -> Signed n Ord, Int -> Signed n -> ShowS [Signed n] -> ShowS Signed n -> String (Int -> Signed n -> ShowS) -> (Signed n -> String) -> ([Signed n] -> ShowS) -> Show (Signed n) forall n. Show n => Int -> Signed n -> ShowS forall n. Show n => [Signed n] -> ShowS forall n. Show n => Signed n -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: forall n. Show n => Int -> Signed n -> ShowS showsPrec :: Int -> Signed n -> ShowS $cshow :: forall n. Show n => Signed n -> String show :: Signed n -> String $cshowList :: forall n. Show n => [Signed n] -> ShowS showList :: [Signed n] -> ShowS Show) intIso :: Iso' Integer (Signed Integer) intIso :: Iso' Integer (Signed Integer) intIso = (Integer -> Signed Integer) -> (Signed Integer -> Integer) -> Iso' Integer (Signed Integer) forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b iso Integer -> Signed Integer forall {n}. (Ord n, Num n) => n -> Signed n f Signed Integer -> Integer forall {a}. Num a => Signed a -> a g where f :: n -> Signed n f n x = case n -> n -> Ordering forall a. Ord a => a -> a -> Ordering compare n x n 0 of Ordering EQ -> Signed n forall n. Signed n Zero Ordering LT -> Positive n -> Signed n forall n. Positive n -> Signed n Minus (n -> Positive n forall number. number -> Positive number PositiveUnsafe (n -> n forall a. Num a => a -> a abs n x)) Ordering GT -> Positive n -> Signed n forall n. Positive n -> Signed n Plus (n -> Positive n forall number. number -> Positive number PositiveUnsafe n x) g :: Signed a -> a g Signed a y = case Signed a y of Signed a Zero -> a 0 Plus (PositiveUnsafe a x) -> a x Minus (PositiveUnsafe a x) -> a -> a forall a. Num a => a -> a negate a x intNatIso :: Iso' Integer (Signed Natural) intNatIso :: Iso' Integer (Signed Natural) intNatIso = (Integer -> Signed Natural) -> (Signed Natural -> Integer) -> Iso' Integer (Signed Natural) forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b iso Integer -> Signed Natural forall {a} {n}. (Integral a, Num n) => a -> Signed n f Signed Natural -> Integer forall {a} {a}. (Integral a, Num a) => Signed a -> a g where f :: a -> Signed n f a x = case a -> a -> Ordering forall a. Ord a => a -> a -> Ordering compare a x a 0 of Ordering EQ -> Signed n forall n. Signed n Zero Ordering LT -> Positive n -> Signed n forall n. Positive n -> Signed n Minus (n -> Positive n forall number. number -> Positive number PositiveUnsafe (a -> n forall a b. (Integral a, Num b) => a -> b fromIntegral (a -> a forall a. Num a => a -> a abs a x))) Ordering GT -> Positive n -> Signed n forall n. Positive n -> Signed n Plus (n -> Positive n forall number. number -> Positive number PositiveUnsafe (a -> n forall a b. (Integral a, Num b) => a -> b fromIntegral a x)) g :: Signed a -> a g Signed a y = case Signed a y of Signed a Zero -> a 0 Plus (PositiveUnsafe a x) -> a -> a forall a b. (Integral a, Num b) => a -> b fromIntegral a x Minus (PositiveUnsafe a x) -> a -> a forall a. Num a => a -> a negate (a -> a forall a b. (Integral a, Num b) => a -> b fromIntegral a x)