-- kontrakt typu:
-- 30.6.2000 si smite vybrat, zda:
--   a) 29.1.2001 dostanete 100$ a 1.2.2002 vratite 105$, nebo
--   b) 15.12.2000 si budete moct vybrat mezi
--       i) 29.1.2001 dostat 100$ a 1.2.2002 vratit 106$, nebo
--       ii) 29.1.2001 dostat 100$ a 1.2.2003 vratit 112$.

-- jak popsat takovy kontrakt, a umoznit jeho zpracovani
--   (vygenerovani smluv, urceni hodnoty, ...)?

-- zcb::Date->Double->Currency->Contract
-- zcb datum x mena -- v datum dostanete castku x mena
c1 = zcb t1 100 USD
c2 = zcb t2 200 USD

-- and::Contract->Contract->Contract
-- spojeni dvou kontraktu
c3 = c1 `and` c2

-- give::Contract->Contract
-- obraceni kontraktu (misto toho, abych prijimal, davam)
andGive k1 k2 = k1 `and` give k2
c4 = c1 `andGive` c2

-- vlastnosti kontraktu:
--   "acquisition date" -- datum ziskani kontraktu, do uvahy se berou pouze prava
--			   a povinnosti po tomto datu
--   "horizon"		-- maximalni datum, kdy lze ziskat kontrakt (urceno kontraktem,
--			   nemusi se nutne vztahovat k datum prav/povinnosti z kontraktu)
-- 1.1.2001 se rozhodnete, zda ziskate kontrakt C ma horizon 1.1.2001, ale dusledky C
--    (typicky) pozdeji

-- primitivni kombinatory:

-- zero::Contract
-- zadna prava ani povinnosti, neomezeny horizon

-- one::Currency->Contract
-- okamzite ziskate jednu jednotku meny; horizon je neomezeny

-- give::Contract->Contract
-- obraceni kontraktu.  Ziskam-li q, druha strana kontraktu ziska (give q)

-- and::Contract->Contract->Contract
-- and c1 c2 ziska c1 (pokud nevyprsel) a c2 (pokud nevyprsel); vyprsi, pokud vyprsi jak c1 tak c2

-- or::Contract->Contract->Contract
-- or c1 c2 -- vyber ze c1 (pokud nevyprsel) a c2 (pokud nevyprsel); vyprsi, pokud vyprsi jak c1 tak c2

-- truncate::Date->Contract->Date
-- nastavi horizon kontraktu na minimum z puvodniho horizonu a data

-- thn::Contract->Contract->Contract
-- pokud ziskate c1 `thn` c2 a c1 nevyprselo, ziskate c1, jinak c2.  Vyprsi, pokud vyprsi jak c1 tak c2

-- scale::Obs Double -> Contract -> Contract
-- scale o c -- prava a povinnosti kontraktu c se znasobi hodnotou o v okamziku ziskani kontraktu

-- get::Contract->Contract
-- pokud ziskate get c, musite ziskat c v okamziku vyprseni jeho horizonu.  Vyprsi, kdyz c vyprsi

-- anytime::Contract->Contract
-- pokud ziskate anytime c, musite ziskat c kdykoliv predtim, nez c vyprsi.  Vyprsi, kdyz c vyprsi

zcb datum x mena = scaleK x (get (truncate datum (one mena)))

-- observable -- cokoliv, jehoz hodnota se da urcit v dany okamzik
data Obs a = Obs (Datum->a)

-- "veno me dcery bude jeji vaha ve zlate":
-- vahaDcery::Obs Double
-- veno1 = get $ truncate datumSvatby $ scale vahaDcery (one Gold)
-- "veno me dcery je jeji aktualni vaha ve zlate v okamziku uzavreni smlouvy":
-- veno2 = scale vahaDcery $ get $ truncate datumSvatby $ one Gold

konst x = Obs (const x)
scaleK x = scale (konst x)

-- s observably se da pocitat, a provadet dalsi operace
-- instance Num a => Num (Obs a)

-- "European option" -- v dany okamzik si smite zvolit, zda ziskate nejaky kontrakt
perhaps datum c = truncate t (c `or` zero)
european datum c = get (perhaps datum c)

-- "American option" -- v rozmezi dat lze (ale neni nutne) kdykoliv ziskat kontrakt c
-- pred datem d1 lze ziskat pouze moznost ziskat opt v datu d1.  Po d1 lze kdykoliv
-- ziskat opt (moznost vybrat si mezi c a nicim, do data d2)
american (d1, d2) c = get (truncate d1 opt) `thn` opt
  where
    opt = anytime (perhaps d2 c)

time od = Obs (\d -> d `diffDate` od)
lift::(a->b)->Obs a->Obs b
lift f (Obs o) = Obs (\x -> f (o x))
-- ...

-- reprezentace kontraktu
data Contract = Zero
		| One Currency
		| Give Contract
		| Or Contract
		| And Contract
		| Truncate Date Contract
		| Then Contract Contract
		| Scale (Obs Double) Contract
		| Get Contract
		| AnyTime Contract
zero = zero
one = One
or = Or
and = And
truncate = Truncate
thn = Then
scale = Scale
get = Get
anyTime = AnyTime

-- hodnota kontraktu

...

-- pomocne funkce a deklarace

data Currency = USD | GBP | CZK 

type Date = Double

-- date::String->Date
-- t1 = date "1530GMT 1 Jan 2010"
-- t2 = date "1230GMT 1 Feb 2010"
t1 = 0
t2 = 31.125

diffDate::Date->Date->Double
diffDate = (-)

addDate::Date->Double->Date
addDate = (+)