--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Sign
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Signs of expressions
--------------------------------------------------------------------------------
module HGeometry.Sign where

import Data.Foldable1
import Data.Monoid

--------------------------------------------------------------------------------

-- | The sign of an expression
data Sign = Negative | Positive deriving (Int -> Sign -> ShowS
[Sign] -> ShowS
Sign -> String
(Int -> Sign -> ShowS)
-> (Sign -> String) -> ([Sign] -> ShowS) -> Show Sign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sign -> ShowS
showsPrec :: Int -> Sign -> ShowS
$cshow :: Sign -> String
show :: Sign -> String
$cshowList :: [Sign] -> ShowS
showList :: [Sign] -> ShowS
Show,Sign -> Sign -> Bool
(Sign -> Sign -> Bool) -> (Sign -> Sign -> Bool) -> Eq Sign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sign -> Sign -> Bool
== :: Sign -> Sign -> Bool
$c/= :: Sign -> Sign -> Bool
/= :: Sign -> Sign -> Bool
Eq,Eq Sign
Eq Sign =>
(Sign -> Sign -> Ordering)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Sign)
-> (Sign -> Sign -> Sign)
-> Ord Sign
Sign -> Sign -> Bool
Sign -> Sign -> Ordering
Sign -> Sign -> Sign
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
$ccompare :: Sign -> Sign -> Ordering
compare :: Sign -> Sign -> Ordering
$c< :: Sign -> Sign -> Bool
< :: Sign -> Sign -> Bool
$c<= :: Sign -> Sign -> Bool
<= :: Sign -> Sign -> Bool
$c> :: Sign -> Sign -> Bool
> :: Sign -> Sign -> Bool
$c>= :: Sign -> Sign -> Bool
>= :: Sign -> Sign -> Bool
$cmax :: Sign -> Sign -> Sign
max :: Sign -> Sign -> Sign
$cmin :: Sign -> Sign -> Sign
min :: Sign -> Sign -> Sign
Ord,Int -> Sign
Sign -> Int
Sign -> [Sign]
Sign -> Sign
Sign -> Sign -> [Sign]
Sign -> Sign -> Sign -> [Sign]
(Sign -> Sign)
-> (Sign -> Sign)
-> (Int -> Sign)
-> (Sign -> Int)
-> (Sign -> [Sign])
-> (Sign -> Sign -> [Sign])
-> (Sign -> Sign -> [Sign])
-> (Sign -> Sign -> Sign -> [Sign])
-> Enum Sign
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Sign -> Sign
succ :: Sign -> Sign
$cpred :: Sign -> Sign
pred :: Sign -> Sign
$ctoEnum :: Int -> Sign
toEnum :: Int -> Sign
$cfromEnum :: Sign -> Int
fromEnum :: Sign -> Int
$cenumFrom :: Sign -> [Sign]
enumFrom :: Sign -> [Sign]
$cenumFromThen :: Sign -> Sign -> [Sign]
enumFromThen :: Sign -> Sign -> [Sign]
$cenumFromTo :: Sign -> Sign -> [Sign]
enumFromTo :: Sign -> Sign -> [Sign]
$cenumFromThenTo :: Sign -> Sign -> Sign -> [Sign]
enumFromThenTo :: Sign -> Sign -> Sign -> [Sign]
Enum,Sign
Sign -> Sign -> Bounded Sign
forall a. a -> a -> Bounded a
$cminBound :: Sign
minBound :: Sign
$cmaxBound :: Sign
maxBound :: Sign
Bounded)

-- | Flip Positive <=> Negative.
flipSign :: Sign -> Sign
flipSign :: Sign -> Sign
flipSign = \case
  Sign
Negative -> Sign
Positive
  Sign
Positive -> Sign
Negative

--------------------------------------------------------------------------------

-- | Given the terms, in decreasing order of significance, computes the sign
--
-- i.e. expects a list of terms, we base the sign on the sign of the first non-zero term.
signFromTerms :: (Num r, Eq r, Foldable1 f) => f r -> Maybe Sign
signFromTerms :: forall r (f :: * -> *).
(Num r, Eq r, Foldable1 f) =>
f r -> Maybe Sign
signFromTerms = First Sign -> Maybe Sign
forall a. First a -> Maybe a
getFirst (First Sign -> Maybe Sign)
-> (f r -> First Sign) -> f r -> Maybe Sign
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> First Sign) -> f r -> First Sign
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe Sign -> First Sign
forall a. Maybe a -> First a
First (Maybe Sign -> First Sign) -> (r -> Maybe Sign) -> r -> First Sign
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Maybe Sign
forall {a}. (Num a, Eq a) => a -> Maybe Sign
signum')
  where
    signum' :: a -> Maybe Sign
signum' a
x = case a -> a
forall a. Num a => a -> a
signum a
x of
                  -1 -> Sign -> Maybe Sign
forall a. a -> Maybe a
Just Sign
Negative
                  a
0  -> Maybe Sign
forall a. Maybe a
Nothing
                  a
1  -> Sign -> Maybe Sign
forall a. a -> Maybe a
Just Sign
Positive
                  a
_  -> String -> Maybe Sign
forall a. HasCallStack => String -> a
error String
"signum': absurd"