netrium-0.6.0: Contract normaliser and simulator

Safe HaskellNone
LanguageHaskell98

Contract

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

The definition of the basic contract language

Synopsis

Contracts

The contract type and primitives

zero :: Contract Source #

The zero contract has no rights and no obligations.

one :: Tradeable -> Contract Source #

If you acquire one t you immediately recieve one unit of the Tradeable t.

and :: Contract -> Contract -> Contract Source #

If you acquire c1 and c2 you immediately acquire both c1 and c2.

give :: Contract -> Contract Source #

Swap the rights and obligations of the party and counterparty.

party :: PartyName -> Contract -> Contract Source #

Make a contract with a named 3rd party as the counterparty.

or :: ChoiceId -> Contract -> Contract -> Contract Source #

If you acquire c1 or c2 you immediately acquire your choice of either c1 or c2.

cond :: Obs Bool -> Contract -> Contract -> Contract Source #

If you acquire cond obs c1 c2 then you acquire c1 if the observable obs is true at the moment of acquistion, and c2 otherwise.

scale :: Obs ScaleFactor -> Contract -> Contract Source #

If you acquire scale obs c, then you acquire c at the same moment except that all the subsequent trades of c are multiplied by the value of the observable obs at the moment of acquistion.

type ScaleFactor = Double Source #

Scaling factor (used to scale the One contract)

when :: Obs Bool -> Contract -> Contract Source #

If you acquire when obs c, you must acquire c as soon as observable obs subsequently becomes true.

anytime :: ChoiceId -> Obs Bool -> Contract -> Contract Source #

Once you acquire anytime obs c, you may acquire c at any time the observable obs is true.

until :: Obs Bool -> Contract -> Contract Source #

Once acquired, until obs c is exactly like c except that it /must be abandoned/ when observable obs becomes true.

read :: Var -> Obs Double -> Contract -> Contract Source #

Deprecated: Use letin instead.

letin Source #

Arguments

:: String

A unique variable name

-> Obs Double

The observable to observe now

-> (Obs Double -> Contract)

The contract using the observed value

-> Contract 

Observe the value of an observable now and save its value to use later.

Currently this requires a unique variable name.

Example:

letin "count" (count-1) $ \count' ->
  ...

Tradable items

data Tradeable Source #

A canonical tradeable element, physical or financial

Instances

newtype Commodity Source #

Commodity, e.g. Gas, Electricity

Constructors

Commodity String 

Instances

newtype Unit Source #

Unit, e.g. tonnes, MWh

Constructors

Unit String 

Instances

Eq Unit Source # 

Methods

(==) :: Unit -> Unit -> Bool #

(/=) :: Unit -> Unit -> Bool #

Show Unit Source # 

Methods

showsPrec :: Int -> Unit -> ShowS #

show :: Unit -> String #

showList :: [Unit] -> ShowS #

XmlContent Unit Source # 

Methods

parseContents :: XMLParser Unit

toContents :: Unit -> [Content ()]

xToChar :: Unit -> Char

xFromChar :: Char -> Unit

HTypeable Unit Source # 

Methods

toHType :: Unit -> HType

newtype Location Source #

Location, e.g. UK, EU

Constructors

Location String 

Instances

Eq Location Source # 
Show Location Source # 
XmlContent Location Source # 

Methods

parseContents :: XMLParser Location

toContents :: Location -> [Content ()]

xToChar :: Location -> Char

xFromChar :: Char -> Location

HTypeable Location Source # 

Methods

toHType :: Location -> HType

newtype Duration Source #

A duration is a span of time, measured in seconds.

Constructors

Duration Int 

newtype Currency Source #

Currency, e.g. EUR, USD, GBP

Constructors

Currency String 

Instances

Eq Currency Source # 
Show Currency Source # 
XmlContent Currency Source # 

Methods

parseContents :: XMLParser Currency

toContents :: Currency -> [Content ()]

xToChar :: Currency -> Char

xFromChar :: Char -> Currency

HTypeable Currency Source # 

Methods

toHType :: Currency -> HType

newtype CashFlowType Source #

Cashflow type, e.g. cash, premium

Constructors

CashFlowType String 

newtype Portfolio Source #

Portfolio name

Constructors

Portfolio String 

Instances

Choice identifiers

type ChoiceId = String Source #

Choice label, used for options

type PartyName = String Source #

Name of a third party mentioned in a contract

Observables

data Obs a 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

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.

var :: VarName -> Obs Double Source #

A named interal contract program variable.

Usually you should use letin rather than this directly.

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

type Time = UTCTime Source #

We use a continuous model of time.

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

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.

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

Absolute value.

(%==) :: 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 #