{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# 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 (Getter)
import Language.Drasil.Symbol (Symbol)
data Space =
Integer
| Rational
| Real
| Natural
| Boolean
| Char
| String
| Vect Space
| Matrix Int Int Space
| Array Space
| Actor String
| DiscreteD [Double]
| DiscreteS [String]
| Function (NE.NonEmpty Primitive) Primitive
| Void
deriving (Space -> Space -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Space -> Space -> Bool
$c/= :: Space -> Space -> Bool
== :: Space -> Space -> Bool
$c== :: Space -> Space -> Bool
Eq, Int -> Space -> ShowS
[Space] -> ShowS
Space -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Space] -> ShowS
$cshowList :: [Space] -> ShowS
show :: Space -> String
$cshow :: Space -> String
showsPrec :: Int -> Space -> ShowS
$cshowsPrec :: Int -> Space -> ShowS
Show)
class HasSpace c where
typ :: Getter c Space
type Primitive = Space
mkFunction :: [Primitive] -> Primitive -> Space
mkFunction :: [Space] -> Space -> Space
mkFunction [] = forall a. HasCallStack => String -> a
error String
"Function space creation requires at least 1 input Space"
mkFunction [Space]
ins = NonEmpty Space -> Space -> Space
Function (forall a. [a] -> NonEmpty a
NE.fromList [Space]
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
data RealInterval a b where
Bounded :: (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
UpTo :: (Inclusive, a) -> RealInterval a b
UpFrom :: (Inclusive, b) -> RealInterval a b
getActorName :: Space -> String
getActorName :: Space -> String
getActorName (Actor String
n) = String
n
getActorName Space
_ = forall a. HasCallStack => String -> a
error String
"getActorName called on non-actor space"
getInnerSpace :: Space -> Space
getInnerSpace :: Space -> Space
getInnerSpace (Vect Space
s) = Space
s
getInnerSpace Space
_ = forall a. HasCallStack => String -> a
error String
"getInnerSpace called on non-vector space"
isBasicNumSpace :: Space -> Bool
isBasicNumSpace :: Space -> Bool
isBasicNumSpace Space
Integer = Bool
True
isBasicNumSpace Space
Rational = Bool
True
isBasicNumSpace Space
Real = Bool
True
isBasicNumSpace Space
Natural = Bool
True
isBasicNumSpace Space
Boolean = Bool
False
isBasicNumSpace Space
Char = Bool
False
isBasicNumSpace Space
String = Bool
False
isBasicNumSpace Vect {} = Bool
False
isBasicNumSpace Matrix {} = Bool
False
isBasicNumSpace Array {} = Bool
False
isBasicNumSpace Actor {} = Bool
False
isBasicNumSpace DiscreteD {} = Bool
False
isBasicNumSpace DiscreteS {} = Bool
False
isBasicNumSpace Function {} = Bool
False
isBasicNumSpace Space
Void = Bool
False