netrium-0.6.0: Contract normaliser and simulator

Safe HaskellNone
LanguageHaskell98

Observable

Contents

Description

Netrium is Copyright Anthony Waite, Dave Hetwett, Shaun Laurens 2009-2015, and files herein are licensed |under the MIT license, the text of which can be found in license.txt

Synopsis

Creating observables

data Obs a where Source #

A simple expression language of "observable values". An observable represents is a time-varying value (a function from Time to a value).

Currently there are two types of observables:

  • condition observables, type Obs Bool
  • real-valued observables, type Obs Double

Constructors

Const :: (Show a, Eq a) => a -> Obs a 
Var :: VarName -> Obs Double 
NamedVal :: VarName -> Obs Double 
NamedCond :: VarName -> Obs Bool 
At :: Time -> Obs Bool 
After :: Time -> Obs Bool 
Before :: Time -> Obs Bool 
UnOp :: UnOp a b -> Obs a -> Obs b 
BinOp :: BinOp a a b -> Obs a -> Obs a -> Obs b 
IfThen :: Obs Bool -> Obs a -> Obs a -> Obs a 

Instances

Eq (Obs a) Source #

Equality

Methods

(==) :: Obs a -> Obs a -> Bool #

(/=) :: Obs a -> Obs a -> Bool #

Floating (Obs Double) Source #

Floating operations

Fractional (Obs Double) Source #

Double operations

Num (Obs Double) Source #

Note that you can use ordinary Num operators like +, -, * etc in observable expressions.

Show (Obs a) Source #

Display tree instances

Methods

showsPrec :: Int -> Obs a -> ShowS #

show :: Obs a -> String #

showList :: [Obs a] -> ShowS #

konst :: (Show a, Eq a) => a -> Obs a Source #

A constant observable.

Named observables

type VarName = String Source #

A variable name

primVar :: VarName -> Obs Double Source #

A named external real-valued observable

Example:

primVar "gas-price"

primCond :: VarName -> Obs Bool Source #

A named external condition observable

var :: VarName -> Obs Double Source #

A named interal contract program variable.

Usually you should use letin rather than this directly.

Time-based observables

type Time = UTCTime Source #

We use a continuous model of time.

mkdate :: Integer -> Int -> Int -> Time Source #

Convenience function to create a time from a date.

at :: Time -> Obs Bool Source #

An observable that becomes true at a single given point in time and is false at all other times.

before :: Time -> Obs Bool Source #

An observable that is true up to a given point in time and is false thereafter.

after :: Time -> Obs Bool Source #

An observable that becomes true after a given point in time and is false prior to that time.

between :: Time -> Time -> Obs Bool Source #

An observable that is true between two given points in time and is false at all other times.

between t1 t2 = time >= t1 && time < t2

Operators

Comparison, logical and numeric operators

(%==) :: Obs Double -> Obs Double -> Obs Bool infix 4 Source #

(%>) :: Obs Double -> Obs Double -> Obs Bool infix 4 Source #

(%>=) :: Obs Double -> Obs Double -> Obs Bool infix 4 Source #

(%<) :: Obs Double -> Obs Double -> Obs Bool infix 4 Source #

(%<=) :: Obs Double -> Obs Double -> Obs Bool infix 4 Source #

(%&&) :: Obs Bool -> Obs Bool -> Obs Bool infixr 3 Source #

(%||) :: Obs Bool -> Obs Bool -> Obs Bool infixr 2 Source #

(%+) :: Obs Double -> Obs Double -> Obs Double infixl 6 Source #

(%-) :: Obs Double -> Obs Double -> Obs Double infixl 6 Source #

(%*) :: Obs Double -> Obs Double -> Obs Double infixl 7 Source #

(%/) :: Obs Double -> Obs Double -> Obs Double infixl 7 Source #

Other observable functions

ifthen :: Obs Bool -> Obs a -> Obs a -> Obs a Source #

if..then..else for observables (returns an observable)

negate :: Num a => a -> a #

Unary negation.

not :: Obs Bool -> Obs Bool Source #

Negate a boolean observable

abs :: Num a => a -> a #

Absolute value.

Other utilities on observables

Parsing

parseObsCond :: XMLParser (Obs Bool) Source #

XML parser for condition observables

parseObsReal :: XMLParser (Obs Double) Source #

XML parser for real-valued observables

printObs :: Obs a -> Content () Source #

Create XML tags

Evaluating

eval :: Time -> Obs a -> Steps a Source #

Evaluate an observable at a given time

data Steps a Source #

Instances

Show a => Show (Steps a) Source # 

Methods

showsPrec :: Int -> Steps a -> ShowS #

show :: Steps a -> String #

showList :: [Steps a] -> ShowS #

subst :: VarName -> Double -> Obs a -> Obs a Source #

Analysing

isTrue :: Time -> Obs Bool -> Bool Source #

Check if an observable is known to be true at a given point in time, independent of knowledge of any external observables

isFalse :: Time -> Obs Bool -> Bool Source #

Check if an observable is known to be false at a given point in time, independent of knowledge of any external observables

nextTrue :: Time -> Obs Bool -> Maybe Time Source #

The next time that an observable is guaranteed to become true

nextFalse :: Time -> Obs Bool -> Maybe Time Source #

The next time that an observable is guaranteed to become false

timeHorizon :: Time -> Obs Bool -> Maybe Time Source #

The time horizon of an condition observable is earliest time that it guaranteed to become true (or Nothing if there is no such time)

earliestTimeHorizon :: Time -> [(Obs Bool, a)] -> Maybe (Time, a) Source #

Return the earliest time horizon of a set of observables and the associate tag of the observable that has the earliest time horizon (or Nothing if none of the observables have a time horizon)