{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
# LANGUAGE FlexibleInstances      #
# LANGUAGE GADTs                  #
# LANGUAGE KindSignatures         #
# LANGUAGE MultiParamTypeClasses #

-- | Number space types and functions.
module Language.Drasil.Space (
  -- * Types
  Space(..), Primitive,
  RealInterval(..), Inclusive(..),
  DomainDesc(..), RTopology(..), DiscreteDomainDesc, ContinuousDomainDesc,
  -- * Class
  HasSpace(..),
  -- * Functions
  getActorName, getInnerSpace, mkFunction, isBasicNumSpace
) where

import qualified Data.List.NonEmpty        as NE

import           Control.Lens              (Lens')
import           Language.Drasil.Symbol    (Symbol)

-- FIXME: These need to be spaces and not just types.

-- | The difference kinds of spaces that may exist. This type holds
-- numerical spaces (such as the set of integers, rationals, etc.),
-- a space for booleans, a space for characters, dimensional spaces (vectors, arrays, etc.),
-- a space for Actors, discrete sets (both for numbers and strings), and a void space.
data Space =
    Integer
  | Rational
  | Real
  | Natural
  | Boolean
  | Char
  | String
  | Vect Space -- TODO: Length for vectors?
  | Matrix Int Int Space
  | Array Space
  | Actor String
  | DiscreteD [Double]
  | DiscreteS [String] --ex. let Meal = {"breakfast", "lunch", "dinner"}
  | Function (NE.NonEmpty Primitive) Primitive
  | Void
  deriving (Eq, Show)

  | HasSpace is anything which has a ' Space ' .
class HasSpace c where
  -- | Provides a 'Lens' to the 'Space'.
  typ      :: Lens' c Space

type Primitive = Space

mkFunction :: [Primitive] -> Primitive -> Space
mkFunction []  = error "Function space creation requires at least 1 input Space"
mkFunction ins = Function (NE.fromList ins)

-- The 'spaces' below are all good.

-- | Topology of a subset of reals.
data RTopology = Continuous | Discrete

-- | Describes the domain of a 'Symbol' given a topology. Can be bounded or encase all of the domain.
data DomainDesc (tplgy :: RTopology) a b where
  BoundedDD :: Symbol -> RTopology -> a -> b -> DomainDesc 'Discrete a b
  AllDD     :: Symbol -> RTopology -> DomainDesc 'Continuous a b

type DiscreteDomainDesc a b = DomainDesc 'Discrete a b
type ContinuousDomainDesc a b = DomainDesc 'Continuous a b

-- | Inclusive or exclusive bounds.
data Inclusive = Inc | Exc

-- | A RealInterval is a subset of 'Real' (as a 'Space').
-- These come in different flavours.
  For now , we embed '  ' for the bounds , but that will change as well .
data RealInterval a b where
  Bounded :: (Inclusive, a) -> (Inclusive, b) -> RealInterval a b -- ^ Interval from (x .. y).
  UpTo    :: (Inclusive, a) -> RealInterval a b                   -- ^ Interval from (-infinity .. x).
  UpFrom  :: (Inclusive, b) -> RealInterval a b                   -- ^ Interval from (x .. infinity).

-- | Gets the name of an 'Actor'.
getActorName :: Space -> String
getActorName (Actor n) = n
getActorName _         = error "getActorName called on non-actor space"

-- | Gets the inner 'Space' of a vector.
getInnerSpace :: Space -> Space
getInnerSpace (Vect s) = s
getInnerSpace _        = error "getInnerSpace called on non-vector space"

-- | Is this Space a basic numeric space?
isBasicNumSpace :: Space -> Bool
isBasicNumSpace Integer      = True
isBasicNumSpace Rational     = True
isBasicNumSpace Real         = True
isBasicNumSpace Natural      = True
isBasicNumSpace Boolean      = False
isBasicNumSpace Char         = False
isBasicNumSpace String       = False
isBasicNumSpace Vect {}      = False
isBasicNumSpace Matrix {}    = False
isBasicNumSpace Array {}     = False
isBasicNumSpace Actor {}     = False
isBasicNumSpace DiscreteD {} = False
isBasicNumSpace DiscreteS {} = False
isBasicNumSpace Function {}  = False
isBasicNumSpace Void         = False

# LANGUAGE DataKinds             #
# LANGUAGE FlexibleContexts      #
 | Number space types and functions.
 * Types
 * Class
 * Functions
 FIXME: These need to be spaces and not just types.
 | The difference kinds of spaces that may exist. This type holds
 numerical spaces (such as the set of integers, rationals, etc.),
 a space for booleans, a space for characters, dimensional spaces (vectors, arrays, etc.),
 a space for Actors, discrete sets (both for numbers and strings), and a void space.
 TODO: Length for vectors?
ex. let Meal = {"breakfast", "lunch", "dinner"}
 | Provides a 'Lens' to the 'Space'.
 The 'spaces' below are all good.
 | Topology of a subset of reals.
 | Describes the domain of a 'Symbol' given a topology. Can be bounded or encase all of the domain.
 | Inclusive or exclusive bounds.
 | A RealInterval is a subset of 'Real' (as a 'Space').
 These come in different flavours.
 ^ Interval from (x .. y).
 ^ Interval from (-infinity .. x).
 ^ Interval from (x .. infinity).
 | Gets the name of an 'Actor'.
 | Gets the inner 'Space' of a vector.
 | Is this Space a basic numeric space?
# LANGUAGE FlexibleInstances      #
# LANGUAGE GADTs                  #
# LANGUAGE KindSignatures         #
# LANGUAGE MultiParamTypeClasses #

module Language.Drasil.Space (
  Space(..), Primitive,
  RealInterval(..), Inclusive(..),
  DomainDesc(..), RTopology(..), DiscreteDomainDesc, ContinuousDomainDesc,
  HasSpace(..),
  getActorName, getInnerSpace, mkFunction, isBasicNumSpace
) where

import qualified Data.List.NonEmpty        as NE

import           Control.Lens              (Lens')
import           Language.Drasil.Symbol    (Symbol)


data Space =
    Integer
  | Rational
  | Real
  | Natural
  | Boolean
  | Char
  | String
  | Matrix Int Int Space
  | Array Space
  | Actor String
  | DiscreteD [Double]
  | Function (NE.NonEmpty Primitive) Primitive
  | Void
  deriving (Eq, Show)

  | HasSpace is anything which has a ' Space ' .
class HasSpace c where
  typ      :: Lens' c Space

type Primitive = Space

mkFunction :: [Primitive] -> Primitive -> Space
mkFunction []  = error "Function space creation requires at least 1 input Space"
mkFunction ins = Function (NE.fromList ins)


data RTopology = Continuous | Discrete

data DomainDesc (tplgy :: RTopology) a b where
  BoundedDD :: Symbol -> RTopology -> a -> b -> DomainDesc 'Discrete a b
  AllDD     :: Symbol -> RTopology -> DomainDesc 'Continuous a b

type DiscreteDomainDesc a b = DomainDesc 'Discrete a b
type ContinuousDomainDesc a b = DomainDesc 'Continuous a b

data Inclusive = Inc | Exc

  For now , we embed '  ' for the bounds , but that will change as well .
data RealInterval a b where

getActorName :: Space -> String
getActorName (Actor n) = n
getActorName _         = error "getActorName called on non-actor space"

getInnerSpace :: Space -> Space
getInnerSpace (Vect s) = s
getInnerSpace _        = error "getInnerSpace called on non-vector space"

isBasicNumSpace :: Space -> Bool
isBasicNumSpace Integer      = True
isBasicNumSpace Rational     = True
isBasicNumSpace Real         = True
isBasicNumSpace Natural      = True
isBasicNumSpace Boolean      = False
isBasicNumSpace Char         = False
isBasicNumSpace String       = False
isBasicNumSpace Vect {}      = False
isBasicNumSpace Matrix {}    = False
isBasicNumSpace Array {}     = False
isBasicNumSpace Actor {}     = False
isBasicNumSpace DiscreteD {} = False
isBasicNumSpace DiscreteS {} = False
isBasicNumSpace Function {}  = False
isBasicNumSpace Void         = False
