-- | A module for describing 'Set's of 'Element's. Necessary in a few cases (such as discrete sets) that 'Manifold's don't handle well.
module Goal.Geometry.Set
    ( -- * Sets
      Set
    , Element
    , Discrete (elements)
    -- * Instances
    -- ** Discrete
    , Boolean (Boolean)
    , NaturalNumbers (NaturalNumbers)
    , Integers (Integers)
    -- ** Continuous
    , Coordinates
    , Euclidean (Euclidean)
    , Continuum (Continuum)
    -- * Combinators
    -- ** Replicated
    , Replicated (Replicated)
    ) where


--- Imports ---


-- Goal --

import Goal.Core

-- Qualified --

import qualified Data.Vector.Storable as C


--- Classes ---


-- | 'Set's are collections of distinguishable 'Element's.
class (Eq s, Eq (Element s)) => Set s where
    type Element s :: *


-- | A 'Discrete' 'Set' is one where we can list its elements. The
-- returned list should satisfy the law
--
-- > elements s = nub $ elements s
--
class Set s => Discrete s where
    elements :: s -> [Element s]


--- Types ---


-- Discrete --

-- | The set of natural numbers.
data NaturalNumbers = NaturalNumbers deriving (Eq,Read,Show)

-- | The set of integers.
data Integers = Integers deriving (Eq,Read,Show)

-- | 'True' and 'False'.
data Boolean = Boolean deriving (Eq,Read,Show)

-- Continuous  --

-- | 'Euclidean' space.
newtype Euclidean = Euclidean Int deriving (Eq,Read,Show)

-- | One dimensional 'Euclidean' space.
data Continuum = Continuum deriving (Eq,Read,Show)

-- | 'Element's of 'Euclidean' spaces are referred to as 'Coordinates'.
type Coordinates = C.Vector Double

-- Replicated --

-- | A 'Replicated' set is a single set multiplied a specified number of times
-- via the Cartesian product.
data Replicated m = Replicated !m !Int deriving (Eq,Read,Show)


--- Instances ---


-- Discrete --

instance Set NaturalNumbers where
    type Element NaturalNumbers = Int

instance Discrete NaturalNumbers where
    elements _ = [0..]

instance Set Integers where
    type Element Integers = Int

instance Discrete Integers where
    elements _ = (0:) $ concat [ [-k,k] | k <- [1..] ]

instance Set Boolean where
    type Element Boolean = Bool

instance Discrete Boolean where
    elements _ = [True,False]

instance Eq k => Set [k] where
    type Element [k] = k

instance Eq k => Discrete [k] where
    elements = id

-- Continuous --

instance Set Continuum where
    type Element Continuum = Double

instance Set Euclidean where
    type Element Euclidean = Coordinates


-- Replicated --

instance Set s => Set (Replicated s) where
    type Element (Replicated s) = [Element s]


instance Discrete s => Discrete (Replicated s) where
    elements (Replicated s n) = replicateM n $ elements s

-- Direct Sums --

instance (Set s, Set r) => Set (s,r) where
    type Element (s,r) = (Element s,Element r)