{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall #-}
#if ( __GLASGOW_HASKELL__ < 820 )
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}
#endif

-- | representation of a possibly discontinuous range
module NumHask.RangeD
  ( RangeD(..)
  , normalise
  ) where

import NumHask.Prelude as P
import NumHask.Space
import NumHask.Range

import Test.QuickCheck.Arbitrary (Arbitrary(..))

newtype RangeD a = RangeD [Range a]
  deriving (Eq, Generic, Show, Functor, Foldable, Traversable, Arbitrary)

instance NFData a => NFData (RangeD a)

normalise :: (Ord (Range a), Ord a, BoundedField a, FromInteger a) =>
    RangeD a -> RangeD a
normalise (RangeD rs) = RangeD $ reverse $ foldl' step [] (sort rs)
  where
    step [] a = [a]
    step (x:xs) a = (a `unify` x) <> xs

    unify a b = bool (bool [a,b] [b,a] (a<b)) [a + b] (a `intersects` b)

instance (FromInteger a, Ord a, BoundedField a) => AdditiveMagma (RangeD a) where
    plus (RangeD l0) (RangeD l1) = normalise $ RangeD $ l0 <> l1

instance (FromInteger a, Ord a, BoundedField a) => AdditiveUnital (RangeD a) where
    zero = RangeD []

instance (FromInteger a, Ord a, BoundedField a) => AdditiveAssociative (RangeD a)

instance (FromInteger a, Ord a, BoundedField a) => AdditiveInvertible (RangeD a) where
    negate (RangeD rs) = normalise $ RangeD $ negate <$> rs

instance (FromInteger a, Ord a, BoundedField a) => AdditiveCommutative (RangeD a)
instance (FromInteger a, Ord a, BoundedField a) => Additive (RangeD a)
instance (FromInteger a, Ord a, BoundedField a) => AdditiveGroup (RangeD a)

-- | times may well be some sort of affine projection lurking under the hood
instance (FromInteger a, Ord a, BoundedField a) => MultiplicativeMagma (RangeD a) where
    times (RangeD a) (RangeD b) = normalise $ RangeD $ times <$> a <*> b

instance (FromInteger a, Ord a, BoundedField a) => MultiplicativeUnital (RangeD a) where
    one = RangeD [one]

instance (FromInteger a, Ord a, BoundedField a) => MultiplicativeAssociative (RangeD a)

instance (FromInteger a, Ord a, BoundedField a) => MultiplicativeInvertible (RangeD a) where
    recip (RangeD rs) = normalise $ RangeD $ recip <$> rs

instance (FromInteger a, Ord a, BoundedField a) => MultiplicativeCommutative (RangeD a)
instance (FromInteger a, Ord a, BoundedField a) => Multiplicative (RangeD a)
instance (FromInteger a, Ord a, BoundedField a) => MultiplicativeGroup (RangeD a)