67 lines
2.4 KiB
Plaintext
67 lines
2.4 KiB
Plaintext
!import "base" !Local
|
|
!import "list" !Local
|
|
!import "contracts" !Local
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Contracts + interaction trees with `do` notation
|
|
--
|
|
-- The `do` keyword takes a monadic bind operator. Here we use `bindM` from
|
|
-- `lib/contracts.tri` to sequence pure, contract-checked computations.
|
|
--
|
|
-- checkM contract value -- lift a contract failure into the tree
|
|
-- exceptE tag value k -- a resumable failure carrying a continuation
|
|
-- handleM tag handler tree -- rewrite matching exceptions
|
|
-- runM tree -- interpret the tree into a Result
|
|
--
|
|
-- A handler receives the exception value and the resumption continuation `k`.
|
|
-- It may resume by calling `k value`, or it may replace the failing action with
|
|
-- a new tree of its own.
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
positive? = guardC "expected positive integer" (n : gte? n 1)
|
|
nonEmpty? = guardC "expected non-empty list" (xs : not? (emptyList? xs))
|
|
|
|
-- Average a list. Fails with a contract exception if the list is empty.
|
|
average = (xs :
|
|
do bindM
|
|
_ <- checkM nonEmpty? xs
|
|
n <- pureM (length xs)
|
|
_ <- checkM positive? n
|
|
total <- pureM (sum xs)
|
|
pureM (div total n))
|
|
|
|
-- A resumable config lookup. When the key is missing, callers can supply a
|
|
-- value by handling the "missing" exception.
|
|
lookupConfig = (key defaultValue :
|
|
exceptE "missing" key (resume : pureM defaultValue))
|
|
|
|
-- A pipeline that averages a list and divides by a configured divisor.
|
|
pipeline = (xs :
|
|
do bindM
|
|
divisor <- lookupConfig "divisor" 1
|
|
avg <- average xs
|
|
scaled <- liftM (x : div x divisor) avg
|
|
pureM scaled)
|
|
|
|
-- Without a handler the missing-key exception reaches runM.
|
|
unhandled = runM (pipeline [10 20 30])
|
|
-- < unhandled
|
|
-- > [t, "divisor"]
|
|
|
|
-- With a handler we replace the missing divisor with 2, so 20 / 2 = 10.
|
|
withHandler = runM (handleM "missing" (key k : pureM 2) (pipeline [10 20 30]))
|
|
-- < withHandler
|
|
-- > [t t, 10]
|
|
|
|
-- Handler can also use the original default by calling the resumption.
|
|
withResume = runM (handleM "missing" (key k : k 2) (pipeline [10 20 30]))
|
|
-- < withResume
|
|
-- > [t t, 20]
|
|
|
|
-- Contract failures still propagate through handlers for other tags.
|
|
bothFail = runM (handleM "missing" (key k : pureM 2) (pipeline []))
|
|
-- < bothFail
|
|
-- > [t, "expected non-empty list"]
|
|
|
|
main = withHandler
|